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"
39 #ifdef HAVE_LIBGEN_H /* Must come before sysfile.h */
52 #endif /* HPUX_PRE_8_0 */
55 int lisp_to_time(Lisp_Object, time_t *);
56 Lisp_Object time_to_lisp(time_t);
58 /* Nonzero during writing of auto-save files */
59 static int auto_saving;
61 /* Set by auto_save_1 to mode of original file so Fwrite_region_internal
62 will create a new file with the same mode as the original */
63 static int auto_save_mode_bits;
65 /* Alist of elements (REGEXP . HANDLER) for file names
66 whose I/O is done with a special handler. */
67 Lisp_Object Vfile_name_handler_alist;
69 /* Format for auto-save files */
70 Lisp_Object Vauto_save_file_format;
72 /* Lisp functions for translating file formats */
73 Lisp_Object Qformat_decode, Qformat_annotate_function;
75 /* Functions to be called to process text properties in inserted file. */
76 Lisp_Object Vafter_insert_file_functions;
78 /* Functions to be called to create text property annotations for file. */
79 Lisp_Object Vwrite_region_annotate_functions;
81 /* During build_annotations, each time an annotation function is called,
82 this holds the annotations made by the previous functions. */
83 Lisp_Object Vwrite_region_annotations_so_far;
85 /* File name in which we write a list of all our auto save files. */
86 Lisp_Object Vauto_save_list_file_name;
88 /* Prefix used to construct Vauto_save_list_file_name. */
89 Lisp_Object Vauto_save_list_file_prefix;
91 /* When non-nil, it prevents auto-save list file creation. */
92 int inhibit_auto_save_session;
94 int disable_auto_save_when_buffer_shrinks;
96 Lisp_Object Vdirectory_sep_char;
98 /* These variables describe handlers that have "already" had a chance
99 to handle the current operation.
101 Vinhibit_file_name_handlers is a list of file name handlers.
102 Vinhibit_file_name_operation is the operation being handled.
103 If we try to handle that operation, we ignore those handlers. */
105 static Lisp_Object Vinhibit_file_name_handlers;
106 static Lisp_Object Vinhibit_file_name_operation;
108 Lisp_Object Qfile_error, Qfile_already_exists;
110 Lisp_Object Qauto_save_hook;
111 Lisp_Object Qauto_save_error;
112 Lisp_Object Qauto_saving;
114 Lisp_Object Qcar_less_than_car;
116 Lisp_Object Qcompute_buffer_file_truename;
118 EXFUN(Frunning_temacs_p, 0);
120 /* signal a file error when errno contains a meaningful value. */
122 DOESNT_RETURN report_file_error(const char *string, Lisp_Object data)
124 /* #### dmoore - This uses current_buffer, better make sure no one
125 has GC'd the current buffer. File handlers are giving me a headache
126 maybe I'll just always protect current_buffer around all of those
129 signal_error(Qfile_error,
130 Fcons(build_translated_string(string),
131 Fcons(lisp_strerror(errno), data)));
135 maybe_report_file_error(const char *string, Lisp_Object data,
136 Lisp_Object class, Error_behavior errb)
139 if (ERRB_EQ(errb, ERROR_ME_NOT))
142 maybe_signal_error(Qfile_error,
143 Fcons(build_translated_string(string),
144 Fcons(lisp_strerror(errno), data)),
148 /* signal a file error when errno does not contain a meaningful value. */
150 DOESNT_RETURN signal_file_error(const char *string, Lisp_Object data)
152 signal_error(Qfile_error, list2(build_translated_string(string), data));
156 maybe_signal_file_error(const char *string, Lisp_Object data,
157 Lisp_Object class, Error_behavior errb)
160 if (ERRB_EQ(errb, ERROR_ME_NOT))
162 maybe_signal_error(Qfile_error,
163 list2(build_translated_string(string), data),
168 signal_double_file_error(const char *string1, const char *string2,
171 signal_error(Qfile_error,
172 list3(build_translated_string(string1),
173 build_translated_string(string2), data));
177 maybe_signal_double_file_error(const char *string1, const char *string2,
178 Lisp_Object data, Lisp_Object class,
182 if (ERRB_EQ(errb, ERROR_ME_NOT))
184 maybe_signal_error(Qfile_error,
185 list3(build_translated_string(string1),
186 build_translated_string(string2),
191 signal_double_file_error_2(const char *string1, const char *string2,
192 Lisp_Object data1, Lisp_Object data2)
194 signal_error(Qfile_error,
195 list4(build_translated_string(string1),
196 build_translated_string(string2), data1, data2));
200 maybe_signal_double_file_error_2(const char *string1, const char *string2,
201 Lisp_Object data1, Lisp_Object data2,
202 Lisp_Object class, Error_behavior errb)
205 if (ERRB_EQ(errb, ERROR_ME_NOT))
207 maybe_signal_error(Qfile_error,
208 list4(build_translated_string(string1),
209 build_translated_string(string2),
210 data1, data2), class, errb);
213 /* Just like strerror(3), except return a lisp string instead of char *.
214 The string needs to be converted since it may be localized.
215 Perhaps this should use strerror-coding-system instead? */
216 Lisp_Object lisp_strerror(int errnum)
218 return build_ext_string(strerror(errnum), Qnative);
221 static Lisp_Object close_file_unwind(Lisp_Object fd)
225 close(XINT(XCAR(fd)));
227 free_cons(XCONS(fd));
234 static Lisp_Object delete_stream_unwind(Lisp_Object stream)
236 Lstream_delete(XLSTREAM(stream));
240 /* Restore point, having saved it as a marker. */
242 static Lisp_Object restore_point_unwind(Lisp_Object point_marker)
244 BUF_SET_PT(current_buffer, marker_position(point_marker));
245 return Fset_marker(point_marker, Qnil, Qnil);
248 /* Versions of read() and write() that allow quitting out of the actual
249 I/O. We don't use immediate_quit (i.e. direct longjmp() out of the
250 signal handler) because that's way too losing.
252 (#### Actually, longjmp()ing out of the signal handler may not be
253 as losing as I thought. See sys_do_signal() in sysdep.c.) */
255 ssize_t read_allowing_quit(int fildes, void *buf, size_t size)
258 return sys_read_1(fildes, buf, size, 1);
261 ssize_t write_allowing_quit(int fildes, const void *buf, size_t size)
264 return sys_write_1(fildes, buf, size, 1);
267 Lisp_Object Qexpand_file_name;
268 Lisp_Object Qfile_truename;
269 Lisp_Object Qsubstitute_in_file_name;
270 Lisp_Object Qdirectory_file_name;
271 Lisp_Object Qfile_dirname;
272 Lisp_Object Qfile_basename;
273 Lisp_Object Qfile_name_directory;
274 Lisp_Object Qfile_name_nondirectory;
275 Lisp_Object Qunhandled_file_name_directory;
276 Lisp_Object Qfile_name_as_directory;
277 Lisp_Object Qcopy_file;
278 Lisp_Object Qmake_directory_internal;
279 Lisp_Object Qdelete_directory;
280 Lisp_Object Qdelete_file;
281 Lisp_Object Qrename_file;
282 Lisp_Object Qadd_name_to_file;
283 Lisp_Object Qmake_symbolic_link;
284 Lisp_Object Qfile_exists_p;
285 Lisp_Object Qfile_executable_p;
286 Lisp_Object Qfile_readable_p;
287 Lisp_Object Qfile_symlink_p;
288 Lisp_Object Qfile_writable_p;
289 Lisp_Object Qfile_directory_p;
290 Lisp_Object Qfile_regular_p;
291 Lisp_Object Qfile_accessible_directory_p;
292 Lisp_Object Qfile_modes;
293 Lisp_Object Qset_file_modes;
294 Lisp_Object Qfile_newer_than_file_p;
295 Lisp_Object Qinsert_file_contents;
296 Lisp_Object Qwrite_region;
297 Lisp_Object Qverify_visited_file_modtime;
298 Lisp_Object Qset_visited_file_modtime;
300 /* If FILENAME is handled specially on account of its syntax,
301 return its handler function. Otherwise, return nil. */
303 DEFUN("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /*
304 Return FILENAME's handler function for OPERATION, if it has one.
305 Otherwise, return nil.
306 A file name is handled if one of the regular expressions in
307 `file-name-handler-alist' matches it.
309 If OPERATION equals `inhibit-file-name-operation', then we ignore
310 any handlers that are members of `inhibit-file-name-handlers',
311 but we still do run any other handlers. This lets handlers
312 use the standard functions without calling themselves recursively.
314 Otherwise, OPERATION is the name of a funcall'able function.
316 (filename, operation))
318 /* This function does not GC */
319 /* This function can be called during GC */
320 /* This function must not munge the match data. */
321 Lisp_Object chain, inhibited_handlers;
323 CHECK_STRING(filename);
325 if (EQ(operation, Vinhibit_file_name_operation))
326 inhibited_handlers = Vinhibit_file_name_handlers;
328 inhibited_handlers = Qnil;
330 EXTERNAL_LIST_LOOP(chain, Vfile_name_handler_alist) {
331 Lisp_Object elt = XCAR(chain);
333 Lisp_Object string = XCAR(elt);
335 && (fast_lisp_string_match(string, filename) >= 0)) {
336 Lisp_Object handler = XCDR(elt);
337 if (NILP(Fmemq(handler, inhibited_handlers)))
347 call2_check_string(Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
349 /* This function can call lisp */
350 Lisp_Object result = call2(fn, arg0, arg1);
351 CHECK_STRING(result);
356 call2_check_string_or_nil(Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1)
358 /* This function can call lisp */
359 Lisp_Object result = call2(fn, arg0, arg1);
361 CHECK_STRING(result);
366 call3_check_string(Lisp_Object fn, Lisp_Object arg0,
367 Lisp_Object arg1, Lisp_Object arg2)
369 /* This function can call lisp */
370 Lisp_Object result = call3(fn, arg0, arg1, arg2);
371 CHECK_STRING(result);
375 DEFUN("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
376 Return the directory component in file name FILENAME.
377 Return nil if FILENAME does not include a directory.
378 Otherwise return a directory spec.
379 Given a Unix syntax file name, returns a string ending in slash.
383 /* This function can GC. GC checked 2000-07-28 ben */
388 CHECK_STRING(filename);
390 /* If the file name has special constructs in it,
391 call the corresponding file handler. */
392 handler = Ffind_file_name_handler(filename, Qfile_name_directory);
394 return call2_check_string_or_nil(handler, Qfile_name_directory,
397 #ifdef FILE_SYSTEM_CASE
398 filename = FILE_SYSTEM_CASE(filename);
400 beg = XSTRING_DATA(filename);
401 p = beg + XSTRING_LENGTH(filename);
403 while (p != beg && !IS_ANY_SEP(p[-1])
409 return make_string(beg, p - beg);
412 DEFUN("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
413 Return file name FILENAME sans its directory.
414 For example, in a Unix-syntax file name,
415 this is everything after the last slash,
416 or the entire name if it contains no slash.
420 /* This function can GC. GC checked 2000-07-28 ben */
421 Bufbyte *beg, *p, *end;
424 CHECK_STRING(filename);
426 /* If the file name has special constructs in it,
427 call the corresponding file handler. */
428 handler = Ffind_file_name_handler(filename, Qfile_name_nondirectory);
430 return call2_check_string(handler, Qfile_name_nondirectory,
433 beg = XSTRING_DATA(filename);
434 end = p = beg + XSTRING_LENGTH(filename);
436 while (p != beg && !IS_ANY_SEP(p[-1])
440 return make_string(p, end - p);
445 Bytecount file_basename_match_extension(Lisp_Object filename,
446 Lisp_Object extension)
448 Bytecount match = -1;
449 Bytecount len = XSTRING_LENGTH( extension );
453 Bufbyte *ext = XSTRING_DATA(extension);
457 if ( strncmp( (char*)ext, "\\.", 2 ) != 0 ) {
458 strncpy(rep, "\\.", 3);
462 /* Note that we advance by len-1 to be positioned at
463 the last char of extension so that we can check it
464 for '$' on the if statement and advance to the
465 terminator if need to append...
471 regexp = make_string( (Bufbyte*)re, strlen(re));
472 match = fast_lisp_string_match( regexp, filename );
477 DEFUN("file-basename", Ffile_basename, 1, 2, 0, /*
478 Return the basename of FILENAME sans its base directory.
479 If EXTENSION is non-nil the extension is also removed if it matches the regexp.
480 EXTENSION can be a list of regexps.
481 For example, in a Unix-syntax file name,
482 this is everything after the last slash,
483 or the entire name if it contains no slash.
484 It ignores trailing slash.
486 (filename, extension))
488 /* This function can GC. GC checked 2000-07-28 ben */
489 Bufbyte *beg, *p, *end;
494 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
496 CHECK_STRING(filename);
497 if ( ! NILP(extension) && ! STRINGP(extension) &&
499 dead_wrong_type_argument(Qstringp, extension);
501 GCPRO4(handler,res,rest,ext);
503 /* If the file name has special constructs in it,
504 call the corresponding file handler. */
505 handler = Ffind_file_name_handler(filename, Qfile_basename);
507 return call2_check_string(handler, Qfile_basename,
510 beg = XSTRING_DATA(filename);
511 end = p = beg + XSTRING_LENGTH(filename);
512 if ( IS_ANY_SEP(p[-1]) ) {
516 while (p != beg && !IS_ANY_SEP(p[-1]))
519 res = make_string(p, end - p);
520 if ( STRINGP( extension ) ) {
522 match = file_basename_match_extension(res,
525 RETURN_UNGCPRO(make_string(p, match));
526 } else if ( ! NILP(extension) && LISTP( extension ) ) {
531 match = file_basename_match_extension(res,
534 RETURN_UNGCPRO(make_string(p, match));
536 } while( ! NILP(rest) );
542 DEFUN("file-dirname", Ffile_dirname, 1, 1, 0, /*
543 Return the directory component in file name FILENAME.
544 Return nil if FILENAME does not include a directory.
545 Otherwise return a directory spec.
546 Given a Unix syntax file name, returns a string ending in slash.
547 It ignores the trailing slash in FILENAME.
551 /* This function can GC. GC checked 2000-07-28 ben */
552 Bufbyte *beg, *p, *end;
555 CHECK_STRING(filename);
557 /* If the file name has special constructs in it,
558 call the corresponding file handler. */
559 handler = Ffind_file_name_handler(filename, Qfile_dirname);
561 return call2_check_string_or_nil(handler, Qfile_dirname,
564 beg = XSTRING_DATA(filename);
565 end = p = beg + XSTRING_LENGTH(filename);
566 if ( IS_ANY_SEP(p[-1]) ) {
570 while (p != beg && !IS_ANY_SEP(p[-1])
576 return make_string(beg, p-beg);
580 DEFUN("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /*
581 Return a directly usable directory name somehow associated with FILENAME.
582 A `directly usable' directory name is one that may be used without the
583 intervention of any file handler.
584 If FILENAME is a directly usable file itself, return
585 \(file-name-directory FILENAME).
586 The `call-process' and `start-process' functions use this function to
587 get a current directory to run processes in.
591 /* This function can GC. GC checked 2000-07-28 ben */
594 /* If the file name has special constructs in it,
595 call the corresponding file handler. */
597 Ffind_file_name_handler(filename, Qunhandled_file_name_directory);
599 return call2(handler, Qunhandled_file_name_directory, filename);
601 return Ffile_name_directory(filename);
604 static char *file_name_as_directory(char *out, const char *in, size_t len)
606 /* This function cannot GC */
607 int size = strlen(in);
612 out[1] = DIRECTORY_SEP;
615 xstrncpy(out, in, len);
616 /* Append a slash if necessary */
617 if (!IS_ANY_SEP(out[size - 1])) {
618 out[size] = DIRECTORY_SEP;
619 out[size + 1] = '\0';
625 DEFUN("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
626 Return a string representing file FILENAME interpreted as a directory.
627 This operation exists because a directory is also a file, but its name as
628 a directory is different from its name as a file.
629 The result can be used as the value of `default-directory'
630 or passed as second argument to `expand-file-name'.
631 For a Unix-syntax file name, just appends a slash,
632 except for (file-name-as-directory \"\") => \"./\".
636 /* This function can GC. GC checked 2000-07-28 ben */
639 Lisp_Object handler = Qnil;
641 CHECK_STRING(filename);
643 /* If the file name has special constructs in it,
644 call the corresponding file handler. */
645 handler = Ffind_file_name_handler(filename, Qfile_name_as_directory);
647 return call2_check_string(handler, Qfile_name_as_directory,
650 len = XSTRING_LENGTH(filename) + 10;
651 buf = (char *)alloca(len);
652 return build_string(file_name_as_directory
653 (buf, (char*)XSTRING_DATA(filename), len));
657 * Convert from directory name to filename.
658 * On UNIX, it's simple: just make sure there isn't a terminating /
660 * Value is nonzero if the string output is different from the input.
663 static int directory_file_name(const char *src, char *dst, size_t len)
665 /* This function cannot GC */
666 long slen = strlen(src);
667 /* Process as Unix format: just remove any final slash.
668 But leave "/" unchanged; do not change it to "". */
669 xstrncpy(dst, src, len);
670 if (slen > 1 && IS_DIRECTORY_SEP(dst[slen - 1])
676 DEFUN("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
677 Return the file name of the directory named DIRECTORY.
678 This is the name of the file that holds the data for the directory.
679 This operation exists because a directory is also a file, but its name as
680 a directory is different from its name as a file.
681 In Unix-syntax, this function just removes the final slash.
685 /* This function can GC. GC checked 2000-07-28 ben */
690 CHECK_STRING(directory);
692 #if 0 /* #### WTF? */
697 /* If the file name has special constructs in it,
698 call the corresponding file handler. */
699 handler = Ffind_file_name_handler(directory, Qdirectory_file_name);
701 return call2_check_string(handler, Qdirectory_file_name,
703 len = XSTRING_LENGTH(directory) + 20;
704 buf = (char *)alloca(len);
705 directory_file_name((char *)XSTRING_DATA(directory), buf, len);
706 return build_string(buf);
709 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
710 proved too broken for our purposes (it supported only 26 or 62
711 unique names under some implementations). For example, this
712 arbitrary limit broke generation of Gnus Incoming* files.
714 This implementation is better than what one usually finds in libc.
717 static unsigned int temp_name_rand;
719 DEFUN("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
720 Generate a temporary file name starting with PREFIX.
721 The Emacs process number forms part of the result, so there is no
722 danger of generating a name being used by another process.
724 In addition, this function makes an attempt to choose a name that
725 does not specify an existing file. To make this work, PREFIX should
726 be an absolute file name.
730 static const char tbl[64] = {
731 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
732 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
733 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
734 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f',
735 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
736 'o', 'p', 'q', 'r', 's', 't', 'u', 'v',
737 'w', 'x', 'y', 'z', '0', '1', '2', '3',
738 '4', '5', '6', '7', '8', '9', '-', '_'
745 CHECK_STRING(prefix);
747 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
750 1) It might change the prefix, so the resulting string might not
751 begin with PREFIX. This violates the principle of least
754 2) It breaks under many unforeseeable circumstances, such as with
755 the code that uses (make-temp-name "") instead of
756 (make-temp-name "./").
758 3) It might yield unexpected (to stat(2)) results in the presence
759 of EFS and file name handlers. */
761 len = XSTRING_LENGTH(prefix);
762 val = make_uninit_string(len + 6);
763 data = XSTRING_DATA(val);
764 memcpy(data, XSTRING_DATA(prefix), len);
767 /* VAL is created by adding 6 characters to PREFIX. The first three
768 are the PID of this process, in base 64, and the second three are
769 a pseudo-random number seeded from process startup time. This
770 ensures 262144 unique file names per PID per PREFIX per machine. */
773 unsigned int pid = (unsigned int)getpid();
774 *p++ = tbl[(pid >> 0) & 63];
775 *p++ = tbl[(pid >> 6) & 63];
776 *p++ = tbl[(pid >> 12) & 63];
779 /* Here we try to minimize useless stat'ing when this function is
780 invoked many times successively with the same PREFIX. We achieve
781 this by using a very pseudo-random number generator to generate
782 file names unique to this process, with a very long cycle. */
787 p[0] = tbl[(temp_name_rand >> 0) & 63];
788 p[1] = tbl[(temp_name_rand >> 6) & 63];
789 p[2] = tbl[(temp_name_rand >> 12) & 63];
791 /* Poor man's congruential RN generator. Replace with ++count
793 temp_name_rand += 25229;
794 temp_name_rand %= 225307;
798 if (sxemacs_stat((const char *)data, &ignored) < 0) {
799 /* We want to return only if errno is ENOENT. */
803 /* The error here is dubious, but there is little else we
804 can do. The alternatives are to return nil, which is
805 as bad as (and in many cases worse than) throwing the
806 error, or to ignore the error, which will likely result
809 ("Cannot create temporary name for prefix",
811 return Qnil; /* not reached */
816 DEFUN("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
817 Convert filename NAME to absolute, and canonicalize it.
818 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
819 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
820 the current buffer's value of `default-directory' is used.
821 File name components that are `.' are removed, and
822 so are file name components followed by `..', along with the `..' itself;
823 note that these simplifications are done without checking the resulting
824 file names in the file system.
825 An initial `~/' expands to your home directory.
826 An initial `~USER/' expands to USER's home directory.
827 See also the function `substitute-in-file-name'.
829 (name, default_directory))
831 /* This function can GC. GC-checked 2000-11-18 */
834 Bufbyte *newdir, *p, *o;
839 Lisp_Object handler = Qnil;
840 struct gcpro gcpro1, gcpro2, gcpro3;
842 /* both of these get set below */
843 GCPRO3(name, default_directory, handler);
847 /* If the file name has special constructs in it,
848 call the corresponding file handler. */
849 handler = Ffind_file_name_handler(name, Qexpand_file_name);
851 RETURN_UNGCPRO(call3_check_string(handler, Qexpand_file_name,
852 name, default_directory));
854 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
855 if (NILP(default_directory))
856 default_directory = current_buffer->directory;
857 if (!STRINGP(default_directory))
858 default_directory = build_string("/");
860 if (!NILP(default_directory)) {
862 Ffind_file_name_handler(default_directory,
865 RETURN_UNGCPRO(call3(handler, Qexpand_file_name,
866 name, default_directory));
869 o = XSTRING_DATA(default_directory);
871 /* Make sure DEFAULT_DIRECTORY is properly expanded.
872 It would be better to do this down below where we actually use
873 default_directory. Unfortunately, calling Fexpand_file_name recursively
874 could invoke GC, and the strings might be relocated. This would
875 be annoying because we have pointers into strings lying around
876 that would need adjusting, and people would add new pointers to
877 the code and forget to adjust them, resulting in intermittent bugs.
878 Putting this call here avoids all that crud.
880 The EQ test avoids infinite recursion. */
881 if (!NILP(default_directory) && !EQ(default_directory, name)
882 /* Save time in some common cases - as long as default_directory
883 is not relative, it can be canonicalized with name below (if it
884 is needed at all) without requiring it to be expanded now. */
885 /* Detect Unix absolute file names (/... alone is not absolute on
887 && !(IS_DIRECTORY_SEP(o[0]))
890 default_directory = Fexpand_file_name(default_directory, Qnil);
892 #ifdef FILE_SYSTEM_CASE
893 name = FILE_SYSTEM_CASE(name);
896 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
897 into name should be safe during all of this, though. */
898 nm = XSTRING_DATA(name);
900 /* If nm is absolute, look for /./ or /../ sequences; if none are
901 found, we can probably return right away. We will avoid allocating
902 a new string if name is already fully expanded. */
903 if (IS_DIRECTORY_SEP(nm[0])) {
904 /* If it turns out that the filename we want to return is just a
905 suffix of FILENAME, we don't need to go through and edit
906 things; we just need to construct a new string using data
907 starting at the middle of FILENAME. If we set lose to a
908 non-zero value, that means we've discovered that we can't do
914 /* Since we know the name is absolute, we can assume
915 that each element starts with a "/". */
917 /* "." and ".." are hairy. */
918 if (IS_DIRECTORY_SEP(p[0])
919 && p[1] == '.' && (IS_DIRECTORY_SEP(p[2])
922 && (IS_DIRECTORY_SEP(p[3])
929 if (nm == XSTRING_DATA(name)) {
930 RETURN_UNGCPRO(name);
932 RETURN_UNGCPRO(build_string((char*)nm));
936 /* At this point, nm might or might not be an absolute file name. We
937 need to expand ~ or ~user if present, otherwise prefix nm with
938 default_directory if nm is not absolute, and finally collapse /./
939 and /foo/../ sequences.
941 We set newdir to be the appropriate prefix if one is needed:
942 - the relevant user directory if nm starts with ~ or ~user
943 - the specified drive's working dir (DOS/NT only) if nm does not
945 - the value of default_directory.
947 Note that these prefixes are not guaranteed to be absolute (except
948 for the working dir of a drive). Therefore, to ensure we always
949 return an absolute name, if the final prefix is not absolute we
950 append it to the current working directory. */
954 if (nm[0] == '~') { /* prefix ~ */
955 if (IS_DIRECTORY_SEP(nm[1]) || nm[1] == 0) {
957 Extbyte *newdir_external = get_home_directory();
959 if (newdir_external == NULL) {
960 newdir = (Bufbyte *) "";
962 /* aint that a bit weird just to get the
963 * signedness correct? */
964 Extbyte *newdir_cpy = (Extbyte*)newdir;
966 C_STRING, newdir_external,
970 newdir = (Bufbyte*)newdir_cpy;
973 } else { /* ~user/filename */
975 for (p = nm; *p && (!IS_DIRECTORY_SEP(*p)); p++)
977 o = (Bufbyte *) alloca(p - nm + 1);
978 memcpy(o, (char *)nm, p - nm);
981 /* #### While NT is single-user (for the moment) you still
982 can have multiple user profiles users defined, each with
983 its HOME. So maybe possibly we should think about handling
985 /* Jamie reports that getpwnam() can get wedged
986 by SIGIO/SIGALARM occurring in it. (It can call
988 slow_down_interrupts();
989 pw = (struct passwd *)getpwnam((char *)o + 1);
990 speed_up_interrupts();
992 newdir = (Bufbyte *) pw->pw_dir;
996 /* If we don't find a user of that name, leave the name
997 unchanged; don't move nm forward to p. */
1001 /* Finally, if no prefix has been specified and nm is not absolute,
1002 then it must be expanded relative to default_directory. */
1005 /* /... alone is not absolute on DOS and Windows. */
1006 && !IS_DIRECTORY_SEP(nm[0])
1008 newdir = XSTRING_DATA(default_directory);
1012 /* Get rid of any slash at the end of newdir, unless newdir is
1013 just // (an incomplete UNC name). */
1014 length = strlen((char *)newdir);
1015 if (length > 1 && IS_DIRECTORY_SEP(newdir[length - 1])) {
1016 Bufbyte *temp = (Bufbyte *) alloca(length);
1017 memcpy(temp, newdir, length - 1);
1018 temp[length - 1] = 0;
1025 /* Now concatenate the directory and name to new space in the stack frame */
1026 tlen += strlen((char *)nm) + 1;
1027 target = (Bufbyte *) alloca(tlen);
1031 if (nm[0] == 0 || IS_DIRECTORY_SEP(nm[0]))
1032 xstrncpy((char *)target, (char *)newdir, tlen);
1034 file_name_as_directory((char *)target, (char *)newdir, tlen);
1037 xstrncat((char *)target, (char *)nm, tlen-1);
1039 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1041 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1047 if (!IS_DIRECTORY_SEP(*p)) {
1049 } else if (IS_DIRECTORY_SEP(p[0])
1050 && p[1] == '.' && (IS_DIRECTORY_SEP(p[2])
1052 /* If "/." is the entire filename, keep the "/". Otherwise,
1053 just delete the whole "/.". */
1054 if (o == target && p[2] == '\0')
1057 } else if (IS_DIRECTORY_SEP(p[0]) && p[1] == '.' && p[2] == '.'
1058 /* `/../' is the "superroot" on certain file systems. */
1060 && (IS_DIRECTORY_SEP(p[3]) || p[3] == 0)) {
1061 while (o != target && (--o) && !IS_DIRECTORY_SEP(*o)) ;
1062 /* Keep initial / only if this is the whole name. */
1063 if (o == target && IS_ANY_SEP(*o) && p[3] == 0)
1072 RETURN_UNGCPRO(make_string(target, o - target));
1075 DEFUN("file-truename", Ffile_truename, 1, 2, 0, /*
1076 Return the canonical name of FILENAME.
1077 Second arg DEFAULT is directory to start with if FILENAME is relative
1078 (does not start with slash); if DEFAULT is nil or missing,
1079 the current buffer's value of `default-directory' is used.
1080 No component of the resulting pathname will be a symbolic link, as
1081 in the realpath() function.
1083 (filename, default_))
1085 /* This function can GC. GC checked 2000-07-28 ben. */
1086 Lisp_Object expanded_name;
1087 struct gcpro gcpro1;
1089 CHECK_STRING(filename);
1091 expanded_name = Fexpand_file_name(filename, default_);
1093 if (!STRINGP(expanded_name))
1096 GCPRO1(expanded_name);
1099 Lisp_Object handler =
1100 Ffind_file_name_handler(expanded_name, Qfile_truename);
1105 (handler, Qfile_truename, expanded_name));
1109 char resolved_path[MAXPATHLEN];
1110 Extbyte *path = NULL;
1114 TO_EXTERNAL_FORMAT(LISP_STRING, expanded_name,
1115 ALLOCA, (path, elen), Qfile_name);
1118 if (elen > MAXPATHLEN)
1121 /* Try doing it all at once. */
1122 /* !! Does realpath() Mule-encapsulate? Answer: Nope!
1123 So we do it above */
1124 if (path != NULL && !xrealpath((char *)path, resolved_path)) {
1125 /* Didn't resolve it -- have to do it one
1126 component at a time.
1128 "realpath" is a typically useless, stupid
1129 un*x piece of crap. It claims to return a
1130 useful value in the "error" case, but since
1131 there is no indication provided of how far
1132 along the pathname the function went before
1133 erring, there is no way to use the partial
1134 result returned. What a piece of junk.
1136 The above comment refers to historical
1137 versions of realpath(). The Unix98 specs
1140 "On successful completion, realpath()
1141 returns a pointer to the resolved
1142 name. Otherwise, realpath() returns a null
1143 pointer and sets errno to indicate the
1144 error, and the contents of the buffer
1145 pointed to by resolved_name are undefined."
1147 Since we depend on undocumented semantics
1148 of various system realpath()s, we just use
1149 our own version in realpath.c.
1152 Extbyte *pos = NULL;
1154 for (pos = p + 1; pos < path + elen; pos++) {
1155 if (IS_DIRECTORY_SEP(*pos)) {
1163 if (xrealpath((char *)path, resolved_path)) {
1169 } else if (errno == ENOENT || errno == EACCES) {
1170 /* Failed on this component.
1171 Just tack on the rest of
1172 the string and we are
1174 int rlen = strlen(resolved_path);
1176 /* "On failure, it returns
1178 indicate the error, and
1179 places in resolved_path the
1180 absolute pathname of the
1181 path component which could
1187 int plen = elen - (p - path);
1191 (resolved_path[rlen - 1]))
1194 if ((plen + rlen + 1) >
1195 countof(resolved_path))
1198 resolved_path[rlen] = DIRECTORY_SEP;
1199 memcpy(resolved_path + rlen + 1,
1200 p + 1, plen + 1 - 1);
1208 Lisp_Object resolved_name;
1209 int rlen = strlen(resolved_path);
1212 && IS_DIRECTORY_SEP(
1213 XSTRING_BYTE(expanded_name, elen-1))
1215 IS_DIRECTORY_SEP(resolved_path[rlen-1]))) {
1216 if (rlen + 1 > countof(resolved_path))
1218 resolved_path[rlen++] = DIRECTORY_SEP;
1219 resolved_path[rlen] = '\0';
1221 TO_INTERNAL_FORMAT(DATA, (resolved_path, rlen),
1222 LISP_STRING, resolved_name,
1224 RETURN_UNGCPRO(resolved_name);
1228 errno = ENAMETOOLONG;
1231 report_file_error("Finding truename", list1(expanded_name));
1233 RETURN_UNGCPRO(Qnil);
1236 DEFUN("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1237 Substitute environment variables referred to in FILENAME.
1238 `$FOO' where FOO is an environment variable name means to substitute
1239 the value of that variable. The variable name should be terminated
1240 with a character, not a letter, digit or underscore; otherwise, enclose
1241 the entire variable name in braces.
1242 If `/~' appears, all of FILENAME through that `/' is discarded.
1246 /* This function can GC. GC checked 2000-07-28 ben. */
1249 Bufbyte *s, *p, *o, *x, *endp;
1250 Bufbyte *target = 0;
1252 int substituted = 0;
1255 Lisp_Object handler;
1257 CHECK_STRING(filename);
1259 /* If the file name has special constructs in it,
1260 call the corresponding file handler. */
1261 handler = Ffind_file_name_handler(filename, Qsubstitute_in_file_name);
1263 return call2_check_string_or_nil(handler,
1264 Qsubstitute_in_file_name,
1267 nm = XSTRING_DATA(filename);
1268 endp = nm + XSTRING_LENGTH(filename);
1270 /* If /~ or // appears, discard everything through first slash. */
1272 for (p = nm; p != endp; p++) {
1274 || IS_DIRECTORY_SEP(p[0])
1276 && p != nm && (IS_DIRECTORY_SEP(p[-1]))) {
1282 /* See if any variables are substituted into the string
1283 and find the total length of their values in `total' */
1285 for (p = nm; p != endp;)
1292 else if (*p == '$') {
1293 /* "$$" means a single "$" */
1298 } else if (*p == '{') {
1300 while (p != endp && *p != '}')
1307 while (p != endp && (isalnum(*p) || *p == '_'))
1312 /* Copy out the variable name */
1313 target = (Bufbyte *) alloca(s - o + 1);
1314 strncpy((char *)target, (char *)o, s - o);
1315 target[s - o] = '\0';
1317 /* Get variable value */
1318 o = (Bufbyte *) egetenv((char *)target);
1321 total += strlen((char *)o);
1328 /* If substitution required, recopy the filename and do it */
1329 /* Make space in stack frame for the new copy */
1330 avail = XSTRING_LENGTH(filename) + total + 1;
1331 xnm = (Bufbyte *) alloca(avail);
1334 /* Copy the rest of the name through, replacing $ constructs with values */
1343 else if (*p == '$') {
1347 } else if (*p == '{') {
1349 while (p != endp && *p != '}')
1356 while (p != endp && (isalnum(*p) || *p == '_'))
1361 /* Copy out the variable name */
1362 target = (Bufbyte *) alloca(s - o + 1);
1363 strncpy((char *)target, (char *)o, s - o);
1364 target[s - o] = '\0';
1366 /* Get variable value */
1367 o = (Bufbyte *) egetenv((char *)target);
1371 xstrncpy((char *)x, (char *)o, avail);
1372 x += strlen((char *)o);
1373 avail -= strlen((char *)o);
1378 /* If /~ or // appears, discard everything through first slash. */
1380 for (p = xnm; p != x; p++)
1382 || IS_DIRECTORY_SEP(p[0])
1384 /* don't do p[-1] if that would go off the beginning --jwz */
1385 && p != nm && p > xnm && IS_DIRECTORY_SEP(p[-1]))
1388 return make_string(xnm, x - xnm);
1391 syntax_error("Bad format environment-variable substitution", filename);
1393 syntax_error("Missing \"}\" in environment-variable substitution",
1396 syntax_error_2("Substituting nonexistent environment variable",
1397 filename, build_string((char *)target));
1400 return Qnil; /* suppress compiler warning */
1403 /* A slightly faster and more convenient way to get
1404 (directory-file-name (expand-file-name FOO)). */
1406 Lisp_Object expand_and_dir_to_file(Lisp_Object filename, Lisp_Object defdir)
1408 /* This function can call Lisp. GC checked 2000-07-28 ben */
1409 Lisp_Object abspath;
1410 struct gcpro gcpro1;
1412 abspath = Fexpand_file_name(filename, defdir);
1414 /* Remove final slash, if any (unless path is root).
1415 stat behaves differently depending! */
1416 if (XSTRING_LENGTH(abspath) > 1
1418 IS_DIRECTORY_SEP(XSTRING_BYTE(abspath, XSTRING_LENGTH(abspath) - 1))
1420 !IS_DEVICE_SEP(XSTRING_BYTE(abspath, XSTRING_LENGTH(abspath) - 2)))
1421 /* We cannot take shortcuts; they might be wrong for magic file names. */
1422 abspath = Fdirectory_file_name(abspath);
1427 /* Signal an error if the file ABSNAME already exists.
1428 If INTERACTIVE is nonzero, ask the user whether to proceed,
1429 and bypass the error if the user says to go ahead.
1430 QUERYSTRING is a name for the action that is being considered
1432 *STATPTR is used to store the stat information if the file exists.
1433 If the file does not exist, STATPTR->st_mode is set to 0. */
1436 barf_or_query_if_file_exists(Lisp_Object absname, const char *querystring,
1437 int interactive, struct stat *statptr)
1439 /* This function can call Lisp. GC checked 2000-07-28 ben */
1440 struct stat statbuf;
1442 /* stat is a good way to tell whether the file exists,
1443 regardless of what access permissions it has. */
1444 if (sxemacs_stat((char *)XSTRING_DATA(absname), &statbuf) >= 0) {
1449 struct gcpro gcpro1;
1451 prompt = emacs_doprnt_string_c
1453 GETTEXT("File %s already exists; %s anyway? "),
1454 Qnil, -1, XSTRING_DATA(absname),
1455 GETTEXT(querystring));
1458 tem = call1(Qyes_or_no_p, prompt);
1464 Fsignal(Qfile_already_exists,
1465 list2(build_translated_string
1466 ("File already exists"), absname));
1471 statptr->st_mode = 0;
1476 DEFUN("copy-file", Fcopy_file, 2, 4, "fCopy file: \nFCopy %s to file: \np\nP", /*
1477 Copy FILENAME to NEWNAME. Both args must be strings.
1478 Signals a `file-already-exists' error if file NEWNAME already exists,
1479 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1480 A number as third arg means request confirmation if NEWNAME already exists.
1481 This is what happens in interactive use with M-x.
1482 Fourth arg KEEP-TIME non-nil means give the new file the same
1483 last-modified time as the old one. (This works on only some systems.)
1484 A prefix arg makes KEEP-TIME non-nil.
1486 (filename, newname, ok_if_already_exists, keep_time))
1488 /* This function can call Lisp. GC checked 2000-07-28 ben */
1490 char buf[16 * 1024];
1491 struct stat st, out_st;
1492 Lisp_Object handler;
1493 int speccount = specpdl_depth();
1494 struct gcpro gcpro1, gcpro2;
1495 /* Lisp_Object args[6]; */
1496 int input_file_statable_p;
1498 GCPRO2(filename, newname);
1499 CHECK_STRING(filename);
1500 CHECK_STRING(newname);
1501 filename = Fexpand_file_name(filename, Qnil);
1502 newname = Fexpand_file_name(newname, Qnil);
1504 /* If the input file name has special constructs in it,
1505 call the corresponding file handler. */
1506 handler = Ffind_file_name_handler(filename, Qcopy_file);
1507 /* Likewise for output file name. */
1509 handler = Ffind_file_name_handler(newname, Qcopy_file);
1510 if (!NILP(handler)) {
1512 return call5(handler, Qcopy_file, filename, newname,
1513 ok_if_already_exists, keep_time);
1516 /* When second argument is a directory, copy the file into it.
1517 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1519 if (!NILP(Ffile_directory_p(newname))) {
1520 Lisp_Object args[3] = {newname, Qnil, Qnil};
1521 struct gcpro ngcpro1;
1524 NGCPROn(args, countof(args));
1525 if (!IS_DIRECTORY_SEP(
1526 XSTRING_BYTE(newname,
1527 XSTRING_LENGTH(newname) - 1))) {
1528 args[i++] = Fchar_to_string(Vdirectory_sep_char);
1530 args[i++] = Ffile_name_nondirectory(filename);
1531 newname = Fconcat(i, args);
1535 if (NILP(ok_if_already_exists)
1536 || INTP(ok_if_already_exists))
1537 barf_or_query_if_file_exists(newname, "copy to it",
1538 INTP(ok_if_already_exists),
1540 else if (sxemacs_stat((const char *)XSTRING_DATA(newname), &out_st) < 0)
1543 ifd = interruptible_open((char *)XSTRING_DATA(filename),
1544 O_RDONLY | OPEN_BINARY, 0);
1546 report_file_error("Opening input file", list1(filename));
1549 record_unwind_protect(close_file_unwind, make_int(ifd));
1551 /* We can only copy regular files and symbolic links. Other files are not
1553 input_file_statable_p = (fstat(ifd, &st) >= 0);
1555 if (out_st.st_mode != 0
1556 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) {
1558 report_file_error("Input and output files are the same",
1559 list2(filename, newname));
1562 #if defined (S_ISREG) && defined (S_ISLNK)
1563 if (input_file_statable_p) {
1564 if (!(S_ISREG(st.st_mode))
1565 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1567 && !(S_ISCHR(st.st_mode))
1569 && !(S_ISLNK(st.st_mode))) {
1570 #if defined (EISDIR)
1571 /* Get a better looking error message. */
1574 report_file_error("Non-regular file", list1(filename));
1577 #endif /* S_ISREG && S_ISLNK */
1579 ofd = open((char *)XSTRING_DATA(newname),
1580 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1582 report_file_error("Opening output file", list1(newname));
1585 Lisp_Object ofd_locative = noseeum_cons(make_int(ofd), Qnil);
1587 record_unwind_protect(close_file_unwind, ofd_locative);
1589 while ((n = read_allowing_quit(ifd, buf, sizeof(buf))) > 0) {
1590 if (write_allowing_quit(ofd, buf, n) != n)
1591 report_file_error("I/O error", list1(newname));
1595 report_file_error("I/O error", list1(filename));
1596 /* Closing the output clobbers the file times on some systems. */
1598 report_file_error("I/O error", list1(newname));
1600 if (input_file_statable_p) {
1601 if (!NILP(keep_time)) {
1602 EMACS_TIME atime, mtime;
1603 EMACS_SET_SECS_USECS(atime, st.st_atime, 0);
1604 EMACS_SET_SECS_USECS(mtime, st.st_mtime, 0);
1605 if (set_file_times(newname, atime, mtime))
1606 report_file_error("I/O error",
1609 chmod((const char *)XSTRING_DATA(newname),
1610 st.st_mode & 07777);
1613 /* We'll close it by hand */
1614 XCAR(ofd_locative) = Qnil;
1617 unbind_to(speccount, Qnil);
1624 DEFUN("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1625 Create a directory. One argument, a file name string.
1629 /* This function can GC. GC checked 1997.04.06. */
1630 char dir[MAXPATHLEN];
1631 Lisp_Object handler;
1632 struct gcpro gcpro1;
1634 CHECK_STRING(dirname_);
1635 dirname_ = Fexpand_file_name(dirname_, Qnil);
1638 handler = Ffind_file_name_handler(dirname_, Qmake_directory_internal);
1641 return (call2(handler, Qmake_directory_internal, dirname_));
1643 if (XSTRING_LENGTH(dirname_) > (Bytecount) (sizeof(dir) - 1)) {
1644 return Fsignal(Qfile_error,
1645 list3(build_translated_string
1646 ("Creating directory"),
1647 build_translated_string
1648 ("pathname too long"), dirname_));
1650 strncpy(dir, (char *)XSTRING_DATA(dirname_),
1651 XSTRING_LENGTH(dirname_) + 1);
1652 dir[XSTRING_LENGTH(dirname_)]='\0';
1653 if (dir[XSTRING_LENGTH(dirname_) - 1] == '/')
1654 dir[XSTRING_LENGTH(dirname_) - 1] = '\0';
1656 if (mkdir(dir, 0777) != 0)
1657 report_file_error("Creating directory", list1(dirname_));
1662 DEFUN("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1663 Delete a directory. One argument, a file name or directory name string.
1667 /* This function can GC. GC checked 1997.04.06. */
1668 Lisp_Object handler;
1669 struct gcpro gcpro1;
1671 CHECK_STRING(dirname_);
1674 dirname_ = Fexpand_file_name(dirname_, Qnil);
1675 dirname_ = Fdirectory_file_name(dirname_);
1677 handler = Ffind_file_name_handler(dirname_, Qdelete_directory);
1680 return (call2(handler, Qdelete_directory, dirname_));
1682 if (rmdir((char *)XSTRING_DATA(dirname_)) != 0)
1683 report_file_error("Removing directory", list1(dirname_));
1688 DEFUN("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1689 Delete the file named FILENAME (a string).
1690 If FILENAME has multiple names, it continues to exist with the other names.
1694 /* This function can GC. GC checked 1997.04.06. */
1695 Lisp_Object handler;
1696 struct gcpro gcpro1;
1698 CHECK_STRING(filename);
1699 filename = Fexpand_file_name(filename, Qnil);
1702 handler = Ffind_file_name_handler(filename, Qdelete_file);
1705 return call2(handler, Qdelete_file, filename);
1707 if (0 > unlink((char *)XSTRING_DATA(filename)))
1708 report_file_error("Removing old name", list1(filename));
1713 internal_delete_file_1(Lisp_Object ignore, Lisp_Object ignore2)
1718 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1720 int internal_delete_file(Lisp_Object filename)
1722 /* This function can GC. GC checked 1997.04.06. */
1723 return NILP(condition_case_1(Qt, Fdelete_file, filename,
1724 internal_delete_file_1, Qnil));
1727 DEFUN("rename-file", Frename_file, 2, 3, "fRename file: \nFRename %s to file: \np", /*
1728 Rename FILENAME as NEWNAME. Both args must be strings.
1729 If file has names other than FILENAME, it continues to have those names.
1730 Signals a `file-already-exists' error if a file NEWNAME already exists
1731 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1732 A number as third arg means request confirmation if NEWNAME already exists.
1733 This is what happens in interactive use with M-x.
1735 (filename, newname, ok_if_already_exists))
1737 /* This function can GC. GC checked 1997.04.06. */
1738 Lisp_Object handler;
1739 struct gcpro gcpro1, gcpro2;
1741 GCPRO2(filename, newname);
1742 CHECK_STRING(filename);
1743 CHECK_STRING(newname);
1744 filename = Fexpand_file_name(filename, Qnil);
1745 newname = Fexpand_file_name(newname, Qnil);
1747 /* If the file name has special constructs in it,
1748 call the corresponding file handler. */
1749 handler = Ffind_file_name_handler(filename, Qrename_file);
1751 handler = Ffind_file_name_handler(newname, Qrename_file);
1752 if (!NILP(handler)) {
1754 return call4(handler, Qrename_file,
1755 filename, newname, ok_if_already_exists);
1758 /* When second argument is a directory, rename the file into it.
1759 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1761 if (!NILP(Ffile_directory_p(newname))) {
1762 Lisp_Object args[3] = {newname, Qnil, Qnil};
1763 struct gcpro ngcpro1;
1766 NGCPROn(args, countof(args));
1767 if (XSTRING_BYTE(newname, XSTRING_LENGTH(newname) - 1) != '/') {
1768 args[i++] = build_string("/");
1770 args[i++] = Ffile_name_nondirectory(filename);
1771 newname = Fconcat(i, args);
1775 if (NILP(ok_if_already_exists)
1776 || INTP(ok_if_already_exists))
1777 barf_or_query_if_file_exists(newname, "rename to it",
1778 INTP(ok_if_already_exists), 0);
1780 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1781 WIN32_NATIVE here; I've removed it. --marcpa */
1783 /* We have configure check for rename() and emulate using
1784 link()/unlink() if necessary. */
1785 if (0 > rename((char *)XSTRING_DATA(filename),
1786 (char *)XSTRING_DATA(newname))) {
1787 if (errno == EXDEV) {
1788 Fcopy_file(filename, newname,
1789 /* We have already prompted if it was an integer,
1790 so don't have copy-file prompt again. */
1791 (NILP(ok_if_already_exists) ? Qnil : Qt),
1793 Fdelete_file(filename);
1795 report_file_error("Renaming", list2(filename, newname));
1802 DEFUN("add-name-to-file", Fadd_name_to_file, 2, 3, "fAdd name to file: \nFName to add to %s: \np", /*
1803 Give FILENAME additional name NEWNAME. Both args must be strings.
1804 Signals a `file-already-exists' error if a file NEWNAME already exists
1805 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1806 A number as third arg means request confirmation if NEWNAME already exists.
1807 This is what happens in interactive use with M-x.
1809 (filename, newname, ok_if_already_exists))
1811 /* This function can GC. GC checked 1997.04.06. */
1812 Lisp_Object handler;
1813 struct gcpro gcpro1, gcpro2;
1815 GCPRO2(filename, newname);
1816 CHECK_STRING(filename);
1817 CHECK_STRING(newname);
1818 filename = Fexpand_file_name(filename, Qnil);
1819 newname = Fexpand_file_name(newname, Qnil);
1821 /* If the file name has special constructs in it,
1822 call the corresponding file handler. */
1823 handler = Ffind_file_name_handler(filename, Qadd_name_to_file);
1825 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1826 newname, ok_if_already_exists));
1828 /* If the new name has special constructs in it,
1829 call the corresponding file handler. */
1830 handler = Ffind_file_name_handler(newname, Qadd_name_to_file);
1832 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1833 newname, ok_if_already_exists));
1835 if (NILP(ok_if_already_exists)
1836 || INTP(ok_if_already_exists))
1837 barf_or_query_if_file_exists(newname, "make it a new name",
1838 INTP(ok_if_already_exists), 0);
1839 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
1840 on NT here. --marcpa */
1841 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
1842 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
1843 Reverted to previous behavior pending a working fix. (jhar) */
1845 unlink((char *)XSTRING_DATA(newname));
1846 if (0 > link((char *)XSTRING_DATA(filename),
1847 (char *)XSTRING_DATA(newname))) {
1848 report_file_error("Adding new name", list2(filename, newname));
1855 DEFUN("make-symbolic-link", Fmake_symbolic_link, 2, 3, "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
1856 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
1857 Signals a `file-already-exists' error if a file LINKNAME already exists
1858 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1859 A number as third arg means request confirmation if LINKNAME already exists.
1860 This happens for interactive use with M-x.
1862 (filename, linkname, ok_if_already_exists))
1864 /* This function can GC. GC checked 1997.06.04. */
1865 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
1866 Lisp_Object handler;
1867 struct gcpro gcpro1, gcpro2;
1869 GCPRO2(filename, linkname);
1870 CHECK_STRING(filename);
1871 CHECK_STRING(linkname);
1872 /* If the link target has a ~, we must expand it to get
1873 a truly valid file name. Otherwise, do not expand;
1874 we want to permit links to relative file names. */
1875 if (XSTRING_BYTE(filename, 0) == '~')
1876 filename = Fexpand_file_name(filename, Qnil);
1877 linkname = Fexpand_file_name(linkname, Qnil);
1879 /* If the file name has special constructs in it,
1880 call the corresponding file handler. */
1881 handler = Ffind_file_name_handler(filename, Qmake_symbolic_link);
1883 RETURN_UNGCPRO(call4
1884 (handler, Qmake_symbolic_link, filename,
1885 linkname, ok_if_already_exists));
1887 /* If the new link name has special constructs in it,
1888 call the corresponding file handler. */
1889 handler = Ffind_file_name_handler(linkname, Qmake_symbolic_link);
1891 RETURN_UNGCPRO(call4(handler, Qmake_symbolic_link, filename,
1892 linkname, ok_if_already_exists));
1895 if (NILP(ok_if_already_exists)
1896 || INTP(ok_if_already_exists))
1897 barf_or_query_if_file_exists(linkname, "make it a link",
1898 INTP(ok_if_already_exists), 0);
1900 unlink((char *)XSTRING_DATA(linkname));
1901 if (0 > symlink((char *)XSTRING_DATA(filename),
1902 (char *)XSTRING_DATA(linkname))) {
1903 report_file_error("Making symbolic link",
1904 list2(filename, linkname));
1906 #endif /* S_IFLNK */
1914 DEFUN("sysnetunam", Fsysnetunam, 2, 2, 0, /*
1915 Open a network connection to PATH using LOGIN as the login string.
1920 const char *path_ext;
1921 const char *login_ext;
1924 CHECK_STRING(login);
1926 /* netunam, being a strange-o system call only used once, is not
1929 LISP_STRING_TO_EXTERNAL(path, path_ext, Qfile_name);
1930 LISP_STRING_TO_EXTERNAL(login, login_ext, Qnative);
1932 netresult = netunam(path_ext, login_ext);
1934 return netresult == -1 ? Qnil : Qt;
1936 #endif /* HPUX_NET */
1938 DEFUN("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
1939 Return t if file FILENAME specifies an absolute path name.
1940 On Unix, this is a name starting with a `/' or a `~'.
1944 /* This function does not GC */
1947 CHECK_STRING(filename);
1948 ptr = XSTRING_DATA(filename);
1949 return (IS_DIRECTORY_SEP(*ptr) || *ptr == '~'
1953 /* Return nonzero if file FILENAME exists and can be executed. */
1955 static int check_executable(char *filename)
1958 return eaccess(filename, X_OK) >= 0;
1960 /* Access isn't quite right because it uses the real uid
1961 and we really want to test with the effective uid.
1962 But Unix doesn't give us a right way to do it. */
1963 return access(filename, X_OK) >= 0;
1964 #endif /* HAVE_EACCESS */
1967 /* Return nonzero if file FILENAME exists and can be written. */
1969 static int check_writable(const char *filename)
1972 return (eaccess(filename, W_OK) >= 0);
1974 /* Access isn't quite right because it uses the real uid
1975 and we really want to test with the effective uid.
1976 But Unix doesn't give us a right way to do it.
1977 Opening with O_WRONLY could work for an ordinary file,
1978 but would lose for directories. */
1979 return (access(filename, W_OK) >= 0);
1983 DEFUN("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
1984 Return t if file FILENAME exists. (This does not mean you can read it.)
1985 See also `file-readable-p' and `file-attributes'.
1989 /* This function can call lisp; GC checked 2000-07-11 ben */
1990 Lisp_Object abspath;
1991 Lisp_Object handler;
1992 struct stat statbuf;
1993 struct gcpro gcpro1;
1995 CHECK_STRING(filename);
1996 abspath = Fexpand_file_name(filename, Qnil);
1998 /* If the file name has special constructs in it,
1999 call the corresponding file handler. */
2001 handler = Ffind_file_name_handler(abspath, Qfile_exists_p);
2004 return call2(handler, Qfile_exists_p, abspath);
2006 return sxemacs_stat((char *)XSTRING_DATA(abspath),
2007 &statbuf) >= 0 ? Qt : Qnil;
2010 DEFUN("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2011 Return t if FILENAME can be executed by you.
2012 For a directory, this means you can access files in that directory.
2016 /* This function can GC. GC checked 07-11-2000 ben. */
2017 Lisp_Object abspath;
2018 Lisp_Object handler;
2019 struct gcpro gcpro1;
2021 CHECK_STRING(filename);
2022 abspath = Fexpand_file_name(filename, Qnil);
2024 /* If the file name has special constructs in it,
2025 call the corresponding file handler. */
2027 handler = Ffind_file_name_handler(abspath, Qfile_executable_p);
2030 return call2(handler, Qfile_executable_p, abspath);
2032 return check_executable((char *)XSTRING_DATA(abspath)) ? Qt : Qnil;
2035 DEFUN("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2036 Return t if file FILENAME exists and you can read it.
2037 See also `file-exists-p' and `file-attributes'.
2041 /* This function can GC */
2042 Lisp_Object abspath = Qnil;
2043 Lisp_Object handler;
2044 struct gcpro gcpro1;
2047 CHECK_STRING(filename);
2048 abspath = Fexpand_file_name(filename, Qnil);
2050 /* If the file name has special constructs in it,
2051 call the corresponding file handler. */
2052 handler = Ffind_file_name_handler(abspath, Qfile_readable_p);
2054 RETURN_UNGCPRO(call2(handler, Qfile_readable_p, abspath));
2058 interruptible_open((char *)XSTRING_DATA(abspath),
2059 O_RDONLY | OPEN_BINARY, 0);
2068 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2070 DEFUN("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2071 Return t if file FILENAME can be written or created by you.
2075 /* This function can GC. GC checked 1997.04.10. */
2076 Lisp_Object abspath, dir;
2077 Lisp_Object handler;
2078 struct stat statbuf;
2079 struct gcpro gcpro1;
2081 CHECK_STRING(filename);
2082 abspath = Fexpand_file_name(filename, Qnil);
2084 /* If the file name has special constructs in it,
2085 call the corresponding file handler. */
2087 handler = Ffind_file_name_handler(abspath, Qfile_writable_p);
2090 return call2(handler, Qfile_writable_p, abspath);
2092 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &statbuf) >= 0)
2093 return (check_writable((char *)XSTRING_DATA(abspath))
2097 dir = Ffile_name_directory(abspath);
2099 return (check_writable(!NILP(dir) ? (char *)XSTRING_DATA(dir)
2104 DEFUN("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2105 Return non-nil if file FILENAME is the name of a symbolic link.
2106 The value is the name of the file to which it is linked.
2107 Otherwise returns nil.
2111 /* This function can GC. GC checked 1997.04.10. */
2112 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2119 Lisp_Object handler;
2120 struct gcpro gcpro1;
2122 CHECK_STRING(filename);
2123 filename = Fexpand_file_name(filename, Qnil);
2125 /* If the file name has special constructs in it,
2126 call the corresponding file handler. */
2128 handler = Ffind_file_name_handler(filename, Qfile_symlink_p);
2130 if (!NILP(handler)) {
2131 return call2(handler, Qfile_symlink_p, filename);
2136 buf = ynew_array_and_zero(char, bufsize);
2137 valsize = readlink((char *)XSTRING_DATA(filename),
2139 if (valsize < bufsize) {
2142 /* Buffer was not long enough */
2146 if (valsize == -1) {
2150 val = make_string((Bufbyte*)buf, valsize);
2153 #else /* not S_IFLNK */
2155 #endif /* not S_IFLNK */
2158 DEFUN("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2159 Return t if file FILENAME is the name of a directory as a file.
2160 A directory name spec may be given instead; then the value is t
2161 if the directory so specified exists and really is a directory.
2165 /* This function can GC. GC checked 1997.04.10. */
2166 Lisp_Object abspath;
2168 Lisp_Object handler;
2169 struct gcpro gcpro1;
2171 GCPRO1(current_buffer->directory);
2172 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2175 /* If the file name has special constructs in it,
2176 call the corresponding file handler. */
2178 handler = Ffind_file_name_handler(abspath, Qfile_directory_p);
2181 return call2(handler, Qfile_directory_p, abspath);
2183 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2185 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2188 DEFUN("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2189 Return t if file FILENAME is the name of a directory as a file,
2190 and files in that directory can be opened by you. In order to use a
2191 directory as a buffer's current directory, this predicate must return true.
2192 A directory name spec may be given instead; then the value is t
2193 if the directory so specified exists and really is a readable and
2194 searchable directory.
2198 /* This function can GC. GC checked 1997.04.10. */
2199 Lisp_Object handler;
2201 /* If the file name has special constructs in it,
2202 call the corresponding file handler. */
2204 Ffind_file_name_handler(filename, Qfile_accessible_directory_p);
2206 return call2(handler, Qfile_accessible_directory_p, filename);
2208 if (NILP(Ffile_directory_p(filename)))
2211 return Ffile_executable_p(filename);
2214 DEFUN("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2215 Return t if file FILENAME is the name of a regular file.
2216 This is the sort of file that holds an ordinary stream of data bytes.
2220 /* This function can GC. GC checked 1997.04.10. */
2221 Lisp_Object abspath;
2223 Lisp_Object handler;
2224 struct gcpro gcpro1;
2226 GCPRO1(current_buffer->directory);
2227 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2230 /* If the file name has special constructs in it,
2231 call the corresponding file handler. */
2233 handler = Ffind_file_name_handler(abspath, Qfile_regular_p);
2236 return call2(handler, Qfile_regular_p, abspath);
2238 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2240 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2243 DEFUN("file-modes", Ffile_modes, 1, 1, 0, /*
2244 Return mode bits of file named FILENAME, as an integer.
2248 /* This function can GC. GC checked 1997.04.10. */
2249 Lisp_Object abspath;
2251 Lisp_Object handler;
2252 struct gcpro gcpro1;
2254 GCPRO1(current_buffer->directory);
2255 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2258 /* If the file name has special constructs in it,
2259 call the corresponding file handler. */
2261 handler = Ffind_file_name_handler(abspath, Qfile_modes);
2264 return call2(handler, Qfile_modes, abspath);
2266 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2268 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2270 return make_int(st.st_mode & 07777);
2273 DEFUN("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2274 Set mode bits of file named FILENAME to MODE (an integer).
2275 Only the 12 low bits of MODE are used.
2279 /* This function can GC. GC checked 1997.04.10. */
2280 Lisp_Object abspath;
2281 Lisp_Object handler;
2282 struct gcpro gcpro1;
2284 GCPRO1(current_buffer->directory);
2285 abspath = Fexpand_file_name(filename, current_buffer->directory);
2290 /* If the file name has special constructs in it,
2291 call the corresponding file handler. */
2293 handler = Ffind_file_name_handler(abspath, Qset_file_modes);
2296 return call3(handler, Qset_file_modes, abspath, mode);
2298 if (chmod((char *)XSTRING_DATA(abspath), XINT(mode)) < 0)
2299 report_file_error("Doing chmod", list1(abspath));
2304 DEFUN("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2305 Set the file permission bits for newly created files.
2306 The argument MODE should be an integer; if a bit in MODE is 1,
2307 subsequently created files will not have the permission corresponding
2308 to that bit enabled. Only the low 9 bits are used.
2309 This setting is inherited by subprocesses.
2315 umask((~XINT(mode)) & 0777);
2320 DEFUN("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2321 Return the default file protection for created files.
2322 The umask value determines which permissions are enabled in newly
2323 created files. If a permission's bit in the umask is 1, subsequently
2324 created files will not have that permission enabled.
2333 return make_int((~mode) & 0777);
2336 DEFUN("unix-sync", Funix_sync, 0, 0, "", /*
2337 Tell Unix to finish all pending disk updates.
2345 DEFUN("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2346 Return t if file FILE1 is newer than file FILE2.
2347 If FILE1 does not exist, the answer is nil;
2348 otherwise, if FILE2 does not exist, the answer is t.
2352 /* This function can GC. GC checked 1997.04.10. */
2353 Lisp_Object abspath1, abspath2;
2356 Lisp_Object handler;
2357 struct gcpro gcpro1, gcpro2, gcpro3;
2359 CHECK_STRING(file1);
2360 CHECK_STRING(file2);
2365 GCPRO3(abspath1, abspath2, current_buffer->directory);
2366 abspath1 = expand_and_dir_to_file(file1, current_buffer->directory);
2367 abspath2 = expand_and_dir_to_file(file2, current_buffer->directory);
2369 /* If the file name has special constructs in it,
2370 call the corresponding file handler. */
2371 handler = Ffind_file_name_handler(abspath1, Qfile_newer_than_file_p);
2374 Ffind_file_name_handler(abspath2, Qfile_newer_than_file_p);
2377 return call3(handler, Qfile_newer_than_file_p, abspath1,
2380 if (sxemacs_stat((char *)XSTRING_DATA(abspath1), &st) < 0)
2383 mtime1 = st.st_mtime;
2385 if (sxemacs_stat((char *)XSTRING_DATA(abspath2), &st) < 0)
2388 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2391 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2392 /* #define READ_BUF_SIZE (2 << 16) */
2393 #define READ_BUF_SIZE (1 << 15)
2395 DEFUN("insert-file-contents-internal", Finsert_file_contents_internal, 1, 7, 0, /*
2396 Insert contents of file FILENAME after point; no coding-system frobbing.
2397 This function is identical to `insert-file-contents' except for the
2398 handling of the CODESYS and USED-CODESYS arguments under
2399 SXEmacs/Mule. (When Mule support is not present, both functions are
2400 identical and ignore the CODESYS and USED-CODESYS arguments.)
2402 If support for Mule exists in this Emacs, the file is decoded according
2403 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2404 it should be a symbol, and the actual coding system that was used for the
2405 decoding is stored into it. It will in general be different from CODESYS
2406 if CODESYS specifies automatic encoding detection or end-of-line detection.
2408 Currently START and END refer to byte positions (as opposed to character
2409 positions), even in Mule. (Fixing this is very difficult.)
2411 (filename, visit, start, end, replace, codesys, used_codesys))
2413 /* This function can call lisp */
2417 Charcount inserted = 0;
2419 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2420 Lisp_Object handler = Qnil, val = Qnil;
2422 Bufbyte read_buf[READ_BUF_SIZE];
2424 struct buffer *buf = current_buffer;
2426 int not_regular = 0;
2428 if (UNLIKELY(buf->base_buffer && !NILP(visit))) {
2429 error("Cannot do file visiting in an indirect buffer");
2432 /* No need to call Fbarf_if_buffer_read_only() here.
2433 That's called in begin_multiple_change() or wherever. */
2434 /* #### dmoore - should probably check in various places to see if
2435 curbuf was killed and if so signal an error? */
2436 XSETBUFFER(curbuf, buf);
2438 GCPRO5(filename, val, visit, handler, curbuf);
2440 if (LIKELY(NILP(replace))) {
2441 mc_count = begin_multiple_change(buf, BUF_PT(buf), BUF_PT(buf));
2443 mc_count = begin_multiple_change(buf, BUF_BEG(buf), BUF_Z(buf));
2446 /* begin_multiple_change also adds an unwind_protect */
2447 speccount = specpdl_depth();
2449 filename = Fexpand_file_name(filename, Qnil);
2451 /* If the file name has special constructs in it,
2452 call the corresponding file handler. */
2453 handler = Ffind_file_name_handler(filename, Qinsert_file_contents);
2454 if (!NILP(handler)) {
2455 val = call6(handler, Qinsert_file_contents, filename,
2456 visit, start, end, replace);
2460 if (!NILP(used_codesys))
2461 CHECK_SYMBOL(used_codesys);
2464 if ((!NILP(start) || !NILP(end)) && !NILP(visit))
2465 error("Attempt to visit less than an entire file");
2469 if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) < 0) {
2474 report_file_error("Opening input file",
2480 /* Signal an error if we are accessing a non-regular file, with
2481 REPLACE, START or END being non-nil. */
2482 if (!S_ISREG(st.st_mode)) {
2488 if (!NILP(replace) || !NILP(start) || !NILP(end)) {
2489 end_multiple_change(buf, mc_count);
2492 (Fsignal(Qfile_error,
2493 list2(build_translated_string
2494 ("not a regular file"), filename)));
2497 #endif /* S_IFREG */
2508 if ((fd = interruptible_open((char *)XSTRING_DATA(filename),
2509 O_RDONLY | OPEN_BINARY, 0)) < 0)
2513 /* Replacement should preserve point as it preserves markers. */
2515 record_unwind_protect(restore_point_unwind,
2516 Fpoint_marker(Qnil, Qnil));
2518 record_unwind_protect(close_file_unwind, make_int(fd));
2520 /* Supposedly happens on VMS. */
2522 error("File size is negative");
2526 end = make_int(st.st_size);
2527 if (XINT(end) != st.st_size)
2528 error("Maximum buffer size exceeded");
2532 /* If requested, replace the accessible part of the buffer
2533 with the file contents. Avoid replacing text at the
2534 beginning or end of the buffer that matches the file contents;
2535 that preserves markers pointing to the unchanged parts. */
2536 #if !defined (FILE_CODING)
2537 /* The replace-mode code currently only works when the assumption
2538 'one byte == one char' holds true. This fails Mule because
2539 files may contain multibyte characters. It holds under Windows NT
2540 provided we convert CRLF into LF. */
2541 # define FSFMACS_SPEEDY_INSERT
2542 #endif /* !defined (FILE_CODING) */
2544 #ifndef FSFMACS_SPEEDY_INSERT
2545 if (!NILP(replace)) {
2546 buffer_delete_range(buf, BUF_BEG(buf), BUF_Z(buf),
2547 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2549 #else /* FSFMACS_SPEEDY_INSERT */
2550 if (!NILP(replace)) {
2551 char buffer[1 << 14];
2552 Bufpos same_at_start = BUF_BEGV(buf);
2553 Bufpos same_at_end = BUF_ZV(buf);
2556 /* Count how many chars at the start of the file
2557 match the text at the beginning of the buffer. */
2561 nread = read_allowing_quit(fd, buffer, sizeof buffer);
2563 error("IO error reading %s: %s",
2564 XSTRING_DATA(filename), strerror(errno));
2565 else if (nread == 0)
2568 while (bufpos < nread && same_at_start < BUF_ZV(buf)
2569 && BUF_FETCH_CHAR(buf,
2572 same_at_start++, bufpos++;
2573 /* If we found a discrepancy, stop the scan.
2574 Otherwise loop around and scan the next bufferful. */
2575 if (bufpos != nread)
2578 /* If the file matches the buffer completely,
2579 there's no need to replace anything. */
2580 if (same_at_start - BUF_BEGV(buf) == st.st_size) {
2582 unbind_to(speccount, Qnil);
2583 /* Truncate the buffer to the size of the file. */
2584 buffer_delete_range(buf, same_at_start, same_at_end,
2585 !NILP(visit) ? INSDEL_NO_LOCKING :
2589 /* Count how many chars at the end of the file
2590 match the text at the end of the buffer. */
2592 int total_read, nread;
2593 Bufpos bufpos, curpos, trial;
2595 /* At what file position are we now scanning? */
2596 curpos = st.st_size - (BUF_ZV(buf) - same_at_end);
2597 /* If the entire file matches the buffer tail, stop the scan. */
2600 /* How much can we scan in the next step? */
2601 trial = min(curpos, (Bufpos) sizeof(buffer));
2602 if (lseek(fd, curpos - trial, 0) < 0)
2603 report_file_error("Setting file position",
2607 while (total_read < trial) {
2609 read_allowing_quit(fd, buffer + total_read,
2610 trial - total_read);
2613 ("IO error reading file",
2615 total_read += nread;
2617 /* Scan this bufferful from the end, comparing with
2618 the Emacs buffer. */
2619 bufpos = total_read;
2620 /* Compare with same_at_start to avoid counting some buffer text
2621 as matching both at the file's beginning and at the end. */
2622 while (bufpos > 0 && same_at_end > same_at_start
2623 && BUF_FETCH_CHAR(buf, same_at_end - 1) ==
2625 same_at_end--, bufpos--;
2626 /* If we found a discrepancy, stop the scan.
2627 Otherwise loop around and scan the preceding bufferful. */
2630 /* If display current starts at beginning of line,
2631 keep it that way. */
2632 if (XBUFFER(XWINDOW(Fselected_window(Qnil))->buffer) ==
2634 XWINDOW(Fselected_window(Qnil))->
2636 !NILP(Fbolp(make_buffer(buf)));
2639 /* Don't try to reuse the same piece of text twice. */
2640 overlap = same_at_start - BUF_BEGV(buf) -
2641 (same_at_end + st.st_size - BUF_ZV(buf));
2643 same_at_end += overlap;
2645 /* Arrange to read only the nonmatching middle part of the file. */
2646 start = make_int(same_at_start - BUF_BEGV(buf));
2647 end = make_int(st.st_size - (BUF_ZV(buf) - same_at_end));
2649 buffer_delete_range(buf, same_at_start, same_at_end,
2650 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2651 /* Insert from the file at the proper position. */
2652 BUF_SET_PT(buf, same_at_start);
2654 #endif /* FSFMACS_SPEEDY_INSERT */
2657 total = XINT(end) - XINT(start);
2659 /* Make sure point-max won't overflow after this insertion. */
2660 if (total != XINT(make_int(total)))
2661 error("Maximum buffer size exceeded");
2663 /* For a special file, all we can do is guess. The value of -1
2664 will make the stream functions read as much as possible. */
2667 if (XINT(start) != 0
2668 #ifdef FSFMACS_SPEEDY_INSERT
2669 /* why was this here? asked jwz. The reason is that the replace-mode
2670 connivings above will normally put the file pointer other than
2671 where it should be. */
2673 #endif /* !FSFMACS_SPEEDY_INSERT */
2675 if (lseek(fd, XINT(start), 0) < 0)
2676 report_file_error("Setting file position",
2681 Bufpos cur_point = BUF_PT(buf);
2682 struct gcpro ngcpro1;
2683 Lisp_Object stream = make_filedesc_input_stream(fd, 0, total,
2687 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2690 stream = make_decoding_input_stream
2691 (XLSTREAM(stream), Fget_coding_system(codesys));
2692 Lstream_set_character_mode(XLSTREAM(stream));
2693 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2695 #endif /* FILE_CODING */
2697 record_unwind_protect(delete_stream_unwind, stream);
2699 /* No need to limit the amount of stuff we attempt to read. (It would
2700 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2701 occurs inside of the filedesc stream. */
2703 Lstream_data_count this_len;
2704 Charcount cc_inserted;
2707 this_len = Lstream_read(XLSTREAM(stream), read_buf,
2710 if (this_len <= 0) {
2717 buffer_insert_raw_string_1(buf, cur_point, read_buf,
2718 this_len, !NILP(visit)
2719 ? INSDEL_NO_LOCKING : 0);
2720 inserted += cc_inserted;
2721 cur_point += cc_inserted;
2724 if (!NILP(used_codesys)) {
2726 decoding_stream_coding_system(XLSTREAM(stream));
2727 Fset(used_codesys, XCODING_SYSTEM_NAME(tmp));
2729 #endif /* FILE_CODING */
2733 /* Close the file/stream */
2734 unbind_to(speccount, Qnil);
2736 if (saverrno != 0) {
2737 error("IO error reading %s: %s",
2738 XSTRING_DATA(filename), strerror(saverrno));
2744 end_multiple_change(buf, mc_count);
2747 if (!EQ(buf->undo_list, Qt))
2748 buf->undo_list = Qnil;
2749 if (NILP(handler)) {
2750 buf->modtime = st.st_mtime;
2751 buf->filename = filename;
2752 /* XEmacs addition: */
2753 /* This function used to be in C, ostensibly so that
2754 it could be called here. But that's just silly.
2755 There's no reason C code can't call out to Lisp
2756 code, and it's a lot cleaner this way. */
2757 /* Note: compute-buffer-file-truename is called for
2758 side-effect! Its return value is intentionally
2760 if (!NILP(Ffboundp(Qcompute_buffer_file_truename)))
2761 call1(Qcompute_buffer_file_truename,
2764 BUF_SAVE_MODIFF(buf) = BUF_MODIFF(buf);
2765 buf->auto_save_modified = BUF_MODIFF(buf);
2766 buf->saved_size = make_int(BUF_SIZE(buf));
2767 #ifdef CLASH_DETECTION
2768 if (NILP(handler)) {
2769 if (!NILP(buf->file_truename))
2770 unlock_file(buf->file_truename);
2771 unlock_file(filename);
2773 #endif /* CLASH_DETECTION */
2775 RETURN_UNGCPRO(Fsignal(Qfile_error,
2777 ("not a regular file"),
2780 /* If visiting nonexistent file, return nil. */
2781 if (buf->modtime == -1)
2782 report_file_error("Opening input file",
2786 /* Decode file format */
2788 Lisp_Object insval = call3(Qformat_decode,
2789 Qnil, make_int(inserted), visit);
2791 inserted = XINT(insval);
2796 struct gcpro ngcpro1;
2799 EXTERNAL_LIST_LOOP(p, Vafter_insert_file_functions) {
2800 Lisp_Object insval = call1(XCAR(p), make_int(inserted));
2801 if (!NILP(insval)) {
2802 CHECK_NATNUM(insval);
2803 inserted = XINT(insval);
2815 return (list2(filename, make_int(inserted)));
2818 static int a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
2819 Lisp_Object * annot);
2820 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end);
2822 /* If build_annotations switched buffers, switch back to BUF.
2823 Kill the temporary buffer that was selected in the meantime. */
2825 static Lisp_Object build_annotations_unwind(Lisp_Object buf)
2829 if (XBUFFER(buf) == current_buffer)
2831 tembuf = Fcurrent_buffer();
2833 Fkill_buffer(tembuf);
2837 DEFUN("write-region-internal", Fwrite_region_internal, 3, 7, "r\nFWrite region to file: ", /*
2838 Write current region into specified file; no coding-system frobbing.
2839 This function is identical to `write-region' except for the handling
2840 of the CODESYS argument under SXEmacs/Mule. (When Mule support is not
2841 present, both functions are identical and ignore the CODESYS argument.)
2842 If support for Mule exists in this Emacs, the file is encoded according
2843 to the value of CODESYS. If this is nil, no code conversion occurs.
2845 As a special kludge to support auto-saving, when START is nil START and
2846 END are set to the beginning and end, respectively, of the buffer,
2847 regardless of any restrictions. Don't use this feature. It is documented
2848 here because write-region handler writers need to be aware of it.
2850 (start, end, filename, append, visit, lockname, codesys))
2852 /* This function can call lisp. GC checked 2000-07-28 ben */
2854 int failure, stat_res;
2857 Lisp_Object fn = Qnil;
2858 int speccount = specpdl_depth();
2859 int visiting_other = STRINGP(visit);
2860 int visiting = (EQ(visit, Qt) || visiting_other);
2861 int quietly = (!visiting && !NILP(visit));
2862 Lisp_Object visit_file = Qnil;
2863 Lisp_Object annotations = Qnil;
2864 struct buffer *given_buffer;
2865 Bufpos start1, end1;
2866 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2867 struct gcpro ngcpro1, ngcpro2;
2870 XSETBUFFER(curbuf, current_buffer);
2872 /* start, end, visit, and append are never modified in this fun
2873 so we don't protect them. */
2874 GCPRO5(visit_file, filename, codesys, lockname, annotations);
2875 NGCPRO2(curbuf, fn);
2877 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
2878 we should signal an error rather than blissfully continuing
2879 along. ARGH, this function is going to lose lose lose. We need
2880 to protect the current_buffer from being destroyed, but the
2881 multiple return points make this a pain in the butt. ]] we do
2882 protect curbuf now. --ben */
2885 codesys = Fget_coding_system(codesys);
2886 #endif /* FILE_CODING */
2888 if (current_buffer->base_buffer && !NILP(visit))
2890 ("Cannot do file visiting in an indirect buffer", curbuf);
2892 if (!NILP(start) && !STRINGP(start))
2893 get_buffer_range_char(current_buffer, start, end, &start1,
2897 Lisp_Object handler;
2900 visit_file = Fexpand_file_name(visit, Qnil);
2902 visit_file = filename;
2903 filename = Fexpand_file_name(filename, Qnil);
2906 lockname = visit_file;
2908 /* We used to UNGCPRO here. BAD! visit_file is used below after
2909 more Lisp calling. */
2910 /* If the file name has special constructs in it,
2911 call the corresponding file handler. */
2912 handler = Ffind_file_name_handler(filename, Qwrite_region);
2913 /* If FILENAME has no handler, see if VISIT has one. */
2914 if (NILP(handler) && STRINGP(visit))
2915 handler = Ffind_file_name_handler(visit, Qwrite_region);
2917 if (!NILP(handler)) {
2919 call8(handler, Qwrite_region, start, end,
2920 filename, append, visit, lockname, codesys);
2922 BUF_SAVE_MODIFF(current_buffer) =
2923 BUF_MODIFF(current_buffer);
2924 current_buffer->saved_size =
2925 make_int(BUF_SIZE(current_buffer));
2926 current_buffer->filename = visit_file;
2927 MARK_MODELINE_CHANGED;
2935 #ifdef CLASH_DETECTION
2937 lock_file(lockname);
2938 #endif /* CLASH_DETECTION */
2940 /* Special kludge to simplify auto-saving. */
2942 start1 = BUF_BEG(current_buffer);
2943 end1 = BUF_Z(current_buffer);
2946 record_unwind_protect(build_annotations_unwind, Fcurrent_buffer());
2948 given_buffer = current_buffer;
2949 annotations = build_annotations(start, end);
2950 if (current_buffer != given_buffer) {
2951 start1 = BUF_BEGV(current_buffer);
2952 end1 = BUF_ZV(current_buffer);
2957 if (!NILP(append)) {
2959 open((char *)XSTRING_DATA(fn), O_WRONLY | OPEN_BINARY, 0);
2962 desc = open((char *)XSTRING_DATA(fn),
2963 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
2964 auto_saving ? auto_save_mode_bits : CREAT_MODE);
2968 #ifdef CLASH_DETECTION
2971 unlock_file(lockname);
2973 #endif /* CLASH_DETECTION */
2974 report_file_error("Opening output file", list1(filename));
2978 Lisp_Object desc_locative = Fcons(make_int(desc), Qnil);
2979 Lisp_Object instream = Qnil, outstream = Qnil;
2980 struct gcpro nngcpro1, nngcpro2;
2981 /* need to gcpro; QUIT could happen out of call to write() */
2982 NNGCPRO2(instream, outstream);
2984 record_unwind_protect(close_file_unwind, desc_locative);
2986 if (!NILP(append)) {
2987 if (lseek(desc, 0, 2) < 0) {
2988 #ifdef CLASH_DETECTION
2990 unlock_file(lockname);
2991 #endif /* CLASH_DETECTION */
2992 report_file_error("Lseek error",
2999 /* Note: I tried increasing the buffering size, along with
3000 various other tricks, but nothing seemed to make much of
3001 a difference in the time it took to save a large file.
3002 (Actually that's not true. With a local disk, changing
3003 the buffer size doesn't seem to make much difference.
3004 With an NFS-mounted disk, it could make a lot of difference
3005 because you're affecting the number of network requests
3006 that need to be made, and there could be a large latency
3007 for each request. So I've increased the buffer size
3009 outstream = make_filedesc_output_stream(desc, 0, -1, 0);
3010 Lstream_set_buffering(XLSTREAM(outstream),
3011 LSTREAM_BLOCKN_BUFFERED, 65536);
3014 make_encoding_output_stream(XLSTREAM(outstream), codesys);
3015 Lstream_set_buffering(XLSTREAM(outstream),
3016 LSTREAM_BLOCKN_BUFFERED, 65536);
3017 #endif /* FILE_CODING */
3018 if (STRINGP(start)) {
3019 instream = make_lisp_string_input_stream(start, 0, -1);
3023 make_lisp_buffer_input_stream(current_buffer,
3026 LSTR_IGNORE_ACCESSIBLE);
3028 (0 > (a_write(outstream, instream, start1, &annotations)));
3030 /* Note that this doesn't close the desc since we created the
3031 stream without the LSTR_CLOSING flag, but it does
3032 flush out any buffered data. */
3033 if (Lstream_close(XLSTREAM(outstream)) < 0) {
3037 Lstream_close(XLSTREAM(instream));
3040 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3041 Disk full in NFS may be reported here. */
3042 /* mib says that closing the file will try to write as fast as NFS can do
3043 it, and that means the fsync here is not crucial for autosave files. */
3044 if (!auto_saving && fsync(desc) < 0
3045 /* If fsync fails with EINTR, don't treat that as serious. */
3046 && errno != EINTR) {
3050 #endif /* HAVE_FSYNC */
3052 /* Spurious "file has changed on disk" warnings used to be seen on
3053 systems where close() can change the modtime. This is known to
3054 happen on various NFS file systems, on Windows, and on Linux.
3055 Rather than handling this on a per-system basis, we
3056 unconditionally do the sxemacs_stat() after the close(). */
3058 /* NFS can report a write failure now. */
3059 if (close(desc) < 0) {
3064 /* Discard the close unwind-protect. Execute the one for
3065 build_annotations (switches back to the original current buffer
3067 XCAR(desc_locative) = Qnil;
3068 unbind_to(speccount, Qnil);
3073 stat_res = sxemacs_stat((char *)XSTRING_DATA(fn), &st);
3075 #ifdef CLASH_DETECTION
3077 unlock_file(lockname);
3078 #endif /* CLASH_DETECTION */
3080 /* Do this before reporting IO error
3081 to avoid a "file has changed on disk" warning on
3082 next attempt to save. */
3085 current_buffer->modtime = st.st_mtime;
3087 If sxemacs_stat failed, we have bigger problems, and
3088 most likely the file is gone, so the error next time is
3094 report_file_error("Writing file", list1(fn));
3098 BUF_SAVE_MODIFF(current_buffer) = BUF_MODIFF(current_buffer);
3099 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3100 current_buffer->filename = visit_file;
3101 MARK_MODELINE_CHANGED;
3102 } else if (quietly) {
3110 message("Wrote %s", XSTRING_DATA(visit_file));
3112 Lisp_Object fsp = Qnil;
3113 struct gcpro nngcpro1;
3116 fsp = Ffile_symlink_p(fn);
3118 message("Wrote %s", XSTRING_DATA(fn));
3120 message("Wrote %s (symlink to %s)",
3121 XSTRING_DATA(fn), XSTRING_DATA(fsp));
3130 /* #### This is such a load of shit!!!! There is no way we should define
3131 something so stupid as a subr, just sort the fucking list more
3133 DEFUN("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3134 Return t if (car A) is numerically less than (car B).
3138 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcar(a), Fcar(b)))
3144 /* Heh heh heh, let's define this too, just to aggravate the person who
3145 wrote the above comment. */
3146 DEFUN("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3147 Return t if (cdr A) is numerically less than (cdr B).
3151 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcdr(a), Fcdr(b)))
3157 /* Build the complete list of annotations appropriate for writing out
3158 the text between START and END, by calling all the functions in
3159 write-region-annotate-functions and merging the lists they return.
3160 If one of these functions switches to a different buffer, we assume
3161 that buffer contains altered text. Therefore, the caller must
3162 make sure to restore the current buffer in all cases,
3163 as save-excursion would do. */
3165 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end)
3167 /* This function can GC */
3168 Lisp_Object annotations;
3170 struct gcpro gcpro1, gcpro2;
3171 Lisp_Object original_buffer;
3173 XSETBUFFER(original_buffer, current_buffer);
3176 p = Vwrite_region_annotate_functions;
3177 GCPRO2(annotations, p);
3179 struct buffer *given_buffer = current_buffer;
3180 Vwrite_region_annotations_so_far = annotations;
3181 res = call2(Fcar(p), start, end);
3182 /* If the function makes a different buffer current,
3183 assume that means this buffer contains altered text to be output.
3184 Reset START and END from the buffer bounds
3185 and discard all previous annotations because they should have
3186 been dealt with by this function. */
3187 if (current_buffer != given_buffer) {
3188 start = make_int(BUF_BEGV(current_buffer));
3189 end = make_int(BUF_ZV(current_buffer));
3192 Flength(res); /* Check basic validity of return value */
3193 annotations = merge(annotations, res, Qcar_less_than_car);
3197 /* Now do the same for annotation functions implied by the file-format */
3198 if (auto_saving && (!EQ(Vauto_save_file_format, Qt)))
3199 p = Vauto_save_file_format;
3201 p = current_buffer->file_format;
3203 struct buffer *given_buffer = current_buffer;
3204 Vwrite_region_annotations_so_far = annotations;
3205 res = call4(Qformat_annotate_function, Fcar(p), start, end,
3207 if (current_buffer != given_buffer) {
3208 start = make_int(BUF_BEGV(current_buffer));
3209 end = make_int(BUF_ZV(current_buffer));
3213 annotations = merge(annotations, res, Qcar_less_than_car);
3220 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3221 EOF is encountered), assuming they start at position POS in the buffer
3222 of string that STREAM refers to. Intersperse with them the annotations
3223 from *ANNOT that fall into the range of positions we are reading from,
3224 each at its appropriate position.
3226 Modify *ANNOT by discarding elements as we output them.
3227 The return value is negative in case of system call failure. */
3229 /* 4K should probably be fine. We just need to reduce the number of
3230 function calls to reasonable level. The Lstream stuff itself will
3231 batch to 64K to reduce the number of system calls. */
3233 #define A_WRITE_BATCH_SIZE 4096
3236 a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
3237 Lisp_Object * annot)
3241 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3242 Lstream *instr = XLSTREAM(instream);
3243 Lstream *outstr = XLSTREAM(outstream);
3245 while (LISTP(*annot)) {
3246 tem = Fcar_safe(Fcar(*annot));
3248 nextpos = XINT(tem);
3252 /* If there are annotations left and we have Mule, then we
3253 have to do the I/O one emchar at a time so we can
3254 determine when to insert the annotation. */
3255 if (!NILP(*annot)) {
3257 while (pos != nextpos
3258 && (ch = Lstream_get_emchar(instr)) != EOF) {
3259 if (Lstream_put_emchar(outstr, ch) < 0)
3266 while (pos != nextpos) {
3267 /* Otherwise there is no point to that. Just go in batches. */
3269 min(nextpos - pos, A_WRITE_BATCH_SIZE);
3271 chunk = Lstream_read(instr, largebuf, chunk);
3274 if (chunk == 0) /* EOF */
3276 if (Lstream_write(outstr, largebuf, chunk) <
3282 if (pos == nextpos) {
3283 tem = Fcdr(Fcar(*annot));
3285 if (Lstream_write(outstr, XSTRING_DATA(tem),
3286 XSTRING_LENGTH(tem)) < 0)
3289 *annot = Fcdr(*annot);
3296 DEFUN("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3297 Return t if last mod time of BUFFER's visited file matches what BUFFER records.
3298 This means that the file has not been changed since it was visited or saved.
3302 /* This function can call lisp; GC checked 2000-07-11 ben */
3305 Lisp_Object handler;
3307 CHECK_BUFFER(buffer);
3308 b = XBUFFER(buffer);
3310 if (!STRINGP(b->filename))
3312 if (b->modtime == 0)
3315 /* If the file name has special constructs in it,
3316 call the corresponding file handler. */
3317 handler = Ffind_file_name_handler(b->filename,
3318 Qverify_visited_file_modtime);
3320 return call2(handler, Qverify_visited_file_modtime, buffer);
3322 if (sxemacs_stat((char *)XSTRING_DATA(b->filename), &st) < 0) {
3323 /* If the file doesn't exist now and didn't exist before,
3324 we say that it isn't modified, provided the error is a tame one. */
3325 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3330 if (st.st_mtime == b->modtime
3331 /* If both are positive, accept them if they are off by one second. */
3332 || (st.st_mtime > 0 && b->modtime > 0
3333 && (st.st_mtime == b->modtime + 1
3334 || st.st_mtime == b->modtime - 1)))
3339 DEFUN("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3340 Clear out records of last mod time of visited file.
3341 Next attempt to save will certainly not complain of a discrepancy.
3345 current_buffer->modtime = 0;
3349 DEFUN("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3350 Return the current buffer's recorded visited file modification time.
3351 The value is a list of the form (HIGH . LOW), like the time values
3352 that `file-attributes' returns.
3356 return time_to_lisp((time_t) current_buffer->modtime);
3359 DEFUN("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3360 Update buffer's recorded modification time from the visited file's time.
3361 Useful if the buffer was not read from the file normally
3362 or if the file itself has been changed for some known benign reason.
3363 An argument specifies the modification time value to use
3364 \(instead of that of the visited file), in the form of a list
3365 \(HIGH . LOW) or (HIGH LOW).
3369 /* This function can call lisp */
3370 if (!NILP(time_list)) {
3372 lisp_to_time(time_list, &the_time);
3373 current_buffer->modtime = (int)the_time;
3375 Lisp_Object filename = Qnil;
3377 Lisp_Object handler;
3378 struct gcpro gcpro1, gcpro2, gcpro3;
3380 GCPRO3(filename, time_list, current_buffer->filename);
3381 filename = Fexpand_file_name(current_buffer->filename, Qnil);
3383 /* If the file name has special constructs in it,
3384 call the corresponding file handler. */
3386 Ffind_file_name_handler(filename,
3387 Qset_visited_file_modtime);
3390 /* The handler can find the file name the same way we did. */
3391 return call2(handler, Qset_visited_file_modtime, Qnil);
3392 else if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) >= 0)
3393 current_buffer->modtime = st.st_mtime;
3400 auto_save_error(Lisp_Object condition_object, Lisp_Object ignored)
3402 /* This function can call lisp */
3405 /* Don't try printing an error message after everything is gone! */
3406 if (preparing_for_armageddon)
3408 clear_echo_area(selected_frame(), Qauto_saving, 1);
3409 Fding(Qt, Qauto_save_error, Qnil);
3410 message("Auto-saving...error for %s",
3411 XSTRING_DATA(current_buffer->name));
3412 Fsleep_for(make_int(1));
3413 message("Auto-saving...error!for %s",
3414 XSTRING_DATA(current_buffer->name));
3415 Fsleep_for(make_int(1));
3416 message("Auto-saving...error for %s",
3417 XSTRING_DATA(current_buffer->name));
3418 Fsleep_for(make_int(1));
3422 static Lisp_Object auto_save_1(Lisp_Object ignored)
3424 /* This function can call lisp */
3425 /* #### I think caller is protecting current_buffer? */
3427 Lisp_Object fn = current_buffer->filename;
3428 Lisp_Object a = current_buffer->auto_save_file_name;
3433 /* Get visited file's mode to become the auto save file's mode. */
3434 if (STRINGP(fn) && sxemacs_stat((char *)XSTRING_DATA(fn), &st) >= 0)
3435 /* But make sure we can overwrite it later! */
3436 auto_save_mode_bits = st.st_mode | 0600;
3438 /* default mode for auto-save files of buffers with no file is
3439 readable by owner only. This may annoy some small number of
3440 people, but the alternative removes all privacy from email. */
3441 auto_save_mode_bits = 0600;
3444 /* !!#### need to deal with this 'escape-quoted everywhere */
3445 Fwrite_region_internal(Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3447 current_buffer->buffer_file_coding_system
3455 auto_save_expand_name_error(Lisp_Object condition_object, Lisp_Object ignored)
3457 /* #### this function should spew an error message about not being
3458 able to open the .saves file. */
3462 static Lisp_Object auto_save_expand_name(Lisp_Object name)
3464 struct gcpro gcpro1;
3466 /* note that caller did NOT gc protect name, so we do it. */
3467 /* #### dmoore - this might not be necessary, if condition_case_1
3468 protects it. but I don't think it does. */
3470 RETURN_UNGCPRO(Fexpand_file_name(name, Qnil));
3473 static Lisp_Object do_auto_save_unwind(Lisp_Object fd)
3479 static Lisp_Object do_auto_save_unwind_2(Lisp_Object old_auto_saving)
3481 auto_saving = XINT(old_auto_saving);
3485 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3486 and if so, tries to avoid touching lisp objects.
3488 The only time that Fdo_auto_save() is called while GC is in progress
3489 is if we're going down, as a result of an abort() or a kill signal.
3490 It's fairly important that we generate autosave files in that case!
3493 DEFUN("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3494 Auto-save all buffers that need it.
3495 This is all buffers that have auto-saving enabled
3496 and are changed since last auto-saved.
3497 Auto-saving writes the buffer into a file
3498 so that your editing is not lost if the system crashes.
3499 This file is not the file you visited; that changes only when you save.
3500 Normally we run the normal hook `auto-save-hook' before saving.
3502 Non-nil first argument means do not print any message if successful.
3503 Non-nil second argument means save only current buffer.
3505 (no_message, current_only))
3507 /* This function can call lisp */
3509 Lisp_Object tail, buf;
3511 int do_handled_files;
3512 Lisp_Object oquit = Qnil;
3513 Lisp_Object listfile = Qnil;
3516 int speccount = specpdl_depth();
3517 struct gcpro gcpro1, gcpro2, gcpro3;
3519 XSETBUFFER(old, current_buffer);
3520 GCPRO3(oquit, listfile, old);
3521 check_quit(); /* make Vquit_flag accurate */
3522 /* Ordinarily don't quit within this function,
3523 but don't make it impossible to quit (in case we get hung in I/O). */
3527 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3528 variables point to non-strings reached from Vbuffer_alist. */
3530 if (minibuf_level != 0 || preparing_for_armageddon)
3533 run_hook(Qauto_save_hook);
3535 if (STRINGP(Vauto_save_list_file_name))
3536 listfile = condition_case_1(Qt,
3537 auto_save_expand_name,
3538 Vauto_save_list_file_name,
3539 auto_save_expand_name_error, Qnil);
3541 /* Make sure auto_saving is reset. */
3542 record_unwind_protect(do_auto_save_unwind_2, make_int(auto_saving));
3546 /* First, save all files which don't have handlers. If Emacs is
3547 crashing, the handlers may tweak what is causing Emacs to crash
3548 in the first place, and it would be a shame if Emacs failed to
3549 autosave perfectly ordinary files because it couldn't handle some
3551 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) {
3552 for (tail = Vbuffer_alist; CONSP(tail); tail = XCDR(tail)) {
3553 buf = XCDR(XCAR(tail));
3556 if (!NILP(current_only)
3557 && b != current_buffer)
3560 /* Don't auto-save indirect buffers.
3561 The base buffer takes care of it. */
3565 /* Check for auto save enabled
3566 and file changed since last auto save
3567 and file changed since last real save. */
3568 if (STRINGP(b->auto_save_file_name)
3569 && BUF_SAVE_MODIFF(b) < BUF_MODIFF(b)
3570 && b->auto_save_modified < BUF_MODIFF(b)
3571 /* -1 means we've turned off autosaving for a while--see below. */
3572 && XINT(b->saved_size) >= 0
3573 && (do_handled_files
3575 NILP(Ffind_file_name_handler
3576 (b->auto_save_file_name,
3578 EMACS_TIME before_time, after_time;
3580 EMACS_GET_TIME(before_time);
3581 /* If we had a failure, don't try again for 20 minutes. */
3582 if (!preparing_for_armageddon
3583 && b->auto_save_failure_time >= 0
3584 && (EMACS_SECS(before_time) -
3585 b->auto_save_failure_time < 1200))
3588 if (!preparing_for_armageddon &&
3589 (XINT(b->saved_size) * 10
3590 > (BUF_Z(b) - BUF_BEG(b)) * 13)
3591 /* A short file is likely to change a large fraction;
3592 spare the user annoying messages. */
3593 && XINT(b->saved_size) > 5000
3594 /* These messages are frequent and annoying for `*mail*'. */
3595 && !NILP(b->filename)
3597 && disable_auto_save_when_buffer_shrinks) {
3598 /* It has shrunk too much; turn off auto-saving here.
3599 Unless we're about to crash, in which case auto-save it
3603 ("Buffer %s has shrunk a lot; auto save turned off there",
3604 XSTRING_DATA(b->name));
3605 /* Turn off auto-saving until there's a real save,
3606 and prevent any more warnings. */
3607 b->saved_size = make_int(-1);
3608 if (!gc_in_progress)
3609 Fsleep_for(make_int(1));
3612 set_buffer_internal(b);
3613 if (!auto_saved && NILP(no_message)) {
3614 static const unsigned char *msg
3616 (const unsigned char *)
3618 echo_area_message(selected_frame(), msg,
3620 strlen((const char *)
3625 /* Open the auto-save list file, if necessary.
3626 We only do this now so that the file only exists
3627 if we actually auto-saved any files. */
3628 if (!auto_saved && !inhibit_auto_save_session
3629 && !NILP(Vauto_save_list_file_prefix)
3630 && STRINGP(listfile) && listdesc < 0) {
3632 open((char *)XSTRING_DATA(listfile),
3633 O_WRONLY | O_TRUNC | O_CREAT |
3634 OPEN_BINARY, CREAT_MODE);
3636 /* Arrange to close that file whether or not we get
3639 record_unwind_protect
3640 (do_auto_save_unwind,
3641 make_int(listdesc));
3644 /* Record all the buffers that we are auto-saving in
3645 the special file that lists them. For each of
3646 these buffers, record visited name (if any) and
3648 if (listdesc >= 0) {
3649 const Extbyte *auto_save_file_name_ext;
3650 Extcount auto_save_file_name_ext_len;
3652 TO_EXTERNAL_FORMAT(LISP_STRING,
3654 auto_save_file_name,
3656 (auto_save_file_name_ext,
3657 auto_save_file_name_ext_len),
3659 if (!NILP(b->filename)) {
3660 const Extbyte *filename_ext;
3661 Extcount filename_ext_len;
3663 TO_EXTERNAL_FORMAT(LISP_STRING,
3669 write(listdesc, filename_ext,
3672 write(listdesc, "\n", 1);
3673 write(listdesc, auto_save_file_name_ext,
3674 auto_save_file_name_ext_len);
3675 write(listdesc, "\n", 1);
3678 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
3679 based on values in Vbuffer_alist. auto_save_1 may
3680 cause lisp handlers to run. Those handlers may kill
3681 the buffer and then GC. Since the buffer is killed,
3682 it's no longer in Vbuffer_alist so it might get reaped
3683 by the GC. We also need to protect tail. */
3684 /* #### There is probably a lot of other code which has
3685 pointers into buffers which may get blown away by
3688 struct gcpro ngcpro1, ngcpro2;
3690 condition_case_1(Qt,
3692 auto_save_error, Qnil);
3695 /* Handler killed our saved current-buffer! Pick any. */
3696 if (!BUFFER_LIVE_P(XBUFFER(old)))
3697 XSETBUFFER(old, current_buffer);
3699 set_buffer_internal(XBUFFER(old));
3702 /* Handler killed their own buffer! */
3703 if (!BUFFER_LIVE_P(b))
3706 b->auto_save_modified = BUF_MODIFF(b);
3707 b->saved_size = make_int(BUF_SIZE(b));
3708 EMACS_GET_TIME(after_time);
3709 /* If auto-save took more than 60 seconds,
3710 assume it was an NFS failure that got a timeout. */
3711 if (EMACS_SECS(after_time) -
3712 EMACS_SECS(before_time) > 60)
3713 b->auto_save_failure_time =
3714 EMACS_SECS(after_time);
3719 /* Prevent another auto save till enough input events come in. */
3723 /* If we didn't save anything into the listfile, remove the old
3724 one because nothing needed to be auto-saved. Do this afterwards
3725 rather than before in case we get a crash attempting to autosave
3726 (in that case we'd still want the old one around). */
3727 if (listdesc < 0 && !auto_saved && STRINGP(listfile))
3728 unlink((char *)XSTRING_DATA(listfile));
3733 /* Show "...done" only if the echo area would otherwise be empty. */
3734 if (auto_saved && NILP(no_message)
3735 && NILP(clear_echo_area(selected_frame(), Qauto_saving, 0))) {
3736 static const unsigned char *msg
3737 = (const unsigned char *)"Auto-saving...done";
3738 echo_area_message(selected_frame(), msg, Qnil, 0,
3739 strlen((const char *)msg), Qauto_saving);
3744 RETURN_UNGCPRO(unbind_to(speccount, Qnil));
3747 DEFUN("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
3748 Mark current buffer as auto-saved with its current text.
3749 No auto-save file will be written until the buffer changes again.
3753 current_buffer->auto_save_modified = BUF_MODIFF(current_buffer);
3754 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3755 current_buffer->auto_save_failure_time = -1;
3759 DEFUN("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
3760 Clear any record of a recent auto-save failure in the current buffer.
3764 current_buffer->auto_save_failure_time = -1;
3768 DEFUN("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
3769 Return t if buffer has been auto-saved since last read in or saved.
3773 return (BUF_SAVE_MODIFF(current_buffer) <
3774 current_buffer->auto_save_modified) ? Qt : Qnil;
3777 /************************************************************************/
3778 /* initialization */
3779 /************************************************************************/
3781 void syms_of_fileio(void)
3783 defsymbol(&Qexpand_file_name, "expand-file-name");
3784 defsymbol(&Qfile_truename, "file-truename");
3785 defsymbol(&Qsubstitute_in_file_name, "substitute-in-file-name");
3786 defsymbol(&Qdirectory_file_name, "directory-file-name");
3787 defsymbol(&Qfile_dirname, "file-dirname");
3788 defsymbol(&Qfile_basename, "file-basename");
3789 defsymbol(&Qfile_name_directory, "file-name-directory");
3790 defsymbol(&Qfile_name_nondirectory, "file-name-nondirectory");
3791 defsymbol(&Qunhandled_file_name_directory,
3792 "unhandled-file-name-directory");
3793 defsymbol(&Qfile_name_as_directory, "file-name-as-directory");
3794 defsymbol(&Qcopy_file, "copy-file");
3795 defsymbol(&Qmake_directory_internal, "make-directory-internal");
3796 defsymbol(&Qdelete_directory, "delete-directory");
3797 defsymbol(&Qdelete_file, "delete-file");
3798 defsymbol(&Qrename_file, "rename-file");
3799 defsymbol(&Qadd_name_to_file, "add-name-to-file");
3800 defsymbol(&Qmake_symbolic_link, "make-symbolic-link");
3801 defsymbol(&Qfile_exists_p, "file-exists-p");
3802 defsymbol(&Qfile_executable_p, "file-executable-p");
3803 defsymbol(&Qfile_readable_p, "file-readable-p");
3804 defsymbol(&Qfile_symlink_p, "file-symlink-p");
3805 defsymbol(&Qfile_writable_p, "file-writable-p");
3806 defsymbol(&Qfile_directory_p, "file-directory-p");
3807 defsymbol(&Qfile_regular_p, "file-regular-p");
3808 defsymbol(&Qfile_accessible_directory_p, "file-accessible-directory-p");
3809 defsymbol(&Qfile_modes, "file-modes");
3810 defsymbol(&Qset_file_modes, "set-file-modes");
3811 defsymbol(&Qfile_newer_than_file_p, "file-newer-than-file-p");
3812 defsymbol(&Qinsert_file_contents, "insert-file-contents");
3813 defsymbol(&Qwrite_region, "write-region");
3814 defsymbol(&Qverify_visited_file_modtime, "verify-visited-file-modtime");
3815 defsymbol(&Qset_visited_file_modtime, "set-visited-file-modtime");
3816 defsymbol(&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
3818 defsymbol(&Qauto_save_hook, "auto-save-hook");
3819 defsymbol(&Qauto_save_error, "auto-save-error");
3820 defsymbol(&Qauto_saving, "auto-saving");
3822 defsymbol(&Qformat_decode, "format-decode");
3823 defsymbol(&Qformat_annotate_function, "format-annotate-function");
3825 defsymbol(&Qcompute_buffer_file_truename,
3826 "compute-buffer-file-truename");
3827 DEFERROR_STANDARD(Qfile_error, Qio_error);
3828 DEFERROR_STANDARD(Qfile_already_exists, Qfile_error);
3830 DEFSUBR(Ffind_file_name_handler);
3832 DEFSUBR(Ffile_name_directory);
3833 DEFSUBR(Ffile_name_nondirectory);
3834 DEFSUBR(Ffile_basename);
3835 DEFSUBR(Ffile_dirname);
3836 DEFSUBR(Funhandled_file_name_directory);
3837 DEFSUBR(Ffile_name_as_directory);
3838 DEFSUBR(Fdirectory_file_name);
3839 DEFSUBR(Fmake_temp_name);
3840 DEFSUBR(Fexpand_file_name);
3841 DEFSUBR(Ffile_truename);
3842 DEFSUBR(Fsubstitute_in_file_name);
3843 DEFSUBR(Fcopy_file);
3844 DEFSUBR(Fmake_directory_internal);
3845 DEFSUBR(Fdelete_directory);
3846 DEFSUBR(Fdelete_file);
3847 DEFSUBR(Frename_file);
3848 DEFSUBR(Fadd_name_to_file);
3849 DEFSUBR(Fmake_symbolic_link);
3851 DEFSUBR(Fsysnetunam);
3852 #endif /* HPUX_NET */
3853 DEFSUBR(Ffile_name_absolute_p);
3854 DEFSUBR(Ffile_exists_p);
3855 DEFSUBR(Ffile_executable_p);
3856 DEFSUBR(Ffile_readable_p);
3857 DEFSUBR(Ffile_writable_p);
3858 DEFSUBR(Ffile_symlink_p);
3859 DEFSUBR(Ffile_directory_p);
3860 DEFSUBR(Ffile_accessible_directory_p);
3861 DEFSUBR(Ffile_regular_p);
3862 DEFSUBR(Ffile_modes);
3863 DEFSUBR(Fset_file_modes);
3864 DEFSUBR(Fset_default_file_modes);
3865 DEFSUBR(Fdefault_file_modes);
3866 DEFSUBR(Funix_sync);
3867 DEFSUBR(Ffile_newer_than_file_p);
3868 DEFSUBR(Finsert_file_contents_internal);
3869 DEFSUBR(Fwrite_region_internal);
3870 DEFSUBR(Fcar_less_than_car); /* Vomitous! */
3871 DEFSUBR(Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
3872 DEFSUBR(Fverify_visited_file_modtime);
3873 DEFSUBR(Fclear_visited_file_modtime);
3874 DEFSUBR(Fvisited_file_modtime);
3875 DEFSUBR(Fset_visited_file_modtime);
3877 DEFSUBR(Fdo_auto_save);
3878 DEFSUBR(Fset_buffer_auto_saved);
3879 DEFSUBR(Fclear_buffer_auto_save_failure);
3880 DEFSUBR(Frecent_auto_save_p);
3883 void vars_of_fileio(void)
3885 DEFVAR_LISP("auto-save-file-format", &Vauto_save_file_format /*
3886 *Format in which to write auto-save files.
3887 Should be a list of symbols naming formats that are defined in `format-alist'.
3888 If it is t, which is the default, auto-save files are written in the
3889 same format as a regular save would use.
3891 Vauto_save_file_format = Qt;
3893 DEFVAR_LISP("file-name-handler-alist", &Vfile_name_handler_alist /*
3894 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
3895 If a file name matches REGEXP, then all I/O on that file is done by calling
3898 The first argument given to HANDLER is the name of the I/O primitive
3899 to be handled; the remaining arguments are the arguments that were
3900 passed to that primitive. For example, if you do
3901 (file-exists-p FILENAME)
3902 and FILENAME is handled by HANDLER, then HANDLER is called like this:
3903 (funcall HANDLER 'file-exists-p FILENAME)
3904 The function `find-file-name-handler' checks this list for a handler
3907 Vfile_name_handler_alist = Qnil;
3909 DEFVAR_LISP("after-insert-file-functions", &Vafter_insert_file_functions /*
3910 A list of functions to be called at the end of `insert-file-contents'.
3911 Each is passed one argument, the number of bytes inserted. It should return
3912 the new byte count, and leave point the same. If `insert-file-contents' is
3913 intercepted by a handler from `file-name-handler-alist', that handler is
3914 responsible for calling the after-insert-file-functions if appropriate.
3916 Vafter_insert_file_functions = Qnil;
3918 DEFVAR_LISP("write-region-annotate-functions", &Vwrite_region_annotate_functions /*
3919 A list of functions to be called at the start of `write-region'.
3920 Each is passed two arguments, START and END, as for `write-region'.
3921 It should return a list of pairs (POSITION . STRING) of strings to be
3922 effectively inserted at the specified positions of the file being written
3923 \(1 means to insert before the first byte written). The POSITIONs must be
3924 sorted into increasing order. If there are several functions in the list,
3925 the several lists are merged destructively.
3927 Vwrite_region_annotate_functions = Qnil;
3929 DEFVAR_LISP("write-region-annotations-so-far", &Vwrite_region_annotations_so_far /*
3930 When an annotation function is called, this holds the previous annotations.
3931 These are the annotations made by other annotation functions
3932 that were already called. See also `write-region-annotate-functions'.
3934 Vwrite_region_annotations_so_far = Qnil;
3936 DEFVAR_LISP("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
3937 A list of file name handlers that temporarily should not be used.
3938 This applies only to the operation `inhibit-file-name-operation'.
3940 Vinhibit_file_name_handlers = Qnil;
3942 DEFVAR_LISP("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
3943 The operation for which `inhibit-file-name-handlers' is applicable.
3945 Vinhibit_file_name_operation = Qnil;
3947 DEFVAR_LISP("auto-save-list-file-name", &Vauto_save_list_file_name /*
3948 File name in which we write a list of all auto save file names.
3950 Vauto_save_list_file_name = Qnil;
3952 DEFVAR_LISP("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
3953 Prefix for generating auto-save-list-file-name.
3954 Emacs's pid and the system name will be appended to
3955 this prefix to create a unique file name.
3957 Vauto_save_list_file_prefix = build_string("~/.saves-");
3959 DEFVAR_BOOL("inhibit-auto-save-session", &inhibit_auto_save_session /*
3960 When non-nil, inhibit auto save list file creation.
3962 inhibit_auto_save_session = 0;
3964 DEFVAR_BOOL("disable-auto-save-when-buffer-shrinks", &disable_auto_save_when_buffer_shrinks /*
3965 If non-nil, auto-saving is disabled when a buffer shrinks too much.
3966 This is to prevent you from losing your edits if you accidentally
3967 delete a large chunk of the buffer and don't notice it until too late.
3968 Saving the buffer normally turns auto-save back on.
3970 disable_auto_save_when_buffer_shrinks = 1;
3972 DEFVAR_LISP("directory-sep-char", &Vdirectory_sep_char /*
3973 Directory separator character for built-in functions that return file names.
3974 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
3975 This variable affects the built-in functions only on Windows,
3976 on other platforms, it is initialized so that Lisp code can find out
3977 what the normal separator is.
3979 Vdirectory_sep_char = make_char('/');
3981 reinit_vars_of_fileio();
3984 void reinit_vars_of_fileio(void)
3986 /* We want temp_name_rand to be initialized to a value likely to be
3987 unique to the process, not to the executable. The danger is that
3988 two different SXEmacs processes using the same binary on different
3989 machines creating temp files in the same directory will be
3990 unlucky enough to have the same pid. If we randomize using
3991 process startup time, then in practice they will be unlikely to
3992 collide. We use the microseconds field so that scripts that start
3993 simultaneous SXEmacs processes on multiple machines will have less
3994 chance of collision. */
3998 EMACS_GET_TIME(thyme);
4000 (unsigned int)(EMACS_SECS(thyme) ^ EMACS_USECS(thyme));