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 static unsigned int temp_name_rand;
640 DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
641 Generate a temporary file name starting with PREFIX.
642 The Emacs process number forms part of the result, so there is no
643 danger of generating a name being used by another process.
645 In addition, this function makes an attempt to choose a name that
646 does not specify an existing file. To make this work, PREFIX should
647 be an absolute file name.
651 static const char tbl[64] =
653 'A','B','C','D','E','F','G','H',
654 'I','J','K','L','M','N','O','P',
655 'Q','R','S','T','U','V','W','X',
656 'Y','Z','a','b','c','d','e','f',
657 'g','h','i','j','k','l','m','n',
658 'o','p','q','r','s','t','u','v',
659 'w','x','y','z','0','1','2','3',
660 '4','5','6','7','8','9','-','_'
667 CHECK_STRING (prefix);
669 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
672 1) It might change the prefix, so the resulting string might not
673 begin with PREFIX. This violates the principle of least
676 2) It breaks under many unforeseeable circumstances, such as with
677 the code that uses (make-temp-name "") instead of
678 (make-temp-name "./").
680 3) It might yield unexpected (to stat(2)) results in the presence
681 of EFS and file name handlers. */
683 len = XSTRING_LENGTH (prefix);
684 val = make_uninit_string (len + 6);
685 data = XSTRING_DATA (val);
686 memcpy (data, XSTRING_DATA (prefix), len);
689 /* VAL is created by adding 6 characters to PREFIX. The first three
690 are the PID of this process, in base 64, and the second three are
691 a pseudo-random number seeded from process startup time. This
692 ensures 262144 unique file names per PID per PREFIX per machine. */
695 unsigned int pid = (unsigned int) getpid ();
696 *p++ = tbl[(pid >> 0) & 63];
697 *p++ = tbl[(pid >> 6) & 63];
698 *p++ = tbl[(pid >> 12) & 63];
701 /* Here we try to minimize useless stat'ing when this function is
702 invoked many times successively with the same PREFIX. We achieve
703 this by using a very pseudo-random number generator to generate
704 file names unique to this process, with a very long cycle. */
710 p[0] = tbl[(temp_name_rand >> 0) & 63];
711 p[1] = tbl[(temp_name_rand >> 6) & 63];
712 p[2] = tbl[(temp_name_rand >> 12) & 63];
714 /* Poor man's congruential RN generator. Replace with ++count
716 temp_name_rand += 25229;
717 temp_name_rand %= 225307;
721 if (stat ((const char *) data, &ignored) < 0)
723 /* We want to return only if errno is ENOENT. */
727 /* The error here is dubious, but there is little else we
728 can do. The alternatives are to return nil, which is
729 as bad as (and in many cases worse than) throwing the
730 error, or to ignore the error, which will likely result
732 report_file_error ("Cannot create temporary name for prefix",
734 return Qnil; /* not reached */
740 DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
741 Convert filename NAME to absolute, and canonicalize it.
742 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
743 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
744 the current buffer's value of default-directory is used.
745 File name components that are `.' are removed, and
746 so are file name components followed by `..', along with the `..' itself;
747 note that these simplifications are done without checking the resulting
748 file names in the file system.
749 An initial `~/' expands to your home directory.
750 An initial `~USER/' expands to USER's home directory.
751 See also the function `substitute-in-file-name'.
753 (name, default_directory))
755 /* This function can GC */
758 Bufbyte *newdir, *p, *o;
763 int collapse_newdir = 1;
766 #endif /* WINDOWSNT */
775 /* If the file name has special constructs in it,
776 call the corresponding file handler. */
777 handler = Ffind_file_name_handler (name, Qexpand_file_name);
779 return call3_check_string (handler, Qexpand_file_name, name,
782 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
783 if (NILP (default_directory))
784 default_directory = current_buffer->directory;
785 if (! STRINGP (default_directory))
786 default_directory = build_string ("/");
788 if (!NILP (default_directory))
790 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
792 return call3 (handler, Qexpand_file_name, name, default_directory);
795 o = XSTRING_DATA (default_directory);
797 /* Make sure DEFAULT_DIRECTORY is properly expanded.
798 It would be better to do this down below where we actually use
799 default_directory. Unfortunately, calling Fexpand_file_name recursively
800 could invoke GC, and the strings might be relocated. This would
801 be annoying because we have pointers into strings lying around
802 that would need adjusting, and people would add new pointers to
803 the code and forget to adjust them, resulting in intermittent bugs.
804 Putting this call here avoids all that crud.
806 The EQ test avoids infinite recursion. */
807 if (! NILP (default_directory) && !EQ (default_directory, name)
808 /* Save time in some common cases - as long as default_directory
809 is not relative, it can be canonicalized with name below (if it
810 is needed at all) without requiring it to be expanded now. */
812 /* Detect MSDOS file names with drive specifiers. */
813 && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
814 /* Detect Windows file names in UNC format. */
815 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
817 #else /* not WINDOWSNT */
819 /* Detect Unix absolute file names (/... alone is not absolute on
821 && ! (IS_DIRECTORY_SEP (o[0]))
822 #endif /* not WINDOWSNT */
828 default_directory = Fexpand_file_name (default_directory, Qnil);
832 #ifdef FILE_SYSTEM_CASE
833 name = FILE_SYSTEM_CASE (name);
836 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
837 into name should be safe during all of this, though. */
838 nm = XSTRING_DATA (name);
841 /* We will force directory separators to be either all \ or /, so make
842 a local copy to modify, even if there ends up being no change. */
843 nm = strcpy ((char *)alloca (strlen ((char *)nm) + 1), (char *)nm);
845 /* Find and remove drive specifier if present; this makes nm absolute
846 even if the rest of the name appears to be relative. */
848 Bufbyte *colon = (Bufbyte *) strrchr ((char *)nm, ':');
851 /* Only recognize colon as part of drive specifier if there is a
852 single alphabetic character preceding the colon (and if the
853 character before the drive letter, if present, is a directory
854 separator); this is to support the remote system syntax used by
855 ange-ftp, and the "po:username" syntax for POP mailboxes. */
859 else if (IS_DRIVE (colon[-1])
860 && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
867 while (--colon >= nm)
873 /* If we see "c://somedir", we want to strip the first slash after the
874 colon when stripping the drive letter. Otherwise, this expands to
876 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
878 #endif /* WINDOWSNT */
880 /* If nm is absolute, look for /./ or /../ sequences; if none are
881 found, we can probably return right away. We will avoid allocating
882 a new string if name is already fully expanded. */
884 IS_DIRECTORY_SEP (nm[0])
886 && (drive || IS_DIRECTORY_SEP (nm[1]))
890 /* If it turns out that the filename we want to return is just a
891 suffix of FILENAME, we don't need to go through and edit
892 things; we just need to construct a new string using data
893 starting at the middle of FILENAME. If we set lose to a
894 non-zero value, that means we've discovered that we can't do
901 /* Since we know the name is absolute, we can assume that each
902 element starts with a "/". */
904 /* "." and ".." are hairy. */
905 if (IS_DIRECTORY_SEP (p[0])
907 && (IS_DIRECTORY_SEP (p[2])
909 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
917 /* Make sure directories are all separated with / or \ as
918 desired, but avoid allocation of a new string when not
920 CORRECT_DIR_SEPS (nm);
921 if (IS_DIRECTORY_SEP (nm[1]))
923 if (strcmp (nm, XSTRING_DATA (name)) != 0)
924 name = build_string (nm);
926 /* drive must be set, so this is okay */
927 else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0)
929 name = make_string (nm - 2, p - nm + 2);
930 XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
931 XSTRING_DATA (name)[1] = ':';
934 #else /* not WINDOWSNT */
935 if (nm == XSTRING_DATA (name))
937 return build_string ((char *) nm);
938 #endif /* not WINDOWSNT */
942 /* At this point, nm might or might not be an absolute file name. We
943 need to expand ~ or ~user if present, otherwise prefix nm with
944 default_directory if nm is not absolute, and finally collapse /./
945 and /foo/../ sequences.
947 We set newdir to be the appropriate prefix if one is needed:
948 - the relevant user directory if nm starts with ~ or ~user
949 - the specified drive's working dir (DOS/NT only) if nm does not
951 - the value of default_directory.
953 Note that these prefixes are not guaranteed to be absolute (except
954 for the working dir of a drive). Therefore, to ensure we always
955 return an absolute name, if the final prefix is not absolute we
956 append it to the current working directory. */
960 if (nm[0] == '~') /* prefix ~ */
962 if (IS_DIRECTORY_SEP (nm[1])
963 || nm[1] == 0) /* ~ by itself */
965 Extbyte *newdir_external = get_home_directory ();
967 if (newdir_external == NULL)
968 newdir = (Bufbyte *) "";
970 TO_INTERNAL_FORMAT (C_STRING, newdir_external,
971 C_STRING_ALLOCA, (* ((char **) &newdir)),
979 else /* ~user/filename */
981 for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++)
983 o = (Bufbyte *) alloca (p - nm + 1);
984 memcpy (o, (char *) nm, p - nm);
987 /* #### marcpa's syncing note: FSF uses getpwnam even on NT,
988 which does not work. The following works only if ~USER
989 names the user who runs this instance of XEmacs. While
990 NT is single-user (for the moment) you still can have
991 multiple user profiles users defined, each with its HOME.
992 Therefore, the following should be reworked to handle
995 /* Now if the file given is "~foo/file" and HOME="c:/", then
996 we want the file to be named "c:/file" ("~foo" becomes
997 "c:/"). The variable o has "~foo", so we can use the
998 length of that string to offset nm. August Hill, 31 Aug
1000 newdir = (Bufbyte *) get_home_directory();
1001 dostounix_filename (newdir);
1002 nm += strlen(o) + 1;
1003 #else /* not WINDOWSNT */
1005 if ((user = user_login_name (NULL)) != NULL)
1007 /* Does the user login name match the ~name? */
1008 if (strcmp (user, (char *) o + 1) == 0)
1010 newdir = (Bufbyte *) get_home_directory();
1016 #endif /* __CYGWIN32__ */
1017 /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM
1018 occurring in it. (It can call select()). */
1019 slow_down_interrupts ();
1020 pw = (struct passwd *) getpwnam ((char *) o + 1);
1021 speed_up_interrupts ();
1024 newdir = (Bufbyte *) pw -> pw_dir;
1030 #endif /* not WINDOWSNT */
1032 /* If we don't find a user of that name, leave the name
1033 unchanged; don't move nm forward to p. */
1038 /* On DOS and Windows, nm is absolute if a drive name was specified;
1039 use the drive's current directory as the prefix if needed. */
1040 if (!newdir && drive)
1042 /* Get default directory if needed to make nm absolute. */
1043 if (!IS_DIRECTORY_SEP (nm[0]))
1045 newdir = alloca (MAXPATHLEN + 1);
1046 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
1051 /* Either nm starts with /, or drive isn't mounted. */
1052 newdir = alloca (4);
1053 newdir[0] = DRIVE_LETTER (drive);
1059 #endif /* WINDOWSNT */
1061 /* Finally, if no prefix has been specified and nm is not absolute,
1062 then it must be expanded relative to default_directory. */
1066 /* /... alone is not absolute on DOS and Windows. */
1067 && !IS_DIRECTORY_SEP (nm[0])
1069 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1073 newdir = XSTRING_DATA (default_directory);
1079 /* First ensure newdir is an absolute name. */
1081 /* Detect MSDOS file names with drive specifiers. */
1082 ! (IS_DRIVE (newdir[0])
1083 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1084 /* Detect Windows file names in UNC format. */
1085 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1086 /* Detect drive spec by itself */
1087 && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0)
1090 /* Effectively, let newdir be (expand-file-name newdir cwd).
1091 Because of the admonition against calling expand-file-name
1092 when we have pointers into lisp strings, we accomplish this
1093 indirectly by prepending newdir to nm if necessary, and using
1094 cwd (or the wd of newdir's drive) as the new newdir. */
1096 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1101 if (!IS_DIRECTORY_SEP (nm[0]))
1103 char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
1104 file_name_as_directory (tmp, newdir);
1108 newdir = alloca (MAXPATHLEN + 1);
1111 if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
1118 /* Strip off drive name from prefix, if present. */
1119 if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
1125 /* Keep only a prefix from newdir if nm starts with slash
1126 (/ /server/share for UNC, nothing otherwise). */
1127 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1129 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
1131 newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
1133 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1135 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1142 #endif /* WINDOWSNT */
1146 /* Get rid of any slash at the end of newdir, unless newdir is
1147 just // (an incomplete UNC name). */
1148 length = strlen ((char *) newdir);
1149 if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1151 && !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
1155 Bufbyte *temp = (Bufbyte *) alloca (length);
1156 memcpy (temp, newdir, length - 1);
1157 temp[length - 1] = 0;
1165 /* Now concatenate the directory and name to new space in the stack frame */
1166 tlen += strlen ((char *) nm) + 1;
1168 /* Add reserved space for drive name. (The Microsoft x86 compiler
1169 produces incorrect code if the following two lines are combined.) */
1170 target = (Bufbyte *) alloca (tlen + 2);
1172 #else /* not WINDOWSNT */
1173 target = (Bufbyte *) alloca (tlen);
1174 #endif /* not WINDOWSNT */
1179 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1180 strcpy ((char *) target, (char *) newdir);
1182 file_name_as_directory ((char *) target, (char *) newdir);
1185 strcat ((char *) target, (char *) nm);
1187 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1189 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1196 if (!IS_DIRECTORY_SEP (*p))
1200 else if (IS_DIRECTORY_SEP (p[0])
1202 && (IS_DIRECTORY_SEP (p[2])
1205 /* If "/." is the entire filename, keep the "/". Otherwise,
1206 just delete the whole "/.". */
1207 if (o == target && p[2] == '\0')
1211 else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
1212 /* `/../' is the "superroot" on certain file systems. */
1214 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1216 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
1218 /* Keep initial / only if this is the whole name. */
1219 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1224 /* if drive is set, we're not dealing with an UNC, so
1225 multiple dir-seps are redundant (and reportedly cause trouble
1227 else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
1237 /* At last, set drive name, except for network file name. */
1241 target[0] = DRIVE_LETTER (drive);
1246 assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]));
1248 CORRECT_DIR_SEPS (target);
1249 #endif /* WINDOWSNT */
1251 return make_string (target, o - target);
1254 DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
1255 Return the canonical name of the given FILE.
1256 Second arg DEFAULT is directory to start with if FILE is relative
1257 (does not start with slash); if DEFAULT is nil or missing,
1258 the current buffer's value of default-directory is used.
1259 No component of the resulting pathname will be a symbolic link, as
1260 in the realpath() function.
1262 (filename, default_))
1264 /* This function can GC. */
1265 Lisp_Object expanded_name;
1266 struct gcpro gcpro1;
1268 CHECK_STRING (filename);
1270 expanded_name = Fexpand_file_name (filename, default_);
1272 GCPRO1 (expanded_name);
1274 if (!STRINGP (expanded_name))
1278 Lisp_Object handler =
1279 Ffind_file_name_handler (expanded_name, Qfile_truename);
1281 if (!NILP (handler))
1283 (call2_check_string (handler, Qfile_truename, expanded_name));
1287 char resolved_path[MAXPATHLEN];
1292 TO_EXTERNAL_FORMAT (LISP_STRING, expanded_name,
1293 ALLOCA, (path, elen),
1296 if (elen > MAXPATHLEN)
1299 /* Try doing it all at once. */
1300 /* !! Does realpath() Mule-encapsulate?
1301 Answer: Nope! So we do it above */
1302 if (!xrealpath ((char *) path, resolved_path))
1304 /* Didn't resolve it -- have to do it one component at a time. */
1305 /* "realpath" is a typically useless, stupid un*x piece of crap.
1306 It claims to return a useful value in the "error" case, but since
1307 there is no indication provided of how far along the pathname
1308 the function went before erring, there is no way to use the
1309 partial result returned. What a piece of junk.
1311 The above comment refers to historical versions of
1312 realpath(). The Unix98 specs state:
1314 "On successful completion, realpath() returns a
1315 pointer to the resolved name. Otherwise, realpath()
1316 returns a null pointer and sets errno to indicate the
1317 error, and the contents of the buffer pointed to by
1318 resolved_name are undefined."
1320 Since we depend on undocumented semantics of various system realpath()s,
1321 we just use our own version in realpath.c. */
1324 p = (Extbyte *) memchr (p + 1, '/', elen - (p + 1 - path));
1328 if (xrealpath ((char *) path, resolved_path))
1336 else if (errno == ENOENT || errno == EACCES)
1338 /* Failed on this component. Just tack on the rest of
1339 the string and we are done. */
1340 int rlen = strlen (resolved_path);
1342 /* "On failure, it returns NULL, sets errno to indicate
1343 the error, and places in resolved_path the absolute pathname
1344 of the path component which could not be resolved." */
1348 int plen = elen - (p - path);
1350 if (rlen > 1 && resolved_path[rlen - 1] == '/')
1353 if (plen + rlen + 1 > countof (resolved_path))
1356 resolved_path[rlen] = '/';
1357 memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
1367 Lisp_Object resolved_name;
1368 int rlen = strlen (resolved_path);
1369 if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/'
1370 && !(rlen > 0 && resolved_path[rlen - 1] == '/'))
1372 if (rlen + 1 > countof (resolved_path))
1374 resolved_path[rlen++] = '/';
1375 resolved_path[rlen] = '\0';
1377 TO_INTERNAL_FORMAT (DATA, (resolved_path, rlen),
1378 LISP_STRING, resolved_name,
1380 RETURN_UNGCPRO (resolved_name);
1384 errno = ENAMETOOLONG;
1387 report_file_error ("Finding truename", list1 (expanded_name));
1389 RETURN_UNGCPRO (Qnil);
1393 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1394 Substitute environment variables referred to in FILENAME.
1395 `$FOO' where FOO is an environment variable name means to substitute
1396 the value of that variable. The variable name should be terminated
1397 with a character not a letter, digit or underscore; otherwise, enclose
1398 the entire variable name in braces.
1399 If `/~' appears, all of FILENAME through that `/' is discarded.
1404 /* This function can GC. GC checked 1997.04.06. */
1407 Bufbyte *s, *p, *o, *x, *endp;
1408 Bufbyte *target = 0;
1410 int substituted = 0;
1412 Lisp_Object handler;
1414 CHECK_STRING (string);
1416 /* If the file name has special constructs in it,
1417 call the corresponding file handler. */
1418 handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name);
1419 if (!NILP (handler))
1420 return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
1423 nm = XSTRING_DATA (string);
1424 endp = nm + XSTRING_LENGTH (string);
1426 /* If /~ or // appears, discard everything through first slash. */
1428 for (p = nm; p != endp; p++)
1431 #if defined (WINDOWSNT) || defined (__CYGWIN32__)
1432 /* // at start of file name is meaningful in WindowsNT systems */
1433 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
1434 #else /* not (WINDOWSNT || __CYGWIN32__) */
1435 || IS_DIRECTORY_SEP (p[0])
1436 #endif /* not (WINDOWSNT || __CYGWIN32__) */
1439 && (IS_DIRECTORY_SEP (p[-1])))
1445 /* see comment in expand-file-name about drive specifiers */
1446 else if (IS_DRIVE (p[0]) && p[1] == ':'
1447 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1452 #endif /* WINDOWSNT */
1455 /* See if any variables are substituted into the string
1456 and find the total length of their values in `total' */
1458 for (p = nm; p != endp;)
1468 /* "$$" means a single "$" */
1477 while (p != endp && *p != '}') p++;
1478 if (*p != '}') goto missingclose;
1484 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1488 /* Copy out the variable name */
1489 target = (Bufbyte *) alloca (s - o + 1);
1490 strncpy ((char *) target, (char *) o, s - o);
1493 strupr (target); /* $home == $HOME etc. */
1494 #endif /* WINDOWSNT */
1496 /* Get variable value */
1497 o = (Bufbyte *) egetenv ((char *) target);
1498 if (!o) goto badvar;
1499 total += strlen ((char *) o);
1506 /* If substitution required, recopy the string and do it */
1507 /* Make space in stack frame for the new copy */
1508 xnm = (Bufbyte *) alloca (XSTRING_LENGTH (string) + total + 1);
1511 /* Copy the rest of the name through, replacing $ constructs with values */
1528 while (p != endp && *p != '}') p++;
1529 if (*p != '}') goto missingclose;
1535 while (p != endp && (isalnum (*p) || *p == '_')) p++;
1539 /* Copy out the variable name */
1540 target = (Bufbyte *) alloca (s - o + 1);
1541 strncpy ((char *) target, (char *) o, s - o);
1544 strupr (target); /* $home == $HOME etc. */
1545 #endif /* WINDOWSNT */
1547 /* Get variable value */
1548 o = (Bufbyte *) egetenv ((char *) target);
1552 strcpy ((char *) x, (char *) o);
1553 x += strlen ((char *) o);
1558 /* If /~ or // appears, discard everything through first slash. */
1560 for (p = xnm; p != x; p++)
1562 #if defined (WINDOWSNT)
1563 || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
1564 #else /* not WINDOWSNT */
1565 || IS_DIRECTORY_SEP (p[0])
1566 #endif /* not WINDOWSNT */
1568 /* don't do p[-1] if that would go off the beginning --jwz */
1569 && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1]))
1572 else if (IS_DRIVE (p[0]) && p[1] == ':'
1573 && p > nm && IS_DIRECTORY_SEP (p[-1]))
1577 return make_string (xnm, x - xnm);
1580 error ("Bad format environment-variable substitution");
1582 error ("Missing \"}\" in environment-variable substitution");
1584 error ("Substituting nonexistent environment variable \"%s\"",
1588 return Qnil; /* suppress compiler warning */
1591 /* A slightly faster and more convenient way to get
1592 (directory-file-name (expand-file-name FOO)). */
1595 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1597 /* This function can call lisp */
1598 Lisp_Object abspath;
1599 struct gcpro gcpro1;
1601 abspath = Fexpand_file_name (filename, defdir);
1603 /* Remove final slash, if any (unless path is root).
1604 stat behaves differently depending! */
1605 if (XSTRING_LENGTH (abspath) > 1
1606 && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1))
1607 && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2)))
1608 /* We cannot take shortcuts; they might be wrong for magic file names. */
1609 abspath = Fdirectory_file_name (abspath);
1614 /* Signal an error if the file ABSNAME already exists.
1615 If INTERACTIVE is nonzero, ask the user whether to proceed,
1616 and bypass the error if the user says to go ahead.
1617 QUERYSTRING is a name for the action that is being considered
1619 *STATPTR is used to store the stat information if the file exists.
1620 If the file does not exist, STATPTR->st_mode is set to 0. */
1623 barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
1624 int interactive, struct stat *statptr)
1626 /* This function can GC. GC checked 1997.04.06. */
1627 struct stat statbuf;
1629 /* stat is a good way to tell whether the file exists,
1630 regardless of what access permissions it has. */
1631 if (stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
1638 struct gcpro gcpro1;
1640 prompt = emacs_doprnt_string_c
1641 ((const Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "),
1642 Qnil, -1, XSTRING_DATA (absname),
1643 GETTEXT (querystring));
1646 tem = call1 (Qyes_or_no_p, prompt);
1653 Fsignal (Qfile_already_exists,
1654 list2 (build_translated_string ("File already exists"),
1662 statptr->st_mode = 0;
1667 DEFUN ("copy-file", Fcopy_file, 2, 4,
1668 "fCopy file: \nFCopy %s to file: \np\nP", /*
1669 Copy FILE to NEWNAME. Both args must be strings.
1670 Signals a `file-already-exists' error if file NEWNAME already exists,
1671 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1672 A number as third arg means request confirmation if NEWNAME already exists.
1673 This is what happens in interactive use with M-x.
1674 Fourth arg KEEP-TIME non-nil means give the new file the same
1675 last-modified time as the old one. (This works on only some systems.)
1676 A prefix arg makes KEEP-TIME non-nil.
1678 (filename, newname, ok_if_already_exists, keep_time))
1680 /* This function can GC. GC checked 1997.04.06. */
1682 char buf[16 * 1024];
1683 struct stat st, out_st;
1684 Lisp_Object handler;
1685 int speccount = specpdl_depth ();
1686 struct gcpro gcpro1, gcpro2;
1687 /* Lisp_Object args[6]; */
1688 int input_file_statable_p;
1690 GCPRO2 (filename, newname);
1691 CHECK_STRING (filename);
1692 CHECK_STRING (newname);
1693 filename = Fexpand_file_name (filename, Qnil);
1694 newname = Fexpand_file_name (newname, Qnil);
1696 /* If the input file name has special constructs in it,
1697 call the corresponding file handler. */
1698 handler = Ffind_file_name_handler (filename, Qcopy_file);
1699 /* Likewise for output file name. */
1701 handler = Ffind_file_name_handler (newname, Qcopy_file);
1702 if (!NILP (handler))
1705 return call5 (handler, Qcopy_file, filename, newname,
1706 ok_if_already_exists, keep_time);
1709 /* When second argument is a directory, copy the file into it.
1710 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1712 if (!NILP (Ffile_directory_p (newname)))
1714 Lisp_Object args[3];
1715 struct gcpro ngcpro1;
1719 args[1] = Qnil; args[2] = Qnil;
1722 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1723 args[i++] = build_string ("/");
1724 args[i++] = Ffile_name_nondirectory (filename);
1725 newname = Fconcat (i, args);
1729 if (NILP (ok_if_already_exists)
1730 || INTP (ok_if_already_exists))
1731 barf_or_query_if_file_exists (newname, "copy to it",
1732 INTP (ok_if_already_exists), &out_st);
1733 else if (stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
1736 ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
1738 report_file_error ("Opening input file", list1 (filename));
1740 record_unwind_protect (close_file_unwind, make_int (ifd));
1742 /* We can only copy regular files and symbolic links. Other files are not
1744 input_file_statable_p = (fstat (ifd, &st) >= 0);
1747 if (out_st.st_mode != 0
1748 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1751 report_file_error ("Input and output files are the same",
1752 list2 (filename, newname));
1756 #if defined (S_ISREG) && defined (S_ISLNK)
1757 if (input_file_statable_p)
1759 if (!(S_ISREG (st.st_mode))
1760 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1762 && !(S_ISCHR (st.st_mode))
1764 && !(S_ISLNK (st.st_mode)))
1766 #if defined (EISDIR)
1767 /* Get a better looking error message. */
1770 report_file_error ("Non-regular file", list1 (filename));
1773 #endif /* S_ISREG && S_ISLNK */
1775 ofd = open( (char *) XSTRING_DATA (newname),
1776 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1778 report_file_error ("Opening output file", list1 (newname));
1781 Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil);
1783 record_unwind_protect (close_file_unwind, ofd_locative);
1785 while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0)
1787 if (write_allowing_quit (ofd, buf, n) != n)
1788 report_file_error ("I/O error", list1 (newname));
1791 /* Closing the output clobbers the file times on some systems. */
1792 if (close (ofd) < 0)
1793 report_file_error ("I/O error", list1 (newname));
1795 if (input_file_statable_p)
1797 if (!NILP (keep_time))
1799 EMACS_TIME atime, mtime;
1800 EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
1801 EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
1802 if (set_file_times ((char *) XSTRING_DATA (newname), atime,
1804 report_file_error ("I/O error", list1 (newname));
1806 chmod ((const char *) XSTRING_DATA (newname),
1807 st.st_mode & 07777);
1810 /* We'll close it by hand */
1811 XCAR (ofd_locative) = Qnil;
1814 unbind_to (speccount, Qnil);
1821 DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1822 Create a directory. One argument, a file name string.
1826 /* This function can GC. GC checked 1997.04.06. */
1827 char dir [MAXPATHLEN];
1828 Lisp_Object handler;
1829 struct gcpro gcpro1;
1831 CHECK_STRING (dirname_);
1832 dirname_ = Fexpand_file_name (dirname_, Qnil);
1835 handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal);
1837 if (!NILP (handler))
1838 return (call2 (handler, Qmake_directory_internal, dirname_));
1840 if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1))
1842 return Fsignal (Qfile_error,
1843 list3 (build_translated_string ("Creating directory"),
1844 build_translated_string ("pathname too long"),
1847 strncpy (dir, (char *) XSTRING_DATA (dirname_),
1848 XSTRING_LENGTH (dirname_) + 1);
1850 if (dir [XSTRING_LENGTH (dirname_) - 1] == '/')
1851 dir [XSTRING_LENGTH (dirname_) - 1] = 0;
1853 if (mkdir (dir, 0777) != 0)
1854 report_file_error ("Creating directory", list1 (dirname_));
1859 DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1860 Delete a directory. One argument, a file name or directory name string.
1864 /* This function can GC. GC checked 1997.04.06. */
1865 Lisp_Object handler;
1866 struct gcpro gcpro1;
1868 CHECK_STRING (dirname_);
1871 dirname_ = Fexpand_file_name (dirname_, Qnil);
1872 dirname_ = Fdirectory_file_name (dirname_);
1874 handler = Ffind_file_name_handler (dirname_, Qdelete_directory);
1876 if (!NILP (handler))
1877 return (call2 (handler, Qdelete_directory, dirname_));
1879 if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0)
1880 report_file_error ("Removing directory", list1 (dirname_));
1885 DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1886 Delete the file named FILENAME (a string).
1887 If FILENAME has multiple names, it continues to exist with the other names.
1891 /* This function can GC. GC checked 1997.04.06. */
1892 Lisp_Object handler;
1893 struct gcpro gcpro1;
1895 CHECK_STRING (filename);
1896 filename = Fexpand_file_name (filename, Qnil);
1899 handler = Ffind_file_name_handler (filename, Qdelete_file);
1901 if (!NILP (handler))
1902 return call2 (handler, Qdelete_file, filename);
1904 if (0 > unlink ((char *) XSTRING_DATA (filename)))
1905 report_file_error ("Removing old name", list1 (filename));
1910 internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2)
1915 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1918 internal_delete_file (Lisp_Object filename)
1920 /* This function can GC. GC checked 1997.04.06. */
1921 return NILP (condition_case_1 (Qt, Fdelete_file, filename,
1922 internal_delete_file_1, Qnil));
1925 DEFUN ("rename-file", Frename_file, 2, 3,
1926 "fRename file: \nFRename %s to file: \np", /*
1927 Rename FILE as NEWNAME. Both args strings.
1928 If file has names other than FILE, it continues to have those names.
1929 Signals a `file-already-exists' error if a file NEWNAME already exists
1930 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1931 A number as third arg means request confirmation if NEWNAME already exists.
1932 This is what happens in interactive use with M-x.
1934 (filename, newname, ok_if_already_exists))
1936 /* This function can GC. GC checked 1997.04.06. */
1937 Lisp_Object handler;
1938 struct gcpro gcpro1, gcpro2;
1940 GCPRO2 (filename, newname);
1941 CHECK_STRING (filename);
1942 CHECK_STRING (newname);
1943 filename = Fexpand_file_name (filename, Qnil);
1944 newname = Fexpand_file_name (newname, Qnil);
1946 /* If the file name has special constructs in it,
1947 call the corresponding file handler. */
1948 handler = Ffind_file_name_handler (filename, Qrename_file);
1950 handler = Ffind_file_name_handler (newname, Qrename_file);
1951 if (!NILP (handler))
1954 return call4 (handler, Qrename_file,
1955 filename, newname, ok_if_already_exists);
1958 /* When second argument is a directory, rename the file into it.
1959 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1961 if (!NILP (Ffile_directory_p (newname)))
1963 Lisp_Object args[3];
1964 struct gcpro ngcpro1;
1968 args[1] = Qnil; args[2] = Qnil;
1971 if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
1972 args[i++] = build_string ("/");
1973 args[i++] = Ffile_name_nondirectory (filename);
1974 newname = Fconcat (i, args);
1978 if (NILP (ok_if_already_exists)
1979 || INTP (ok_if_already_exists))
1980 barf_or_query_if_file_exists (newname, "rename to it",
1981 INTP (ok_if_already_exists), 0);
1983 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1984 WINDOWSNT here; I've removed it. --marcpa */
1986 /* FSFmacs only calls rename() here under BSD 4.1, and calls
1987 link() and unlink() otherwise, but that's bogus. Sometimes
1988 rename() succeeds where link()/unlink() fail, and we have
1989 configure check for rename() and emulate using link()/unlink()
1991 if (0 > rename ((char *) XSTRING_DATA (filename),
1992 (char *) XSTRING_DATA (newname)))
1996 Fcopy_file (filename, newname,
1997 /* We have already prompted if it was an integer,
1998 so don't have copy-file prompt again. */
1999 (NILP (ok_if_already_exists) ? Qnil : Qt),
2001 Fdelete_file (filename);
2005 report_file_error ("Renaming", list2 (filename, newname));
2012 DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
2013 "fAdd name to file: \nFName to add to %s: \np", /*
2014 Give FILE additional name NEWNAME. Both args strings.
2015 Signals a `file-already-exists' error if a file NEWNAME already exists
2016 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2017 A number as third arg means request confirmation if NEWNAME already exists.
2018 This is what happens in interactive use with M-x.
2020 (filename, newname, ok_if_already_exists))
2022 /* This function can GC. GC checked 1997.04.06. */
2023 Lisp_Object handler;
2024 struct gcpro gcpro1, gcpro2;
2026 GCPRO2 (filename, newname);
2027 CHECK_STRING (filename);
2028 CHECK_STRING (newname);
2029 filename = Fexpand_file_name (filename, Qnil);
2030 newname = Fexpand_file_name (newname, Qnil);
2032 /* If the file name has special constructs in it,
2033 call the corresponding file handler. */
2034 handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
2035 if (!NILP (handler))
2036 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2037 newname, ok_if_already_exists));
2039 /* If the new name has special constructs in it,
2040 call the corresponding file handler. */
2041 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2042 if (!NILP (handler))
2043 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
2044 newname, ok_if_already_exists));
2046 if (NILP (ok_if_already_exists)
2047 || INTP (ok_if_already_exists))
2048 barf_or_query_if_file_exists (newname, "make it a new name",
2049 INTP (ok_if_already_exists), 0);
2050 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
2051 on NT here. --marcpa */
2052 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
2053 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
2054 Reverted to previous behavior pending a working fix. (jhar) */
2055 #if defined(WINDOWSNT)
2056 /* Windows does not support this operation. */
2057 report_file_error ("Adding new name", Flist (2, &filename));
2058 #else /* not defined(WINDOWSNT) */
2060 unlink ((char *) XSTRING_DATA (newname));
2061 if (0 > link ((char *) XSTRING_DATA (filename),
2062 (char *) XSTRING_DATA (newname)))
2064 report_file_error ("Adding new name",
2065 list2 (filename, newname));
2067 #endif /* defined(WINDOWSNT) */
2073 DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3,
2074 "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
2075 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
2076 Signals a `file-already-exists' error if a file LINKNAME already exists
2077 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2078 A number as third arg means request confirmation if LINKNAME already exists.
2079 This happens for interactive use with M-x.
2081 (filename, linkname, ok_if_already_exists))
2083 /* This function can GC. GC checked 1997.06.04. */
2084 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2085 Lisp_Object handler;
2086 struct gcpro gcpro1, gcpro2;
2088 GCPRO2 (filename, linkname);
2089 CHECK_STRING (filename);
2090 CHECK_STRING (linkname);
2091 /* If the link target has a ~, we must expand it to get
2092 a truly valid file name. Otherwise, do not expand;
2093 we want to permit links to relative file names. */
2094 if (XSTRING_BYTE (filename, 0) == '~')
2095 filename = Fexpand_file_name (filename, Qnil);
2096 linkname = Fexpand_file_name (linkname, Qnil);
2098 /* If the file name has special constructs in it,
2099 call the corresponding file handler. */
2100 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2101 if (!NILP (handler))
2102 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname,
2103 ok_if_already_exists));
2105 /* If the new link name has special constructs in it,
2106 call the corresponding file handler. */
2107 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2108 if (!NILP (handler))
2109 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2110 linkname, ok_if_already_exists));
2113 if (NILP (ok_if_already_exists)
2114 || INTP (ok_if_already_exists))
2115 barf_or_query_if_file_exists (linkname, "make it a link",
2116 INTP (ok_if_already_exists), 0);
2118 unlink ((char *) XSTRING_DATA (linkname));
2119 if (0 > symlink ((char *) XSTRING_DATA (filename),
2120 (char *) XSTRING_DATA (linkname)))
2122 report_file_error ("Making symbolic link",
2123 list2 (filename, linkname));
2125 #endif /* S_IFLNK */
2133 DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /*
2134 Open a network connection to PATH using LOGIN as the login string.
2139 const char *path_ext;
2140 const char *login_ext;
2142 CHECK_STRING (path);
2143 CHECK_STRING (login);
2145 /* netunam, being a strange-o system call only used once, is not
2148 TO_EXTERNAL_FORMAT (LISP_STRING, path, C_STRING_ALLOCA, path_ext, Qfile_name);
2149 TO_EXTERNAL_FORMAT (LISP_STRING, login, C_STRING_ALLOCA, login_ext, Qnative);
2151 netresult = netunam (path_ext, login_ext);
2153 return netresult == -1 ? Qnil : Qt;
2155 #endif /* HPUX_NET */
2157 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
2158 Return t if file FILENAME specifies an absolute path name.
2159 On Unix, this is a name starting with a `/' or a `~'.
2163 /* This function does not GC */
2166 CHECK_STRING (filename);
2167 ptr = XSTRING_DATA (filename);
2168 return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
2170 || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
2175 /* Return nonzero if file FILENAME exists and can be executed. */
2178 check_executable (char *filename)
2182 if (stat (filename, &st) < 0)
2184 return ((st.st_mode & S_IEXEC) != 0);
2185 #else /* not WINDOWSNT */
2187 return eaccess (filename, 1) >= 0;
2189 /* Access isn't quite right because it uses the real uid
2190 and we really want to test with the effective uid.
2191 But Unix doesn't give us a right way to do it. */
2192 return access (filename, 1) >= 0;
2193 #endif /* HAVE_EACCESS */
2194 #endif /* not WINDOWSNT */
2197 /* Return nonzero if file FILENAME exists and can be written. */
2200 check_writable (const char *filename)
2203 return (eaccess (filename, 2) >= 0);
2205 /* Access isn't quite right because it uses the real uid
2206 and we really want to test with the effective uid.
2207 But Unix doesn't give us a right way to do it.
2208 Opening with O_WRONLY could work for an ordinary file,
2209 but would lose for directories. */
2210 return (access (filename, 2) >= 0);
2214 DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
2215 Return t if file FILENAME exists. (This does not mean you can read it.)
2216 See also `file-readable-p' and `file-attributes'.
2220 /* This function can call lisp */
2221 Lisp_Object abspath;
2222 Lisp_Object handler;
2223 struct stat statbuf;
2224 struct gcpro gcpro1;
2226 CHECK_STRING (filename);
2227 abspath = Fexpand_file_name (filename, Qnil);
2229 /* If the file name has special constructs in it,
2230 call the corresponding file handler. */
2232 handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
2234 if (!NILP (handler))
2235 return call2 (handler, Qfile_exists_p, abspath);
2237 return stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
2240 DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2241 Return t if FILENAME can be executed by you.
2242 For a directory, this means you can access files in that directory.
2247 /* This function can GC. GC checked 1997.04.10. */
2248 Lisp_Object abspath;
2249 Lisp_Object handler;
2250 struct gcpro gcpro1;
2252 CHECK_STRING (filename);
2253 abspath = Fexpand_file_name (filename, Qnil);
2255 /* If the file name has special constructs in it,
2256 call the corresponding file handler. */
2258 handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
2260 if (!NILP (handler))
2261 return call2 (handler, Qfile_executable_p, abspath);
2263 return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil;
2266 DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2267 Return t if file FILENAME exists and you can read it.
2268 See also `file-exists-p' and `file-attributes'.
2272 /* This function can GC */
2273 Lisp_Object abspath = Qnil;
2274 Lisp_Object handler;
2275 struct gcpro gcpro1;
2278 CHECK_STRING (filename);
2279 abspath = Fexpand_file_name (filename, Qnil);
2281 /* If the file name has special constructs in it,
2282 call the corresponding file handler. */
2283 handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
2284 if (!NILP (handler))
2285 RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath));
2287 #if defined(WINDOWSNT) || defined(__CYGWIN32__)
2288 /* Under MS-DOS and Windows, open does not work for directories. */
2290 if (access (XSTRING_DATA (abspath), 0) == 0)
2294 #else /* not WINDOWSNT */
2296 int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0);
2303 #endif /* not WINDOWSNT */
2306 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2308 DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2309 Return t if file FILENAME can be written or created by you.
2313 /* This function can GC. GC checked 1997.04.10. */
2314 Lisp_Object abspath, dir;
2315 Lisp_Object handler;
2316 struct stat statbuf;
2317 struct gcpro gcpro1;
2319 CHECK_STRING (filename);
2320 abspath = Fexpand_file_name (filename, Qnil);
2322 /* If the file name has special constructs in it,
2323 call the corresponding file handler. */
2325 handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
2327 if (!NILP (handler))
2328 return call2 (handler, Qfile_writable_p, abspath);
2330 if (stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
2331 return (check_writable ((char *) XSTRING_DATA (abspath))
2336 dir = Ffile_name_directory (abspath);
2338 return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir)
2343 DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2344 Return non-nil if file FILENAME is the name of a symbolic link.
2345 The value is the name of the file to which it is linked.
2346 Otherwise returns nil.
2350 /* This function can GC. GC checked 1997.04.10. */
2351 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2358 Lisp_Object handler;
2359 struct gcpro gcpro1;
2361 CHECK_STRING (filename);
2362 filename = Fexpand_file_name (filename, Qnil);
2364 /* If the file name has special constructs in it,
2365 call the corresponding file handler. */
2367 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2369 if (!NILP (handler))
2370 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);
4188 DEFSUBR (Fmake_symbolic_link);
4190 DEFSUBR (Fsysnetunam);
4191 #endif /* HPUX_NET */
4192 DEFSUBR (Ffile_name_absolute_p);
4193 DEFSUBR (Ffile_exists_p);
4194 DEFSUBR (Ffile_executable_p);
4195 DEFSUBR (Ffile_readable_p);
4196 DEFSUBR (Ffile_writable_p);
4197 DEFSUBR (Ffile_symlink_p);
4198 DEFSUBR (Ffile_directory_p);
4199 DEFSUBR (Ffile_accessible_directory_p);
4200 DEFSUBR (Ffile_regular_p);
4201 DEFSUBR (Ffile_modes);
4202 DEFSUBR (Fset_file_modes);
4203 DEFSUBR (Fset_default_file_modes);
4204 DEFSUBR (Fdefault_file_modes);
4205 DEFSUBR (Funix_sync);
4206 DEFSUBR (Ffile_newer_than_file_p);
4207 DEFSUBR (Finsert_file_contents_internal);
4208 DEFSUBR (Fwrite_region_internal);
4209 DEFSUBR (Fcar_less_than_car); /* Vomitous! */
4210 DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
4212 DEFSUBR (Fencrypt_string);
4213 DEFSUBR (Fdecrypt_string);
4215 DEFSUBR (Fverify_visited_file_modtime);
4216 DEFSUBR (Fclear_visited_file_modtime);
4217 DEFSUBR (Fvisited_file_modtime);
4218 DEFSUBR (Fset_visited_file_modtime);
4220 DEFSUBR (Fdo_auto_save);
4221 DEFSUBR (Fset_buffer_auto_saved);
4222 DEFSUBR (Fclear_buffer_auto_save_failure);
4223 DEFSUBR (Frecent_auto_save_p);
4227 vars_of_fileio (void)
4229 DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /*
4230 *Format in which to write auto-save files.
4231 Should be a list of symbols naming formats that are defined in `format-alist'.
4232 If it is t, which is the default, auto-save files are written in the
4233 same format as a regular save would use.
4235 Vauto_save_file_format = Qt;
4237 DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /*
4238 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
4239 If a file name matches REGEXP, then all I/O on that file is done by calling
4242 The first argument given to HANDLER is the name of the I/O primitive
4243 to be handled; the remaining arguments are the arguments that were
4244 passed to that primitive. For example, if you do
4245 (file-exists-p FILENAME)
4246 and FILENAME is handled by HANDLER, then HANDLER is called like this:
4247 (funcall HANDLER 'file-exists-p FILENAME)
4248 The function `find-file-name-handler' checks this list for a handler
4251 Vfile_name_handler_alist = Qnil;
4253 DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /*
4254 A list of functions to be called at the end of `insert-file-contents'.
4255 Each is passed one argument, the number of bytes inserted. It should return
4256 the new byte count, and leave point the same. If `insert-file-contents' is
4257 intercepted by a handler from `file-name-handler-alist', that handler is
4258 responsible for calling the after-insert-file-functions if appropriate.
4260 Vafter_insert_file_functions = Qnil;
4262 DEFVAR_LISP ("write-region-annotate-functions",
4263 &Vwrite_region_annotate_functions /*
4264 A list of functions to be called at the start of `write-region'.
4265 Each is passed two arguments, START and END, as for `write-region'.
4266 It should return a list of pairs (POSITION . STRING) of strings to be
4267 effectively inserted at the specified positions of the file being written
4268 \(1 means to insert before the first byte written). The POSITIONs must be
4269 sorted into increasing order. If there are several functions in the list,
4270 the several lists are merged destructively.
4272 Vwrite_region_annotate_functions = Qnil;
4274 DEFVAR_LISP ("write-region-annotations-so-far",
4275 &Vwrite_region_annotations_so_far /*
4276 When an annotation function is called, this holds the previous annotations.
4277 These are the annotations made by other annotation functions
4278 that were already called. See also `write-region-annotate-functions'.
4280 Vwrite_region_annotations_so_far = Qnil;
4282 DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
4283 A list of file name handlers that temporarily should not be used.
4284 This applies only to the operation `inhibit-file-name-operation'.
4286 Vinhibit_file_name_handlers = Qnil;
4288 DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
4289 The operation for which `inhibit-file-name-handlers' is applicable.
4291 Vinhibit_file_name_operation = Qnil;
4293 DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /*
4294 File name in which we write a list of all auto save file names.
4296 Vauto_save_list_file_name = Qnil;
4298 DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
4299 &disable_auto_save_when_buffer_shrinks /*
4300 If non-nil, auto-saving is disabled when a buffer shrinks too much.
4301 This is to prevent you from losing your edits if you accidentally
4302 delete a large chunk of the buffer and don't notice it until too late.
4303 Saving the buffer normally turns auto-save back on.
4305 disable_auto_save_when_buffer_shrinks = 1;
4307 DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /*
4308 Directory separator character for built-in functions that return file names.
4309 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
4310 This variable affects the built-in functions only on Windows,
4311 on other platforms, it is initialized so that Lisp code can find out
4312 what the normal separator is.
4315 Vdirectory_sep_char = make_char ('\\');
4317 Vdirectory_sep_char = make_char ('/');
4320 reinit_vars_of_fileio ();
4324 reinit_vars_of_fileio (void)
4326 /* We want temp_name_rand to be initialized to a value likely to be
4327 unique to the process, not to the executable. The danger is that
4328 two different XEmacs processes using the same binary on different
4329 machines creating temp files in the same directory will be
4330 unlucky enough to have the same pid. If we randomize using
4331 process startup time, then in practice they will be unlikely to
4332 collide. We use the microseconds field so that scripts that start
4333 simultaneous XEmacs processes on multiple machines will have less
4334 chance of collision. */
4338 EMACS_GET_TIME (thyme);
4339 temp_name_rand = (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));