1 /* File IO for SXEmacs.
2 Copyright (C) 1985-1988, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1996 Ben Wing.
5 This file is part of SXEmacs
7 SXEmacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 SXEmacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* Synched up with: Mule 2.0, FSF 19.30. */
22 /* More syncing: FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org> */
28 #include "events/events.h"
30 #include "ui/insdel.h"
32 #include "ui/redisplay.h"
34 #include "ui/window.h" /* minibuf_level */
36 #include "mule/file-coding.h"
40 #ifdef HAVE_LIBGEN_H /* Must come before sysfile.h */
53 #endif /* HPUX_PRE_8_0 */
56 int lisp_to_time(Lisp_Object, time_t *);
57 Lisp_Object time_to_lisp(time_t);
59 /* Nonzero during writing of auto-save files */
60 static int auto_saving;
62 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal
63 will create a new file with the same mode as the original */
64 static int auto_save_mode_bits;
66 /* Alist of elements (REGEXP . HANDLER) for file names
67 whose I/O is done with a special handler. */
68 Lisp_Object Vfile_name_handler_alist;
70 /* Format for auto-save files */
71 Lisp_Object Vauto_save_file_format;
73 /* Lisp functions for translating file formats */
74 Lisp_Object Qformat_decode, Qformat_annotate_function;
76 /* Functions to be called to process text properties in inserted file. */
77 Lisp_Object Vafter_insert_file_functions;
79 /* Functions to be called to create text property annotations for file. */
80 Lisp_Object Vwrite_region_annotate_functions;
82 /* During build_annotations, each time an annotation function is called,
83 this holds the annotations made by the previous functions. */
84 Lisp_Object Vwrite_region_annotations_so_far;
86 /* File name in which we write a list of all our auto save files. */
87 Lisp_Object Vauto_save_list_file_name;
89 /* Prefix used to construct Vauto_save_list_file_name. */
90 Lisp_Object Vauto_save_list_file_prefix;
92 /* When non-nil, it prevents auto-save list file creation. */
93 int inhibit_auto_save_session;
95 int disable_auto_save_when_buffer_shrinks;
97 Lisp_Object Vdirectory_sep_char;
99 /* These variables describe handlers that have "already" had a chance
100 to handle the current operation.
102 Vinhibit_file_name_handlers is a list of file name handlers.
103 Vinhibit_file_name_operation is the operation being handled.
104 If we try to handle that operation, we ignore those handlers. */
106 static Lisp_Object Vinhibit_file_name_handlers;
107 static Lisp_Object Vinhibit_file_name_operation;
109 Lisp_Object Qfile_error, Qfile_already_exists;
111 Lisp_Object Qauto_save_hook;
112 Lisp_Object Qauto_save_error;
113 Lisp_Object Qauto_saving;
115 Lisp_Object Qcar_less_than_car;
117 Lisp_Object Qcompute_buffer_file_truename;
119 EXFUN(Frunning_temacs_p, 0);
121 /* signal a file error when errno contains a meaningful value. */
123 DOESNT_RETURN report_file_error(const char *string, Lisp_Object data)
125 /* #### dmoore - This uses current_buffer, better make sure no one
126 has GC'd the current buffer. File handlers are giving me a headache
127 maybe I'll just always protect current_buffer around all of those
130 signal_error(Qfile_error,
131 Fcons(build_translated_string(string),
132 Fcons(lisp_strerror(errno), data)));
136 maybe_report_file_error(const char *string, Lisp_Object data,
137 Lisp_Object class, Error_behavior errb)
140 if (ERRB_EQ(errb, ERROR_ME_NOT))
143 maybe_signal_error(Qfile_error,
144 Fcons(build_translated_string(string),
145 Fcons(lisp_strerror(errno), data)),
149 /* signal a file error when errno does not contain a meaningful value. */
151 DOESNT_RETURN signal_file_error(const char *string, Lisp_Object data)
153 signal_error(Qfile_error, list2(build_translated_string(string), data));
157 maybe_signal_file_error(const char *string, Lisp_Object data,
158 Lisp_Object class, Error_behavior errb)
161 if (ERRB_EQ(errb, ERROR_ME_NOT))
163 maybe_signal_error(Qfile_error,
164 list2(build_translated_string(string), data),
169 signal_double_file_error(const char *string1, const char *string2,
172 signal_error(Qfile_error,
173 list3(build_translated_string(string1),
174 build_translated_string(string2), data));
178 maybe_signal_double_file_error(const char *string1, const char *string2,
179 Lisp_Object data, Lisp_Object class,
183 if (ERRB_EQ(errb, ERROR_ME_NOT))
185 maybe_signal_error(Qfile_error,
186 list3(build_translated_string(string1),
187 build_translated_string(string2),
192 signal_double_file_error_2(const char *string1, const char *string2,
193 Lisp_Object data1, Lisp_Object data2)
195 signal_error(Qfile_error,
196 list4(build_translated_string(string1),
197 build_translated_string(string2), data1, data2));
201 maybe_signal_double_file_error_2(const char *string1, const char *string2,
202 Lisp_Object data1, Lisp_Object data2,
203 Lisp_Object class, Error_behavior errb)
206 if (ERRB_EQ(errb, ERROR_ME_NOT))
208 maybe_signal_error(Qfile_error,
209 list4(build_translated_string(string1),
210 build_translated_string(string2),
211 data1, data2), class, errb);
214 /* Just like strerror(3), except return a lisp string instead of char *.
215 The string needs to be converted since it may be localized.
216 Perhaps this should use strerror-coding-system instead? */
217 Lisp_Object lisp_strerror(int errnum)
219 return build_ext_string(strerror(errnum), Qnative);
222 static Lisp_Object close_file_unwind(Lisp_Object fd)
226 close(XINT(XCAR(fd)));
228 free_cons(XCONS(fd));
235 static Lisp_Object delete_stream_unwind(Lisp_Object stream)
237 Lstream_delete(XLSTREAM(stream));
241 /* Restore point, having saved it as a marker. */
243 static Lisp_Object restore_point_unwind(Lisp_Object point_marker)
245 BUF_SET_PT(current_buffer, marker_position(point_marker));
246 return Fset_marker(point_marker, Qnil, Qnil);
249 /* Versions of read() and write() that allow quitting out of the actual
250 I/O. We don't use immediate_quit (i.e. direct longjmp() out of the
251 signal handler) because that's way too losing.
253 (#### Actually, longjmp()ing out of the signal handler may not be
254 as losing as I thought. See sys_do_signal() in sysdep.c.) */
256 ssize_t read_allowing_quit(int fildes, void *buf, size_t size)
259 return sys_read_1(fildes, buf, size, 1);
262 ssize_t write_allowing_quit(int fildes, const void *buf, size_t size)
265 return sys_write_1(fildes, buf, size, 1);
268 Lisp_Object Qexpand_file_name;
269 Lisp_Object Qfile_truename;
270 Lisp_Object Qsubstitute_in_file_name;
271 Lisp_Object Qdirectory_file_name;
272 Lisp_Object Qfile_dirname;
273 Lisp_Object Qfile_basename;
274 Lisp_Object Qfile_name_directory;
275 Lisp_Object Qfile_name_nondirectory;
276 Lisp_Object Qunhandled_file_name_directory;
277 Lisp_Object Qfile_name_as_directory;
278 Lisp_Object Qcopy_file;
279 Lisp_Object Qmake_directory_internal;
280 Lisp_Object Qdelete_directory;
281 Lisp_Object Qdelete_file;
282 Lisp_Object Qrename_file;
283 Lisp_Object Qadd_name_to_file;
284 Lisp_Object Qmake_symbolic_link;
285 Lisp_Object Qfile_exists_p;
286 Lisp_Object Qfile_executable_p;
287 Lisp_Object Qfile_readable_p;
288 Lisp_Object Qfile_symlink_p;
289 Lisp_Object Qfile_writable_p;
290 Lisp_Object Qfile_directory_p;
291 Lisp_Object Qfile_regular_p;
292 Lisp_Object Qfile_accessible_directory_p;
293 Lisp_Object Qfile_modes;
294 Lisp_Object Qset_file_modes;
295 Lisp_Object Qfile_newer_than_file_p;
296 Lisp_Object Qinsert_file_contents;
297 Lisp_Object Qwrite_region;
298 Lisp_Object Qverify_visited_file_modtime;
299 Lisp_Object Qset_visited_file_modtime;
301 /* If FILENAME is handled specially on account of its syntax,
302 return its handler function. Otherwise, return nil. */
304 DEFUN("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
305 Return FILENAME's handler function for OPERATION, if it has one.
306 Otherwise, return nil.
307 A file name is handled if one of the regular expressions in
308 `file-name-handler-alist' matches it.
310 If OPERATION equals `inhibit-file-name-operation', then we ignore
311 any handlers that are members of `inhibit-file-name-handlers',
312 but we still do run any other handlers. This lets handlers
313 use the standard functions without calling themselves recursively.
315 Otherwise, OPERATION is the name of a funcall'able function.
317 (filename, operation))
319 /* This function does not GC */
320 /* This function can be called during GC */
321 /* This function must not munge the match data. */
322 Lisp_Object chain, inhibited_handlers;
324 CHECK_STRING(filename);
326 if (EQ(operation, Vinhibit_file_name_operation))
327 inhibited_handlers = Vinhibit_file_name_handlers;
329 inhibited_handlers = Qnil;
331 EXTERNAL_LIST_LOOP(chain, Vfile_name_handler_alist) {
332 Lisp_Object elt = XCAR(chain);
334 Lisp_Object string = XCAR(elt);
336 && (fast_lisp_string_match(string, filename) >= 0)) {
337 Lisp_Object handler = XCDR(elt);
338 if (NILP(Fmemq(handler, inhibited_handlers)))
348 call2_check_string(Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
350 /* This function can call lisp */
351 Lisp_Object result = call2(fn, arg0, arg1);
352 CHECK_STRING(result);
357 call2_check_string_or_nil(Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
359 /* This function can call lisp */
360 Lisp_Object result = call2(fn, arg0, arg1);
362 CHECK_STRING(result);
367 call3_check_string(Lisp_Object fn, Lisp_Object arg0,
368 Lisp_Object arg1, Lisp_Object arg2)
370 /* This function can call lisp */
371 Lisp_Object result = call3(fn, arg0, arg1, arg2);
372 CHECK_STRING(result);
376 DEFUN("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
377 Return the directory component in file name FILENAME.
378 Return nil if FILENAME does not include a directory.
379 Otherwise return a directory spec.
380 Given a Unix syntax file name, returns a string ending in slash.
384 /* This function can GC. GC checked 2000-07-28 ben */
389 CHECK_STRING(filename);
391 /* If the file name has special constructs in it,
392 call the corresponding file handler. */
393 handler = Ffind_file_name_handler(filename, Qfile_name_directory);
395 return call2_check_string_or_nil(handler, Qfile_name_directory,
398 #ifdef FILE_SYSTEM_CASE
399 filename = FILE_SYSTEM_CASE(filename);
401 beg = XSTRING_DATA(filename);
402 p = beg + XSTRING_LENGTH(filename);
404 while (p != beg && !IS_ANY_SEP(p[-1])
410 return make_string(beg, p - beg);
413 DEFUN("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
414 Return file name FILENAME sans its directory.
415 For example, in a Unix-syntax file name,
416 this is everything after the last slash,
417 or the entire name if it contains no slash.
421 /* This function can GC. GC checked 2000-07-28 ben */
422 Bufbyte *beg, *p, *end;
425 CHECK_STRING(filename);
427 /* If the file name has special constructs in it,
428 call the corresponding file handler. */
429 handler = Ffind_file_name_handler(filename, Qfile_name_nondirectory);
431 return call2_check_string(handler, Qfile_name_nondirectory,
434 beg = XSTRING_DATA(filename);
435 end = p = beg + XSTRING_LENGTH(filename);
437 while (p != beg && !IS_ANY_SEP(p[-1])
441 return make_string(p, end - p);
446 Bytecount file_basename_match_extension(Lisp_Object filename,
447 Lisp_Object extension)
449 Bytecount match = -1;
450 Bytecount len = XSTRING_LENGTH( extension );
454 Bufbyte *ext = XSTRING_DATA(extension);
458 if ( strncmp( (char*)ext, "\\.", 2 ) != 0 ) {
459 strncpy(rep, "\\.", 3);
463 /* Note that we advance by len-1 to be positioned at
464 the last char of extension so that we can check it
465 for '$' on the if statement and advance to the
466 terminator if need to append...
472 regexp = make_string( (Bufbyte*)re, strlen(re));
473 match = fast_lisp_string_match( regexp, filename );
478 DEFUN("file-basename", Ffile_basename, 1, 2, 0, /*
479 Return the basename of FILENAME sans its base directory.
480 If EXTENSION is non-nil the extension is also removed if it matches the regexp.
481 EXTENSION can be a list of regexps.
482 For example, in a Unix-syntax file name,
483 this is everything after the last slash,
484 or the entire name if it contains no slash.
485 It ignores trailing slash.
487 (filename, extension))
489 /* This function can GC. GC checked 2000-07-28 ben */
490 Bufbyte *beg, *p, *end;
495 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
497 CHECK_STRING(filename);
498 if ( ! NILP(extension) && ! STRINGP(extension) &&
500 dead_wrong_type_argument(Qstringp, extension);
502 GCPRO4(handler,res,rest,ext);
504 /* If the file name has special constructs in it,
505 call the corresponding file handler. */
506 handler = Ffind_file_name_handler(filename, Qfile_basename);
508 return call2_check_string(handler, Qfile_basename,
511 beg = XSTRING_DATA(filename);
512 end = p = beg + XSTRING_LENGTH(filename);
513 if ( IS_ANY_SEP(p[-1]) ) {
517 while (p != beg && !IS_ANY_SEP(p[-1]))
520 res = make_string(p, end - p);
521 if ( STRINGP( extension ) ) {
523 match = file_basename_match_extension(res,
526 RETURN_UNGCPRO(make_string(p, match));
527 } else if ( ! NILP(extension) && LISTP( extension ) ) {
532 match = file_basename_match_extension(res,
535 RETURN_UNGCPRO(make_string(p, match));
537 } while( ! NILP(rest) );
543 DEFUN("file-dirname", Ffile_dirname, 1, 1, 0, /*
544 Return the directory component in file name FILENAME.
545 Return nil if FILENAME does not include a directory.
546 Otherwise return a directory spec.
547 Given a Unix syntax file name, returns a string ending in slash.
548 It ignores the trailing slash in FILENAME.
552 /* This function can GC. GC checked 2000-07-28 ben */
553 Bufbyte *beg, *p, *end;
556 CHECK_STRING(filename);
558 /* If the file name has special constructs in it,
559 call the corresponding file handler. */
560 handler = Ffind_file_name_handler(filename, Qfile_dirname);
562 return call2_check_string_or_nil(handler, Qfile_dirname,
565 beg = XSTRING_DATA(filename);
566 end = p = beg + XSTRING_LENGTH(filename);
567 if ( IS_ANY_SEP(p[-1]) ) {
571 while (p != beg && !IS_ANY_SEP(p[-1])
577 return make_string(beg, p-beg);
581 DEFUN("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
582 Return a directly usable directory name somehow associated with FILENAME.
583 A `directly usable' directory name is one that may be used without the
584 intervention of any file handler.
585 If FILENAME is a directly usable file itself, return
586 \(file-name-directory FILENAME).
587 The `call-process' and `start-process' functions use this function to
588 get a current directory to run processes in.
592 /* This function can GC. GC checked 2000-07-28 ben */
595 /* If the file name has special constructs in it,
596 call the corresponding file handler. */
598 Ffind_file_name_handler(filename, Qunhandled_file_name_directory);
600 return call2(handler, Qunhandled_file_name_directory, filename);
602 return Ffile_name_directory(filename);
605 static char *file_name_as_directory(char *out, const char *in, size_t len)
607 /* This function cannot GC */
608 int size = strlen(in);
613 out[1] = DIRECTORY_SEP;
616 xstrncpy(out, in, len);
617 /* Append a slash if necessary */
618 if (!IS_ANY_SEP(out[size - 1])) {
619 out[size] = DIRECTORY_SEP;
620 out[size + 1] = '\0';
626 DEFUN("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
627 Return a string representing file FILENAME interpreted as a directory.
628 This operation exists because a directory is also a file, but its name as
629 a directory is different from its name as a file.
630 The result can be used as the value of `default-directory'
631 or passed as second argument to `expand-file-name'.
632 For a Unix-syntax file name, just appends a slash,
633 except for (file-name-as-directory \"\") => \"./\".
637 /* This function can GC. GC checked 2000-07-28 ben */
640 Lisp_Object handler = Qnil;
642 CHECK_STRING(filename);
644 /* If the file name has special constructs in it,
645 call the corresponding file handler. */
646 handler = Ffind_file_name_handler(filename, Qfile_name_as_directory);
648 return call2_check_string(handler, Qfile_name_as_directory,
651 len = XSTRING_LENGTH(filename) + 10;
652 buf = (char *)alloca(len);
653 return build_string(file_name_as_directory
654 (buf, (char*)XSTRING_DATA(filename), len));
658 * Convert from directory name to filename.
659 * On UNIX, it's simple: just make sure there isn't a terminating /
661 * Value is nonzero if the string output is different from the input.
664 static int directory_file_name(const char *src, char *dst, size_t len)
666 /* This function cannot GC */
667 long slen = strlen(src);
668 /* Process as Unix format: just remove any final slash.
669 But leave "/" unchanged; do not change it to "". */
670 xstrncpy(dst, src, len);
671 if (slen > 1 && IS_DIRECTORY_SEP(dst[slen - 1])
677 DEFUN("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
678 Return the file name of the directory named DIRECTORY.
679 This is the name of the file that holds the data for the directory.
680 This operation exists because a directory is also a file, but its name as
681 a directory is different from its name as a file.
682 In Unix-syntax, this function just removes the final slash.
686 /* This function can GC. GC checked 2000-07-28 ben */
691 CHECK_STRING(directory);
693 #if 0 /* #### WTF? */
698 /* If the file name has special constructs in it,
699 call the corresponding file handler. */
700 handler = Ffind_file_name_handler(directory, Qdirectory_file_name);
702 return call2_check_string(handler, Qdirectory_file_name,
704 len = XSTRING_LENGTH(directory) + 20;
705 buf = (char *)alloca(len);
706 directory_file_name((char *)XSTRING_DATA(directory), buf, len);
707 return build_string(buf);
710 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
711 proved too broken for our purposes (it supported only 26 or 62
712 unique names under some implementations). For example, this
713 arbitrary limit broke generation of Gnus Incoming* files.
715 This implementation is better than what one usually finds in libc.
718 static unsigned int temp_name_rand;
720 DEFUN("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
721 Generate a temporary file name starting with PREFIX.
722 The Emacs process number forms part of the result, so there is no
723 danger of generating a name being used by another process.
725 In addition, this function makes an attempt to choose a name that
726 does not specify an existing file. To make this work, PREFIX should
727 be an absolute file name.
731 static const char tbl[64] = {
732 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
733 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
734 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
735 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f',
736 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
737 'o', 'p', 'q', 'r', 's', 't', 'u', 'v',
738 'w', 'x', 'y', 'z', '0', '1', '2', '3',
739 '4', '5', '6', '7', '8', '9', '-', '_'
746 CHECK_STRING(prefix);
748 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
751 1) It might change the prefix, so the resulting string might not
752 begin with PREFIX. This violates the principle of least
755 2) It breaks under many unforeseeable circumstances, such as with
756 the code that uses (make-temp-name "") instead of
757 (make-temp-name "./").
759 3) It might yield unexpected (to stat(2)) results in the presence
760 of EFS and file name handlers. */
762 len = XSTRING_LENGTH(prefix);
763 val = make_uninit_string(len + 6);
764 data = XSTRING_DATA(val);
765 memcpy(data, XSTRING_DATA(prefix), len);
768 /* VAL is created by adding 6 characters to PREFIX. The first three
769 are the PID of this process, in base 64, and the second three are
770 a pseudo-random number seeded from process startup time. This
771 ensures 262144 unique file names per PID per PREFIX per machine. */
774 unsigned int pid = (unsigned int)getpid();
775 *p++ = tbl[(pid >> 0) & 63];
776 *p++ = tbl[(pid >> 6) & 63];
777 *p++ = tbl[(pid >> 12) & 63];
780 /* Here we try to minimize useless stat'ing when this function is
781 invoked many times successively with the same PREFIX. We achieve
782 this by using a very pseudo-random number generator to generate
783 file names unique to this process, with a very long cycle. */
788 p[0] = tbl[(temp_name_rand >> 0) & 63];
789 p[1] = tbl[(temp_name_rand >> 6) & 63];
790 p[2] = tbl[(temp_name_rand >> 12) & 63];
792 /* Poor man's congruential RN generator. Replace with ++count
794 temp_name_rand += 25229;
795 temp_name_rand %= 225307;
799 if (sxemacs_stat((const char *)data, &ignored) < 0) {
800 /* We want to return only if errno is ENOENT. */
804 /* The error here is dubious, but there is little else we
805 can do. The alternatives are to return nil, which is
806 as bad as (and in many cases worse than) throwing the
807 error, or to ignore the error, which will likely result
810 ("Cannot create temporary name for prefix",
812 return Qnil; /* not reached */
817 DEFUN("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
818 Convert filename NAME to absolute, and canonicalize it.
819 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
820 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
821 the current buffer's value of `default-directory' is used.
822 File name components that are `.' are removed, and
823 so are file name components followed by `..', along with the `..' itself;
824 note that these simplifications are done without checking the resulting
825 file names in the file system.
826 An initial `~/' expands to your home directory.
827 An initial `~USER/' expands to USER's home directory.
828 See also the function `substitute-in-file-name'.
830 (name, default_directory))
832 /* This function can GC. GC-checked 2000-11-18 */
835 Bufbyte *newdir, *p, *o;
840 Lisp_Object handler = Qnil;
841 struct gcpro gcpro1, gcpro2, gcpro3;
843 /* both of these get set below */
844 GCPRO3(name, default_directory, handler);
848 /* If the file name has special constructs in it,
849 call the corresponding file handler. */
850 handler = Ffind_file_name_handler(name, Qexpand_file_name);
852 RETURN_UNGCPRO(call3_check_string(handler, Qexpand_file_name,
853 name, default_directory));
855 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
856 if (NILP(default_directory))
857 default_directory = current_buffer->directory;
858 if (!STRINGP(default_directory))
859 default_directory = build_string("/");
861 if (!NILP(default_directory)) {
863 Ffind_file_name_handler(default_directory,
866 RETURN_UNGCPRO(call3(handler, Qexpand_file_name,
867 name, default_directory));
870 o = XSTRING_DATA(default_directory);
872 /* Make sure DEFAULT_DIRECTORY is properly expanded.
873 It would be better to do this down below where we actually use
874 default_directory. Unfortunately, calling Fexpand_file_name recursively
875 could invoke GC, and the strings might be relocated. This would
876 be annoying because we have pointers into strings lying around
877 that would need adjusting, and people would add new pointers to
878 the code and forget to adjust them, resulting in intermittent bugs.
879 Putting this call here avoids all that crud.
881 The EQ test avoids infinite recursion. */
882 if (!NILP(default_directory) && !EQ(default_directory, name)
883 /* Save time in some common cases - as long as default_directory
884 is not relative, it can be canonicalized with name below (if it
885 is needed at all) without requiring it to be expanded now. */
886 /* Detect Unix absolute file names (/... alone is not absolute on
888 && !(IS_DIRECTORY_SEP(o[0]))
891 default_directory = Fexpand_file_name(default_directory, Qnil);
893 #ifdef FILE_SYSTEM_CASE
894 name = FILE_SYSTEM_CASE(name);
897 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
898 into name should be safe during all of this, though. */
899 nm = XSTRING_DATA(name);
901 /* If nm is absolute, look for /./ or /../ sequences; if none are
902 found, we can probably return right away. We will avoid allocating
903 a new string if name is already fully expanded. */
904 if (IS_DIRECTORY_SEP(nm[0])) {
905 /* If it turns out that the filename we want to return is just a
906 suffix of FILENAME, we don't need to go through and edit
907 things; we just need to construct a new string using data
908 starting at the middle of FILENAME. If we set lose to a
909 non-zero value, that means we've discovered that we can't do
915 /* Since we know the name is absolute, we can assume
916 that each element starts with a "/". */
918 /* "." and ".." are hairy. */
919 if (IS_DIRECTORY_SEP(p[0])
920 && p[1] == '.' && (IS_DIRECTORY_SEP(p[2])
923 && (IS_DIRECTORY_SEP(p[3])
930 if (nm == XSTRING_DATA(name)) {
931 RETURN_UNGCPRO(name);
933 RETURN_UNGCPRO(build_string((char*)nm));
937 /* At this point, nm might or might not be an absolute file name. We
938 need to expand ~ or ~user if present, otherwise prefix nm with
939 default_directory if nm is not absolute, and finally collapse /./
940 and /foo/../ sequences.
942 We set newdir to be the appropriate prefix if one is needed:
943 - the relevant user directory if nm starts with ~ or ~user
944 - the specified drive's working dir (DOS/NT only) if nm does not
946 - the value of default_directory.
948 Note that these prefixes are not guaranteed to be absolute (except
949 for the working dir of a drive). Therefore, to ensure we always
950 return an absolute name, if the final prefix is not absolute we
951 append it to the current working directory. */
955 if (nm[0] == '~') { /* prefix ~ */
956 if (IS_DIRECTORY_SEP(nm[1]) || nm[1] == 0) {
958 Extbyte *newdir_external = get_home_directory();
960 if (newdir_external == NULL) {
961 newdir = (Bufbyte *) "";
963 /* aint that a bit weird just to get the
964 * signedness correct? */
965 Extbyte *newdir_cpy = (Extbyte*)newdir;
967 C_STRING, newdir_external,
971 newdir = (Bufbyte*)newdir_cpy;
974 } else { /* ~user/filename */
976 for (p = nm; *p && (!IS_DIRECTORY_SEP(*p)); p++)
978 o = (Bufbyte *) alloca(p - nm + 1);
979 memcpy(o, (char *)nm, p - nm);
982 /* #### While NT is single-user (for the moment) you still
983 can have multiple user profiles users defined, each with
984 its HOME. So maybe possibly we should think about handling
986 /* Jamie reports that getpwnam() can get wedged
987 by SIGIO/SIGALARM occurring in it. (It can call
989 slow_down_interrupts();
990 pw = (struct passwd *)getpwnam((char *)o + 1);
991 speed_up_interrupts();
993 newdir = (Bufbyte *) pw->pw_dir;
997 /* If we don't find a user of that name, leave the name
998 unchanged; don't move nm forward to p. */
1002 /* Finally, if no prefix has been specified and nm is not absolute,
1003 then it must be expanded relative to default_directory. */
1006 /* /... alone is not absolute on DOS and Windows. */
1007 && !IS_DIRECTORY_SEP(nm[0])
1009 newdir = XSTRING_DATA(default_directory);
1013 /* Get rid of any slash at the end of newdir, unless newdir is
1014 just // (an incomplete UNC name). */
1015 length = strlen((char *)newdir);
1016 if (length > 1 && IS_DIRECTORY_SEP(newdir[length - 1])) {
1017 Bufbyte *temp = (Bufbyte *) alloca(length);
1018 memcpy(temp, newdir, length - 1);
1019 temp[length - 1] = 0;
1026 /* Now concatenate the directory and name to new space in the stack frame */
1027 tlen += strlen((char *)nm) + 1;
1028 target = (Bufbyte *) alloca(tlen);
1032 if (nm[0] == 0 || IS_DIRECTORY_SEP(nm[0]))
1033 xstrncpy((char *)target, (char *)newdir, tlen);
1035 file_name_as_directory((char *)target, (char *)newdir, tlen);
1038 xstrncat((char *)target, (char *)nm, tlen-1);
1040 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1042 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1048 if (!IS_DIRECTORY_SEP(*p)) {
1050 } else if (IS_DIRECTORY_SEP(p[0])
1051 && p[1] == '.' && (IS_DIRECTORY_SEP(p[2])
1053 /* If "/." is the entire filename, keep the "/". Otherwise,
1054 just delete the whole "/.". */
1055 if (o == target && p[2] == '\0')
1058 } else if (IS_DIRECTORY_SEP(p[0]) && p[1] == '.' && p[2] == '.'
1059 /* `/../' is the "superroot" on certain file systems. */
1061 && (IS_DIRECTORY_SEP(p[3]) || p[3] == 0)) {
1062 while (o != target && (--o) && !IS_DIRECTORY_SEP(*o)) ;
1063 /* Keep initial / only if this is the whole name. */
1064 if (o == target && IS_ANY_SEP(*o) && p[3] == 0)
1073 RETURN_UNGCPRO(make_string(target, o - target));
1076 DEFUN("file-truename", Ffile_truename, 1, 2, 0, /*
1077 Return the canonical name of FILENAME.
1078 Second arg DEFAULT is directory to start with if FILENAME is relative
1079 (does not start with slash); if DEFAULT is nil or missing,
1080 the current buffer's value of `default-directory' is used.
1081 No component of the resulting pathname will be a symbolic link, as
1082 in the realpath() function.
1084 (filename, default_))
1086 /* This function can GC. GC checked 2000-07-28 ben. */
1087 Lisp_Object expanded_name;
1088 struct gcpro gcpro1;
1090 CHECK_STRING(filename);
1092 expanded_name = Fexpand_file_name(filename, default_);
1094 if (!STRINGP(expanded_name))
1097 GCPRO1(expanded_name);
1100 Lisp_Object handler =
1101 Ffind_file_name_handler(expanded_name, Qfile_truename);
1106 (handler, Qfile_truename, expanded_name));
1110 char resolved_path[MAXPATHLEN];
1111 Extbyte *path = NULL;
1115 TO_EXTERNAL_FORMAT(LISP_STRING, expanded_name,
1116 ALLOCA, (path, elen), Qfile_name);
1119 if (elen > MAXPATHLEN)
1122 /* Try doing it all at once. */
1123 /* !! Does realpath() Mule-encapsulate? Answer: Nope!
1124 So we do it above */
1125 if (path != NULL && !xrealpath((char *)path, resolved_path)) {
1126 /* Didn't resolve it -- have to do it one
1127 component at a time.
1129 "realpath" is a typically useless, stupid
1130 un*x piece of crap. It claims to return a
1131 useful value in the "error" case, but since
1132 there is no indication provided of how far
1133 along the pathname the function went before
1134 erring, there is no way to use the partial
1135 result returned. What a piece of junk.
1137 The above comment refers to historical
1138 versions of realpath(). The Unix98 specs
1141 "On successful completion, realpath()
1142 returns a pointer to the resolved
1143 name. Otherwise, realpath() returns a null
1144 pointer and sets errno to indicate the
1145 error, and the contents of the buffer
1146 pointed to by resolved_name are undefined."
1148 Since we depend on undocumented semantics
1149 of various system realpath()s, we just use
1150 our own version in realpath.c.
1153 Extbyte *pos = NULL;
1155 for (pos = p + 1; pos < path + elen; pos++) {
1156 if (IS_DIRECTORY_SEP(*pos)) {
1164 if (xrealpath((char *)path, resolved_path)) {
1170 } else if (errno == ENOENT || errno == EACCES) {
1171 /* Failed on this component.
1172 Just tack on the rest of
1173 the string and we are
1175 int rlen = strlen(resolved_path);
1177 /* "On failure, it returns
1179 indicate the error, and
1180 places in resolved_path the
1181 absolute pathname of the
1182 path component which could
1188 int plen = elen - (p - path);
1192 (resolved_path[rlen - 1]))
1195 if ((plen + rlen + 1) >
1196 countof(resolved_path))
1199 resolved_path[rlen] = DIRECTORY_SEP;
1200 memcpy(resolved_path + rlen + 1,
1201 p + 1, plen + 1 - 1);
1209 Lisp_Object resolved_name;
1210 int rlen = strlen(resolved_path);
1213 && IS_DIRECTORY_SEP(
1214 XSTRING_BYTE(expanded_name, elen-1))
1216 IS_DIRECTORY_SEP(resolved_path[rlen-1]))) {
1217 if (rlen + 1 > countof(resolved_path))
1219 resolved_path[rlen++] = DIRECTORY_SEP;
1220 resolved_path[rlen] = '\0';
1222 TO_INTERNAL_FORMAT(DATA, (resolved_path, rlen),
1223 LISP_STRING, resolved_name,
1225 RETURN_UNGCPRO(resolved_name);
1229 errno = ENAMETOOLONG;
1232 report_file_error("Finding truename", list1(expanded_name));
1234 RETURN_UNGCPRO(Qnil);
1237 DEFUN("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1238 Substitute environment variables referred to in FILENAME.
1239 `$FOO' where FOO is an environment variable name means to substitute
1240 the value of that variable. The variable name should be terminated
1241 with a character, not a letter, digit or underscore; otherwise, enclose
1242 the entire variable name in braces.
1243 If `/~' appears, all of FILENAME through that `/' is discarded.
1247 /* This function can GC. GC checked 2000-07-28 ben. */
1250 Bufbyte *s, *p, *o, *x, *endp;
1251 Bufbyte *target = 0;
1253 int substituted = 0;
1256 Lisp_Object handler;
1258 CHECK_STRING(filename);
1260 /* If the file name has special constructs in it,
1261 call the corresponding file handler. */
1262 handler = Ffind_file_name_handler(filename, Qsubstitute_in_file_name);
1264 return call2_check_string_or_nil(handler,
1265 Qsubstitute_in_file_name,
1268 nm = XSTRING_DATA(filename);
1269 endp = nm + XSTRING_LENGTH(filename);
1271 /* If /~ or // appears, discard everything through first slash. */
1273 for (p = nm; p != endp; p++) {
1275 || IS_DIRECTORY_SEP(p[0])
1277 && p != nm && (IS_DIRECTORY_SEP(p[-1]))) {
1283 /* See if any variables are substituted into the string
1284 and find the total length of their values in `total' */
1286 for (p = nm; p != endp;)
1293 else if (*p == '$') {
1294 /* "$$" means a single "$" */
1299 } else if (*p == '{') {
1301 while (p != endp && *p != '}')
1308 while (p != endp && (isalnum(*p) || *p == '_'))
1313 /* Copy out the variable name */
1314 target = (Bufbyte *) alloca(s - o + 1);
1315 strncpy((char *)target, (char *)o, s - o);
1316 target[s - o] = '\0';
1318 /* Get variable value */
1319 o = (Bufbyte *) egetenv((char *)target);
1322 total += strlen((char *)o);
1329 /* If substitution required, recopy the filename and do it */
1330 /* Make space in stack frame for the new copy */
1331 avail = XSTRING_LENGTH(filename) + total + 1;
1332 xnm = (Bufbyte *) alloca(avail);
1335 /* Copy the rest of the name through, replacing $ constructs with values */
1344 else if (*p == '$') {
1348 } else if (*p == '{') {
1350 while (p != endp && *p != '}')
1357 while (p != endp && (isalnum(*p) || *p == '_'))
1362 /* Copy out the variable name */
1363 target = (Bufbyte *) alloca(s - o + 1);
1364 strncpy((char *)target, (char *)o, s - o);
1365 target[s - o] = '\0';
1367 /* Get variable value */
1368 o = (Bufbyte *) egetenv((char *)target);
1372 xstrncpy((char *)x, (char *)o, avail);
1373 x += strlen((char *)o);
1374 avail -= strlen((char *)o);
1379 /* If /~ or // appears, discard everything through first slash. */
1381 for (p = xnm; p != x; p++)
1383 || IS_DIRECTORY_SEP(p[0])
1385 /* don't do p[-1] if that would go off the beginning --jwz */
1386 && p != nm && p > xnm && IS_DIRECTORY_SEP(p[-1]))
1389 return make_string(xnm, x - xnm);
1392 syntax_error("Bad format environment-variable substitution", filename);
1394 syntax_error("Missing \"}\" in environment-variable substitution",
1397 syntax_error_2("Substituting nonexistent environment variable",
1398 filename, build_string((char *)target));
1401 return Qnil; /* suppress compiler warning */
1404 /* A slightly faster and more convenient way to get
1405 (directory-file-name (expand-file-name FOO)). */
1407 Lisp_Object expand_and_dir_to_file(Lisp_Object filename, Lisp_Object defdir)
1409 /* This function can call Lisp. GC checked 2000-07-28 ben */
1410 Lisp_Object abspath;
1411 struct gcpro gcpro1;
1413 abspath = Fexpand_file_name(filename, defdir);
1415 /* Remove final slash, if any (unless path is root).
1416 stat behaves differently depending! */
1417 if (XSTRING_LENGTH(abspath) > 1
1419 IS_DIRECTORY_SEP(XSTRING_BYTE(abspath, XSTRING_LENGTH(abspath) - 1))
1421 !IS_DEVICE_SEP(XSTRING_BYTE(abspath, XSTRING_LENGTH(abspath) - 2)))
1422 /* We cannot take shortcuts; they might be wrong for magic file names. */
1423 abspath = Fdirectory_file_name(abspath);
1428 /* Signal an error if the file ABSNAME already exists.
1429 If INTERACTIVE is nonzero, ask the user whether to proceed,
1430 and bypass the error if the user says to go ahead.
1431 QUERYSTRING is a name for the action that is being considered
1433 *STATPTR is used to store the stat information if the file exists.
1434 If the file does not exist, STATPTR->st_mode is set to 0. */
1437 barf_or_query_if_file_exists(Lisp_Object absname, const char *querystring,
1438 int interactive, struct stat *statptr)
1440 /* This function can call Lisp. GC checked 2000-07-28 ben */
1441 struct stat statbuf;
1443 /* stat is a good way to tell whether the file exists,
1444 regardless of what access permissions it has. */
1445 if (sxemacs_stat((char *)XSTRING_DATA(absname), &statbuf) >= 0) {
1450 struct gcpro gcpro1;
1452 prompt = emacs_doprnt_string_c
1454 GETTEXT("File %s already exists; %s anyway? "),
1455 Qnil, -1, XSTRING_DATA(absname),
1456 GETTEXT(querystring));
1459 tem = call1(Qyes_or_no_p, prompt);
1465 Fsignal(Qfile_already_exists,
1466 list2(build_translated_string
1467 ("File already exists"), absname));
1472 statptr->st_mode = 0;
1477 DEFUN("copy-file", Fcopy_file, 2, 4, "fCopy file: \nFCopy %s to file: \np\nP", /*
1478 Copy FILENAME to NEWNAME. Both args must be strings.
1479 Signals a `file-already-exists' error if file NEWNAME already exists,
1480 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1481 A number as third arg means request confirmation if NEWNAME already exists.
1482 This is what happens in interactive use with M-x.
1483 Fourth arg KEEP-TIME non-nil means give the new file the same
1484 last-modified time as the old one. (This works on only some systems.)
1485 A prefix arg makes KEEP-TIME non-nil.
1487 (filename, newname, ok_if_already_exists, keep_time))
1489 /* This function can call Lisp. GC checked 2000-07-28 ben */
1491 char buf[16 * 1024];
1492 struct stat st, out_st;
1493 Lisp_Object handler;
1494 int speccount = specpdl_depth();
1495 struct gcpro gcpro1, gcpro2;
1496 /* Lisp_Object args[6]; */
1497 int input_file_statable_p;
1499 GCPRO2(filename, newname);
1500 CHECK_STRING(filename);
1501 CHECK_STRING(newname);
1502 filename = Fexpand_file_name(filename, Qnil);
1503 newname = Fexpand_file_name(newname, Qnil);
1505 /* If the input file name has special constructs in it,
1506 call the corresponding file handler. */
1507 handler = Ffind_file_name_handler(filename, Qcopy_file);
1508 /* Likewise for output file name. */
1510 handler = Ffind_file_name_handler(newname, Qcopy_file);
1511 if (!NILP(handler)) {
1513 return call5(handler, Qcopy_file, filename, newname,
1514 ok_if_already_exists, keep_time);
1517 /* When second argument is a directory, copy the file into it.
1518 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1520 if (!NILP(Ffile_directory_p(newname))) {
1521 Lisp_Object args[3] = {newname, Qnil, Qnil};
1522 struct gcpro ngcpro1;
1525 NGCPROn(args, countof(args));
1526 if (!IS_DIRECTORY_SEP(
1527 XSTRING_BYTE(newname,
1528 XSTRING_LENGTH(newname) - 1))) {
1529 args[i++] = Fchar_to_string(Vdirectory_sep_char);
1531 args[i++] = Ffile_name_nondirectory(filename);
1532 newname = Fconcat(i, args);
1536 if (NILP(ok_if_already_exists)
1537 || INTP(ok_if_already_exists))
1538 barf_or_query_if_file_exists(newname, "copy to it",
1539 INTP(ok_if_already_exists),
1541 else if (sxemacs_stat((const char *)XSTRING_DATA(newname), &out_st) < 0)
1544 ifd = interruptible_open((char *)XSTRING_DATA(filename),
1545 O_RDONLY | OPEN_BINARY, 0);
1547 report_file_error("Opening input file", list1(filename));
1550 record_unwind_protect(close_file_unwind, make_int(ifd));
1552 /* We can only copy regular files and symbolic links. Other files are not
1554 input_file_statable_p = (fstat(ifd, &st) >= 0);
1556 if (out_st.st_mode != 0
1557 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) {
1559 report_file_error("Input and output files are the same",
1560 list2(filename, newname));
1563 #if defined (S_ISREG) && defined (S_ISLNK)
1564 if (input_file_statable_p) {
1565 if (!(S_ISREG(st.st_mode))
1566 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1568 && !(S_ISCHR(st.st_mode))
1570 && !(S_ISLNK(st.st_mode))) {
1571 #if defined (EISDIR)
1572 /* Get a better looking error message. */
1575 report_file_error("Non-regular file", list1(filename));
1578 #endif /* S_ISREG && S_ISLNK */
1580 ofd = open((char *)XSTRING_DATA(newname),
1581 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1583 report_file_error("Opening output file", list1(newname));
1586 Lisp_Object ofd_locative = noseeum_cons(make_int(ofd), Qnil);
1588 record_unwind_protect(close_file_unwind, ofd_locative);
1590 while ((n = read_allowing_quit(ifd, buf, sizeof(buf))) > 0) {
1591 if (write_allowing_quit(ofd, buf, n) != n)
1592 report_file_error("I/O error", list1(newname));
1596 report_file_error("I/O error", list1(filename));
1597 /* Closing the output clobbers the file times on some systems. */
1599 report_file_error("I/O error", list1(newname));
1601 if (input_file_statable_p) {
1602 if (!NILP(keep_time)) {
1603 EMACS_TIME atime, mtime;
1604 EMACS_SET_SECS_USECS(atime, st.st_atime, 0);
1605 EMACS_SET_SECS_USECS(mtime, st.st_mtime, 0);
1606 if (set_file_times(newname, atime, mtime))
1607 report_file_error("I/O error",
1610 chmod((const char *)XSTRING_DATA(newname),
1611 st.st_mode & 07777);
1614 /* We'll close it by hand */
1615 XCAR(ofd_locative) = Qnil;
1618 unbind_to(speccount, Qnil);
1626 DEFUN("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1627 Create a directory. One argument, a file name string.
1631 /* This function can GC. GC checked 1997.04.06. */
1632 char dir[MAXPATHLEN];
1633 Lisp_Object handler;
1634 struct gcpro gcpro1;
1636 CHECK_STRING(dirname_);
1637 dirname_ = Fexpand_file_name(dirname_, Qnil);
1640 handler = Ffind_file_name_handler(dirname_, Qmake_directory_internal);
1643 return (call2(handler, Qmake_directory_internal, dirname_));
1645 if (XSTRING_LENGTH(dirname_) > (Bytecount) (sizeof(dir) - 1)) {
1646 return Fsignal(Qfile_error,
1647 list3(build_translated_string
1648 ("Creating directory"),
1649 build_translated_string
1650 ("pathname too long"), dirname_));
1652 strncpy(dir, (char *)XSTRING_DATA(dirname_),
1653 XSTRING_LENGTH(dirname_) + 1);
1654 dir[XSTRING_LENGTH(dirname_)]='\0';
1655 if (dir[XSTRING_LENGTH(dirname_) - 1] == '/')
1656 dir[XSTRING_LENGTH(dirname_) - 1] = '\0';
1658 if (mkdir(dir, 0777) != 0)
1659 report_file_error("Creating directory", list1(dirname_));
1664 DEFUN("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1665 Delete a directory. One argument, a file name or directory name string.
1669 /* This function can GC. GC checked 1997.04.06. */
1670 Lisp_Object handler;
1671 struct gcpro gcpro1;
1673 CHECK_STRING(dirname_);
1676 dirname_ = Fexpand_file_name(dirname_, Qnil);
1677 dirname_ = Fdirectory_file_name(dirname_);
1679 handler = Ffind_file_name_handler(dirname_, Qdelete_directory);
1682 return (call2(handler, Qdelete_directory, dirname_));
1684 if (rmdir((char *)XSTRING_DATA(dirname_)) != 0)
1685 report_file_error("Removing directory", list1(dirname_));
1690 DEFUN("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1691 Delete the file named FILENAME (a string).
1692 If FILENAME has multiple names, it continues to exist with the other names.
1696 /* This function can GC. GC checked 1997.04.06. */
1697 Lisp_Object handler;
1698 struct gcpro gcpro1;
1700 CHECK_STRING(filename);
1701 filename = Fexpand_file_name(filename, Qnil);
1704 handler = Ffind_file_name_handler(filename, Qdelete_file);
1707 return call2(handler, Qdelete_file, filename);
1709 if (0 > unlink((char *)XSTRING_DATA(filename)))
1710 report_file_error("Removing old name", list1(filename));
1715 internal_delete_file_1(Lisp_Object ignore, Lisp_Object ignore2)
1720 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1722 int internal_delete_file(Lisp_Object filename)
1724 /* This function can GC. GC checked 1997.04.06. */
1725 return NILP(condition_case_1(Qt, Fdelete_file, filename,
1726 internal_delete_file_1, Qnil));
1729 DEFUN("rename-file", Frename_file, 2, 3, "fRename file: \nFRename %s to file: \np", /*
1730 Rename FILENAME as NEWNAME. Both args must be strings.
1731 If file has names other than FILENAME, it continues to have those names.
1732 Signals a `file-already-exists' error if a file NEWNAME already exists
1733 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1734 A number as third arg means request confirmation if NEWNAME already exists.
1735 This is what happens in interactive use with M-x.
1737 (filename, newname, ok_if_already_exists))
1739 /* This function can GC. GC checked 1997.04.06. */
1740 Lisp_Object handler;
1741 struct gcpro gcpro1, gcpro2;
1743 GCPRO2(filename, newname);
1744 CHECK_STRING(filename);
1745 CHECK_STRING(newname);
1746 filename = Fexpand_file_name(filename, Qnil);
1747 newname = Fexpand_file_name(newname, Qnil);
1749 /* If the file name has special constructs in it,
1750 call the corresponding file handler. */
1751 handler = Ffind_file_name_handler(filename, Qrename_file);
1753 handler = Ffind_file_name_handler(newname, Qrename_file);
1754 if (!NILP(handler)) {
1756 return call4(handler, Qrename_file,
1757 filename, newname, ok_if_already_exists);
1760 /* When second argument is a directory, rename the file into it.
1761 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1763 if (!NILP(Ffile_directory_p(newname))) {
1764 Lisp_Object args[3] = {newname, Qnil, Qnil};
1765 struct gcpro ngcpro1;
1768 NGCPROn(args, countof(args));
1769 if (XSTRING_BYTE(newname, XSTRING_LENGTH(newname) - 1) != '/') {
1770 args[i++] = build_string("/");
1772 args[i++] = Ffile_name_nondirectory(filename);
1773 newname = Fconcat(i, args);
1777 if (NILP(ok_if_already_exists)
1778 || INTP(ok_if_already_exists))
1779 barf_or_query_if_file_exists(newname, "rename to it",
1780 INTP(ok_if_already_exists), 0);
1782 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1783 WIN32_NATIVE here; I've removed it. --marcpa */
1785 /* We have configure check for rename() and emulate using
1786 link()/unlink() if necessary. */
1787 if (0 > rename((char *)XSTRING_DATA(filename),
1788 (char *)XSTRING_DATA(newname))) {
1789 if (errno == EXDEV) {
1790 Fcopy_file(filename, newname,
1791 /* We have already prompted if it was an integer,
1792 so don't have copy-file prompt again. */
1793 (NILP(ok_if_already_exists) ? Qnil : Qt),
1795 Fdelete_file(filename);
1797 report_file_error("Renaming", list2(filename, newname));
1804 DEFUN("add-name-to-file", Fadd_name_to_file, 2, 3, "fAdd name to file: \nFName to add to %s: \np", /*
1805 Give FILENAME additional name NEWNAME. Both args must be strings.
1806 Signals a `file-already-exists' error if a file NEWNAME already exists
1807 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1808 A number as third arg means request confirmation if NEWNAME already exists.
1809 This is what happens in interactive use with M-x.
1811 (filename, newname, ok_if_already_exists))
1813 /* This function can GC. GC checked 1997.04.06. */
1814 Lisp_Object handler;
1815 struct gcpro gcpro1, gcpro2;
1817 GCPRO2(filename, newname);
1818 CHECK_STRING(filename);
1819 CHECK_STRING(newname);
1820 filename = Fexpand_file_name(filename, Qnil);
1821 newname = Fexpand_file_name(newname, Qnil);
1823 /* If the file name has special constructs in it,
1824 call the corresponding file handler. */
1825 handler = Ffind_file_name_handler(filename, Qadd_name_to_file);
1827 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1828 newname, ok_if_already_exists));
1830 /* If the new name has special constructs in it,
1831 call the corresponding file handler. */
1832 handler = Ffind_file_name_handler(newname, Qadd_name_to_file);
1834 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1835 newname, ok_if_already_exists));
1837 if (NILP(ok_if_already_exists)
1838 || INTP(ok_if_already_exists))
1839 barf_or_query_if_file_exists(newname, "make it a new name",
1840 INTP(ok_if_already_exists), 0);
1841 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
1842 on NT here. --marcpa */
1843 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
1844 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
1845 Reverted to previous behavior pending a working fix. (jhar) */
1847 unlink((char *)XSTRING_DATA(newname));
1848 if (0 > link((char *)XSTRING_DATA(filename),
1849 (char *)XSTRING_DATA(newname))) {
1850 report_file_error("Adding new name", list2(filename, newname));
1857 DEFUN("make-symbolic-link", Fmake_symbolic_link, 2, 3, "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
1858 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
1859 Signals a `file-already-exists' error if a file LINKNAME already exists
1860 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1861 A number as third arg means request confirmation if LINKNAME already exists.
1862 This happens for interactive use with M-x.
1864 (filename, linkname, ok_if_already_exists))
1866 /* This function can GC. GC checked 1997.06.04. */
1867 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
1868 Lisp_Object handler;
1869 struct gcpro gcpro1, gcpro2;
1871 GCPRO2(filename, linkname);
1872 CHECK_STRING(filename);
1873 CHECK_STRING(linkname);
1874 /* If the link target has a ~, we must expand it to get
1875 a truly valid file name. Otherwise, do not expand;
1876 we want to permit links to relative file names. */
1877 if (XSTRING_BYTE(filename, 0) == '~')
1878 filename = Fexpand_file_name(filename, Qnil);
1879 linkname = Fexpand_file_name(linkname, Qnil);
1881 /* If the file name has special constructs in it,
1882 call the corresponding file handler. */
1883 handler = Ffind_file_name_handler(filename, Qmake_symbolic_link);
1885 RETURN_UNGCPRO(call4
1886 (handler, Qmake_symbolic_link, filename,
1887 linkname, ok_if_already_exists));
1889 /* If the new link name has special constructs in it,
1890 call the corresponding file handler. */
1891 handler = Ffind_file_name_handler(linkname, Qmake_symbolic_link);
1893 RETURN_UNGCPRO(call4(handler, Qmake_symbolic_link, filename,
1894 linkname, ok_if_already_exists));
1897 if (NILP(ok_if_already_exists)
1898 || INTP(ok_if_already_exists))
1899 barf_or_query_if_file_exists(linkname, "make it a link",
1900 INTP(ok_if_already_exists), 0);
1902 unlink((char *)XSTRING_DATA(linkname));
1903 if (0 > symlink((char *)XSTRING_DATA(filename),
1904 (char *)XSTRING_DATA(linkname))) {
1905 report_file_error("Making symbolic link",
1906 list2(filename, linkname));
1908 #endif /* S_IFLNK */
1916 DEFUN("sysnetunam", Fsysnetunam, 2, 2, 0, /*
1917 Open a network connection to PATH using LOGIN as the login string.
1922 const char *path_ext;
1923 const char *login_ext;
1926 CHECK_STRING(login);
1928 /* netunam, being a strange-o system call only used once, is not
1931 LISP_STRING_TO_EXTERNAL(path, path_ext, Qfile_name);
1932 LISP_STRING_TO_EXTERNAL(login, login_ext, Qnative);
1934 netresult = netunam(path_ext, login_ext);
1936 return netresult == -1 ? Qnil : Qt;
1938 #endif /* HPUX_NET */
1940 DEFUN("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
1941 Return t if file FILENAME specifies an absolute path name.
1942 On Unix, this is a name starting with a `/' or a `~'.
1946 /* This function does not GC */
1949 CHECK_STRING(filename);
1950 ptr = XSTRING_DATA(filename);
1951 return (IS_DIRECTORY_SEP(*ptr) || *ptr == '~'
1955 /* Return nonzero if file FILENAME exists and can be executed. */
1957 static int check_executable(char *filename)
1960 return eaccess(filename, X_OK) >= 0;
1962 /* Access isn't quite right because it uses the real uid
1963 and we really want to test with the effective uid.
1964 But Unix doesn't give us a right way to do it. */
1965 return access(filename, X_OK) >= 0;
1966 #endif /* HAVE_EACCESS */
1969 /* Return nonzero if file FILENAME exists and can be written. */
1971 static int check_writable(const char *filename)
1974 return (eaccess(filename, W_OK) >= 0);
1976 /* Access isn't quite right because it uses the real uid
1977 and we really want to test with the effective uid.
1978 But Unix doesn't give us a right way to do it.
1979 Opening with O_WRONLY could work for an ordinary file,
1980 but would lose for directories. */
1981 return (access(filename, W_OK) >= 0);
1985 DEFUN("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
1986 Return t if file FILENAME exists. (This does not mean you can read it.)
1987 See also `file-readable-p' and `file-attributes'.
1991 /* This function can call lisp; GC checked 2000-07-11 ben */
1992 Lisp_Object abspath;
1993 Lisp_Object handler;
1994 struct stat statbuf;
1995 struct gcpro gcpro1;
1997 CHECK_STRING(filename);
1998 abspath = Fexpand_file_name(filename, Qnil);
2000 /* If the file name has special constructs in it,
2001 call the corresponding file handler. */
2003 handler = Ffind_file_name_handler(abspath, Qfile_exists_p);
2006 return call2(handler, Qfile_exists_p, abspath);
2008 return sxemacs_stat((char *)XSTRING_DATA(abspath),
2009 &statbuf) >= 0 ? Qt : Qnil;
2012 DEFUN("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2013 Return t if FILENAME can be executed by you.
2014 For a directory, this means you can access files in that directory.
2018 /* This function can GC. GC checked 07-11-2000 ben. */
2019 Lisp_Object abspath;
2020 Lisp_Object handler;
2021 struct gcpro gcpro1;
2023 CHECK_STRING(filename);
2024 abspath = Fexpand_file_name(filename, Qnil);
2026 /* If the file name has special constructs in it,
2027 call the corresponding file handler. */
2029 handler = Ffind_file_name_handler(abspath, Qfile_executable_p);
2032 return call2(handler, Qfile_executable_p, abspath);
2034 return check_executable((char *)XSTRING_DATA(abspath)) ? Qt : Qnil;
2037 DEFUN("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2038 Return t if file FILENAME exists and you can read it.
2039 See also `file-exists-p' and `file-attributes'.
2043 /* This function can GC */
2044 Lisp_Object abspath = Qnil;
2045 Lisp_Object handler;
2046 struct gcpro gcpro1;
2049 CHECK_STRING(filename);
2050 abspath = Fexpand_file_name(filename, Qnil);
2052 /* If the file name has special constructs in it,
2053 call the corresponding file handler. */
2054 handler = Ffind_file_name_handler(abspath, Qfile_readable_p);
2056 RETURN_UNGCPRO(call2(handler, Qfile_readable_p, abspath));
2060 interruptible_open((char *)XSTRING_DATA(abspath),
2061 O_RDONLY | OPEN_BINARY, 0);
2070 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2072 DEFUN("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2073 Return t if file FILENAME can be written or created by you.
2077 /* This function can GC. GC checked 1997.04.10. */
2078 Lisp_Object abspath, dir;
2079 Lisp_Object handler;
2080 struct stat statbuf;
2081 struct gcpro gcpro1;
2083 CHECK_STRING(filename);
2084 abspath = Fexpand_file_name(filename, Qnil);
2086 /* If the file name has special constructs in it,
2087 call the corresponding file handler. */
2089 handler = Ffind_file_name_handler(abspath, Qfile_writable_p);
2092 return call2(handler, Qfile_writable_p, abspath);
2094 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &statbuf) >= 0)
2095 return (check_writable((char *)XSTRING_DATA(abspath))
2099 dir = Ffile_name_directory(abspath);
2101 return (check_writable(!NILP(dir) ? (char *)XSTRING_DATA(dir)
2106 DEFUN("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2107 Return non-nil if file FILENAME is the name of a symbolic link.
2108 The value is the name of the file to which it is linked.
2109 Otherwise returns nil.
2113 /* This function can GC. GC checked 1997.04.10. */
2114 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2121 Lisp_Object handler;
2122 struct gcpro gcpro1;
2124 CHECK_STRING(filename);
2125 filename = Fexpand_file_name(filename, Qnil);
2127 /* If the file name has special constructs in it,
2128 call the corresponding file handler. */
2130 handler = Ffind_file_name_handler(filename, Qfile_symlink_p);
2132 if (!NILP(handler)) {
2133 return call2(handler, Qfile_symlink_p, filename);
2138 buf = ynew_array_and_zero(char, bufsize);
2139 valsize = readlink((char *)XSTRING_DATA(filename),
2141 if (valsize < bufsize) {
2144 /* Buffer was not long enough */
2148 if (valsize == -1) {
2152 val = make_string((Bufbyte*)buf, valsize);
2155 #else /* not S_IFLNK */
2157 #endif /* not S_IFLNK */
2160 DEFUN("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2161 Return t if file FILENAME is the name of a directory as a file.
2162 A directory name spec may be given instead; then the value is t
2163 if the directory so specified exists and really is a directory.
2167 /* This function can GC. GC checked 1997.04.10. */
2168 Lisp_Object abspath;
2170 Lisp_Object handler;
2171 struct gcpro gcpro1;
2173 GCPRO1(current_buffer->directory);
2174 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2177 /* If the file name has special constructs in it,
2178 call the corresponding file handler. */
2180 handler = Ffind_file_name_handler(abspath, Qfile_directory_p);
2183 return call2(handler, Qfile_directory_p, abspath);
2185 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2187 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2190 DEFUN("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2191 Return t if file FILENAME is the name of a directory as a file,
2192 and files in that directory can be opened by you. In order to use a
2193 directory as a buffer's current directory, this predicate must return true.
2194 A directory name spec may be given instead; then the value is t
2195 if the directory so specified exists and really is a readable and
2196 searchable directory.
2200 /* This function can GC. GC checked 1997.04.10. */
2201 Lisp_Object handler;
2203 /* If the file name has special constructs in it,
2204 call the corresponding file handler. */
2206 Ffind_file_name_handler(filename, Qfile_accessible_directory_p);
2208 return call2(handler, Qfile_accessible_directory_p, filename);
2210 if (NILP(Ffile_directory_p(filename)))
2213 return Ffile_executable_p(filename);
2216 DEFUN("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2217 Return t if file FILENAME is the name of a regular file.
2218 This is the sort of file that holds an ordinary stream of data bytes.
2222 /* This function can GC. GC checked 1997.04.10. */
2223 Lisp_Object abspath;
2225 Lisp_Object handler;
2226 struct gcpro gcpro1;
2228 GCPRO1(current_buffer->directory);
2229 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2232 /* If the file name has special constructs in it,
2233 call the corresponding file handler. */
2235 handler = Ffind_file_name_handler(abspath, Qfile_regular_p);
2238 return call2(handler, Qfile_regular_p, abspath);
2240 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2242 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2245 DEFUN("file-modes", Ffile_modes, 1, 1, 0, /*
2246 Return mode bits of file named FILENAME, as an integer.
2250 /* This function can GC. GC checked 1997.04.10. */
2251 Lisp_Object abspath;
2253 Lisp_Object handler;
2254 struct gcpro gcpro1;
2256 GCPRO1(current_buffer->directory);
2257 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2260 /* If the file name has special constructs in it,
2261 call the corresponding file handler. */
2263 handler = Ffind_file_name_handler(abspath, Qfile_modes);
2266 return call2(handler, Qfile_modes, abspath);
2268 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2270 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2272 return make_int(st.st_mode & 07777);
2275 DEFUN("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2276 Set mode bits of file named FILENAME to MODE (an integer).
2277 Only the 12 low bits of MODE are used.
2281 /* This function can GC. GC checked 1997.04.10. */
2282 Lisp_Object abspath;
2283 Lisp_Object handler;
2284 struct gcpro gcpro1;
2286 GCPRO1(current_buffer->directory);
2287 abspath = Fexpand_file_name(filename, current_buffer->directory);
2292 /* If the file name has special constructs in it,
2293 call the corresponding file handler. */
2295 handler = Ffind_file_name_handler(abspath, Qset_file_modes);
2298 return call3(handler, Qset_file_modes, abspath, mode);
2300 if (chmod((char *)XSTRING_DATA(abspath), XINT(mode)) < 0)
2301 report_file_error("Doing chmod", list1(abspath));
2306 DEFUN("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2307 Set the file permission bits for newly created files.
2308 The argument MODE should be an integer; if a bit in MODE is 1,
2309 subsequently created files will not have the permission corresponding
2310 to that bit enabled. Only the low 9 bits are used.
2311 This setting is inherited by subprocesses.
2317 umask((~XINT(mode)) & 0777);
2322 DEFUN("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2323 Return the default file protection for created files.
2324 The umask value determines which permissions are enabled in newly
2325 created files. If a permission's bit in the umask is 1, subsequently
2326 created files will not have that permission enabled.
2335 return make_int((~mode) & 0777);
2338 DEFUN("unix-sync", Funix_sync, 0, 0, "", /*
2339 Tell Unix to finish all pending disk updates.
2347 DEFUN("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2348 Return t if file FILE1 is newer than file FILE2.
2349 If FILE1 does not exist, the answer is nil;
2350 otherwise, if FILE2 does not exist, the answer is t.
2354 /* This function can GC. GC checked 1997.04.10. */
2355 Lisp_Object abspath1, abspath2;
2358 Lisp_Object handler;
2359 struct gcpro gcpro1, gcpro2, gcpro3;
2361 CHECK_STRING(file1);
2362 CHECK_STRING(file2);
2367 GCPRO3(abspath1, abspath2, current_buffer->directory);
2368 abspath1 = expand_and_dir_to_file(file1, current_buffer->directory);
2369 abspath2 = expand_and_dir_to_file(file2, current_buffer->directory);
2371 /* If the file name has special constructs in it,
2372 call the corresponding file handler. */
2373 handler = Ffind_file_name_handler(abspath1, Qfile_newer_than_file_p);
2376 Ffind_file_name_handler(abspath2, Qfile_newer_than_file_p);
2379 return call3(handler, Qfile_newer_than_file_p, abspath1,
2382 if (sxemacs_stat((char *)XSTRING_DATA(abspath1), &st) < 0)
2385 mtime1 = st.st_mtime;
2387 if (sxemacs_stat((char *)XSTRING_DATA(abspath2), &st) < 0)
2390 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2393 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2394 /* #define READ_BUF_SIZE (2 << 16) */
2395 #define READ_BUF_SIZE (1 << 15)
2397 DEFUN("insert-file-contents-internal", Finsert_file_contents_internal, 1, 7, 0, /*
2398 Insert contents of file FILENAME after point; no coding-system frobbing.
2399 This function is identical to `insert-file-contents' except for the
2400 handling of the CODESYS and USED-CODESYS arguments under
2401 SXEmacs/Mule. (When Mule support is not present, both functions are
2402 identical and ignore the CODESYS and USED-CODESYS arguments.)
2404 If support for Mule exists in this Emacs, the file is decoded according
2405 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2406 it should be a symbol, and the actual coding system that was used for the
2407 decoding is stored into it. It will in general be different from CODESYS
2408 if CODESYS specifies automatic encoding detection or end-of-line detection.
2410 Currently START and END refer to byte positions (as opposed to character
2411 positions), even in Mule. (Fixing this is very difficult.)
2413 (filename, visit, start, end, replace, codesys, used_codesys))
2415 /* This function can call lisp */
2419 Charcount inserted = 0;
2421 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2422 Lisp_Object handler = Qnil, val = Qnil;
2424 Bufbyte read_buf[READ_BUF_SIZE];
2426 struct buffer *buf = current_buffer;
2428 int not_regular = 0;
2430 if (UNLIKELY(buf->base_buffer && !NILP(visit))) {
2431 error("Cannot do file visiting in an indirect buffer");
2434 /* No need to call Fbarf_if_buffer_read_only() here.
2435 That's called in begin_multiple_change() or wherever. */
2436 /* #### dmoore - should probably check in various places to see if
2437 curbuf was killed and if so signal an error? */
2438 XSETBUFFER(curbuf, buf);
2440 GCPRO5(filename, val, visit, handler, curbuf);
2442 if (LIKELY(NILP(replace))) {
2443 mc_count = begin_multiple_change(buf, BUF_PT(buf), BUF_PT(buf));
2445 mc_count = begin_multiple_change(buf, BUF_BEG(buf), BUF_Z(buf));
2448 /* begin_multiple_change also adds an unwind_protect */
2449 speccount = specpdl_depth();
2451 filename = Fexpand_file_name(filename, Qnil);
2453 /* If the file name has special constructs in it,
2454 call the corresponding file handler. */
2455 handler = Ffind_file_name_handler(filename, Qinsert_file_contents);
2456 if (!NILP(handler)) {
2457 val = call6(handler, Qinsert_file_contents, filename,
2458 visit, start, end, replace);
2462 if (!NILP(used_codesys))
2463 CHECK_SYMBOL(used_codesys);
2466 if ((!NILP(start) || !NILP(end)) && !NILP(visit))
2467 error("Attempt to visit less than an entire file");
2471 if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) < 0) {
2476 report_file_error("Opening input file",
2482 /* Signal an error if we are accessing a non-regular file, with
2483 REPLACE, START or END being non-nil. */
2484 if (!S_ISREG(st.st_mode)) {
2490 if (!NILP(replace) || !NILP(start) || !NILP(end)) {
2491 end_multiple_change(buf, mc_count);
2494 (Fsignal(Qfile_error,
2495 list2(build_translated_string
2496 ("not a regular file"), filename)));
2499 #endif /* S_IFREG */
2510 if ((fd = interruptible_open((char *)XSTRING_DATA(filename),
2511 O_RDONLY | OPEN_BINARY, 0)) < 0)
2515 /* Replacement should preserve point as it preserves markers. */
2517 record_unwind_protect(restore_point_unwind,
2518 Fpoint_marker(Qnil, Qnil));
2520 record_unwind_protect(close_file_unwind, make_int(fd));
2522 /* Supposedly happens on VMS. */
2524 error("File size is negative");
2528 end = make_int(st.st_size);
2529 if (XINT(end) != st.st_size)
2530 error("Maximum buffer size exceeded");
2534 /* If requested, replace the accessible part of the buffer
2535 with the file contents. Avoid replacing text at the
2536 beginning or end of the buffer that matches the file contents;
2537 that preserves markers pointing to the unchanged parts. */
2538 #if !defined (FILE_CODING)
2539 /* The replace-mode code currently only works when the assumption
2540 'one byte == one char' holds true. This fails Mule because
2541 files may contain multibyte characters. It holds under Windows NT
2542 provided we convert CRLF into LF. */
2543 # define FSFMACS_SPEEDY_INSERT
2544 #endif /* !defined (FILE_CODING) */
2546 #ifndef FSFMACS_SPEEDY_INSERT
2547 if (!NILP(replace)) {
2548 buffer_delete_range(buf, BUF_BEG(buf), BUF_Z(buf),
2549 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2551 #else /* FSFMACS_SPEEDY_INSERT */
2552 if (!NILP(replace)) {
2553 char buffer[1 << 14];
2554 Bufpos same_at_start = BUF_BEGV(buf);
2555 Bufpos same_at_end = BUF_ZV(buf);
2558 /* Count how many chars at the start of the file
2559 match the text at the beginning of the buffer. */
2563 nread = read_allowing_quit(fd, buffer, sizeof buffer);
2565 error("IO error reading %s: %s",
2566 XSTRING_DATA(filename), strerror(errno));
2567 else if (nread == 0)
2570 while (bufpos < nread && same_at_start < BUF_ZV(buf)
2571 && BUF_FETCH_CHAR(buf,
2574 same_at_start++, bufpos++;
2575 /* If we found a discrepancy, stop the scan.
2576 Otherwise loop around and scan the next bufferful. */
2577 if (bufpos != nread)
2580 /* If the file matches the buffer completely,
2581 there's no need to replace anything. */
2582 if (same_at_start - BUF_BEGV(buf) == st.st_size) {
2584 unbind_to(speccount, Qnil);
2585 /* Truncate the buffer to the size of the file. */
2586 buffer_delete_range(buf, same_at_start, same_at_end,
2587 !NILP(visit) ? INSDEL_NO_LOCKING :
2591 /* Count how many chars at the end of the file
2592 match the text at the end of the buffer. */
2594 int total_read, nread;
2595 Bufpos bufpos, curpos, trial;
2597 /* At what file position are we now scanning? */
2598 curpos = st.st_size - (BUF_ZV(buf) - same_at_end);
2599 /* If the entire file matches the buffer tail, stop the scan. */
2602 /* How much can we scan in the next step? */
2603 trial = min(curpos, (Bufpos) sizeof(buffer));
2604 if (lseek(fd, curpos - trial, 0) < 0)
2605 report_file_error("Setting file position",
2609 while (total_read < trial) {
2611 read_allowing_quit(fd, buffer + total_read,
2612 trial - total_read);
2615 ("IO error reading file",
2617 total_read += nread;
2619 /* Scan this bufferful from the end, comparing with
2620 the Emacs buffer. */
2621 bufpos = total_read;
2622 /* Compare with same_at_start to avoid counting some buffer text
2623 as matching both at the file's beginning and at the end. */
2624 while (bufpos > 0 && same_at_end > same_at_start
2625 && BUF_FETCH_CHAR(buf, same_at_end - 1) ==
2627 same_at_end--, bufpos--;
2628 /* If we found a discrepancy, stop the scan.
2629 Otherwise loop around and scan the preceding bufferful. */
2632 /* If display current starts at beginning of line,
2633 keep it that way. */
2634 if (XBUFFER(XWINDOW(Fselected_window(Qnil))->buffer) ==
2636 XWINDOW(Fselected_window(Qnil))->
2638 !NILP(Fbolp(make_buffer(buf)));
2641 /* Don't try to reuse the same piece of text twice. */
2642 overlap = same_at_start - BUF_BEGV(buf) -
2643 (same_at_end + st.st_size - BUF_ZV(buf));
2645 same_at_end += overlap;
2647 /* Arrange to read only the nonmatching middle part of the file. */
2648 start = make_int(same_at_start - BUF_BEGV(buf));
2649 end = make_int(st.st_size - (BUF_ZV(buf) - same_at_end));
2651 buffer_delete_range(buf, same_at_start, same_at_end,
2652 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2653 /* Insert from the file at the proper position. */
2654 BUF_SET_PT(buf, same_at_start);
2656 #endif /* FSFMACS_SPEEDY_INSERT */
2659 total = XINT(end) - XINT(start);
2661 /* Make sure point-max won't overflow after this insertion. */
2662 if (total != XINT(make_int(total)))
2663 error("Maximum buffer size exceeded");
2665 /* For a special file, all we can do is guess. The value of -1
2666 will make the stream functions read as much as possible. */
2669 if (XINT(start) != 0
2670 #ifdef FSFMACS_SPEEDY_INSERT
2671 /* why was this here? asked jwz. The reason is that the replace-mode
2672 connivings above will normally put the file pointer other than
2673 where it should be. */
2675 #endif /* !FSFMACS_SPEEDY_INSERT */
2677 if (lseek(fd, XINT(start), 0) < 0)
2678 report_file_error("Setting file position",
2683 Bufpos cur_point = BUF_PT(buf);
2684 struct gcpro ngcpro1;
2685 Lisp_Object stream = make_filedesc_input_stream(fd, 0, total,
2689 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2692 stream = make_decoding_input_stream
2693 (XLSTREAM(stream), Fget_coding_system(codesys));
2694 Lstream_set_character_mode(XLSTREAM(stream));
2695 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2697 #endif /* FILE_CODING */
2699 record_unwind_protect(delete_stream_unwind, stream);
2701 /* No need to limit the amount of stuff we attempt to read. (It would
2702 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2703 occurs inside of the filedesc stream. */
2705 Lstream_data_count this_len;
2706 Charcount cc_inserted;
2709 this_len = Lstream_read(XLSTREAM(stream), read_buf,
2712 if (this_len <= 0) {
2719 buffer_insert_raw_string_1(buf, cur_point, read_buf,
2720 this_len, !NILP(visit)
2721 ? INSDEL_NO_LOCKING : 0);
2722 inserted += cc_inserted;
2723 cur_point += cc_inserted;
2726 if (!NILP(used_codesys)) {
2728 decoding_stream_coding_system(XLSTREAM(stream));
2729 Fset(used_codesys, XCODING_SYSTEM_NAME(tmp));
2731 #endif /* FILE_CODING */
2735 /* Close the file/stream */
2736 unbind_to(speccount, Qnil);
2738 if (saverrno != 0) {
2739 error("IO error reading %s: %s",
2740 XSTRING_DATA(filename), strerror(saverrno));
2746 end_multiple_change(buf, mc_count);
2749 if (!EQ(buf->undo_list, Qt))
2750 buf->undo_list = Qnil;
2751 if (NILP(handler)) {
2752 buf->modtime = st.st_mtime;
2753 buf->filename = filename;
2754 /* XEmacs addition: */
2755 /* This function used to be in C, ostensibly so that
2756 it could be called here. But that's just silly.
2757 There's no reason C code can't call out to Lisp
2758 code, and it's a lot cleaner this way. */
2759 /* Note: compute-buffer-file-truename is called for
2760 side-effect! Its return value is intentionally
2762 if (!NILP(Ffboundp(Qcompute_buffer_file_truename)))
2763 call1(Qcompute_buffer_file_truename,
2766 BUF_SAVE_MODIFF(buf) = BUF_MODIFF(buf);
2767 buf->auto_save_modified = BUF_MODIFF(buf);
2768 buf->saved_size = make_int(BUF_SIZE(buf));
2769 #ifdef CLASH_DETECTION
2770 if (NILP(handler)) {
2771 if (!NILP(buf->file_truename))
2772 unlock_file(buf->file_truename);
2773 unlock_file(filename);
2775 #endif /* CLASH_DETECTION */
2777 RETURN_UNGCPRO(Fsignal(Qfile_error,
2779 ("not a regular file"),
2782 /* If visiting nonexistent file, return nil. */
2783 if (buf->modtime == -1)
2784 report_file_error("Opening input file",
2788 /* Decode file format */
2790 Lisp_Object insval = call3(Qformat_decode,
2791 Qnil, make_int(inserted), visit);
2793 inserted = XINT(insval);
2798 struct gcpro ngcpro1;
2801 EXTERNAL_LIST_LOOP(p, Vafter_insert_file_functions) {
2802 Lisp_Object insval = call1(XCAR(p), make_int(inserted));
2803 if (!NILP(insval)) {
2804 CHECK_NATNUM(insval);
2805 inserted = XINT(insval);
2817 return (list2(filename, make_int(inserted)));
2820 static int a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
2821 Lisp_Object * annot);
2822 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end);
2824 /* If build_annotations switched buffers, switch back to BUF.
2825 Kill the temporary buffer that was selected in the meantime. */
2827 static Lisp_Object build_annotations_unwind(Lisp_Object buf)
2831 if (XBUFFER(buf) == current_buffer)
2833 tembuf = Fcurrent_buffer();
2835 Fkill_buffer(tembuf);
2839 DEFUN("write-region-internal", Fwrite_region_internal, 3, 7, "r\nFWrite region to file: ", /*
2840 Write current region into specified file; no coding-system frobbing.
2841 This function is identical to `write-region' except for the handling
2842 of the CODESYS argument under SXEmacs/Mule. (When Mule support is not
2843 present, both functions are identical and ignore the CODESYS argument.)
2844 If support for Mule exists in this Emacs, the file is encoded according
2845 to the value of CODESYS. If this is nil, no code conversion occurs.
2847 As a special kludge to support auto-saving, when START is nil START and
2848 END are set to the beginning and end, respectively, of the buffer,
2849 regardless of any restrictions. Don't use this feature. It is documented
2850 here because write-region handler writers need to be aware of it.
2852 (start, end, filename, append, visit, lockname, codesys))
2854 /* This function can call lisp. GC checked 2000-07-28 ben */
2856 int failure, stat_res;
2859 Lisp_Object fn = Qnil;
2860 int speccount = specpdl_depth();
2861 int visiting_other = STRINGP(visit);
2862 int visiting = (EQ(visit, Qt) || visiting_other);
2863 int quietly = (!visiting && !NILP(visit));
2864 Lisp_Object visit_file = Qnil;
2865 Lisp_Object annotations = Qnil;
2866 struct buffer *given_buffer;
2867 Bufpos start1, end1;
2868 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2869 struct gcpro ngcpro1, ngcpro2;
2872 XSETBUFFER(curbuf, current_buffer);
2874 /* start, end, visit, and append are never modified in this fun
2875 so we don't protect them. */
2876 GCPRO5(visit_file, filename, codesys, lockname, annotations);
2877 NGCPRO2(curbuf, fn);
2879 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
2880 we should signal an error rather than blissfully continuing
2881 along. ARGH, this function is going to lose lose lose. We need
2882 to protect the current_buffer from being destroyed, but the
2883 multiple return points make this a pain in the butt. ]] we do
2884 protect curbuf now. --ben */
2887 codesys = Fget_coding_system(codesys);
2888 #endif /* FILE_CODING */
2890 if (current_buffer->base_buffer && !NILP(visit))
2892 ("Cannot do file visiting in an indirect buffer", curbuf);
2894 if (!NILP(start) && !STRINGP(start))
2895 get_buffer_range_char(current_buffer, start, end, &start1,
2899 Lisp_Object handler;
2902 visit_file = Fexpand_file_name(visit, Qnil);
2904 visit_file = filename;
2905 filename = Fexpand_file_name(filename, Qnil);
2908 lockname = visit_file;
2910 /* We used to UNGCPRO here. BAD! visit_file is used below after
2911 more Lisp calling. */
2912 /* If the file name has special constructs in it,
2913 call the corresponding file handler. */
2914 handler = Ffind_file_name_handler(filename, Qwrite_region);
2915 /* If FILENAME has no handler, see if VISIT has one. */
2916 if (NILP(handler) && STRINGP(visit))
2917 handler = Ffind_file_name_handler(visit, Qwrite_region);
2919 if (!NILP(handler)) {
2921 call8(handler, Qwrite_region, start, end,
2922 filename, append, visit, lockname, codesys);
2924 BUF_SAVE_MODIFF(current_buffer) =
2925 BUF_MODIFF(current_buffer);
2926 current_buffer->saved_size =
2927 make_int(BUF_SIZE(current_buffer));
2928 current_buffer->filename = visit_file;
2929 MARK_MODELINE_CHANGED;
2937 #ifdef CLASH_DETECTION
2939 lock_file(lockname);
2940 #endif /* CLASH_DETECTION */
2942 /* Special kludge to simplify auto-saving. */
2944 start1 = BUF_BEG(current_buffer);
2945 end1 = BUF_Z(current_buffer);
2948 record_unwind_protect(build_annotations_unwind, Fcurrent_buffer());
2950 given_buffer = current_buffer;
2951 annotations = build_annotations(start, end);
2952 if (current_buffer != given_buffer) {
2953 start1 = BUF_BEGV(current_buffer);
2954 end1 = BUF_ZV(current_buffer);
2959 if (!NILP(append)) {
2961 open((char *)XSTRING_DATA(fn), O_WRONLY | OPEN_BINARY, 0);
2964 desc = open((char *)XSTRING_DATA(fn),
2965 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
2966 auto_saving ? auto_save_mode_bits : CREAT_MODE);
2970 #ifdef CLASH_DETECTION
2973 unlock_file(lockname);
2975 #endif /* CLASH_DETECTION */
2976 report_file_error("Opening output file", list1(filename));
2980 Lisp_Object desc_locative = Fcons(make_int(desc), Qnil);
2981 Lisp_Object instream = Qnil, outstream = Qnil;
2982 struct gcpro nngcpro1, nngcpro2;
2983 /* need to gcpro; QUIT could happen out of call to write() */
2984 NNGCPRO2(instream, outstream);
2986 record_unwind_protect(close_file_unwind, desc_locative);
2988 if (!NILP(append)) {
2989 if (lseek(desc, 0, 2) < 0) {
2990 #ifdef CLASH_DETECTION
2992 unlock_file(lockname);
2993 #endif /* CLASH_DETECTION */
2994 report_file_error("Lseek error",
3001 /* Note: I tried increasing the buffering size, along with
3002 various other tricks, but nothing seemed to make much of
3003 a difference in the time it took to save a large file.
3004 (Actually that's not true. With a local disk, changing
3005 the buffer size doesn't seem to make much difference.
3006 With an NFS-mounted disk, it could make a lot of difference
3007 because you're affecting the number of network requests
3008 that need to be made, and there could be a large latency
3009 for each request. So I've increased the buffer size
3011 outstream = make_filedesc_output_stream(desc, 0, -1, 0);
3012 Lstream_set_buffering(XLSTREAM(outstream),
3013 LSTREAM_BLOCKN_BUFFERED, 65536);
3016 make_encoding_output_stream(XLSTREAM(outstream), codesys);
3017 Lstream_set_buffering(XLSTREAM(outstream),
3018 LSTREAM_BLOCKN_BUFFERED, 65536);
3019 #endif /* FILE_CODING */
3020 if (STRINGP(start)) {
3021 instream = make_lisp_string_input_stream(start, 0, -1);
3025 make_lisp_buffer_input_stream(current_buffer,
3028 LSTR_IGNORE_ACCESSIBLE);
3030 (0 > (a_write(outstream, instream, start1, &annotations)));
3032 /* Note that this doesn't close the desc since we created the
3033 stream without the LSTR_CLOSING flag, but it does
3034 flush out any buffered data. */
3035 if (Lstream_close(XLSTREAM(outstream)) < 0) {
3039 Lstream_close(XLSTREAM(instream));
3042 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3043 Disk full in NFS may be reported here. */
3044 /* mib says that closing the file will try to write as fast as NFS can do
3045 it, and that means the fsync here is not crucial for autosave files. */
3046 if (!auto_saving && fsync(desc) < 0
3047 /* If fsync fails with EINTR, don't treat that as serious. */
3048 && errno != EINTR) {
3052 #endif /* HAVE_FSYNC */
3054 /* Spurious "file has changed on disk" warnings used to be seen on
3055 systems where close() can change the modtime. This is known to
3056 happen on various NFS file systems, on Windows, and on Linux.
3057 Rather than handling this on a per-system basis, we
3058 unconditionally do the sxemacs_stat() after the close(). */
3060 /* NFS can report a write failure now. */
3061 if (close(desc) < 0) {
3066 /* Discard the close unwind-protect. Execute the one for
3067 build_annotations (switches back to the original current buffer
3069 XCAR(desc_locative) = Qnil;
3070 unbind_to(speccount, Qnil);
3075 stat_res = sxemacs_stat((char *)XSTRING_DATA(fn), &st);
3077 #ifdef CLASH_DETECTION
3079 unlock_file(lockname);
3080 #endif /* CLASH_DETECTION */
3082 /* Do this before reporting IO error
3083 to avoid a "file has changed on disk" warning on
3084 next attempt to save. */
3087 current_buffer->modtime = st.st_mtime;
3089 If sxemacs_stat failed, we have bigger problems, and
3090 most likely the file is gone, so the error next time is
3096 report_file_error("Writing file", list1(fn));
3100 BUF_SAVE_MODIFF(current_buffer) = BUF_MODIFF(current_buffer);
3101 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3102 current_buffer->filename = visit_file;
3103 MARK_MODELINE_CHANGED;
3104 } else if (quietly) {
3112 message("Wrote %s", XSTRING_DATA(visit_file));
3114 Lisp_Object fsp = Qnil;
3115 struct gcpro nngcpro1;
3118 fsp = Ffile_symlink_p(fn);
3120 message("Wrote %s", XSTRING_DATA(fn));
3122 message("Wrote %s (symlink to %s)",
3123 XSTRING_DATA(fn), XSTRING_DATA(fsp));
3132 /* #### This is such a load of shit!!!! There is no way we should define
3133 something so stupid as a subr, just sort the fucking list more
3135 DEFUN("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3136 Return t if (car A) is numerically less than (car B).
3140 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcar(a), Fcar(b)))
3146 /* Heh heh heh, let's define this too, just to aggravate the person who
3147 wrote the above comment. */
3148 DEFUN("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3149 Return t if (cdr A) is numerically less than (cdr B).
3153 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcdr(a), Fcdr(b)))
3159 /* Build the complete list of annotations appropriate for writing out
3160 the text between START and END, by calling all the functions in
3161 write-region-annotate-functions and merging the lists they return.
3162 If one of these functions switches to a different buffer, we assume
3163 that buffer contains altered text. Therefore, the caller must
3164 make sure to restore the current buffer in all cases,
3165 as save-excursion would do. */
3167 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end)
3169 /* This function can GC */
3170 Lisp_Object annotations;
3172 struct gcpro gcpro1, gcpro2;
3173 Lisp_Object original_buffer;
3175 XSETBUFFER(original_buffer, current_buffer);
3178 p = Vwrite_region_annotate_functions;
3179 GCPRO2(annotations, p);
3181 struct buffer *given_buffer = current_buffer;
3182 Vwrite_region_annotations_so_far = annotations;
3183 res = call2(Fcar(p), start, end);
3184 /* If the function makes a different buffer current,
3185 assume that means this buffer contains altered text to be output.
3186 Reset START and END from the buffer bounds
3187 and discard all previous annotations because they should have
3188 been dealt with by this function. */
3189 if (current_buffer != given_buffer) {
3190 start = make_int(BUF_BEGV(current_buffer));
3191 end = make_int(BUF_ZV(current_buffer));
3194 Flength(res); /* Check basic validity of return value */
3195 annotations = merge(annotations, res, Qcar_less_than_car);
3199 /* Now do the same for annotation functions implied by the file-format */
3200 if (auto_saving && (!EQ(Vauto_save_file_format, Qt)))
3201 p = Vauto_save_file_format;
3203 p = current_buffer->file_format;
3205 struct buffer *given_buffer = current_buffer;
3206 Vwrite_region_annotations_so_far = annotations;
3207 res = call4(Qformat_annotate_function, Fcar(p), start, end,
3209 if (current_buffer != given_buffer) {
3210 start = make_int(BUF_BEGV(current_buffer));
3211 end = make_int(BUF_ZV(current_buffer));
3215 annotations = merge(annotations, res, Qcar_less_than_car);
3222 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3223 EOF is encountered), assuming they start at position POS in the buffer
3224 of string that STREAM refers to. Intersperse with them the annotations
3225 from *ANNOT that fall into the range of positions we are reading from,
3226 each at its appropriate position.
3228 Modify *ANNOT by discarding elements as we output them.
3229 The return value is negative in case of system call failure. */
3231 /* 4K should probably be fine. We just need to reduce the number of
3232 function calls to reasonable level. The Lstream stuff itself will
3233 batch to 64K to reduce the number of system calls. */
3235 #define A_WRITE_BATCH_SIZE 4096
3238 a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
3239 Lisp_Object * annot)
3243 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3244 Lstream *instr = XLSTREAM(instream);
3245 Lstream *outstr = XLSTREAM(outstream);
3247 while (LISTP(*annot)) {
3248 tem = Fcar_safe(Fcar(*annot));
3250 nextpos = XINT(tem);
3254 /* If there are annotations left and we have Mule, then we
3255 have to do the I/O one emchar at a time so we can
3256 determine when to insert the annotation. */
3257 if (!NILP(*annot)) {
3259 while (pos != nextpos
3260 && (ch = Lstream_get_emchar(instr)) != EOF) {
3261 if (Lstream_put_emchar(outstr, ch) < 0)
3268 while (pos != nextpos) {
3269 /* Otherwise there is no point to that. Just go in batches. */
3271 min(nextpos - pos, A_WRITE_BATCH_SIZE);
3273 chunk = Lstream_read(instr, largebuf, chunk);
3276 if (chunk == 0) /* EOF */
3278 if (Lstream_write(outstr, largebuf, chunk) <
3284 if (pos == nextpos) {
3285 tem = Fcdr(Fcar(*annot));
3287 if (Lstream_write(outstr, XSTRING_DATA(tem),
3288 XSTRING_LENGTH(tem)) < 0)
3291 *annot = Fcdr(*annot);
3298 DEFUN("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3299 Return t if last mod time of BUFFER's visited file matches what BUFFER records.
3300 This means that the file has not been changed since it was visited or saved.
3304 /* This function can call lisp; GC checked 2000-07-11 ben */
3307 Lisp_Object handler;
3309 CHECK_BUFFER(buffer);
3310 b = XBUFFER(buffer);
3312 if (!STRINGP(b->filename))
3314 if (b->modtime == 0)
3317 /* If the file name has special constructs in it,
3318 call the corresponding file handler. */
3319 handler = Ffind_file_name_handler(b->filename,
3320 Qverify_visited_file_modtime);
3322 return call2(handler, Qverify_visited_file_modtime, buffer);
3324 if (sxemacs_stat((char *)XSTRING_DATA(b->filename), &st) < 0) {
3325 /* If the file doesn't exist now and didn't exist before,
3326 we say that it isn't modified, provided the error is a tame one. */
3327 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3332 if (st.st_mtime == b->modtime
3333 /* If both are positive, accept them if they are off by one second. */
3334 || (st.st_mtime > 0 && b->modtime > 0
3335 && (st.st_mtime == b->modtime + 1
3336 || st.st_mtime == b->modtime - 1)))
3341 DEFUN("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3342 Clear out records of last mod time of visited file.
3343 Next attempt to save will certainly not complain of a discrepancy.
3347 current_buffer->modtime = 0;
3351 DEFUN("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3352 Return the current buffer's recorded visited file modification time.
3353 The value is a list of the form (HIGH . LOW), like the time values
3354 that `file-attributes' returns.
3358 return time_to_lisp((time_t) current_buffer->modtime);
3361 DEFUN("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3362 Update buffer's recorded modification time from the visited file's time.
3363 Useful if the buffer was not read from the file normally
3364 or if the file itself has been changed for some known benign reason.
3365 An argument specifies the modification time value to use
3366 \(instead of that of the visited file), in the form of a list
3367 \(HIGH . LOW) or (HIGH LOW).
3371 /* This function can call lisp */
3372 if (!NILP(time_list)) {
3374 lisp_to_time(time_list, &the_time);
3375 current_buffer->modtime = (int)the_time;
3377 Lisp_Object filename = Qnil;
3379 Lisp_Object handler;
3380 struct gcpro gcpro1, gcpro2, gcpro3;
3382 GCPRO3(filename, time_list, current_buffer->filename);
3383 filename = Fexpand_file_name(current_buffer->filename, Qnil);
3385 /* If the file name has special constructs in it,
3386 call the corresponding file handler. */
3388 Ffind_file_name_handler(filename,
3389 Qset_visited_file_modtime);
3392 /* The handler can find the file name the same way we did. */
3393 return call2(handler, Qset_visited_file_modtime, Qnil);
3394 else if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) >= 0)
3395 current_buffer->modtime = st.st_mtime;
3402 auto_save_error(Lisp_Object condition_object, Lisp_Object ignored)
3404 /* This function can call lisp */
3407 /* Don't try printing an error message after everything is gone! */
3408 if (preparing_for_armageddon)
3410 clear_echo_area(selected_frame(), Qauto_saving, 1);
3411 Fding(Qt, Qauto_save_error, Qnil);
3412 message("Auto-saving...error for %s",
3413 XSTRING_DATA(current_buffer->name));
3414 Fsleep_for(make_int(1));
3415 message("Auto-saving...error!for %s",
3416 XSTRING_DATA(current_buffer->name));
3417 Fsleep_for(make_int(1));
3418 message("Auto-saving...error for %s",
3419 XSTRING_DATA(current_buffer->name));
3420 Fsleep_for(make_int(1));
3424 static Lisp_Object auto_save_1(Lisp_Object ignored)
3426 /* This function can call lisp */
3427 /* #### I think caller is protecting current_buffer? */
3429 Lisp_Object fn = current_buffer->filename;
3430 Lisp_Object a = current_buffer->auto_save_file_name;
3435 /* Get visited file's mode to become the auto save file's mode. */
3436 if (STRINGP(fn) && sxemacs_stat((char *)XSTRING_DATA(fn), &st) >= 0)
3437 /* But make sure we can overwrite it later! */
3438 auto_save_mode_bits = st.st_mode | 0600;
3440 /* default mode for auto-save files of buffers with no file is
3441 readable by owner only. This may annoy some small number of
3442 people, but the alternative removes all privacy from email. */
3443 auto_save_mode_bits = 0600;
3446 /* !!#### need to deal with this 'escape-quoted everywhere */
3447 Fwrite_region_internal(Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3449 current_buffer->buffer_file_coding_system
3457 auto_save_expand_name_error(Lisp_Object condition_object, Lisp_Object ignored)
3459 /* #### this function should spew an error message about not being
3460 able to open the .saves file. */
3464 static Lisp_Object auto_save_expand_name(Lisp_Object name)
3466 struct gcpro gcpro1;
3468 /* note that caller did NOT gc protect name, so we do it. */
3469 /* #### dmoore - this might not be necessary, if condition_case_1
3470 protects it. but I don't think it does. */
3472 RETURN_UNGCPRO(Fexpand_file_name(name, Qnil));
3475 static Lisp_Object do_auto_save_unwind(Lisp_Object fd)
3481 static Lisp_Object do_auto_save_unwind_2(Lisp_Object old_auto_saving)
3483 auto_saving = XINT(old_auto_saving);
3487 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3488 and if so, tries to avoid touching lisp objects.
3490 The only time that Fdo_auto_save() is called while GC is in progress
3491 is if we're going down, as a result of an abort() or a kill signal.
3492 It's fairly important that we generate autosave files in that case!
3495 DEFUN("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3496 Auto-save all buffers that need it.
3497 This is all buffers that have auto-saving enabled
3498 and are changed since last auto-saved.
3499 Auto-saving writes the buffer into a file
3500 so that your editing is not lost if the system crashes.
3501 This file is not the file you visited; that changes only when you save.
3502 Normally we run the normal hook `auto-save-hook' before saving.
3504 Non-nil first argument means do not print any message if successful.
3505 Non-nil second argument means save only current buffer.
3507 (no_message, current_only))
3509 /* This function can call lisp */
3511 Lisp_Object tail, buf;
3513 int do_handled_files;
3514 Lisp_Object oquit = Qnil;
3515 Lisp_Object listfile = Qnil;
3518 int speccount = specpdl_depth();
3519 struct gcpro gcpro1, gcpro2, gcpro3;
3521 XSETBUFFER(old, current_buffer);
3522 GCPRO3(oquit, listfile, old);
3523 check_quit(); /* make Vquit_flag accurate */
3524 /* Ordinarily don't quit within this function,
3525 but don't make it impossible to quit (in case we get hung in I/O). */
3529 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3530 variables point to non-strings reached from Vbuffer_alist. */
3532 if (minibuf_level != 0 || preparing_for_armageddon)
3535 run_hook(Qauto_save_hook);
3537 if (STRINGP(Vauto_save_list_file_name))
3538 listfile = condition_case_1(Qt,
3539 auto_save_expand_name,
3540 Vauto_save_list_file_name,
3541 auto_save_expand_name_error, Qnil);
3543 /* Make sure auto_saving is reset. */
3544 record_unwind_protect(do_auto_save_unwind_2, make_int(auto_saving));
3548 /* First, save all files which don't have handlers. If Emacs is
3549 crashing, the handlers may tweak what is causing Emacs to crash
3550 in the first place, and it would be a shame if Emacs failed to
3551 autosave perfectly ordinary files because it couldn't handle some
3553 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) {
3554 for (tail = Vbuffer_alist; CONSP(tail); tail = XCDR(tail)) {
3555 buf = XCDR(XCAR(tail));
3558 if (!NILP(current_only)
3559 && b != current_buffer)
3562 /* Don't auto-save indirect buffers.
3563 The base buffer takes care of it. */
3567 /* Check for auto save enabled
3568 and file changed since last auto save
3569 and file changed since last real save. */
3570 if (STRINGP(b->auto_save_file_name)
3571 && BUF_SAVE_MODIFF(b) < BUF_MODIFF(b)
3572 && b->auto_save_modified < BUF_MODIFF(b)
3573 /* -1 means we've turned off autosaving for a while--see below. */
3574 && XINT(b->saved_size) >= 0
3575 && (do_handled_files
3577 NILP(Ffind_file_name_handler
3578 (b->auto_save_file_name,
3580 EMACS_TIME before_time, after_time;
3582 EMACS_GET_TIME(before_time);
3583 /* If we had a failure, don't try again for 20 minutes. */
3584 if (!preparing_for_armageddon
3585 && b->auto_save_failure_time >= 0
3586 && (EMACS_SECS(before_time) -
3587 b->auto_save_failure_time < 1200))
3590 if (!preparing_for_armageddon &&
3591 (XINT(b->saved_size) * 10
3592 > (BUF_Z(b) - BUF_BEG(b)) * 13)
3593 /* A short file is likely to change a large fraction;
3594 spare the user annoying messages. */
3595 && XINT(b->saved_size) > 5000
3596 /* These messages are frequent and annoying for `*mail*'. */
3597 && !NILP(b->filename)
3599 && disable_auto_save_when_buffer_shrinks) {
3600 /* It has shrunk too much; turn off auto-saving here.
3601 Unless we're about to crash, in which case auto-save it
3605 ("Buffer %s has shrunk a lot; auto save turned off there",
3606 XSTRING_DATA(b->name));
3607 /* Turn off auto-saving until there's a real save,
3608 and prevent any more warnings. */
3609 b->saved_size = make_int(-1);
3610 if (!gc_in_progress)
3611 Fsleep_for(make_int(1));
3614 set_buffer_internal(b);
3615 if (!auto_saved && NILP(no_message)) {
3616 static const unsigned char *msg
3618 (const unsigned char *)
3620 echo_area_message(selected_frame(), msg,
3622 strlen((const char *)
3627 /* Open the auto-save list file, if necessary.
3628 We only do this now so that the file only exists
3629 if we actually auto-saved any files. */
3630 if (!auto_saved && !inhibit_auto_save_session
3631 && !NILP(Vauto_save_list_file_prefix)
3632 && STRINGP(listfile) && listdesc < 0) {
3634 open((char *)XSTRING_DATA(listfile),
3635 O_WRONLY | O_TRUNC | O_CREAT |
3636 OPEN_BINARY, CREAT_MODE);
3638 /* Arrange to close that file whether or not we get
3641 record_unwind_protect
3642 (do_auto_save_unwind,
3643 make_int(listdesc));
3646 /* Record all the buffers that we are auto-saving in
3647 the special file that lists them. For each of
3648 these buffers, record visited name (if any) and
3650 if (listdesc >= 0) {
3651 const Extbyte *auto_save_file_name_ext;
3652 Extcount auto_save_file_name_ext_len;
3654 TO_EXTERNAL_FORMAT(LISP_STRING,
3656 auto_save_file_name,
3658 (auto_save_file_name_ext,
3659 auto_save_file_name_ext_len),
3661 if (!NILP(b->filename)) {
3662 const Extbyte *filename_ext;
3663 Extcount filename_ext_len;
3665 TO_EXTERNAL_FORMAT(LISP_STRING,
3671 write(listdesc, filename_ext,
3674 write(listdesc, "\n", 1);
3675 write(listdesc, auto_save_file_name_ext,
3676 auto_save_file_name_ext_len);
3677 write(listdesc, "\n", 1);
3680 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
3681 based on values in Vbuffer_alist. auto_save_1 may
3682 cause lisp handlers to run. Those handlers may kill
3683 the buffer and then GC. Since the buffer is killed,
3684 it's no longer in Vbuffer_alist so it might get reaped
3685 by the GC. We also need to protect tail. */
3686 /* #### There is probably a lot of other code which has
3687 pointers into buffers which may get blown away by
3690 struct gcpro ngcpro1, ngcpro2;
3692 condition_case_1(Qt,
3694 auto_save_error, Qnil);
3697 /* Handler killed our saved current-buffer! Pick any. */
3698 if (!BUFFER_LIVE_P(XBUFFER(old)))
3699 XSETBUFFER(old, current_buffer);
3701 set_buffer_internal(XBUFFER(old));
3704 /* Handler killed their own buffer! */
3705 if (!BUFFER_LIVE_P(b))
3708 b->auto_save_modified = BUF_MODIFF(b);
3709 b->saved_size = make_int(BUF_SIZE(b));
3710 EMACS_GET_TIME(after_time);
3711 /* If auto-save took more than 60 seconds,
3712 assume it was an NFS failure that got a timeout. */
3713 if (EMACS_SECS(after_time) -
3714 EMACS_SECS(before_time) > 60)
3715 b->auto_save_failure_time =
3716 EMACS_SECS(after_time);
3721 /* Prevent another auto save till enough input events come in. */
3725 /* If we didn't save anything into the listfile, remove the old
3726 one because nothing needed to be auto-saved. Do this afterwards
3727 rather than before in case we get a crash attempting to autosave
3728 (in that case we'd still want the old one around). */
3729 if (listdesc < 0 && !auto_saved && STRINGP(listfile))
3730 unlink((char *)XSTRING_DATA(listfile));
3735 /* Show "...done" only if the echo area would otherwise be empty. */
3736 if (auto_saved && NILP(no_message)
3737 && NILP(clear_echo_area(selected_frame(), Qauto_saving, 0))) {
3738 static const unsigned char *msg
3739 = (const unsigned char *)"Auto-saving...done";
3740 echo_area_message(selected_frame(), msg, Qnil, 0,
3741 strlen((const char *)msg), Qauto_saving);
3746 RETURN_UNGCPRO(unbind_to(speccount, Qnil));
3749 DEFUN("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
3750 Mark current buffer as auto-saved with its current text.
3751 No auto-save file will be written until the buffer changes again.
3755 current_buffer->auto_save_modified = BUF_MODIFF(current_buffer);
3756 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3757 current_buffer->auto_save_failure_time = -1;
3761 DEFUN("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
3762 Clear any record of a recent auto-save failure in the current buffer.
3766 current_buffer->auto_save_failure_time = -1;
3770 DEFUN("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
3771 Return t if buffer has been auto-saved since last read in or saved.
3775 return (BUF_SAVE_MODIFF(current_buffer) <
3776 current_buffer->auto_save_modified) ? Qt : Qnil;
3779 /************************************************************************/
3780 /* initialization */
3781 /************************************************************************/
3783 void syms_of_fileio(void)
3785 defsymbol(&Qexpand_file_name, "expand-file-name");
3786 defsymbol(&Qfile_truename, "file-truename");
3787 defsymbol(&Qsubstitute_in_file_name, "substitute-in-file-name");
3788 defsymbol(&Qdirectory_file_name, "directory-file-name");
3789 defsymbol(&Qfile_dirname, "file-dirname");
3790 defsymbol(&Qfile_basename, "file-basename");
3791 defsymbol(&Qfile_name_directory, "file-name-directory");
3792 defsymbol(&Qfile_name_nondirectory, "file-name-nondirectory");
3793 defsymbol(&Qunhandled_file_name_directory,
3794 "unhandled-file-name-directory");
3795 defsymbol(&Qfile_name_as_directory, "file-name-as-directory");
3796 defsymbol(&Qcopy_file, "copy-file");
3797 defsymbol(&Qmake_directory_internal, "make-directory-internal");
3798 defsymbol(&Qdelete_directory, "delete-directory");
3799 defsymbol(&Qdelete_file, "delete-file");
3800 defsymbol(&Qrename_file, "rename-file");
3801 defsymbol(&Qadd_name_to_file, "add-name-to-file");
3802 defsymbol(&Qmake_symbolic_link, "make-symbolic-link");
3803 defsymbol(&Qfile_exists_p, "file-exists-p");
3804 defsymbol(&Qfile_executable_p, "file-executable-p");
3805 defsymbol(&Qfile_readable_p, "file-readable-p");
3806 defsymbol(&Qfile_symlink_p, "file-symlink-p");
3807 defsymbol(&Qfile_writable_p, "file-writable-p");
3808 defsymbol(&Qfile_directory_p, "file-directory-p");
3809 defsymbol(&Qfile_regular_p, "file-regular-p");
3810 defsymbol(&Qfile_accessible_directory_p, "file-accessible-directory-p");
3811 defsymbol(&Qfile_modes, "file-modes");
3812 defsymbol(&Qset_file_modes, "set-file-modes");
3813 defsymbol(&Qfile_newer_than_file_p, "file-newer-than-file-p");
3814 defsymbol(&Qinsert_file_contents, "insert-file-contents");
3815 defsymbol(&Qwrite_region, "write-region");
3816 defsymbol(&Qverify_visited_file_modtime, "verify-visited-file-modtime");
3817 defsymbol(&Qset_visited_file_modtime, "set-visited-file-modtime");
3818 defsymbol(&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
3820 defsymbol(&Qauto_save_hook, "auto-save-hook");
3821 defsymbol(&Qauto_save_error, "auto-save-error");
3822 defsymbol(&Qauto_saving, "auto-saving");
3824 defsymbol(&Qformat_decode, "format-decode");
3825 defsymbol(&Qformat_annotate_function, "format-annotate-function");
3827 defsymbol(&Qcompute_buffer_file_truename,
3828 "compute-buffer-file-truename");
3829 DEFERROR_STANDARD(Qfile_error, Qio_error);
3830 DEFERROR_STANDARD(Qfile_already_exists, Qfile_error);
3832 DEFSUBR(Ffind_file_name_handler);
3834 DEFSUBR(Ffile_name_directory);
3835 DEFSUBR(Ffile_name_nondirectory);
3836 DEFSUBR(Ffile_basename);
3837 DEFSUBR(Ffile_dirname);
3838 DEFSUBR(Funhandled_file_name_directory);
3839 DEFSUBR(Ffile_name_as_directory);
3840 DEFSUBR(Fdirectory_file_name);
3841 DEFSUBR(Fmake_temp_name);
3842 DEFSUBR(Fexpand_file_name);
3843 DEFSUBR(Ffile_truename);
3844 DEFSUBR(Fsubstitute_in_file_name);
3845 DEFSUBR(Fcopy_file);
3846 DEFSUBR(Fmake_directory_internal);
3847 DEFSUBR(Fdelete_directory);
3848 DEFSUBR(Fdelete_file);
3849 DEFSUBR(Frename_file);
3850 DEFSUBR(Fadd_name_to_file);
3851 DEFSUBR(Fmake_symbolic_link);
3853 DEFSUBR(Fsysnetunam);
3854 #endif /* HPUX_NET */
3855 DEFSUBR(Ffile_name_absolute_p);
3856 DEFSUBR(Ffile_exists_p);
3857 DEFSUBR(Ffile_executable_p);
3858 DEFSUBR(Ffile_readable_p);
3859 DEFSUBR(Ffile_writable_p);
3860 DEFSUBR(Ffile_symlink_p);
3861 DEFSUBR(Ffile_directory_p);
3862 DEFSUBR(Ffile_accessible_directory_p);
3863 DEFSUBR(Ffile_regular_p);
3864 DEFSUBR(Ffile_modes);
3865 DEFSUBR(Fset_file_modes);
3866 DEFSUBR(Fset_default_file_modes);
3867 DEFSUBR(Fdefault_file_modes);
3868 DEFSUBR(Funix_sync);
3869 DEFSUBR(Ffile_newer_than_file_p);
3870 DEFSUBR(Finsert_file_contents_internal);
3871 DEFSUBR(Fwrite_region_internal);
3872 DEFSUBR(Fcar_less_than_car); /* Vomitous! */
3873 DEFSUBR(Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
3874 DEFSUBR(Fverify_visited_file_modtime);
3875 DEFSUBR(Fclear_visited_file_modtime);
3876 DEFSUBR(Fvisited_file_modtime);
3877 DEFSUBR(Fset_visited_file_modtime);
3879 DEFSUBR(Fdo_auto_save);
3880 DEFSUBR(Fset_buffer_auto_saved);
3881 DEFSUBR(Fclear_buffer_auto_save_failure);
3882 DEFSUBR(Frecent_auto_save_p);
3885 void vars_of_fileio(void)
3887 DEFVAR_LISP("auto-save-file-format", &Vauto_save_file_format /*
3888 *Format in which to write auto-save files.
3889 Should be a list of symbols naming formats that are defined in `format-alist'.
3890 If it is t, which is the default, auto-save files are written in the
3891 same format as a regular save would use.
3893 Vauto_save_file_format = Qt;
3895 DEFVAR_LISP("file-name-handler-alist", &Vfile_name_handler_alist /*
3896 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
3897 If a file name matches REGEXP, then all I/O on that file is done by calling
3900 The first argument given to HANDLER is the name of the I/O primitive
3901 to be handled; the remaining arguments are the arguments that were
3902 passed to that primitive. For example, if you do
3903 (file-exists-p FILENAME)
3904 and FILENAME is handled by HANDLER, then HANDLER is called like this:
3905 (funcall HANDLER 'file-exists-p FILENAME)
3906 The function `find-file-name-handler' checks this list for a handler
3909 Vfile_name_handler_alist = Qnil;
3911 DEFVAR_LISP("after-insert-file-functions", &Vafter_insert_file_functions /*
3912 A list of functions to be called at the end of `insert-file-contents'.
3913 Each is passed one argument, the number of bytes inserted. It should return
3914 the new byte count, and leave point the same. If `insert-file-contents' is
3915 intercepted by a handler from `file-name-handler-alist', that handler is
3916 responsible for calling the after-insert-file-functions if appropriate.
3918 Vafter_insert_file_functions = Qnil;
3920 DEFVAR_LISP("write-region-annotate-functions", &Vwrite_region_annotate_functions /*
3921 A list of functions to be called at the start of `write-region'.
3922 Each is passed two arguments, START and END, as for `write-region'.
3923 It should return a list of pairs (POSITION . STRING) of strings to be
3924 effectively inserted at the specified positions of the file being written
3925 \(1 means to insert before the first byte written). The POSITIONs must be
3926 sorted into increasing order. If there are several functions in the list,
3927 the several lists are merged destructively.
3929 Vwrite_region_annotate_functions = Qnil;
3931 DEFVAR_LISP("write-region-annotations-so-far", &Vwrite_region_annotations_so_far /*
3932 When an annotation function is called, this holds the previous annotations.
3933 These are the annotations made by other annotation functions
3934 that were already called. See also `write-region-annotate-functions'.
3936 Vwrite_region_annotations_so_far = Qnil;
3938 DEFVAR_LISP("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
3939 A list of file name handlers that temporarily should not be used.
3940 This applies only to the operation `inhibit-file-name-operation'.
3942 Vinhibit_file_name_handlers = Qnil;
3944 DEFVAR_LISP("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
3945 The operation for which `inhibit-file-name-handlers' is applicable.
3947 Vinhibit_file_name_operation = Qnil;
3949 DEFVAR_LISP("auto-save-list-file-name", &Vauto_save_list_file_name /*
3950 File name in which we write a list of all auto save file names.
3952 Vauto_save_list_file_name = Qnil;
3954 DEFVAR_LISP("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
3955 Prefix for generating auto-save-list-file-name.
3956 Emacs's pid and the system name will be appended to
3957 this prefix to create a unique file name.
3959 Vauto_save_list_file_prefix = build_string("~/.saves-");
3961 DEFVAR_BOOL("inhibit-auto-save-session", &inhibit_auto_save_session /*
3962 When non-nil, inhibit auto save list file creation.
3964 inhibit_auto_save_session = 0;
3966 DEFVAR_BOOL("disable-auto-save-when-buffer-shrinks", &disable_auto_save_when_buffer_shrinks /*
3967 If non-nil, auto-saving is disabled when a buffer shrinks too much.
3968 This is to prevent you from losing your edits if you accidentally
3969 delete a large chunk of the buffer and don't notice it until too late.
3970 Saving the buffer normally turns auto-save back on.
3972 disable_auto_save_when_buffer_shrinks = 1;
3974 DEFVAR_LISP("directory-sep-char", &Vdirectory_sep_char /*
3975 Directory separator character for built-in functions that return file names.
3976 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
3977 This variable affects the built-in functions only on Windows,
3978 on other platforms, it is initialized so that Lisp code can find out
3979 what the normal separator is.
3981 Vdirectory_sep_char = make_char('/');
3983 reinit_vars_of_fileio();
3986 void reinit_vars_of_fileio(void)
3988 /* We want temp_name_rand to be initialized to a value likely to be
3989 unique to the process, not to the executable. The danger is that
3990 two different SXEmacs processes using the same binary on different
3991 machines creating temp files in the same directory will be
3992 unlucky enough to have the same pid. If we randomize using
3993 process startup time, then in practice they will be unlikely to
3994 collide. We use the microseconds field so that scripts that start
3995 simultaneous SXEmacs processes on multiple machines will have less
3996 chance of collision. */
4000 EMACS_GET_TIME(thyme);
4002 (unsigned int)(EMACS_SECS(thyme) ^ EMACS_USECS(thyme));