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> */
34 #include "redisplay.h"
36 #include "window.h" /* minibuf_level */
38 #include "file-coding.h"
41 #ifdef HAVE_LIBGEN_H /* Must come before sysfile.h */
54 #endif /* HPUX_PRE_8_0 */
62 #endif /* not WINDOWSNT */
65 #define CORRECT_DIR_SEPS(s) \
66 do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
67 else unixtodos_filename (s); \
69 #define IS_DRIVE(x) isalpha (x)
70 /* Need to lower-case the drive letter, or else expanded
71 filenames will sometimes compare inequal, because
72 `expand-file-name' doesn't always down-case the drive letter. */
73 #define DRIVE_LETTER(x) tolower (x)
74 #endif /* WINDOWSNT */
76 int lisp_to_time (Lisp_Object, time_t *);
77 Lisp_Object time_to_lisp (time_t);
79 /* Nonzero during writing of auto-save files */
80 static int auto_saving;
82 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal
83 will create a new file with the same mode as the original */
84 static int auto_save_mode_bits;
86 /* Alist of elements (REGEXP . HANDLER) for file names
87 whose I/O is done with a special handler. */
88 Lisp_Object Vfile_name_handler_alist;
90 /* Format for auto-save files */
91 Lisp_Object Vauto_save_file_format;
93 /* Lisp functions for translating file formats */
94 Lisp_Object Qformat_decode, Qformat_annotate_function;
96 /* Functions to be called to process text properties in inserted file. */
97 Lisp_Object Vafter_insert_file_functions;
99 /* Functions to be called to create text property annotations for file. */
100 Lisp_Object Vwrite_region_annotate_functions;
102 /* During build_annotations, each time an annotation function is called,
103 this holds the annotations made by the previous functions. */
104 Lisp_Object Vwrite_region_annotations_so_far;
106 /* File name in which we write a list of all our auto save files. */
107 Lisp_Object Vauto_save_list_file_name;
109 int disable_auto_save_when_buffer_shrinks;
111 Lisp_Object Vdirectory_sep_char;
113 /* These variables describe handlers that have "already" had a chance
114 to handle the current operation.
116 Vinhibit_file_name_handlers is a list of file name handlers.
117 Vinhibit_file_name_operation is the operation being handled.
118 If we try to handle that operation, we ignore those handlers. */
120 static Lisp_Object Vinhibit_file_name_handlers;
121 static Lisp_Object Vinhibit_file_name_operation;
123 Lisp_Object Qfile_error, Qfile_already_exists;
125 Lisp_Object Qauto_save_hook;
126 Lisp_Object Qauto_save_error;
127 Lisp_Object Qauto_saving;
129 Lisp_Object Qcar_less_than_car;
131 Lisp_Object Qcompute_buffer_file_truename;
133 EXFUN (Frunning_temacs_p, 0);
135 /* signal a file error when errno contains a meaningful value. */
138 report_file_error (const char *string, Lisp_Object data)
140 /* #### dmoore - This uses current_buffer, better make sure no one
141 has GC'd the current buffer. File handlers are giving me a headache
142 maybe I'll just always protect current_buffer around all of those
145 signal_error (Qfile_error,
146 Fcons (build_translated_string (string),
147 Fcons (lisp_strerror (errno), data)));
151 maybe_report_file_error (const char *string, Lisp_Object data,
152 Lisp_Object class, Error_behavior errb)
155 if (ERRB_EQ (errb, ERROR_ME_NOT))
158 maybe_signal_error (Qfile_error,
159 Fcons (build_translated_string (string),
160 Fcons (lisp_strerror (errno), data)),
164 /* signal a file error when errno does not contain a meaningful value. */
167 signal_file_error (const char *string, Lisp_Object data)
169 signal_error (Qfile_error,
170 list2 (build_translated_string (string), data));
174 maybe_signal_file_error (const char *string, Lisp_Object data,
175 Lisp_Object class, Error_behavior errb)
178 if (ERRB_EQ (errb, ERROR_ME_NOT))
180 maybe_signal_error (Qfile_error,
181 list2 (build_translated_string (string), data),
186 signal_double_file_error (const char *string1, const char *string2,
189 signal_error (Qfile_error,
190 list3 (build_translated_string (string1),
191 build_translated_string (string2),
196 maybe_signal_double_file_error (const char *string1, const char *string2,
197 Lisp_Object data, Lisp_Object class,
201 if (ERRB_EQ (errb, ERROR_ME_NOT))
203 maybe_signal_error (Qfile_error,
204 list3 (build_translated_string (string1),
205 build_translated_string (string2),
211 signal_double_file_error_2 (const char *string1, const char *string2,
212 Lisp_Object data1, Lisp_Object data2)
214 signal_error (Qfile_error,
215 list4 (build_translated_string (string1),
216 build_translated_string (string2),
221 maybe_signal_double_file_error_2 (const char *string1, const char *string2,
222 Lisp_Object data1, Lisp_Object data2,
223 Lisp_Object class, Error_behavior errb)
226 if (ERRB_EQ (errb, ERROR_ME_NOT))
228 maybe_signal_error (Qfile_error,
229 list4 (build_translated_string (string1),
230 build_translated_string (string2),
236 /* Just like strerror(3), except return a lisp string instead of char *.
237 The string needs to be converted since it may be localized.
238 Perhaps this should use strerror-coding-system instead? */
240 lisp_strerror (int errnum)
242 return build_ext_string (strerror (errnum), Qnative);
246 close_file_unwind (Lisp_Object fd)
250 if (INTP (XCAR (fd)))
251 close (XINT (XCAR (fd)));
253 free_cons (XCONS (fd));
262 delete_stream_unwind (Lisp_Object stream)
264 Lstream_delete (XLSTREAM (stream));
268 /* Restore point, having saved it as a marker. */
271 restore_point_unwind (Lisp_Object point_marker)
273 BUF_SET_PT (current_buffer, marker_position (point_marker));
274 return Fset_marker (point_marker, Qnil, Qnil);
277 /* Versions of read() and write() that allow quitting out of the actual
278 I/O. We don't use immediate_quit (i.e. direct longjmp() out of the
279 signal handler) because that's way too losing.
281 (#### Actually, longjmp()ing out of the signal handler may not be
282 as losing as I thought. See sys_do_signal() in sysdep.c.) */
285 read_allowing_quit (int fildes, void *buf, size_t size)
288 return sys_read_1 (fildes, buf, size, 1);
292 write_allowing_quit (int fildes, const void *buf, size_t size)
295 return sys_write_1 (fildes, buf, size, 1);
299 Lisp_Object Qexpand_file_name;
300 Lisp_Object Qfile_truename;
301 Lisp_Object Qsubstitute_in_file_name;
302 Lisp_Object Qdirectory_file_name;
303 Lisp_Object Qfile_name_directory;
304 Lisp_Object Qfile_name_nondirectory;
305 Lisp_Object Qunhandled_file_name_directory;
306 Lisp_Object Qfile_name_as_directory;
307 Lisp_Object Qcopy_file;
308 Lisp_Object Qmake_directory_internal;
309 Lisp_Object Qdelete_directory;
310 Lisp_Object Qdelete_file;
311 Lisp_Object Qrename_file;
312 Lisp_Object Qadd_name_to_file;
313 Lisp_Object Qmake_symbolic_link;
314 Lisp_Object Qfile_exists_p;
315 Lisp_Object Qfile_executable_p;
316 Lisp_Object Qfile_readable_p;
317 Lisp_Object Qfile_symlink_p;
318 Lisp_Object Qfile_writable_p;
319 Lisp_Object Qfile_directory_p;
320 Lisp_Object Qfile_regular_p;
321 Lisp_Object Qfile_accessible_directory_p;
322 Lisp_Object Qfile_modes;
323 Lisp_Object Qset_file_modes;
324 Lisp_Object Qfile_newer_than_file_p;
325 Lisp_Object Qinsert_file_contents;
326 Lisp_Object Qwrite_region;
327 Lisp_Object Qverify_visited_file_modtime;
328 Lisp_Object Qset_visited_file_modtime;
330 /* If FILENAME is handled specially on account of its syntax,
331 return its handler function. Otherwise, return nil. */
333 DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
334 Return FILENAME's handler function for OPERATION, if it has one.
335 Otherwise, return nil.
336 A file name is handled if one of the regular expressions in
337 `file-name-handler-alist' matches it.
339 If OPERATION equals `inhibit-file-name-operation', then we ignore
340 any handlers that are members of `inhibit-file-name-handlers',
341 but we still do run any other handlers. This lets handlers
342 use the standard functions without calling themselves recursively.
344 (filename, operation))
346 /* This function does not GC */
347 /* This function can be called during GC */
348 /* This function must not munge the match data. */
349 Lisp_Object chain, inhibited_handlers;
351 CHECK_STRING (filename);
353 if (EQ (operation, Vinhibit_file_name_operation))
354 inhibited_handlers = Vinhibit_file_name_handlers;
356 inhibited_handlers = Qnil;
358 EXTERNAL_LIST_LOOP (chain, Vfile_name_handler_alist)
360 Lisp_Object elt = XCAR (chain);
363 Lisp_Object string = XCAR (elt);
365 && (fast_lisp_string_match (string, filename) >= 0))
367 Lisp_Object handler = XCDR (elt);
368 if (NILP (Fmemq (handler, inhibited_handlers)))
378 call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
380 /* This function can call lisp */
381 Lisp_Object result = call2 (fn, arg0, arg1);
382 CHECK_STRING (result);
387 call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
389 /* This function can call lisp */
390 Lisp_Object result = call2 (fn, arg0, arg1);
392 CHECK_STRING (result);
397 call3_check_string (Lisp_Object fn, Lisp_Object arg0,
398 Lisp_Object arg1, Lisp_Object arg2)
400 /* This function can call lisp */
401 Lisp_Object result = call3 (fn, arg0, arg1, arg2);
402 CHECK_STRING (result);
407 DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
408 Return the directory component in file name NAME.
409 Return nil if NAME does not include a directory.
410 Otherwise return a directory spec.
411 Given a Unix syntax file name, returns a string ending in slash.
415 /* This function can GC. GC checked 1997.04.06. */
422 /* If the file name has special constructs in it,
423 call the corresponding file handler. */
424 handler = Ffind_file_name_handler (file, Qfile_name_directory);
426 return call2_check_string_or_nil (handler, Qfile_name_directory, file);
428 #ifdef FILE_SYSTEM_CASE
429 file = FILE_SYSTEM_CASE (file);
431 beg = XSTRING_DATA (file);
432 p = beg + XSTRING_LENGTH (file);
434 while (p != beg && !IS_ANY_SEP (p[-1])
436 /* only recognize drive specifier at beginning */
437 && !(p[-1] == ':' && p == beg + 2)
444 /* Expansion of "c:" to drive and default directory. */
445 /* (NT does the right thing.) */
446 if (p == beg + 2 && beg[1] == ':')
448 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
449 Bufbyte *res = (Bufbyte*) alloca (MAXPATHLEN + 1);
450 if (getdefdir (toupper (*beg) - 'A' + 1, (char *)res))
452 char *c=((char *) res) + strlen ((char *) res);
453 if (!IS_DIRECTORY_SEP (*c))
455 *c++ = DIRECTORY_SEP;
459 p = beg + strlen ((char *) beg);
462 #endif /* WINDOWSNT */
463 return make_string (beg, p - beg);
466 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
467 Return file name NAME sans its directory.
468 For example, in a Unix-syntax file name,
469 this is everything after the last slash,
470 or the entire name if it contains no slash.
474 /* This function can GC. GC checked 1997.04.06. */
475 Bufbyte *beg, *p, *end;
480 /* If the file name has special constructs in it,
481 call the corresponding file handler. */
482 handler = Ffind_file_name_handler (file, Qfile_name_nondirectory);
484 return call2_check_string (handler, Qfile_name_nondirectory, file);
486 beg = XSTRING_DATA (file);
487 end = p = beg + XSTRING_LENGTH (file);
489 while (p != beg && !IS_ANY_SEP (p[-1])
491 /* only recognize drive specifier at beginning */
492 && !(p[-1] == ':' && p == beg + 2)
496 return make_string (p, end - p);
499 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
500 Return a directly usable directory name somehow associated with FILENAME.
501 A `directly usable' directory name is one that may be used without the
502 intervention of any file handler.
503 If FILENAME is a directly usable file itself, return
504 \(file-name-directory FILENAME).
505 The `call-process' and `start-process' functions use this function to
506 get a current directory to run processes in.
510 /* This function can GC. GC checked 1997.04.06. */
513 /* If the file name has special constructs in it,
514 call the corresponding file handler. */
515 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
517 return call2 (handler, Qunhandled_file_name_directory,
520 return Ffile_name_directory (filename);
525 file_name_as_directory (char *out, char *in)
527 int size = strlen (in);
532 out[1] = DIRECTORY_SEP;
538 /* Append a slash if necessary */
539 if (!IS_ANY_SEP (out[size-1]))
541 out[size] = DIRECTORY_SEP;
542 out[size + 1] = '\0';
548 DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
549 Return a string representing file FILENAME interpreted as a directory.
550 This operation exists because a directory is also a file, but its name as
551 a directory is different from its name as a file.
552 The result can be used as the value of `default-directory'
553 or passed as second argument to `expand-file-name'.
554 For a Unix-syntax file name, just appends a slash,
555 except for (file-name-as-directory \"\") => \"./\".
559 /* This function can GC. GC checked 1997.04.06. */
565 /* If the file name has special constructs in it,
566 call the corresponding file handler. */
567 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
569 return call2_check_string (handler, Qfile_name_as_directory, file);
571 buf = (char *) alloca (XSTRING_LENGTH (file) + 10);
572 return build_string (file_name_as_directory
573 (buf, (char *) XSTRING_DATA (file)));
577 * Convert from directory name to filename.
578 * On UNIX, it's simple: just make sure there isn't a terminating /
580 * Value is nonzero if the string output is different from the input.
584 directory_file_name (const char *src, char *dst)
586 long slen = strlen (src);
587 /* Process as Unix format: just remove any final slash.
588 But leave "/" unchanged; do not change it to "". */
591 && IS_DIRECTORY_SEP (dst[slen - 1])
593 && !IS_ANY_SEP (dst[slen - 2])
594 #endif /* WINDOWSNT */
600 DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
601 Return the file name of the directory named DIR.
602 This is the name of the file that holds the data for the directory DIR.
603 This operation exists because a directory is also a file, but its name as
604 a directory is different from its name as a file.
605 In Unix-syntax, this function just removes the final slash.
609 /* This function can GC. GC checked 1997.04.06. */
613 CHECK_STRING (directory);
615 #if 0 /* #### WTF? */
616 if (NILP (directory))
620 /* If the file name has special constructs in it,
621 call the corresponding file handler. */
622 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
624 return call2_check_string (handler, Qdirectory_file_name, directory);
625 buf = (char *) alloca (XSTRING_LENGTH (directory) + 20);
626 directory_file_name ((char *) XSTRING_DATA (directory), buf);
627 return build_string (buf);
630 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
631 proved too broken for our purposes (it supported only 26 or 62
632 unique names under some implementations). For example, this
633 arbitrary limit broke generation of Gnus Incoming* files.
635 This implementation is better than what one usually finds in libc.
638 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
639 Generate temporary file name starting with PREFIX.
640 The Emacs process number forms part of the result, so there is no
641 danger of generating a name being used by another process.
643 In addition, this function makes an attempt to choose a name that
644 does not specify an existing file. To make this work, PREFIX should
645 be an absolute file name.
649 static char tbl[64] = {
650 'A','B','C','D','E','F','G','H',
651 'I','J','K','L','M','N','O','P',
652 'Q','R','S','T','U','V','W','X',
653 'Y','Z','a','b','c','d','e','f',
654 'g','h','i','j','k','l','m','n',
655 'o','p','q','r','s','t','u','v',
656 'w','x','y','z','0','1','2','3',
657 '4','5','6','7','8','9','-','_' };
658 static unsigned count, count_initialized_p;
665 CHECK_STRING (prefix);
667 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
670 1) It might change the prefix, so the resulting string might not
671 begin with PREFIX. This violates the principle of least
674 2) It breaks under many unforeseeable circumstances, such as with
675 the code that uses (make-temp-name "") instead of
676 (make-temp-name "./").
678 3) It might yield unexpected (to stat(2)) results in the presence
679 of EFS and file name handlers. */
681 len = XSTRING_LENGTH (prefix);
682 val = make_uninit_string (len + 6);
683 data = XSTRING_DATA (val);
684 memcpy (data, XSTRING_DATA (prefix), len);
687 /* VAL is created by adding 6 characters to PREFIX. The first three
688 are the PID of this process, in base 64, and the second three are
689 incremented if the file already exists. This ensures 262144
690 unique file names per PID per PREFIX. */
692 pid = (unsigned)getpid ();
693 *p++ = tbl[pid & 63], pid >>= 6;
694 *p++ = tbl[pid & 63], pid >>= 6;
695 *p++ = tbl[pid & 63], pid >>= 6;
697 /* Here we try to minimize useless stat'ing when this function is
698 invoked many times successively with the same PREFIX. We achieve
699 this by initializing count to a random value, and incrementing it
701 if (!count_initialized_p)
703 count = (unsigned)time (NULL);
704 /* Dumping temacs with a non-zero count_initialized_p wouldn't
706 if (NILP (Frunning_temacs_p ()))
707 count_initialized_p = 1;
713 unsigned num = count;
715 p[0] = tbl[num & 63], num >>= 6;
716 p[1] = tbl[num & 63], num >>= 6;
717 p[2] = tbl[num & 63], num >>= 6;
719 /* Poor man's congruential RN generator. Replace with ++count
726 if (stat ((const char *) data, &ignored) < 0)
728 /* We want to return only if errno is ENOENT. */
732 /* The error here is dubious, but there is little else we
733 can do. The alternatives are to return nil, which is
734 as bad as (and in many cases worse than) throwing the
735 error, or to ignore the error, which will likely result
737 report_file_error ("Cannot create temporary name for prefix",
739 return Qnil; /* not reached */
745 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
746 Convert filename NAME to absolute, and canonicalize it.
747 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
748 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
749 the current buffer's value of default-directory is used.
750 File name components that are `.' are removed, and
751 so are file name components followed by `..', along with the `..' itself;
752 note that these simplifications are done without checking the resulting
753 file names in the file system.
754 An initial `~/' expands to your home directory.
755 An initial `~USER/' expands to USER's home directory.
756 See also the function `substitute-in-file-name'.
758 (name, default_directory))
760 /* This function can GC */
763 Bufbyte *newdir, *p, *o;
768 int collapse_newdir = 1;
771 #endif /* WINDOWSNT */
780 /* If the file name has special constructs in it,
781 call the corresponding file handler. */
782 handler = Ffind_file_name_handler (name, Qexpand_file_name);
784 return call3_check_string (handler, Qexpand_file_name, name,
787 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
788 if (NILP (default_directory))
789 default_directory = current_buffer->directory;
790 if (! STRINGP (default_directory))
791 default_directory = build_string ("/");
793 if (!NILP (default_directory))
795 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
797 return call3 (handler, Qexpand_file_name, name, default_directory);
800 o = XSTRING_DATA (default_directory);
802 /* Make sure DEFAULT_DIRECTORY is properly expanded.
803 It would be better to do this down below where we actually use
804 default_directory. Unfortunately, calling Fexpand_file_name recursively
805 could invoke GC, and the strings might be relocated. This would
806 be annoying because we have pointers into strings lying around
807 that would need adjusting, and people would add new pointers to
808 the code and forget to adjust them, resulting in intermittent bugs.
809 Putting this call here avoids all that crud.
811 The EQ test avoids infinite recursion. */
812 if (! NILP (default_directory) && !EQ (default_directory, name)
813 /* Save time in some common cases - as long as default_directory
814 is not relative, it can be canonicalized with name below (if it
815 is needed at all) without requiring it to be expanded now. */
817 /* Detect MSDOS file names with drive specifiers. */
818 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
819 /* Detect Windows file names in UNC format. */
820 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
822 #else /* not WINDOWSNT */
824 /* Detect Unix absolute file names (/... alone is not absolute on
826 && ! (IS_DIRECTORY_SEP (o[0]))
827 #endif /* not WINDOWSNT */
833 default_directory = Fexpand_file_name (default_directory, Qnil);
837 #ifdef FILE_SYSTEM_CASE
838 name = FILE_SYSTEM_CASE (name);
841 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
842 into name should be safe during all of this, though. */
843 nm = XSTRING_DATA (name);
846 /* We will force directory separators to be either all \ or /, so make
847 a local copy to modify, even if there ends up being no change. */
848 nm = strcpy ((char *)alloca (strlen ((char *)nm) + 1), (char *)nm);
850 /* Find and remove drive specifier if present; this makes nm absolute
851 even if the rest of the name appears to be relative. */
853 Bufbyte *colon = (Bufbyte *) strrchr ((char *)nm, ':');
856 /* Only recognize colon as part of drive specifier if there is a
857 single alphabetic character preceding the colon (and if the
858 character before the drive letter, if present, is a directory
859 separator); this is to support the remote system syntax used by
860 ange-ftp, and the "po:username" syntax for POP mailboxes. */
864 else if (IS_DRIVE (colon[-1])
865 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
872 while (--colon >= nm)
878 /* If we see "c://somedir", we want to strip the first slash after the
879 colon when stripping the drive letter. Otherwise, this expands to
881 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
883 #endif /* WINDOWSNT */
885 /* If nm is absolute, look for /./ or /../ sequences; if none are
886 found, we can probably return right away. We will avoid allocating
887 a new string if name is already fully expanded. */
889 IS_DIRECTORY_SEP (nm[0])
891 && (drive || IS_DIRECTORY_SEP (nm[1]))
895 /* If it turns out that the filename we want to return is just a
896 suffix of FILENAME, we don't need to go through and edit
897 things; we just need to construct a new string using data
898 starting at the middle of FILENAME. If we set lose to a
899 non-zero value, that means we've discovered that we can't do
906 /* Since we know the name is absolute, we can assume that each
907 element starts with a "/". */
909 /* "." and ".." are hairy. */
910 if (IS_DIRECTORY_SEP (p[0])
912 && (IS_DIRECTORY_SEP (p[2])
914 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
922 /* Make sure directories are all separated with / or \ as
923 desired, but avoid allocation of a new string when not
925 CORRECT_DIR_SEPS (nm);
926 if (IS_DIRECTORY_SEP (nm[1]))
928 if (strcmp (nm, XSTRING_DATA (name)) != 0)
929 name = build_string (nm);
931 /* drive must be set, so this is okay */
932 else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0)
934 name = make_string (nm - 2, p - nm + 2);
935 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
936 XSTRING_DATA (name)[1] = ':';
939 #else /* not WINDOWSNT */
940 if (nm == XSTRING_DATA (name))
942 return build_string ((char *) nm);
943 #endif /* not WINDOWSNT */
947 /* At this point, nm might or might not be an absolute file name. We
948 need to expand ~ or ~user if present, otherwise prefix nm with
949 default_directory if nm is not absolute, and finally collapse /./
950 and /foo/../ sequences.
952 We set newdir to be the appropriate prefix if one is needed:
953 - the relevant user directory if nm starts with ~ or ~user
954 - the specified drive's working dir (DOS/NT only) if nm does not
956 - the value of default_directory.
958 Note that these prefixes are not guaranteed to be absolute (except
959 for the working dir of a drive). Therefore, to ensure we always
960 return an absolute name, if the final prefix is not absolute we
961 append it to the current working directory. */
965 if (nm[0] == '~') /* prefix ~ */
967 if (IS_DIRECTORY_SEP (nm[1])
968 || nm[1] == 0) /* ~ by itself */
970 Extbyte *newdir_external = get_home_directory ();
972 if (newdir_external == NULL)
973 newdir = (Bufbyte *) "";
975 TO_INTERNAL_FORMAT (C_STRING, newdir_external,
976 C_STRING_ALLOCA, (* ((char **) &newdir)),
984 else /* ~user/filename */
986 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
988 o = (Bufbyte *) alloca (p - nm + 1);
989 memcpy (o, (char *) nm, p - nm);
992 /* #### marcpa's syncing note: FSF uses getpwnam even on NT,
993 which does not work. The following works only if ~USER
994 names the user who runs this instance of XEmacs. While
995 NT is single-user (for the moment) you still can have
996 multiple user profiles users defined, each with its HOME.
997 Therefore, the following should be reworked to handle
1000 /* Now if the file given is "~foo/file" and HOME="c:/", then
1001 we want the file to be named "c:/file" ("~foo" becomes
1002 "c:/"). The variable o has "~foo", so we can use the
1003 length of that string to offset nm. August Hill, 31 Aug
1005 newdir = (Bufbyte *) get_home_directory();
1006 dostounix_filename (newdir);
1007 nm += strlen(o) + 1;
1008 #else /* not WINDOWSNT */
1010 if ((user = user_login_name (NULL)) != NULL)
1012 /* Does the user login name match the ~name? */
1013 if (strcmp (user, (char *) o + 1) == 0)
1015 newdir = (Bufbyte *) get_home_directory();
1021 #endif /* __CYGWIN32__ */
1022 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
1023 occurring in it. (It can call select()). */
1024 slow_down_interrupts ();
1025 pw = (struct passwd *) getpwnam ((char *) o + 1);
1026 speed_up_interrupts ();
1029 newdir = (Bufbyte *) pw -> pw_dir;
1035 #endif /* not WINDOWSNT */
1037 /* If we don't find a user of that name, leave the name
1038 unchanged; don't move nm forward to p. */
1043 /* On DOS and Windows, nm is absolute if a drive name was specified;
1044 use the drive's current directory as the prefix if needed. */
1045 if (!newdir && drive)
1047 /* Get default directory if needed to make nm absolute. */
1048 if (!IS_DIRECTORY_SEP (nm[0]))
1050 newdir = alloca (MAXPATHLEN + 1);
1051 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
1056 /* Either nm starts with /, or drive isn't mounted. */
1057 newdir = alloca (4);
1058 newdir[0] = DRIVE_LETTER (drive);
1064 #endif /* WINDOWSNT */
1066 /* Finally, if no prefix has been specified and nm is not absolute,
1067 then it must be expanded relative to default_directory. */
1071 /* /... alone is not absolute on DOS and Windows. */
1072 && !IS_DIRECTORY_SEP (nm[0])
1074 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1078 newdir = XSTRING_DATA (default_directory);
1084 /* First ensure newdir is an absolute name. */
1086 /* Detect MSDOS file names with drive specifiers. */
1087 ! (IS_DRIVE (newdir[0])
1088 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1089 /* Detect Windows file names in UNC format. */
1090 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1091 /* Detect drive spec by itself */
1092 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
1095 /* Effectively, let newdir be (expand-file-name newdir cwd).
1096 Because of the admonition against calling expand-file-name
1097 when we have pointers into lisp strings, we accomplish this
1098 indirectly by prepending newdir to nm if necessary, and using
1099 cwd (or the wd of newdir's drive) as the new newdir. */
1101 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1106 if (!IS_DIRECTORY_SEP (nm[0]))
1108 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
1109 file_name_as_directory (tmp, newdir);
1113 newdir = alloca (MAXPATHLEN + 1);
1116 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
1123 /* Strip off drive name from prefix, if present. */
1124 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1130 /* Keep only a prefix from newdir if nm starts with slash
1131 (/ /server/share for UNC, nothing otherwise). */
1132 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1134 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1136 newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
1138 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1140 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1147 #endif /* WINDOWSNT */
1151 /* Get rid of any slash at the end of newdir, unless newdir is
1152 just // (an incomplete UNC name). */
1153 length = strlen ((char *) newdir);
1154 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1156 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
1160 Bufbyte *temp = (Bufbyte *) alloca (length);
1161 memcpy (temp, newdir, length - 1);
1162 temp[length - 1] = 0;
1170 /* Now concatenate the directory and name to new space in the stack frame */
1171 tlen += strlen ((char *) nm) + 1;
1173 /* Add reserved space for drive name. (The Microsoft x86 compiler
1174 produces incorrect code if the following two lines are combined.) */
1175 target = (Bufbyte *) alloca (tlen + 2);
1177 #else /* not WINDOWSNT */
1178 target = (Bufbyte *) alloca (tlen);
1179 #endif /* not WINDOWSNT */
1184 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1185 strcpy ((char *) target, (char *) newdir);
1187 file_name_as_directory ((char *) target, (char *) newdir);
1190 strcat ((char *) target, (char *) nm);
1192 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1194 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1201 if (!IS_DIRECTORY_SEP (*p))
1205 else if (IS_DIRECTORY_SEP (p[0])
1207 && (IS_DIRECTORY_SEP (p[2])
1210 /* If "/." is the entire filename, keep the "/". Otherwise,
1211 just delete the whole "/.". */
1212 if (o == target && p[2] == '\0')
1216 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
1217 /* `/../' is the "superroot" on certain file systems. */
1219 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1221 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
1223 /* Keep initial / only if this is the whole name. */
1224 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1229 /* if drive is set, we're not dealing with an UNC, so
1230 multiple dir-seps are redundant (and reportedly cause trouble
1232 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1242 /* At last, set drive name, except for network file name. */
1246 target[0] = DRIVE_LETTER (drive);
1251 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
1253 CORRECT_DIR_SEPS (target);
1254 #endif /* WINDOWSNT */
1256 return make_string (target, o - target);
1259 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
1260 Return the canonical name of the given FILE.
1261 Second arg DEFAULT is directory to start with if FILE is relative
1262 (does not start with slash); if DEFAULT is nil or missing,
1263 the current buffer's value of default-directory is used.
1264 No component of the resulting pathname will be a symbolic link, as
1265 in the realpath() function.
1267 (filename, default_))
1269 /* This function can GC. */
1270 Lisp_Object expanded_name;
1271 struct gcpro gcpro1;
1273 CHECK_STRING (filename);
1275 expanded_name = Fexpand_file_name (filename, default_);
1277 GCPRO1 (expanded_name);
1279 if (!STRINGP (expanded_name))
1283 Lisp_Object handler =
1284 Ffind_file_name_handler (expanded_name, Qfile_truename);
1286 if (!NILP (handler))
1288 (call2_check_string (handler, Qfile_truename, expanded_name));
1292 char resolved_path[MAXPATHLEN];
1297 TO_EXTERNAL_FORMAT (LISP_STRING, expanded_name,
1298 ALLOCA, (path, elen),
1301 if (elen > MAXPATHLEN)
1304 /* Try doing it all at once. */
1305 /* !! Does realpath() Mule-encapsulate?
1306 Answer: Nope! So we do it above */
1307 if (!xrealpath ((char *) path, resolved_path))
1309 /* Didn't resolve it -- have to do it one component at a time. */
1310 /* "realpath" is a typically useless, stupid un*x piece of crap.
1311 It claims to return a useful value in the "error" case, but since
1312 there is no indication provided of how far along the pathname
1313 the function went before erring, there is no way to use the
1314 partial result returned. What a piece of junk.
1316 The above comment refers to historical versions of
1317 realpath(). The Unix98 specs state:
1319 "On successful completion, realpath() returns a
1320 pointer to the resolved name. Otherwise, realpath()
1321 returns a null pointer and sets errno to indicate the
1322 error, and the contents of the buffer pointed to by
1323 resolved_name are undefined."
1325 Since we depend on undocumented semantics of various system realpath()s,
1326 we just use our own version in realpath.c. */
1329 p = (Extbyte *) memchr (p + 1, '/', elen - (p + 1 - path));
1333 if (xrealpath ((char *) path, resolved_path))
1341 else if (errno == ENOENT || errno == EACCES)
1343 /* Failed on this component. Just tack on the rest of
1344 the string and we are done. */
1345 int rlen = strlen (resolved_path);
1347 /* "On failure, it returns NULL, sets errno to indicate
1348 the error, and places in resolved_path the absolute pathname
1349 of the path component which could not be resolved." */
1353 int plen = elen - (p - path);
1355 if (rlen > 1 && resolved_path[rlen - 1] == '/')
1358 if (plen + rlen + 1 > countof (resolved_path))
1361 resolved_path[rlen] = '/';
1362 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
1372 Lisp_Object resolved_name;
1373 int rlen = strlen (resolved_path);
1374 if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/'
1375 && !(rlen > 0 && resolved_path[rlen - 1] == '/'))
1377 if (rlen + 1 > countof (resolved_path))
1379 resolved_path[rlen++] = '/';
1380 resolved_path[rlen] = '\0';
1382 TO_INTERNAL_FORMAT (DATA, (resolved_path, rlen),
1383 LISP_STRING, resolved_name,
1385 RETURN_UNGCPRO (resolved_name);
1389 errno = ENAMETOOLONG;
1392 report_file_error ("Finding truename", list1 (expanded_name));
1394 RETURN_UNGCPRO (Qnil);
1398 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1399 Substitute environment variables referred to in FILENAME.
1400 `$FOO' where FOO is an environment variable name means to substitute
1401 the value of that variable. The variable name should be terminated
1402 with a character not a letter, digit or underscore; otherwise, enclose
1403 the entire variable name in braces.
1404 If `/~' appears, all of FILENAME through that `/' is discarded.
1409 /* This function can GC. GC checked 1997.04.06. */
1412 Bufbyte *s, *p, *o, *x, *endp;
1413 Bufbyte *target = 0;
1415 int substituted = 0;
1417 Lisp_Object handler;
1419 CHECK_STRING (string);
1421 /* If the file name has special constructs in it,
1422 call the corresponding file handler. */
1423 handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name);
1424 if (!NILP (handler))
1425 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
1428 nm = XSTRING_DATA (string);
1429 endp = nm + XSTRING_LENGTH (string);
1431 /* If /~ or // appears, discard everything through first slash. */
1433 for (p = nm; p != endp; p++)
1436 #if defined (WINDOWSNT) || defined (__CYGWIN32__)
1437 /* // at start of file name is meaningful in WindowsNT systems */
1438 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
1439 #else /* not (WINDOWSNT || __CYGWIN32__) */
1440 || IS_DIRECTORY_SEP (p[0])
1441 #endif /* not (WINDOWSNT || __CYGWIN32__) */
1444 && (IS_DIRECTORY_SEP (p[-1])))
1450 /* see comment in expand-file-name about drive specifiers */
1451 else if (IS_DRIVE (p[0]) && p[1] == ':'
1452 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1457 #endif /* WINDOWSNT */
1460 /* See if any variables are substituted into the string
1461 and find the total length of their values in `total' */
1463 for (p = nm; p != endp;)
1473 /* "$$" means a single "$" */
1482 while (p != endp && *p != '}') p++;
1483 if (*p != '}') goto missingclose;
1489 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1493 /* Copy out the variable name */
1494 target = (Bufbyte *) alloca (s - o + 1);
1495 strncpy ((char *) target, (char *) o, s - o);
1498 strupr (target); /* $home == $HOME etc. */
1499 #endif /* WINDOWSNT */
1501 /* Get variable value */
1502 o = (Bufbyte *) egetenv ((char *) target);
1503 if (!o) goto badvar;
1504 total += strlen ((char *) o);
1511 /* If substitution required, recopy the string and do it */
1512 /* Make space in stack frame for the new copy */
1513 xnm = (Bufbyte *) alloca (XSTRING_LENGTH (string) + total + 1);
1516 /* Copy the rest of the name through, replacing $ constructs with values */
1533 while (p != endp && *p != '}') p++;
1534 if (*p != '}') goto missingclose;
1540 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1544 /* Copy out the variable name */
1545 target = (Bufbyte *) alloca (s - o + 1);
1546 strncpy ((char *) target, (char *) o, s - o);
1549 strupr (target); /* $home == $HOME etc. */
1550 #endif /* WINDOWSNT */
1552 /* Get variable value */
1553 o = (Bufbyte *) egetenv ((char *) target);
1557 strcpy ((char *) x, (char *) o);
1558 x += strlen ((char *) o);
1563 /* If /~ or // appears, discard everything through first slash. */
1565 for (p = xnm; p != x; p++)
1567 #if defined (WINDOWSNT)
1568 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
1569 #else /* not WINDOWSNT */
1570 || IS_DIRECTORY_SEP (p[0])
1571 #endif /* not WINDOWSNT */
1573 /* don't do p[-1] if that would go off the beginning --jwz */
1574 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
1577 else if (IS_DRIVE (p[0]) && p[1] == ':'
1578 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1582 return make_string (xnm, x - xnm);
1585 error ("Bad format environment-variable substitution");
1587 error ("Missing \"}\" in environment-variable substitution");
1589 error ("Substituting nonexistent environment variable \"%s\"",
1593 return Qnil; /* suppress compiler warning */
1596 /* A slightly faster and more convenient way to get
1597 (directory-file-name (expand-file-name FOO)). */
1600 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1602 /* This function can call lisp */
1603 Lisp_Object abspath;
1604 struct gcpro gcpro1;
1606 abspath = Fexpand_file_name (filename, defdir);
1608 /* Remove final slash, if any (unless path is root).
1609 stat behaves differently depending! */
1610 if (XSTRING_LENGTH (abspath) > 1
1611 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
1612 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
1613 /* We cannot take shortcuts; they might be wrong for magic file names. */
1614 abspath = Fdirectory_file_name (abspath);
1619 /* Signal an error if the file ABSNAME already exists.
1620 If INTERACTIVE is nonzero, ask the user whether to proceed,
1621 and bypass the error if the user says to go ahead.
1622 QUERYSTRING is a name for the action that is being considered
1624 *STATPTR is used to store the stat information if the file exists.
1625 If the file does not exist, STATPTR->st_mode is set to 0. */
1628 barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
1629 int interactive, struct stat *statptr)
1631 /* This function can GC. GC checked 1997.04.06. */
1632 struct stat statbuf;
1634 /* stat is a good way to tell whether the file exists,
1635 regardless of what access permissions it has. */
1636 if (stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
1643 struct gcpro gcpro1;
1645 prompt = emacs_doprnt_string_c
1646 ((const Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
1647 Qnil, -1, XSTRING_DATA (absname),
1648 GETTEXT (querystring));
1651 tem = call1 (Qyes_or_no_p, prompt);
1658 Fsignal (Qfile_already_exists,
1659 list2 (build_translated_string ("File already exists"),
1667 statptr->st_mode = 0;
1672 DEFUN ("copy-file", Fcopy_file, 2, 4,
1673 "fCopy file: \nFCopy %s to file: \np\nP", /*
1674 Copy FILE to NEWNAME. Both args must be strings.
1675 Signals a `file-already-exists' error if file NEWNAME already exists,
1676 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1677 A number as third arg means request confirmation if NEWNAME already exists.
1678 This is what happens in interactive use with M-x.
1679 Fourth arg KEEP-TIME non-nil means give the new file the same
1680 last-modified time as the old one. (This works on only some systems.)
1681 A prefix arg makes KEEP-TIME non-nil.
1683 (filename, newname, ok_if_already_exists, keep_time))
1685 /* This function can GC. GC checked 1997.04.06. */
1687 char buf[16 * 1024];
1688 struct stat st, out_st;
1689 Lisp_Object handler;
1690 int speccount = specpdl_depth ();
1691 struct gcpro gcpro1, gcpro2;
1692 /* Lisp_Object args[6]; */
1693 int input_file_statable_p;
1695 GCPRO2 (filename, newname);
1696 CHECK_STRING (filename);
1697 CHECK_STRING (newname);
1698 filename = Fexpand_file_name (filename, Qnil);
1699 newname = Fexpand_file_name (newname, Qnil);
1701 /* If the input file name has special constructs in it,
1702 call the corresponding file handler. */
1703 handler = Ffind_file_name_handler (filename, Qcopy_file);
1704 /* Likewise for output file name. */
1706 handler = Ffind_file_name_handler (newname, Qcopy_file);
1707 if (!NILP (handler))
1710 return call5 (handler, Qcopy_file, filename, newname,
1711 ok_if_already_exists, keep_time);
1714 /* When second argument is a directory, copy the file into it.
1715 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1717 if (!NILP (Ffile_directory_p (newname)))
1719 Lisp_Object args[3];
1720 struct gcpro ngcpro1;
1724 args[1] = Qnil; args[2] = Qnil;
1727 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1728 args[i++] = build_string ("/");
1729 args[i++] = Ffile_name_nondirectory (filename);
1730 newname = Fconcat (i, args);
1734 if (NILP (ok_if_already_exists)
1735 || INTP (ok_if_already_exists))
1736 barf_or_query_if_file_exists (newname, "copy to it",
1737 INTP (ok_if_already_exists), &out_st);
1738 else if (stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
1741 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
1743 report_file_error ("Opening input file", list1 (filename));
1745 record_unwind_protect (close_file_unwind, make_int (ifd));
1747 /* We can only copy regular files and symbolic links. Other files are not
1749 input_file_statable_p = (fstat (ifd, &st) >= 0);
1752 if (out_st.st_mode != 0
1753 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1756 report_file_error ("Input and output files are the same",
1757 list2 (filename, newname));
1761 #if defined (S_ISREG) && defined (S_ISLNK)
1762 if (input_file_statable_p)
1764 if (!(S_ISREG (st.st_mode))
1765 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1767 && !(S_ISCHR (st.st_mode))
1769 && !(S_ISLNK (st.st_mode)))
1771 #if defined (EISDIR)
1772 /* Get a better looking error message. */
1775 report_file_error ("Non-regular file", list1 (filename));
1778 #endif /* S_ISREG && S_ISLNK */
1780 ofd = open( (char *) XSTRING_DATA (newname),
1781 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1783 report_file_error ("Opening output file", list1 (newname));
1786 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
1788 record_unwind_protect (close_file_unwind, ofd_locative);
1790 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
1792 if (write_allowing_quit (ofd, buf, n) != n)
1793 report_file_error ("I/O error", list1 (newname));
1796 /* Closing the output clobbers the file times on some systems. */
1797 if (close (ofd) < 0)
1798 report_file_error ("I/O error", list1 (newname));
1800 if (input_file_statable_p)
1802 if (!NILP (keep_time))
1804 EMACS_TIME atime, mtime;
1805 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1806 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1807 if (set_file_times ((char *) XSTRING_DATA (newname), atime,
1809 report_file_error ("I/O error", list1 (newname));
1811 chmod ((const char *) XSTRING_DATA (newname),
1812 st.st_mode & 07777);
1815 /* We'll close it by hand */
1816 XCAR (ofd_locative) = Qnil;
1819 unbind_to (speccount, Qnil);
1826 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1827 Create a directory. One argument, a file name string.
1831 /* This function can GC. GC checked 1997.04.06. */
1832 char dir [MAXPATHLEN];
1833 Lisp_Object handler;
1834 struct gcpro gcpro1;
1836 CHECK_STRING (dirname_);
1837 dirname_ = Fexpand_file_name (dirname_, Qnil);
1840 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
1842 if (!NILP (handler))
1843 return (call2 (handler, Qmake_directory_internal, dirname_));
1845 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
1847 return Fsignal (Qfile_error,
1848 list3 (build_translated_string ("Creating directory"),
1849 build_translated_string ("pathame too long"),
1852 strncpy (dir, (char *) XSTRING_DATA (dirname_),
1853 XSTRING_LENGTH (dirname_) + 1);
1855 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
1856 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
1858 if (mkdir (dir, 0777) != 0)
1859 report_file_error ("Creating directory", list1 (dirname_));
1864 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1865 Delete a directory. One argument, a file name or directory name string.
1869 /* This function can GC. GC checked 1997.04.06. */
1870 Lisp_Object handler;
1871 struct gcpro gcpro1;
1873 CHECK_STRING (dirname_);
1876 dirname_ = Fexpand_file_name (dirname_, Qnil);
1877 dirname_ = Fdirectory_file_name (dirname_);
1879 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
1881 if (!NILP (handler))
1882 return (call2 (handler, Qdelete_directory, dirname_));
1884 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
1885 report_file_error ("Removing directory", list1 (dirname_));
1890 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1891 Delete the file named FILENAME (a string).
1892 If FILENAME has multiple names, it continues to exist with the other names.
1896 /* This function can GC. GC checked 1997.04.06. */
1897 Lisp_Object handler;
1898 struct gcpro gcpro1;
1900 CHECK_STRING (filename);
1901 filename = Fexpand_file_name (filename, Qnil);
1904 handler = Ffind_file_name_handler (filename, Qdelete_file);
1906 if (!NILP (handler))
1907 return call2 (handler, Qdelete_file, filename);
1909 if (0 > unlink ((char *) XSTRING_DATA (filename)))
1910 report_file_error ("Removing old name", list1 (filename));
1915 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
1920 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1923 internal_delete_file (Lisp_Object filename)
1925 /* This function can GC. GC checked 1997.04.06. */
1926 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
1927 internal_delete_file_1, Qnil));
1930 DEFUN ("rename-file", Frename_file, 2, 3,
1931 "fRename file: \nFRename %s to file: \np", /*
1932 Rename FILE as NEWNAME. Both args strings.
1933 If file has names other than FILE, it continues to have those names.
1934 Signals a `file-already-exists' error if a file NEWNAME already exists
1935 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1936 A number as third arg means request confirmation if NEWNAME already exists.
1937 This is what happens in interactive use with M-x.
1939 (filename, newname, ok_if_already_exists))
1941 /* This function can GC. GC checked 1997.04.06. */
1942 Lisp_Object handler;
1943 struct gcpro gcpro1, gcpro2;
1945 GCPRO2 (filename, newname);
1946 CHECK_STRING (filename);
1947 CHECK_STRING (newname);
1948 filename = Fexpand_file_name (filename, Qnil);
1949 newname = Fexpand_file_name (newname, Qnil);
1951 /* If the file name has special constructs in it,
1952 call the corresponding file handler. */
1953 handler = Ffind_file_name_handler (filename, Qrename_file);
1955 handler = Ffind_file_name_handler (newname, Qrename_file);
1956 if (!NILP (handler))
1959 return call4 (handler, Qrename_file,
1960 filename, newname, ok_if_already_exists);
1963 /* When second argument is a directory, rename the file into it.
1964 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1966 if (!NILP (Ffile_directory_p (newname)))
1968 Lisp_Object args[3];
1969 struct gcpro ngcpro1;
1973 args[1] = Qnil; args[2] = Qnil;
1976 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1977 args[i++] = build_string ("/");
1978 args[i++] = Ffile_name_nondirectory (filename);
1979 newname = Fconcat (i, args);
1983 if (NILP (ok_if_already_exists)
1984 || INTP (ok_if_already_exists))
1985 barf_or_query_if_file_exists (newname, "rename to it",
1986 INTP (ok_if_already_exists), 0);
1988 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1989 WINDOWSNT here; I've removed it. --marcpa */
1991 /* FSFmacs only calls rename() here under BSD 4.1, and calls
1992 link() and unlink() otherwise, but that's bogus. Sometimes
1993 rename() succeeds where link()/unlink() fail, and we have
1994 configure check for rename() and emulate using link()/unlink()
1996 if (0 > rename ((char *) XSTRING_DATA (filename),
1997 (char *) XSTRING_DATA (newname)))
2001 Fcopy_file (filename, newname,
2002 /* We have already prompted if it was an integer,
2003 so don't have copy-file prompt again. */
2004 (NILP (ok_if_already_exists) ? Qnil : Qt),
2006 Fdelete_file (filename);
2010 report_file_error ("Renaming", list2 (filename, newname));
2017 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
2018 "fAdd name to file: \nFName to add to %s: \np", /*
2019 Give FILE additional name NEWNAME. Both args strings.
2020 Signals a `file-already-exists' error if a file NEWNAME already exists
2021 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2022 A number as third arg means request confirmation if NEWNAME already exists.
2023 This is what happens in interactive use with M-x.
2025 (filename, newname, ok_if_already_exists))
2027 /* This function can GC. GC checked 1997.04.06. */
2028 Lisp_Object handler;
2029 struct gcpro gcpro1, gcpro2;
2031 GCPRO2 (filename, newname);
2032 CHECK_STRING (filename);
2033 CHECK_STRING (newname);
2034 filename = Fexpand_file_name (filename, Qnil);
2035 newname = Fexpand_file_name (newname, Qnil);
2037 /* If the file name has special constructs in it,
2038 call the corresponding file handler. */
2039 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
2040 if (!NILP (handler))
2041 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2042 newname, ok_if_already_exists));
2044 /* If the new name has special constructs in it,
2045 call the corresponding file handler. */
2046 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2047 if (!NILP (handler))
2048 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2049 newname, ok_if_already_exists));
2051 if (NILP (ok_if_already_exists)
2052 || INTP (ok_if_already_exists))
2053 barf_or_query_if_file_exists (newname, "make it a new name",
2054 INTP (ok_if_already_exists), 0);
2055 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
2056 on NT here. --marcpa */
2057 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
2058 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
2059 Reverted to previous behavior pending a working fix. (jhar) */
2060 #if defined(WINDOWSNT)
2061 /* Windows does not support this operation. */
2062 report_file_error ("Adding new name", Flist (2, &filename));
2063 #else /* not defined(WINDOWSNT) */
2065 unlink ((char *) XSTRING_DATA (newname));
2066 if (0 > link ((char *) XSTRING_DATA (filename),
2067 (char *) XSTRING_DATA (newname)))
2069 report_file_error ("Adding new name",
2070 list2 (filename, newname));
2072 #endif /* defined(WINDOWSNT) */
2079 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
2080 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
2081 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2082 Signals a `file-already-exists' error if a file LINKNAME already exists
2083 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2084 A number as third arg means request confirmation if LINKNAME already exists.
2085 This happens for interactive use with M-x.
2087 (filename, linkname, ok_if_already_exists))
2089 /* This function can GC. GC checked 1997.06.04. */
2090 Lisp_Object handler;
2091 struct gcpro gcpro1, gcpro2;
2093 GCPRO2 (filename, linkname);
2094 CHECK_STRING (filename);
2095 CHECK_STRING (linkname);
2096 /* If the link target has a ~, we must expand it to get
2097 a truly valid file name. Otherwise, do not expand;
2098 we want to permit links to relative file names. */
2099 if (XSTRING_BYTE (filename, 0) == '~')
2100 filename = Fexpand_file_name (filename, Qnil);
2101 linkname = Fexpand_file_name (linkname, Qnil);
2103 /* If the file name has special constructs in it,
2104 call the corresponding file handler. */
2105 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2106 if (!NILP (handler))
2107 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
2108 ok_if_already_exists));
2110 /* If the new link name has special constructs in it,
2111 call the corresponding file handler. */
2112 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2113 if (!NILP (handler))
2114 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2115 linkname, ok_if_already_exists));
2117 if (NILP (ok_if_already_exists)
2118 || INTP (ok_if_already_exists))
2119 barf_or_query_if_file_exists (linkname, "make it a link",
2120 INTP (ok_if_already_exists), 0);
2122 unlink ((char *) XSTRING_DATA (linkname));
2123 if (0 > symlink ((char *) XSTRING_DATA (filename),
2124 (char *) XSTRING_DATA (linkname)))
2126 report_file_error ("Making symbolic link",
2127 list2 (filename, linkname));
2132 #endif /* S_IFLNK */
2136 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2137 Open a network connection to PATH using LOGIN as the login string.
2142 const char *path_ext;
2143 const char *login_ext;
2145 CHECK_STRING (path);
2146 CHECK_STRING (login);
2148 /* netunam, being a strange-o system call only used once, is not
2151 TO_EXTERNAL_FORMAT (LISP_STRING, path, C_STRING_ALLOCA, path_ext, Qfile_name);
2152 TO_EXTERNAL_FORMAT (LISP_STRING, login, C_STRING_ALLOCA, login_ext, Qnative);
2154 netresult = netunam (path_ext, login_ext);
2156 return netresult == -1 ? Qnil : Qt;
2158 #endif /* HPUX_NET */
2160 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
2161 Return t if file FILENAME specifies an absolute path name.
2162 On Unix, this is a name starting with a `/' or a `~'.
2166 /* This function does not GC */
2169 CHECK_STRING (filename);
2170 ptr = XSTRING_DATA (filename);
2171 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2173 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
2178 /* Return nonzero if file FILENAME exists and can be executed. */
2181 check_executable (char *filename)
2185 if (stat (filename, &st) < 0)
2187 return ((st.st_mode & S_IEXEC) != 0);
2188 #else /* not WINDOWSNT */
2190 return eaccess (filename, 1) >= 0;
2192 /* Access isn't quite right because it uses the real uid
2193 and we really want to test with the effective uid.
2194 But Unix doesn't give us a right way to do it. */
2195 return access (filename, 1) >= 0;
2196 #endif /* HAVE_EACCESS */
2197 #endif /* not WINDOWSNT */
2200 /* Return nonzero if file FILENAME exists and can be written. */
2203 check_writable (const char *filename)
2206 return (eaccess (filename, 2) >= 0);
2208 /* Access isn't quite right because it uses the real uid
2209 and we really want to test with the effective uid.
2210 But Unix doesn't give us a right way to do it.
2211 Opening with O_WRONLY could work for an ordinary file,
2212 but would lose for directories. */
2213 return (access (filename, 2) >= 0);
2217 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
2218 Return t if file FILENAME exists. (This does not mean you can read it.)
2219 See also `file-readable-p' and `file-attributes'.
2223 /* This function can call lisp */
2224 Lisp_Object abspath;
2225 Lisp_Object handler;
2226 struct stat statbuf;
2227 struct gcpro gcpro1;
2229 CHECK_STRING (filename);
2230 abspath = Fexpand_file_name (filename, Qnil);
2232 /* If the file name has special constructs in it,
2233 call the corresponding file handler. */
2235 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
2237 if (!NILP (handler))
2238 return call2 (handler, Qfile_exists_p, abspath);
2240 return stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
2243 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2244 Return t if FILENAME can be executed by you.
2245 For a directory, this means you can access files in that directory.
2250 /* This function can GC. GC checked 1997.04.10. */
2251 Lisp_Object abspath;
2252 Lisp_Object handler;
2253 struct gcpro gcpro1;
2255 CHECK_STRING (filename);
2256 abspath = Fexpand_file_name (filename, Qnil);
2258 /* If the file name has special constructs in it,
2259 call the corresponding file handler. */
2261 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
2263 if (!NILP (handler))
2264 return call2 (handler, Qfile_executable_p, abspath);
2266 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
2269 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2270 Return t if file FILENAME exists and you can read it.
2271 See also `file-exists-p' and `file-attributes'.
2275 /* This function can GC */
2276 Lisp_Object abspath = Qnil;
2277 Lisp_Object handler;
2278 struct gcpro gcpro1;
2281 CHECK_STRING (filename);
2282 abspath = Fexpand_file_name (filename, Qnil);
2284 /* If the file name has special constructs in it,
2285 call the corresponding file handler. */
2286 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
2287 if (!NILP (handler))
2288 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
2290 #if defined(WINDOWSNT) || defined(__CYGWIN32__)
2291 /* Under MS-DOS and Windows, open does not work for directories. */
2293 if (access (XSTRING_DATA (abspath), 0) == 0)
2297 #else /* not WINDOWSNT */
2299 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
2306 #endif /* not WINDOWSNT */
2309 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2311 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2312 Return t if file FILENAME can be written or created by you.
2316 /* This function can GC. GC checked 1997.04.10. */
2317 Lisp_Object abspath, dir;
2318 Lisp_Object handler;
2319 struct stat statbuf;
2320 struct gcpro gcpro1;
2322 CHECK_STRING (filename);
2323 abspath = Fexpand_file_name (filename, Qnil);
2325 /* If the file name has special constructs in it,
2326 call the corresponding file handler. */
2328 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
2330 if (!NILP (handler))
2331 return call2 (handler, Qfile_writable_p, abspath);
2333 if (stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
2334 return (check_writable ((char *) XSTRING_DATA (abspath))
2339 dir = Ffile_name_directory (abspath);
2341 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2346 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2347 Return non-nil if file FILENAME is the name of a symbolic link.
2348 The value is the name of the file to which it is linked.
2349 Otherwise returns nil.
2353 /* This function can GC. GC checked 1997.04.10. */
2359 Lisp_Object handler;
2360 struct gcpro gcpro1;
2362 CHECK_STRING (filename);
2363 filename = Fexpand_file_name (filename, Qnil);
2365 /* If the file name has special constructs in it,
2366 call the corresponding file handler. */
2368 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2370 if (!NILP (handler))
2371 return call2 (handler, Qfile_symlink_p, filename);
2376 buf = xnew_array_and_zero (char, bufsize);
2377 valsize = readlink ((char *) XSTRING_DATA (filename),
2379 if (valsize < bufsize) break;
2380 /* Buffer was not long enough */
2389 val = make_string ((Bufbyte *) buf, valsize);
2392 #else /* not S_IFLNK */
2394 #endif /* not S_IFLNK */
2397 DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2398 Return t if file FILENAME is the name of a directory as a file.
2399 A directory name spec may be given instead; then the value is t
2400 if the directory so specified exists and really is a directory.
2404 /* This function can GC. GC checked 1997.04.10. */
2405 Lisp_Object abspath;
2407 Lisp_Object handler;
2408 struct gcpro gcpro1;
2410 GCPRO1 (current_buffer->directory);
2411 abspath = expand_and_dir_to_file (filename,
2412 current_buffer->directory);
2415 /* If the file name has special constructs in it,
2416 call the corresponding file handler. */
2418 handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
2420 if (!NILP (handler))
2421 return call2 (handler, Qfile_directory_p, abspath);
2423 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2425 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2428 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2429 Return t if file FILENAME is the name of a directory as a file,
2430 and files in that directory can be opened by you. In order to use a
2431 directory as a buffer's current directory, this predicate must return true.
2432 A directory name spec may be given instead; then the value is t
2433 if the directory so specified exists and really is a readable and
2434 searchable directory.
2438 /* This function can GC. GC checked 1997.04.10. */
2439 Lisp_Object handler;
2441 /* If the file name has special constructs in it,
2442 call the corresponding file handler. */
2443 handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
2444 if (!NILP (handler))
2445 return call2 (handler, Qfile_accessible_directory_p,
2448 #if !defined(WINDOWSNT)
2449 if (NILP (Ffile_directory_p (filename)))
2452 return Ffile_executable_p (filename);
2456 struct gcpro gcpro1;
2457 /* It's an unlikely combination, but yes we really do need to gcpro:
2458 Suppose that file-accessible-directory-p has no handler, but
2459 file-directory-p does have a handler; this handler causes a GC which
2460 relocates the string in `filename'; and finally file-directory-p
2461 returns non-nil. Then we would end up passing a garbaged string
2462 to file-executable-p. */
2464 tem = (NILP (Ffile_directory_p (filename))
2465 || NILP (Ffile_executable_p (filename)));
2467 return tem ? Qnil : Qt;
2469 #endif /* !defined(WINDOWSNT) */
2472 DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2473 Return t if file FILENAME is the name of a regular file.
2474 This is the sort of file that holds an ordinary stream of data bytes.
2478 /* This function can GC. GC checked 1997.04.10. */
2479 Lisp_Object abspath;
2481 Lisp_Object handler;
2482 struct gcpro gcpro1;
2484 GCPRO1 (current_buffer->directory);
2485 abspath = expand_and_dir_to_file (filename, current_buffer->directory);
2488 /* If the file name has special constructs in it,
2489 call the corresponding file handler. */
2491 handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
2493 if (!NILP (handler))
2494 return call2 (handler, Qfile_regular_p, abspath);
2496 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2498 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2501 DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
2502 Return mode bits of FILE, as an integer.
2506 /* This function can GC. GC checked 1997.04.10. */
2507 Lisp_Object abspath;
2509 Lisp_Object handler;
2510 struct gcpro gcpro1;
2512 GCPRO1 (current_buffer->directory);
2513 abspath = expand_and_dir_to_file (filename,
2514 current_buffer->directory);
2517 /* If the file name has special constructs in it,
2518 call the corresponding file handler. */
2520 handler = Ffind_file_name_handler (abspath, Qfile_modes);
2522 if (!NILP (handler))
2523 return call2 (handler, Qfile_modes, abspath);
2525 if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
2527 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2530 if (check_executable (XSTRING_DATA (abspath)))
2531 st.st_mode |= S_IEXEC;
2535 return make_int (st.st_mode & 07777);
2538 DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2539 Set mode bits of FILE to MODE (an integer).
2540 Only the 12 low bits of MODE are used.
2544 /* This function can GC. GC checked 1997.04.10. */
2545 Lisp_Object abspath;
2546 Lisp_Object handler;
2547 struct gcpro gcpro1;
2549 GCPRO1 (current_buffer->directory);
2550 abspath = Fexpand_file_name (filename, current_buffer->directory);
2555 /* If the file name has special constructs in it,
2556 call the corresponding file handler. */
2558 handler = Ffind_file_name_handler (abspath, Qset_file_modes);
2560 if (!NILP (handler))
2561 return call3 (handler, Qset_file_modes, abspath, mode);
2563 if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0)
2564 report_file_error ("Doing chmod", list1 (abspath));
2569 DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2570 Set the file permission bits for newly created files.
2571 MASK should be an integer; if a permission's bit in MASK is 1,
2572 subsequently created files will not have that permission enabled.
2573 Only the low 9 bits are used.
2574 This setting is inherited by subprocesses.
2580 umask ((~ XINT (mode)) & 0777);
2585 DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2586 Return the default file protection for created files.
2587 The umask value determines which permissions are enabled in newly
2588 created files. If a permission's bit in the umask is 1, subsequently
2589 created files will not have that permission enabled.
2598 return make_int ((~ mode) & 0777);
2601 DEFUN ("unix-sync", Funix_sync, 0, 0, "", /*
2602 Tell Unix to finish all pending disk updates.
2613 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2614 Return t if file FILE1 is newer than file FILE2.
2615 If FILE1 does not exist, the answer is nil;
2616 otherwise, if FILE2 does not exist, the answer is t.
2620 /* This function can GC. GC checked 1997.04.10. */
2621 Lisp_Object abspath1, abspath2;
2624 Lisp_Object handler;
2625 struct gcpro gcpro1, gcpro2, gcpro3;
2627 CHECK_STRING (file1);
2628 CHECK_STRING (file2);
2633 GCPRO3 (abspath1, abspath2, current_buffer->directory);
2634 abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
2635 abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
2637 /* If the file name has special constructs in it,
2638 call the corresponding file handler. */
2639 handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
2641 handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
2643 if (!NILP (handler))
2644 return call3 (handler, Qfile_newer_than_file_p, abspath1,
2647 if (stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
2650 mtime1 = st.st_mtime;
2652 if (stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
2655 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2659 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2660 /* #define READ_BUF_SIZE (2 << 16) */
2661 #define READ_BUF_SIZE (1 << 15)
2663 DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal,
2665 Insert contents of file FILENAME after point; no coding-system frobbing.
2666 This function is identical to `insert-file-contents' except for the
2667 handling of the CODESYS and USED-CODESYS arguments under
2668 XEmacs/Mule. (When Mule support is not present, both functions are
2669 identical and ignore the CODESYS and USED-CODESYS arguments.)
2671 If support for Mule exists in this Emacs, the file is decoded according
2672 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2673 it should be a symbol, and the actual coding system that was used for the
2674 decoding is stored into it. It will in general be different from CODESYS
2675 if CODESYS specifies automatic encoding detection or end-of-line detection.
2677 Currently BEG and END refer to byte positions (as opposed to character
2678 positions), even in Mule. (Fixing this is very difficult.)
2680 (filename, visit, beg, end, replace, codesys, used_codesys))
2682 /* This function can call lisp */
2683 /* #### dmoore - this function hasn't been checked for gc recently */
2687 Charcount inserted = 0;
2689 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2690 Lisp_Object handler = Qnil, val;
2692 Bufbyte read_buf[READ_BUF_SIZE];
2694 struct buffer *buf = current_buffer;
2696 int not_regular = 0;
2698 if (buf->base_buffer && ! NILP (visit))
2699 error ("Cannot do file visiting in an indirect buffer");
2701 /* No need to call Fbarf_if_buffer_read_only() here.
2702 That's called in begin_multiple_change() or wherever. */
2706 /* #### dmoore - should probably check in various places to see if
2707 curbuf was killed and if so signal an error? */
2709 XSETBUFFER (curbuf, buf);
2711 GCPRO5 (filename, val, visit, handler, curbuf);
2713 mc_count = (NILP (replace)) ?
2714 begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
2715 begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
2717 speccount = specpdl_depth (); /* begin_multiple_change also adds
2718 an unwind_protect */
2720 filename = Fexpand_file_name (filename, Qnil);
2722 /* If the file name has special constructs in it,
2723 call the corresponding file handler. */
2724 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
2725 if (!NILP (handler))
2727 val = call6 (handler, Qinsert_file_contents, filename,
2728 visit, beg, end, replace);
2733 if (!NILP (used_codesys))
2734 CHECK_SYMBOL (used_codesys);
2737 if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) )
2738 error ("Attempt to visit less than an entire file");
2742 if (stat ((char *) XSTRING_DATA (filename), &st) < 0)
2744 if (fd >= 0) close (fd);
2747 report_file_error ("Opening input file", list1 (filename));
2753 /* Signal an error if we are accessing a non-regular file, with
2754 REPLACE, BEG or END being non-nil. */
2755 if (!S_ISREG (st.st_mode))
2762 if (!NILP (replace) || !NILP (beg) || !NILP (end))
2764 end_multiple_change (buf, mc_count);
2766 return Fsignal (Qfile_error,
2767 list2 (build_translated_string("not a regular file"),
2771 #endif /* S_IFREG */
2783 if ((fd = interruptible_open ((char *) XSTRING_DATA (filename),
2784 O_RDONLY | OPEN_BINARY, 0)) < 0)
2788 /* Replacement should preserve point as it preserves markers. */
2789 if (!NILP (replace))
2790 record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil));
2792 record_unwind_protect (close_file_unwind, make_int (fd));
2794 /* Supposedly happens on VMS. */
2796 error ("File size is negative");
2802 end = make_int (st.st_size);
2803 if (XINT (end) != st.st_size)
2804 error ("Maximum buffer size exceeded");
2808 /* If requested, replace the accessible part of the buffer
2809 with the file contents. Avoid replacing text at the
2810 beginning or end of the buffer that matches the file contents;
2811 that preserves markers pointing to the unchanged parts. */
2812 #if !defined (FILE_CODING)
2813 /* The replace-mode code currently only works when the assumption
2814 'one byte == one char' holds true. This fails Mule because
2815 files may contain multibyte characters. It holds under Windows NT
2816 provided we convert CRLF into LF. */
2817 # define FSFMACS_SPEEDY_INSERT
2818 #endif /* !defined (FILE_CODING) */
2820 #ifndef FSFMACS_SPEEDY_INSERT
2821 if (!NILP (replace))
2823 buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf),
2824 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2826 #else /* FSFMACS_SPEEDY_INSERT */
2827 if (!NILP (replace))
2829 char buffer[1 << 14];
2830 Bufpos same_at_start = BUF_BEGV (buf);
2831 Bufpos same_at_end = BUF_ZV (buf);
2834 /* Count how many chars at the start of the file
2835 match the text at the beginning of the buffer. */
2840 nread = read_allowing_quit (fd, buffer, sizeof buffer);
2842 error ("IO error reading %s: %s",
2843 XSTRING_DATA (filename), strerror (errno));
2844 else if (nread == 0)
2847 while (bufpos < nread && same_at_start < BUF_ZV (buf)
2848 && BUF_FETCH_CHAR (buf, same_at_start) == buffer[bufpos])
2849 same_at_start++, bufpos++;
2850 /* If we found a discrepancy, stop the scan.
2851 Otherwise loop around and scan the next bufferful. */
2852 if (bufpos != nread)
2855 /* If the file matches the buffer completely,
2856 there's no need to replace anything. */
2857 if (same_at_start - BUF_BEGV (buf) == st.st_size)
2860 unbind_to (speccount, Qnil);
2861 /* Truncate the buffer to the size of the file. */
2862 buffer_delete_range (buf, same_at_start, same_at_end,
2863 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2866 /* Count how many chars at the end of the file
2867 match the text at the end of the buffer. */
2870 int total_read, nread;
2871 Bufpos bufpos, curpos, trial;
2873 /* At what file position are we now scanning? */
2874 curpos = st.st_size - (BUF_ZV (buf) - same_at_end);
2875 /* If the entire file matches the buffer tail, stop the scan. */
2878 /* How much can we scan in the next step? */
2879 trial = min (curpos, (Bufpos) sizeof (buffer));
2880 if (lseek (fd, curpos - trial, 0) < 0)
2881 report_file_error ("Setting file position", list1 (filename));
2884 while (total_read < trial)
2886 nread = read_allowing_quit (fd, buffer + total_read,
2887 trial - total_read);
2889 report_file_error ("IO error reading file", list1 (filename));
2890 total_read += nread;
2892 /* Scan this bufferful from the end, comparing with
2893 the Emacs buffer. */
2894 bufpos = total_read;
2895 /* Compare with same_at_start to avoid counting some buffer text
2896 as matching both at the file's beginning and at the end. */
2897 while (bufpos > 0 && same_at_end > same_at_start
2898 && BUF_FETCH_CHAR (buf, same_at_end - 1) ==
2900 same_at_end--, bufpos--;
2901 /* If we found a discrepancy, stop the scan.
2902 Otherwise loop around and scan the preceding bufferful. */
2905 /* If display current starts at beginning of line,
2906 keep it that way. */
2907 if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf)
2908 XWINDOW (Fselected_window (Qnil))->start_at_line_beg =
2909 !NILP (Fbolp (make_buffer (buf)));
2912 /* Don't try to reuse the same piece of text twice. */
2913 overlap = same_at_start - BUF_BEGV (buf) -
2914 (same_at_end + st.st_size - BUF_ZV (buf));
2916 same_at_end += overlap;
2918 /* Arrange to read only the nonmatching middle part of the file. */
2919 beg = make_int (same_at_start - BUF_BEGV (buf));
2920 end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
2922 buffer_delete_range (buf, same_at_start, same_at_end,
2923 !NILP (visit) ? INSDEL_NO_LOCKING : 0);
2924 /* Insert from the file at the proper position. */
2925 BUF_SET_PT (buf, same_at_start);
2927 #endif /* FSFMACS_SPEEDY_INSERT */
2931 total = XINT (end) - XINT (beg);
2933 /* Make sure point-max won't overflow after this insertion. */
2934 if (total != XINT (make_int (total)))
2935 error ("Maximum buffer size exceeded");
2938 /* For a special file, all we can do is guess. The value of -1
2939 will make the stream functions read as much as possible. */
2943 #ifdef FSFMACS_SPEEDY_INSERT
2944 /* why was this here? asked jwz. The reason is that the replace-mode
2945 connivings above will normally put the file pointer other than
2946 where it should be. */
2948 #endif /* !FSFMACS_SPEEDY_INSERT */
2951 if (lseek (fd, XINT (beg), 0) < 0)
2952 report_file_error ("Setting file position", list1 (filename));
2956 Bufpos cur_point = BUF_PT (buf);
2957 struct gcpro ngcpro1;
2958 Lisp_Object stream = make_filedesc_input_stream (fd, 0, total,
2962 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2964 stream = make_decoding_input_stream
2965 (XLSTREAM (stream), Fget_coding_system (codesys));
2966 Lstream_set_character_mode (XLSTREAM (stream));
2967 Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536);
2968 #endif /* FILE_CODING */
2970 record_unwind_protect (delete_stream_unwind, stream);
2972 /* No need to limit the amount of stuff we attempt to read. (It would
2973 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2974 occurs inside of the filedesc stream. */
2978 Charcount cc_inserted;
2981 this_len = Lstream_read (XLSTREAM (stream), read_buf,
2991 cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf,
2994 ? INSDEL_NO_LOCKING : 0);
2995 inserted += cc_inserted;
2996 cur_point += cc_inserted;
2999 if (!NILP (used_codesys))
3002 XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream))));
3004 #endif /* FILE_CODING */
3008 /* Close the file/stream */
3009 unbind_to (speccount, Qnil);
3013 error ("IO error reading %s: %s",
3014 XSTRING_DATA (filename), strerror (saverrno));
3020 end_multiple_change (buf, mc_count);
3024 if (!EQ (buf->undo_list, Qt))
3025 buf->undo_list = Qnil;
3028 buf->modtime = st.st_mtime;
3029 buf->filename = filename;
3030 /* XEmacs addition: */
3031 /* This function used to be in C, ostensibly so that
3032 it could be called here. But that's just silly.
3033 There's no reason C code can't call out to Lisp
3034 code, and it's a lot cleaner this way. */
3035 if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
3036 call1 (Qcompute_buffer_file_truename, make_buffer (buf));
3038 BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf);
3039 buf->auto_save_modified = BUF_MODIFF (buf);
3040 buf->saved_size = make_int (BUF_SIZE (buf));
3041 #ifdef CLASH_DETECTION
3044 if (!NILP (buf->file_truename))
3045 unlock_file (buf->file_truename);
3046 unlock_file (filename);
3048 #endif /* CLASH_DETECTION */
3050 RETURN_UNGCPRO (Fsignal (Qfile_error,
3051 list2 (build_string ("not a regular file"),
3054 /* If visiting nonexistent file, return nil. */
3055 if (buf->modtime == -1)
3056 report_file_error ("Opening input file",
3060 /* Decode file format */
3063 Lisp_Object insval = call3 (Qformat_decode,
3064 Qnil, make_int (inserted), visit);
3066 inserted = XINT (insval);
3072 struct gcpro ngcpro1;
3075 EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions)
3077 Lisp_Object insval =
3078 call1 (XCAR (p), make_int (inserted));
3081 CHECK_NATNUM (insval);
3082 inserted = XINT (insval);
3094 return (list2 (filename, make_int (inserted)));
3098 static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3099 Lisp_Object *annot);
3100 static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end);
3102 /* If build_annotations switched buffers, switch back to BUF.
3103 Kill the temporary buffer that was selected in the meantime. */
3106 build_annotations_unwind (Lisp_Object buf)
3110 if (XBUFFER (buf) == current_buffer)
3112 tembuf = Fcurrent_buffer ();
3114 Fkill_buffer (tembuf);
3118 DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7,
3119 "r\nFWrite region to file: ", /*
3120 Write current region into specified file; no coding-system frobbing.
3121 This function is identical to `write-region' except for the handling
3122 of the CODESYS argument under XEmacs/Mule. (When Mule support is not
3123 present, both functions are identical and ignore the CODESYS argument.)
3124 If support for Mule exists in this Emacs, the file is encoded according
3125 to the value of CODESYS. If this is nil, no code conversion occurs.
3127 (start, end, filename, append, visit, lockname, codesys))
3129 /* This function can call lisp */
3135 int speccount = specpdl_depth ();
3136 int visiting_other = STRINGP (visit);
3137 int visiting = (EQ (visit, Qt) || visiting_other);
3138 int quietly = (!visiting && !NILP (visit));
3139 Lisp_Object visit_file = Qnil;
3140 Lisp_Object annotations = Qnil;
3141 struct buffer *given_buffer;
3142 Bufpos start1, end1;
3144 /* #### dmoore - if Fexpand_file_name or handlers kill the buffer,
3145 we should signal an error rather than blissfully continuing
3146 along. ARGH, this function is going to lose lose lose. We need
3147 to protect the current_buffer from being destroyed, but the
3148 multiple return points make this a pain in the butt. */
3151 codesys = Fget_coding_system (codesys);
3152 #endif /* FILE_CODING */
3154 if (current_buffer->base_buffer && ! NILP (visit))
3155 error ("Cannot do file visiting in an indirect buffer");
3157 if (!NILP (start) && !STRINGP (start))
3158 get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
3161 Lisp_Object handler;
3162 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3164 GCPRO5 (start, filename, visit, visit_file, lockname);
3167 visit_file = Fexpand_file_name (visit, Qnil);
3169 visit_file = filename;
3170 filename = Fexpand_file_name (filename, Qnil);
3174 if (NILP (lockname))
3175 lockname = visit_file;
3177 /* If the file name has special constructs in it,
3178 call the corresponding file handler. */
3179 handler = Ffind_file_name_handler (filename, Qwrite_region);
3180 /* If FILENAME has no handler, see if VISIT has one. */
3181 if (NILP (handler) && STRINGP (visit))
3182 handler = Ffind_file_name_handler (visit, Qwrite_region);
3184 if (!NILP (handler))
3186 Lisp_Object val = call8 (handler, Qwrite_region, start, end,
3187 filename, append, visit, lockname, codesys);
3190 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3191 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3192 current_buffer->filename = visit_file;
3193 MARK_MODELINE_CHANGED;
3199 #ifdef CLASH_DETECTION
3203 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3205 XSETBUFFER (curbuf, current_buffer);
3206 GCPRO5 (start, filename, visit_file, lockname, curbuf);
3207 lock_file (lockname);
3210 #endif /* CLASH_DETECTION */
3212 /* Special kludge to simplify auto-saving. */
3215 start1 = BUF_BEG (current_buffer);
3216 end1 = BUF_Z (current_buffer);
3219 record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
3221 given_buffer = current_buffer;
3222 annotations = build_annotations (start, end);
3223 if (current_buffer != given_buffer)
3225 start1 = BUF_BEGV (current_buffer);
3226 end1 = BUF_ZV (current_buffer);
3233 desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0);
3237 desc = open ((char *) XSTRING_DATA (fn),
3238 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3239 auto_saving ? auto_save_mode_bits : CREAT_MODE);
3244 #ifdef CLASH_DETECTION
3246 if (!auto_saving) unlock_file (lockname);
3248 #endif /* CLASH_DETECTION */
3249 report_file_error ("Opening output file", list1 (filename));
3253 Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
3254 Lisp_Object instream = Qnil, outstream = Qnil;
3255 struct gcpro gcpro1, gcpro2;
3256 /* need to gcpro; QUIT could happen out of call to write() */
3257 GCPRO2 (instream, outstream);
3259 record_unwind_protect (close_file_unwind, desc_locative);
3263 if (lseek (desc, 0, 2) < 0)
3265 #ifdef CLASH_DETECTION
3266 if (!auto_saving) unlock_file (lockname);
3267 #endif /* CLASH_DETECTION */
3268 report_file_error ("Lseek error",
3275 /* Note: I tried increasing the buffering size, along with
3276 various other tricks, but nothing seemed to make much of
3277 a difference in the time it took to save a large file.
3278 (Actually that's not true. With a local disk, changing
3279 the buffer size doesn't seem to make much difference.
3280 With an NFS-mounted disk, it could make a lot of difference
3281 because you're affecting the number of network requests
3282 that need to be made, and there could be a large latency
3283 for each request. So I've increased the buffer size
3285 outstream = make_filedesc_output_stream (desc, 0, -1, 0);
3286 Lstream_set_buffering (XLSTREAM (outstream),
3287 LSTREAM_BLOCKN_BUFFERED, 65536);
3290 make_encoding_output_stream (XLSTREAM (outstream), codesys);
3291 Lstream_set_buffering (XLSTREAM (outstream),
3292 LSTREAM_BLOCKN_BUFFERED, 65536);
3293 #endif /* FILE_CODING */
3294 if (STRINGP (start))
3296 instream = make_lisp_string_input_stream (start, 0, -1);
3300 instream = make_lisp_buffer_input_stream (current_buffer, start1, end1,
3302 LSTR_IGNORE_ACCESSIBLE);
3303 failure = (0 > (a_write (outstream, instream, start1,
3306 /* Note that this doesn't close the desc since we created the
3307 stream without the LSTR_CLOSING flag, but it does
3308 flush out any buffered data. */
3309 if (Lstream_close (XLSTREAM (outstream)) < 0)
3314 Lstream_close (XLSTREAM (instream));
3318 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3319 Disk full in NFS may be reported here. */
3320 /* mib says that closing the file will try to write as fast as NFS can do
3321 it, and that means the fsync here is not crucial for autosave files. */
3322 if (!auto_saving && fsync (desc) < 0
3323 /* If fsync fails with EINTR, don't treat that as serious. */
3329 #endif /* HAVE_FSYNC */
3331 /* Spurious "file has changed on disk" warnings used to be seen on
3332 systems where close() can change the modtime. This is known to
3333 happen on various NFS file systems, on Windows, and on Linux.
3334 Rather than handling this on a per-system basis, we
3335 unconditionally do the stat() after the close(). */
3337 /* NFS can report a write failure now. */
3338 if (close (desc) < 0)
3344 /* Discard the close unwind-protect. Execute the one for
3345 build_annotations (switches back to the original current buffer
3347 XCAR (desc_locative) = Qnil;
3348 unbind_to (speccount, Qnil);
3351 stat ((char *) XSTRING_DATA (fn), &st);
3353 #ifdef CLASH_DETECTION
3355 unlock_file (lockname);
3356 #endif /* CLASH_DETECTION */
3358 /* Do this before reporting IO error
3359 to avoid a "file has changed on disk" warning on
3360 next attempt to save. */
3362 current_buffer->modtime = st.st_mtime;
3365 error ("IO error writing %s: %s",
3367 strerror (save_errno));
3371 BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
3372 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
3373 current_buffer->filename = visit_file;
3374 MARK_MODELINE_CHANGED;
3384 message ("Wrote %s", XSTRING_DATA (visit_file));
3387 struct gcpro gcpro1;
3391 fsp = Ffile_symlink_p (fn);
3393 message ("Wrote %s", XSTRING_DATA (fn));
3395 message ("Wrote %s (symlink to %s)",
3396 XSTRING_DATA (fn), XSTRING_DATA (fsp));
3403 /* #### This is such a load of shit!!!! There is no way we should define
3404 something so stupid as a subr, just sort the fucking list more
3406 DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3407 Return t if (car A) is numerically less than (car B).
3411 Lisp_Object objs[2];
3414 return Flss (2, objs);
3417 /* Heh heh heh, let's define this too, just to aggravate the person who
3418 wrote the above comment. */
3419 DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3420 Return t if (cdr A) is numerically less than (cdr B).
3424 Lisp_Object objs[2];
3427 return Flss (2, objs);
3430 /* Build the complete list of annotations appropriate for writing out
3431 the text between START and END, by calling all the functions in
3432 write-region-annotate-functions and merging the lists they return.
3433 If one of these functions switches to a different buffer, we assume
3434 that buffer contains altered text. Therefore, the caller must
3435 make sure to restore the current buffer in all cases,
3436 as save-excursion would do. */
3439 build_annotations (Lisp_Object start, Lisp_Object end)
3441 /* This function can GC */
3442 Lisp_Object annotations;
3444 struct gcpro gcpro1, gcpro2;
3445 Lisp_Object original_buffer;
3447 XSETBUFFER (original_buffer, current_buffer);
3450 p = Vwrite_region_annotate_functions;
3451 GCPRO2 (annotations, p);
3454 struct buffer *given_buffer = current_buffer;
3455 Vwrite_region_annotations_so_far = annotations;
3456 res = call2 (Fcar (p), start, end);
3457 /* If the function makes a different buffer current,
3458 assume that means this buffer contains altered text to be output.
3459 Reset START and END from the buffer bounds
3460 and discard all previous annotations because they should have
3461 been dealt with by this function. */
3462 if (current_buffer != given_buffer)
3464 start = make_int (BUF_BEGV (current_buffer));
3465 end = make_int (BUF_ZV (current_buffer));
3468 Flength (res); /* Check basic validity of return value */
3469 annotations = merge (annotations, res, Qcar_less_than_car);
3473 /* Now do the same for annotation functions implied by the file-format */
3474 if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
3475 p = Vauto_save_file_format;
3477 p = current_buffer->file_format;
3480 struct buffer *given_buffer = current_buffer;
3481 Vwrite_region_annotations_so_far = annotations;
3482 res = call4 (Qformat_annotate_function, Fcar (p), start, end,
3484 if (current_buffer != given_buffer)
3486 start = make_int (BUF_BEGV (current_buffer));
3487 end = make_int (BUF_ZV (current_buffer));
3491 annotations = merge (annotations, res, Qcar_less_than_car);
3498 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3499 EOF is encountered), assuming they start at position POS in the buffer
3500 of string that STREAM refers to. Intersperse with them the annotations
3501 from *ANNOT that fall into the range of positions we are reading from,
3502 each at its appropriate position.
3504 Modify *ANNOT by discarding elements as we output them.
3505 The return value is negative in case of system call failure. */
3507 /* 4K should probably be fine. We just need to reduce the number of
3508 function calls to reasonable level. The Lstream stuff itself will
3509 batch to 64K to reduce the number of system calls. */
3511 #define A_WRITE_BATCH_SIZE 4096
3514 a_write (Lisp_Object outstream, Lisp_Object instream, int pos,
3519 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3520 Lstream *instr = XLSTREAM (instream);
3521 Lstream *outstr = XLSTREAM (outstream);
3523 while (LISTP (*annot))
3525 tem = Fcar_safe (Fcar (*annot));
3527 nextpos = XINT (tem);
3531 /* If there are annotations left and we have Mule, then we
3532 have to do the I/O one emchar at a time so we can
3533 determine when to insert the annotation. */
3537 while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF)
3539 if (Lstream_put_emchar (outstr, ch) < 0)
3547 while (pos != nextpos)
3549 /* Otherwise there is no point to that. Just go in batches. */
3550 int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE);
3552 chunk = Lstream_read (instr, largebuf, chunk);
3555 if (chunk == 0) /* EOF */
3557 if (Lstream_write (outstr, largebuf, chunk) < chunk)
3564 tem = Fcdr (Fcar (*annot));
3567 if (Lstream_write (outstr, XSTRING_DATA (tem),
3568 XSTRING_LENGTH (tem)) < 0)
3571 *annot = Fcdr (*annot);
3582 #include <des_crypt.h>
3584 #define CRYPT_BLOCK_SIZE 8 /* bytes */
3585 #define CRYPT_KEY_SIZE 8 /* bytes */
3587 DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /*
3588 Encrypt STRING using KEY.
3592 char *encrypted_string, *raw_key;
3593 int rounded_size, extra, key_size;
3595 /* !!#### May produce bogus data under Mule. */
3596 CHECK_STRING (string);
3599 extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE;
3600 rounded_size = XSTRING_LENGTH (string) + extra;
3601 encrypted_string = alloca (rounded_size + 1);
3602 memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string));
3603 memset (encrypted_string + rounded_size - extra, 0, extra + 1);
3605 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3607 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3608 memcpy (raw_key, XSTRING_DATA (key), key_size);
3609 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3611 ecb_crypt (raw_key, encrypted_string, rounded_size,
3612 DES_ENCRYPT | DES_SW);
3613 return make_string (encrypted_string, rounded_size);
3616 DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /*
3617 Decrypt STRING using KEY.
3621 char *decrypted_string, *raw_key;
3622 int string_size, key_size;
3624 CHECK_STRING (string);
3627 string_size = XSTRING_LENGTH (string) + 1;
3628 decrypted_string = alloca (string_size);
3629 memcpy (decrypted_string, XSTRING_DATA (string), string_size);
3630 decrypted_string[string_size - 1] = '\0';
3632 key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key))
3634 raw_key = alloca (CRYPT_KEY_SIZE + 1);
3635 memcpy (raw_key, XSTRING_DATA (key), key_size);
3636 memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size);
3639 ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW);
3640 return make_string (decrypted_string, string_size - 1);
3645 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3646 Return t if last mod time of BUF's visited file matches what BUF records.
3647 This means that the file has not been changed since it was visited or saved.
3651 /* This function can call lisp */
3654 Lisp_Object handler;
3659 if (!STRINGP (b->filename)) return Qt;
3660 if (b->modtime == 0) return Qt;
3662 /* If the file name has special constructs in it,
3663 call the corresponding file handler. */
3664 handler = Ffind_file_name_handler (b->filename,
3665 Qverify_visited_file_modtime);
3666 if (!NILP (handler))
3667 return call2 (handler, Qverify_visited_file_modtime, buf);
3669 if (stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
3671 /* If the file doesn't exist now and didn't exist before,
3672 we say that it isn't modified, provided the error is a tame one. */
3673 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3678 if (st.st_mtime == b->modtime
3679 /* If both are positive, accept them if they are off by one second. */
3680 || (st.st_mtime > 0 && b->modtime > 0
3681 && (st.st_mtime == b->modtime + 1
3682 || st.st_mtime == b->modtime - 1)))
3687 DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3688 Clear out records of last mod time of visited file.
3689 Next attempt to save will certainly not complain of a discrepancy.
3693 current_buffer->modtime = 0;
3697 DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3698 Return the current buffer's recorded visited file modification time.
3699 The value is a list of the form (HIGH . LOW), like the time values
3700 that `file-attributes' returns.
3704 return time_to_lisp ((time_t) current_buffer->modtime);
3707 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3708 Update buffer's recorded modification time from the visited file's time.
3709 Useful if the buffer was not read from the file normally
3710 or if the file itself has been changed for some known benign reason.
3711 An argument specifies the modification time value to use
3712 \(instead of that of the visited file), in the form of a list
3713 \(HIGH . LOW) or (HIGH LOW).
3717 /* This function can call lisp */
3718 if (!NILP (time_list))
3721 lisp_to_time (time_list, &the_time);
3722 current_buffer->modtime = (int) the_time;
3726 Lisp_Object filename;
3728 Lisp_Object handler;
3729 struct gcpro gcpro1, gcpro2, gcpro3;
3731 GCPRO3 (filename, time_list, current_buffer->filename);
3732 filename = Fexpand_file_name (current_buffer->filename, Qnil);
3734 /* If the file name has special constructs in it,
3735 call the corresponding file handler. */
3736 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
3738 if (!NILP (handler))
3739 /* The handler can find the file name the same way we did. */
3740 return call2 (handler, Qset_visited_file_modtime, Qnil);
3741 else if (stat ((char *) XSTRING_DATA (filename), &st) >= 0)
3742 current_buffer->modtime = st.st_mtime;
3749 auto_save_error (Lisp_Object condition_object, Lisp_Object ignored)
3751 /* This function can call lisp */
3754 /* Don't try printing an error message after everything is gone! */
3755 if (preparing_for_armageddon)
3757 clear_echo_area (selected_frame (), Qauto_saving, 1);
3758 Fding (Qt, Qauto_save_error, Qnil);
3759 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3760 Fsleep_for (make_int (1));
3761 message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name));
3762 Fsleep_for (make_int (1));
3763 message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name));
3764 Fsleep_for (make_int (1));
3769 auto_save_1 (Lisp_Object ignored)
3771 /* This function can call lisp */
3772 /* #### I think caller is protecting current_buffer? */
3774 Lisp_Object fn = current_buffer->filename;
3775 Lisp_Object a = current_buffer->auto_save_file_name;
3780 /* Get visited file's mode to become the auto save file's mode. */
3782 stat ((char *) XSTRING_DATA (fn), &st) >= 0)
3783 /* But make sure we can overwrite it later! */
3784 auto_save_mode_bits = st.st_mode | 0600;
3786 /* default mode for auto-save files of buffers with no file is
3787 readable by owner only. This may annoy some small number of
3788 people, but the alternative removes all privacy from email. */
3789 auto_save_mode_bits = 0600;
3792 /* !!#### need to deal with this 'escape-quoted everywhere */
3793 Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3803 auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored)
3805 /* #### this function should spew an error message about not being
3806 able to open the .saves file. */
3811 auto_save_expand_name (Lisp_Object name)
3813 struct gcpro gcpro1;
3815 /* note that caller did NOT gc protect name, so we do it. */
3816 /* #### dmoore - this might not be necessary, if condition_case_1
3817 protects it. but I don't think it does. */
3819 RETURN_UNGCPRO (Fexpand_file_name (name, Qnil));
3824 do_auto_save_unwind (Lisp_Object fd)
3831 do_auto_save_unwind_2 (Lisp_Object old_auto_saving)
3833 auto_saving = XINT (old_auto_saving);
3837 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3838 and if so, tries to avoid touching lisp objects.
3840 The only time that Fdo_auto_save() is called while GC is in progress
3841 is if we're going down, as a result of an abort() or a kill signal.
3842 It's fairly important that we generate autosave files in that case!
3845 DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3846 Auto-save all buffers that need it.
3847 This is all buffers that have auto-saving enabled
3848 and are changed since last auto-saved.
3849 Auto-saving writes the buffer into a file
3850 so that your editing is not lost if the system crashes.
3851 This file is not the file you visited; that changes only when you save.
3852 Normally we run the normal hook `auto-save-hook' before saving.
3854 Non-nil first argument means do not print any message if successful.
3855 Non-nil second argument means save only current buffer.
3857 (no_message, current_only))
3859 /* This function can call lisp */
3861 Lisp_Object tail, buf;
3863 int do_handled_files;
3864 Lisp_Object oquit = Qnil;
3865 Lisp_Object listfile = Qnil;
3868 int speccount = specpdl_depth ();
3869 struct gcpro gcpro1, gcpro2, gcpro3;
3871 XSETBUFFER (old, current_buffer);
3872 GCPRO3 (oquit, listfile, old);
3873 check_quit (); /* make Vquit_flag accurate */
3874 /* Ordinarily don't quit within this function,
3875 but don't make it impossible to quit (in case we get hung in I/O). */
3879 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3880 variables point to non-strings reached from Vbuffer_alist. */
3882 if (minibuf_level != 0 || preparing_for_armageddon)
3885 run_hook (Qauto_save_hook);
3887 if (STRINGP (Vauto_save_list_file_name))
3888 listfile = condition_case_1 (Qt,
3889 auto_save_expand_name,
3890 Vauto_save_list_file_name,
3891 auto_save_expand_name_error, Qnil);
3893 /* Make sure auto_saving is reset. */
3894 record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving));
3898 /* First, save all files which don't have handlers. If Emacs is
3899 crashing, the handlers may tweak what is causing Emacs to crash
3900 in the first place, and it would be a shame if Emacs failed to
3901 autosave perfectly ordinary files because it couldn't handle some
3903 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
3905 for (tail = Vbuffer_alist;
3909 buf = XCDR (XCAR (tail));
3912 if (!NILP (current_only)
3913 && b != current_buffer)
3916 /* Don't auto-save indirect buffers.
3917 The base buffer takes care of it. */
3921 /* Check for auto save enabled
3922 and file changed since last auto save
3923 and file changed since last real save. */
3924 if (STRINGP (b->auto_save_file_name)
3925 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
3926 && b->auto_save_modified < BUF_MODIFF (b)
3927 /* -1 means we've turned off autosaving for a while--see below. */
3928 && XINT (b->saved_size) >= 0
3929 && (do_handled_files
3930 || NILP (Ffind_file_name_handler (b->auto_save_file_name,
3933 EMACS_TIME before_time, after_time;
3935 EMACS_GET_TIME (before_time);
3936 /* If we had a failure, don't try again for 20 minutes. */
3937 if (!preparing_for_armageddon
3938 && b->auto_save_failure_time >= 0
3939 && (EMACS_SECS (before_time) - b->auto_save_failure_time <
3943 if (!preparing_for_armageddon &&
3944 (XINT (b->saved_size) * 10
3945 > (BUF_Z (b) - BUF_BEG (b)) * 13)
3946 /* A short file is likely to change a large fraction;
3947 spare the user annoying messages. */
3948 && XINT (b->saved_size) > 5000
3949 /* These messages are frequent and annoying for `*mail*'. */
3950 && !NILP (b->filename)
3951 && NILP (no_message)
3952 && disable_auto_save_when_buffer_shrinks)
3954 /* It has shrunk too much; turn off auto-saving here.
3955 Unless we're about to crash, in which case auto-save it
3959 ("Buffer %s has shrunk a lot; auto save turned off there",
3960 XSTRING_DATA (b->name));
3961 /* Turn off auto-saving until there's a real save,
3962 and prevent any more warnings. */
3963 b->saved_size = make_int (-1);
3964 if (!gc_in_progress)
3965 Fsleep_for (make_int (1));
3968 set_buffer_internal (b);
3969 if (!auto_saved && NILP (no_message))
3971 static const unsigned char *msg
3972 = (const unsigned char *) "Auto-saving...";
3973 echo_area_message (selected_frame (), msg, Qnil,
3974 0, strlen ((const char *) msg),
3978 /* Open the auto-save list file, if necessary.
3979 We only do this now so that the file only exists
3980 if we actually auto-saved any files. */
3981 if (!auto_saved && STRINGP (listfile) && listdesc < 0)
3983 listdesc = open ((char *) XSTRING_DATA (listfile),
3984 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
3987 /* Arrange to close that file whether or not we get
3990 record_unwind_protect (do_auto_save_unwind,
3991 make_int (listdesc));
3994 /* Record all the buffers that we are auto-saving in
3995 the special file that lists them. For each of
3996 these buffers, record visited name (if any) and
4000 const Extbyte *auto_save_file_name_ext;
4001 Extcount auto_save_file_name_ext_len;
4003 TO_EXTERNAL_FORMAT (LISP_STRING, b->auto_save_file_name,
4004 ALLOCA, (auto_save_file_name_ext,
4005 auto_save_file_name_ext_len),
4007 if (!NILP (b->filename))
4009 const Extbyte *filename_ext;
4010 Extcount filename_ext_len;
4012 TO_EXTERNAL_FORMAT (LISP_STRING, b->filename,
4013 ALLOCA, (filename_ext,
4016 write (listdesc, filename_ext, filename_ext_len);
4018 write (listdesc, "\n", 1);
4019 write (listdesc, auto_save_file_name_ext,
4020 auto_save_file_name_ext_len);
4021 write (listdesc, "\n", 1);
4024 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
4025 based on values in Vbuffer_alist. auto_save_1 may
4026 cause lisp handlers to run. Those handlers may kill
4027 the buffer and then GC. Since the buffer is killed,
4028 it's no longer in Vbuffer_alist so it might get reaped
4029 by the GC. We also need to protect tail. */
4030 /* #### There is probably a lot of other code which has
4031 pointers into buffers which may get blown away by
4034 struct gcpro ngcpro1, ngcpro2;
4035 NGCPRO2 (buf, tail);
4036 condition_case_1 (Qt,
4038 auto_save_error, Qnil);
4041 /* Handler killed our saved current-buffer! Pick any. */
4042 if (!BUFFER_LIVE_P (XBUFFER (old)))
4043 XSETBUFFER (old, current_buffer);
4045 set_buffer_internal (XBUFFER (old));
4048 /* Handler killed their own buffer! */
4049 if (!BUFFER_LIVE_P(b))
4052 b->auto_save_modified = BUF_MODIFF (b);
4053 b->saved_size = make_int (BUF_SIZE (b));
4054 EMACS_GET_TIME (after_time);
4055 /* If auto-save took more than 60 seconds,
4056 assume it was an NFS failure that got a timeout. */
4057 if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
4058 b->auto_save_failure_time = EMACS_SECS (after_time);
4063 /* Prevent another auto save till enough input events come in. */
4065 record_auto_save ();
4067 /* If we didn't save anything into the listfile, remove the old
4068 one because nothing needed to be auto-saved. Do this afterwards
4069 rather than before in case we get a crash attempting to autosave
4070 (in that case we'd still want the old one around). */
4071 if (listdesc < 0 && !auto_saved && STRINGP (listfile))
4072 unlink ((char *) XSTRING_DATA (listfile));
4074 /* Show "...done" only if the echo area would otherwise be empty. */
4075 if (auto_saved && NILP (no_message)
4076 && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0)))
4078 static const unsigned char *msg
4079 = (const unsigned char *)"Auto-saving...done";
4080 echo_area_message (selected_frame (), msg, Qnil, 0,
4081 strlen ((const char *) msg), Qauto_saving);
4086 RETURN_UNGCPRO (unbind_to (speccount, Qnil));
4089 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
4090 Mark current buffer as auto-saved with its current text.
4091 No auto-save file will be written until the buffer changes again.
4095 current_buffer->auto_save_modified = BUF_MODIFF (current_buffer);
4096 current_buffer->saved_size = make_int (BUF_SIZE (current_buffer));
4097 current_buffer->auto_save_failure_time = -1;
4101 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
4102 Clear any record of a recent auto-save failure in the current buffer.
4106 current_buffer->auto_save_failure_time = -1;
4110 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
4111 Return t if buffer has been auto-saved since last read in or saved.
4115 return (BUF_SAVE_MODIFF (current_buffer) <
4116 current_buffer->auto_save_modified) ? Qt : Qnil;
4120 /************************************************************************/
4121 /* initialization */
4122 /************************************************************************/
4125 syms_of_fileio (void)
4127 defsymbol (&Qexpand_file_name, "expand-file-name");
4128 defsymbol (&Qfile_truename, "file-truename");
4129 defsymbol (&Qsubstitute_in_file_name, "substitute-in-file-name");
4130 defsymbol (&Qdirectory_file_name, "directory-file-name");
4131 defsymbol (&Qfile_name_directory, "file-name-directory");
4132 defsymbol (&Qfile_name_nondirectory, "file-name-nondirectory");
4133 defsymbol (&Qunhandled_file_name_directory, "unhandled-file-name-directory");
4134 defsymbol (&Qfile_name_as_directory, "file-name-as-directory");
4135 defsymbol (&Qcopy_file, "copy-file");
4136 defsymbol (&Qmake_directory_internal, "make-directory-internal");
4137 defsymbol (&Qdelete_directory, "delete-directory");
4138 defsymbol (&Qdelete_file, "delete-file");
4139 defsymbol (&Qrename_file, "rename-file");
4140 defsymbol (&Qadd_name_to_file, "add-name-to-file");
4141 defsymbol (&Qmake_symbolic_link, "make-symbolic-link");
4142 defsymbol (&Qfile_exists_p, "file-exists-p");
4143 defsymbol (&Qfile_executable_p, "file-executable-p");
4144 defsymbol (&Qfile_readable_p, "file-readable-p");
4145 defsymbol (&Qfile_symlink_p, "file-symlink-p");
4146 defsymbol (&Qfile_writable_p, "file-writable-p");
4147 defsymbol (&Qfile_directory_p, "file-directory-p");
4148 defsymbol (&Qfile_regular_p, "file-regular-p");
4149 defsymbol (&Qfile_accessible_directory_p, "file-accessible-directory-p");
4150 defsymbol (&Qfile_modes, "file-modes");
4151 defsymbol (&Qset_file_modes, "set-file-modes");
4152 defsymbol (&Qfile_newer_than_file_p, "file-newer-than-file-p");
4153 defsymbol (&Qinsert_file_contents, "insert-file-contents");
4154 defsymbol (&Qwrite_region, "write-region");
4155 defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime");
4156 defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime");
4157 defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
4159 defsymbol (&Qauto_save_hook, "auto-save-hook");
4160 defsymbol (&Qauto_save_error, "auto-save-error");
4161 defsymbol (&Qauto_saving, "auto-saving");
4163 defsymbol (&Qformat_decode, "format-decode");
4164 defsymbol (&Qformat_annotate_function, "format-annotate-function");
4166 defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
4167 deferror (&Qfile_error, "file-error", "File error", Qio_error);
4168 deferror (&Qfile_already_exists, "file-already-exists",
4169 "File already exists", Qfile_error);
4171 DEFSUBR (Ffind_file_name_handler);
4173 DEFSUBR (Ffile_name_directory);
4174 DEFSUBR (Ffile_name_nondirectory);
4175 DEFSUBR (Funhandled_file_name_directory);
4176 DEFSUBR (Ffile_name_as_directory);
4177 DEFSUBR (Fdirectory_file_name);
4178 DEFSUBR (Fmake_temp_name);
4179 DEFSUBR (Fexpand_file_name);
4180 DEFSUBR (Ffile_truename);
4181 DEFSUBR (Fsubstitute_in_file_name);
4182 DEFSUBR (Fcopy_file);
4183 DEFSUBR (Fmake_directory_internal);
4184 DEFSUBR (Fdelete_directory);
4185 DEFSUBR (Fdelete_file);
4186 DEFSUBR (Frename_file);
4187 DEFSUBR (Fadd_name_to_file);
4189 DEFSUBR (Fmake_symbolic_link);
4190 #endif /* S_IFLNK */
4192 DEFSUBR (Fsysnetunam);
4193 #endif /* HPUX_NET */
4194 DEFSUBR (Ffile_name_absolute_p);
4195 DEFSUBR (Ffile_exists_p);
4196 DEFSUBR (Ffile_executable_p);
4197 DEFSUBR (Ffile_readable_p);
4198 DEFSUBR (Ffile_writable_p);
4199 DEFSUBR (Ffile_symlink_p);
4200 DEFSUBR (Ffile_directory_p);
4201 DEFSUBR (Ffile_accessible_directory_p);
4202 DEFSUBR (Ffile_regular_p);
4203 DEFSUBR (Ffile_modes);
4204 DEFSUBR (Fset_file_modes);
4205 DEFSUBR (Fset_default_file_modes);
4206 DEFSUBR (Fdefault_file_modes);
4207 DEFSUBR (Funix_sync);
4208 DEFSUBR (Ffile_newer_than_file_p);
4209 DEFSUBR (Finsert_file_contents_internal);
4210 DEFSUBR (Fwrite_region_internal);
4211 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
4212 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
4214 DEFSUBR (Fencrypt_string);
4215 DEFSUBR (Fdecrypt_string);
4217 DEFSUBR (Fverify_visited_file_modtime);
4218 DEFSUBR (Fclear_visited_file_modtime);
4219 DEFSUBR (Fvisited_file_modtime);
4220 DEFSUBR (Fset_visited_file_modtime);
4222 DEFSUBR (Fdo_auto_save);
4223 DEFSUBR (Fset_buffer_auto_saved);
4224 DEFSUBR (Fclear_buffer_auto_save_failure);
4225 DEFSUBR (Frecent_auto_save_p);
4229 vars_of_fileio (void)
4231 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
4232 *Format in which to write auto-save files.
4233 Should be a list of symbols naming formats that are defined in `format-alist'.
4234 If it is t, which is the default, auto-save files are written in the
4235 same format as a regular save would use.
4237 Vauto_save_file_format = Qt;
4239 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4240 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4241 If a file name matches REGEXP, then all I/O on that file is done by calling
4244 The first argument given to HANDLER is the name of the I/O primitive
4245 to be handled; the remaining arguments are the arguments that were
4246 passed to that primitive. For example, if you do
4247 (file-exists-p FILENAME)
4248 and FILENAME is handled by HANDLER, then HANDLER is called like this:
4249 (funcall HANDLER 'file-exists-p FILENAME)
4250 The function `find-file-name-handler' checks this list for a handler
4253 Vfile_name_handler_alist = Qnil;
4255 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
4256 A list of functions to be called at the end of `insert-file-contents'.
4257 Each is passed one argument, the number of bytes inserted. It should return
4258 the new byte count, and leave point the same. If `insert-file-contents' is
4259 intercepted by a handler from `file-name-handler-alist', that handler is
4260 responsible for calling the after-insert-file-functions if appropriate.
4262 Vafter_insert_file_functions = Qnil;
4264 DEFVAR_LISP ("write-region-annotate-functions",
4265 &Vwrite_region_annotate_functions /*
4266 A list of functions to be called at the start of `write-region'.
4267 Each is passed two arguments, START and END, as for `write-region'.
4268 It should return a list of pairs (POSITION . STRING) of strings to be
4269 effectively inserted at the specified positions of the file being written
4270 \(1 means to insert before the first byte written). The POSITIONs must be
4271 sorted into increasing order. If there are several functions in the list,
4272 the several lists are merged destructively.
4274 Vwrite_region_annotate_functions = Qnil;
4276 DEFVAR_LISP ("write-region-annotations-so-far",
4277 &Vwrite_region_annotations_so_far /*
4278 When an annotation function is called, this holds the previous annotations.
4279 These are the annotations made by other annotation functions
4280 that were already called. See also `write-region-annotate-functions'.
4282 Vwrite_region_annotations_so_far = Qnil;
4284 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
4285 A list of file name handlers that temporarily should not be used.
4286 This applies only to the operation `inhibit-file-name-operation'.
4288 Vinhibit_file_name_handlers = Qnil;
4290 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
4291 The operation for which `inhibit-file-name-handlers' is applicable.
4293 Vinhibit_file_name_operation = Qnil;
4295 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
4296 File name in which we write a list of all auto save file names.
4298 Vauto_save_list_file_name = Qnil;
4300 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
4301 &disable_auto_save_when_buffer_shrinks /*
4302 If non-nil, auto-saving is disabled when a buffer shrinks too much.
4303 This is to prevent you from losing your edits if you accidentally
4304 delete a large chunk of the buffer and don't notice it until too late.
4305 Saving the buffer normally turns auto-save back on.
4307 disable_auto_save_when_buffer_shrinks = 1;
4309 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
4310 Directory separator character for built-in functions that return file names.
4311 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
4312 This variable affects the built-in functions only on Windows,
4313 on other platforms, it is initialized so that Lisp code can find out
4314 what the normal separator is.
4317 Vdirectory_sep_char = make_char ('\\');
4319 Vdirectory_sep_char = make_char ('/');