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);
1625 DEFUN("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1626 Create a directory. One argument, a file name string.
1630 /* This function can GC. GC checked 1997.04.06. */
1631 char dir[MAXPATHLEN];
1632 Lisp_Object handler;
1633 struct gcpro gcpro1;
1635 CHECK_STRING(dirname_);
1636 dirname_ = Fexpand_file_name(dirname_, Qnil);
1639 handler = Ffind_file_name_handler(dirname_, Qmake_directory_internal);
1642 return (call2(handler, Qmake_directory_internal, dirname_));
1644 if (XSTRING_LENGTH(dirname_) > (Bytecount) (sizeof(dir) - 1)) {
1645 return Fsignal(Qfile_error,
1646 list3(build_translated_string
1647 ("Creating directory"),
1648 build_translated_string
1649 ("pathname too long"), dirname_));
1651 strncpy(dir, (char *)XSTRING_DATA(dirname_),
1652 XSTRING_LENGTH(dirname_) + 1);
1653 dir[XSTRING_LENGTH(dirname_)]='\0';
1654 if (dir[XSTRING_LENGTH(dirname_) - 1] == '/')
1655 dir[XSTRING_LENGTH(dirname_) - 1] = '\0';
1657 if (mkdir(dir, 0777) != 0)
1658 report_file_error("Creating directory", list1(dirname_));
1663 DEFUN("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1664 Delete a directory. One argument, a file name or directory name string.
1668 /* This function can GC. GC checked 1997.04.06. */
1669 Lisp_Object handler;
1670 struct gcpro gcpro1;
1672 CHECK_STRING(dirname_);
1675 dirname_ = Fexpand_file_name(dirname_, Qnil);
1676 dirname_ = Fdirectory_file_name(dirname_);
1678 handler = Ffind_file_name_handler(dirname_, Qdelete_directory);
1681 return (call2(handler, Qdelete_directory, dirname_));
1683 if (rmdir((char *)XSTRING_DATA(dirname_)) != 0)
1684 report_file_error("Removing directory", list1(dirname_));
1689 DEFUN("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1690 Delete the file named FILENAME (a string).
1691 If FILENAME has multiple names, it continues to exist with the other names.
1695 /* This function can GC. GC checked 1997.04.06. */
1696 Lisp_Object handler;
1697 struct gcpro gcpro1;
1699 CHECK_STRING(filename);
1700 filename = Fexpand_file_name(filename, Qnil);
1703 handler = Ffind_file_name_handler(filename, Qdelete_file);
1706 return call2(handler, Qdelete_file, filename);
1708 if (0 > unlink((char *)XSTRING_DATA(filename)))
1709 report_file_error("Removing old name", list1(filename));
1714 internal_delete_file_1(Lisp_Object ignore, Lisp_Object ignore2)
1719 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1721 int internal_delete_file(Lisp_Object filename)
1723 /* This function can GC. GC checked 1997.04.06. */
1724 return NILP(condition_case_1(Qt, Fdelete_file, filename,
1725 internal_delete_file_1, Qnil));
1728 DEFUN("rename-file", Frename_file, 2, 3, "fRename file: \nFRename %s to file: \np", /*
1729 Rename FILENAME as NEWNAME. Both args must be strings.
1730 If file has names other than FILENAME, it continues to have those names.
1731 Signals a `file-already-exists' error if a file NEWNAME already exists
1732 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1733 A number as third arg means request confirmation if NEWNAME already exists.
1734 This is what happens in interactive use with M-x.
1736 (filename, newname, ok_if_already_exists))
1738 /* This function can GC. GC checked 1997.04.06. */
1739 Lisp_Object handler;
1740 struct gcpro gcpro1, gcpro2;
1742 GCPRO2(filename, newname);
1743 CHECK_STRING(filename);
1744 CHECK_STRING(newname);
1745 filename = Fexpand_file_name(filename, Qnil);
1746 newname = Fexpand_file_name(newname, Qnil);
1748 /* If the file name has special constructs in it,
1749 call the corresponding file handler. */
1750 handler = Ffind_file_name_handler(filename, Qrename_file);
1752 handler = Ffind_file_name_handler(newname, Qrename_file);
1753 if (!NILP(handler)) {
1755 return call4(handler, Qrename_file,
1756 filename, newname, ok_if_already_exists);
1759 /* When second argument is a directory, rename the file into it.
1760 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1762 if (!NILP(Ffile_directory_p(newname))) {
1763 Lisp_Object args[3] = {newname, Qnil, Qnil};
1764 struct gcpro ngcpro1;
1767 NGCPROn(args, countof(args));
1768 if (XSTRING_BYTE(newname, XSTRING_LENGTH(newname) - 1) != '/') {
1769 args[i++] = build_string("/");
1771 args[i++] = Ffile_name_nondirectory(filename);
1772 newname = Fconcat(i, args);
1776 if (NILP(ok_if_already_exists)
1777 || INTP(ok_if_already_exists))
1778 barf_or_query_if_file_exists(newname, "rename to it",
1779 INTP(ok_if_already_exists), 0);
1781 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1782 WIN32_NATIVE here; I've removed it. --marcpa */
1784 /* We have configure check for rename() and emulate using
1785 link()/unlink() if necessary. */
1786 if (0 > rename((char *)XSTRING_DATA(filename),
1787 (char *)XSTRING_DATA(newname))) {
1788 if (errno == EXDEV) {
1789 Fcopy_file(filename, newname,
1790 /* We have already prompted if it was an integer,
1791 so don't have copy-file prompt again. */
1792 (NILP(ok_if_already_exists) ? Qnil : Qt),
1794 Fdelete_file(filename);
1796 report_file_error("Renaming", list2(filename, newname));
1803 DEFUN("add-name-to-file", Fadd_name_to_file, 2, 3, "fAdd name to file: \nFName to add to %s: \np", /*
1804 Give FILENAME additional name NEWNAME. Both args must be strings.
1805 Signals a `file-already-exists' error if a file NEWNAME already exists
1806 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1807 A number as third arg means request confirmation if NEWNAME already exists.
1808 This is what happens in interactive use with M-x.
1810 (filename, newname, ok_if_already_exists))
1812 /* This function can GC. GC checked 1997.04.06. */
1813 Lisp_Object handler;
1814 struct gcpro gcpro1, gcpro2;
1816 GCPRO2(filename, newname);
1817 CHECK_STRING(filename);
1818 CHECK_STRING(newname);
1819 filename = Fexpand_file_name(filename, Qnil);
1820 newname = Fexpand_file_name(newname, Qnil);
1822 /* If the file name has special constructs in it,
1823 call the corresponding file handler. */
1824 handler = Ffind_file_name_handler(filename, Qadd_name_to_file);
1826 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1827 newname, ok_if_already_exists));
1829 /* If the new name has special constructs in it,
1830 call the corresponding file handler. */
1831 handler = Ffind_file_name_handler(newname, Qadd_name_to_file);
1833 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1834 newname, ok_if_already_exists));
1836 if (NILP(ok_if_already_exists)
1837 || INTP(ok_if_already_exists))
1838 barf_or_query_if_file_exists(newname, "make it a new name",
1839 INTP(ok_if_already_exists), 0);
1840 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
1841 on NT here. --marcpa */
1842 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
1843 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
1844 Reverted to previous behavior pending a working fix. (jhar) */
1846 unlink((char *)XSTRING_DATA(newname));
1847 if (0 > link((char *)XSTRING_DATA(filename),
1848 (char *)XSTRING_DATA(newname))) {
1849 report_file_error("Adding new name", list2(filename, newname));
1856 DEFUN("make-symbolic-link", Fmake_symbolic_link, 2, 3, "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
1857 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
1858 Signals a `file-already-exists' error if a file LINKNAME already exists
1859 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1860 A number as third arg means request confirmation if LINKNAME already exists.
1861 This happens for interactive use with M-x.
1863 (filename, linkname, ok_if_already_exists))
1865 /* This function can GC. GC checked 1997.06.04. */
1866 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
1867 Lisp_Object handler;
1868 struct gcpro gcpro1, gcpro2;
1870 GCPRO2(filename, linkname);
1871 CHECK_STRING(filename);
1872 CHECK_STRING(linkname);
1873 /* If the link target has a ~, we must expand it to get
1874 a truly valid file name. Otherwise, do not expand;
1875 we want to permit links to relative file names. */
1876 if (XSTRING_BYTE(filename, 0) == '~')
1877 filename = Fexpand_file_name(filename, Qnil);
1878 linkname = Fexpand_file_name(linkname, Qnil);
1880 /* If the file name has special constructs in it,
1881 call the corresponding file handler. */
1882 handler = Ffind_file_name_handler(filename, Qmake_symbolic_link);
1884 RETURN_UNGCPRO(call4
1885 (handler, Qmake_symbolic_link, filename,
1886 linkname, ok_if_already_exists));
1888 /* If the new link name has special constructs in it,
1889 call the corresponding file handler. */
1890 handler = Ffind_file_name_handler(linkname, Qmake_symbolic_link);
1892 RETURN_UNGCPRO(call4(handler, Qmake_symbolic_link, filename,
1893 linkname, ok_if_already_exists));
1896 if (NILP(ok_if_already_exists)
1897 || INTP(ok_if_already_exists))
1898 barf_or_query_if_file_exists(linkname, "make it a link",
1899 INTP(ok_if_already_exists), 0);
1901 unlink((char *)XSTRING_DATA(linkname));
1902 if (0 > symlink((char *)XSTRING_DATA(filename),
1903 (char *)XSTRING_DATA(linkname))) {
1904 report_file_error("Making symbolic link",
1905 list2(filename, linkname));
1907 #endif /* S_IFLNK */
1915 DEFUN("sysnetunam", Fsysnetunam, 2, 2, 0, /*
1916 Open a network connection to PATH using LOGIN as the login string.
1921 const char *path_ext;
1922 const char *login_ext;
1925 CHECK_STRING(login);
1927 /* netunam, being a strange-o system call only used once, is not
1930 LISP_STRING_TO_EXTERNAL(path, path_ext, Qfile_name);
1931 LISP_STRING_TO_EXTERNAL(login, login_ext, Qnative);
1933 netresult = netunam(path_ext, login_ext);
1935 return netresult == -1 ? Qnil : Qt;
1937 #endif /* HPUX_NET */
1939 DEFUN("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
1940 Return t if file FILENAME specifies an absolute path name.
1941 On Unix, this is a name starting with a `/' or a `~'.
1945 /* This function does not GC */
1948 CHECK_STRING(filename);
1949 ptr = XSTRING_DATA(filename);
1950 return (IS_DIRECTORY_SEP(*ptr) || *ptr == '~'
1954 /* Return nonzero if file FILENAME exists and can be executed. */
1956 static int check_executable(char *filename)
1959 return eaccess(filename, X_OK) >= 0;
1961 /* Access isn't quite right because it uses the real uid
1962 and we really want to test with the effective uid.
1963 But Unix doesn't give us a right way to do it. */
1964 return access(filename, X_OK) >= 0;
1965 #endif /* HAVE_EACCESS */
1968 /* Return nonzero if file FILENAME exists and can be written. */
1970 static int check_writable(const char *filename)
1973 return (eaccess(filename, W_OK) >= 0);
1975 /* Access isn't quite right because it uses the real uid
1976 and we really want to test with the effective uid.
1977 But Unix doesn't give us a right way to do it.
1978 Opening with O_WRONLY could work for an ordinary file,
1979 but would lose for directories. */
1980 return (access(filename, W_OK) >= 0);
1984 DEFUN("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
1985 Return t if file FILENAME exists. (This does not mean you can read it.)
1986 See also `file-readable-p' and `file-attributes'.
1990 /* This function can call lisp; GC checked 2000-07-11 ben */
1991 Lisp_Object abspath;
1992 Lisp_Object handler;
1993 struct stat statbuf;
1994 struct gcpro gcpro1;
1996 CHECK_STRING(filename);
1997 abspath = Fexpand_file_name(filename, Qnil);
1999 /* If the file name has special constructs in it,
2000 call the corresponding file handler. */
2002 handler = Ffind_file_name_handler(abspath, Qfile_exists_p);
2005 return call2(handler, Qfile_exists_p, abspath);
2007 return sxemacs_stat((char *)XSTRING_DATA(abspath),
2008 &statbuf) >= 0 ? Qt : Qnil;
2011 DEFUN("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2012 Return t if FILENAME can be executed by you.
2013 For a directory, this means you can access files in that directory.
2017 /* This function can GC. GC checked 07-11-2000 ben. */
2018 Lisp_Object abspath;
2019 Lisp_Object handler;
2020 struct gcpro gcpro1;
2022 CHECK_STRING(filename);
2023 abspath = Fexpand_file_name(filename, Qnil);
2025 /* If the file name has special constructs in it,
2026 call the corresponding file handler. */
2028 handler = Ffind_file_name_handler(abspath, Qfile_executable_p);
2031 return call2(handler, Qfile_executable_p, abspath);
2033 return check_executable((char *)XSTRING_DATA(abspath)) ? Qt : Qnil;
2036 DEFUN("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2037 Return t if file FILENAME exists and you can read it.
2038 See also `file-exists-p' and `file-attributes'.
2042 /* This function can GC */
2043 Lisp_Object abspath = Qnil;
2044 Lisp_Object handler;
2045 struct gcpro gcpro1;
2048 CHECK_STRING(filename);
2049 abspath = Fexpand_file_name(filename, Qnil);
2051 /* If the file name has special constructs in it,
2052 call the corresponding file handler. */
2053 handler = Ffind_file_name_handler(abspath, Qfile_readable_p);
2055 RETURN_UNGCPRO(call2(handler, Qfile_readable_p, abspath));
2059 interruptible_open((char *)XSTRING_DATA(abspath),
2060 O_RDONLY | OPEN_BINARY, 0);
2069 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2071 DEFUN("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2072 Return t if file FILENAME can be written or created by you.
2076 /* This function can GC. GC checked 1997.04.10. */
2077 Lisp_Object abspath, dir;
2078 Lisp_Object handler;
2079 struct stat statbuf;
2080 struct gcpro gcpro1;
2082 CHECK_STRING(filename);
2083 abspath = Fexpand_file_name(filename, Qnil);
2085 /* If the file name has special constructs in it,
2086 call the corresponding file handler. */
2088 handler = Ffind_file_name_handler(abspath, Qfile_writable_p);
2091 return call2(handler, Qfile_writable_p, abspath);
2093 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &statbuf) >= 0)
2094 return (check_writable((char *)XSTRING_DATA(abspath))
2098 dir = Ffile_name_directory(abspath);
2100 return (check_writable(!NILP(dir) ? (char *)XSTRING_DATA(dir)
2105 DEFUN("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2106 Return non-nil if file FILENAME is the name of a symbolic link.
2107 The value is the name of the file to which it is linked.
2108 Otherwise returns nil.
2112 /* This function can GC. GC checked 1997.04.10. */
2113 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2120 Lisp_Object handler;
2121 struct gcpro gcpro1;
2123 CHECK_STRING(filename);
2124 filename = Fexpand_file_name(filename, Qnil);
2126 /* If the file name has special constructs in it,
2127 call the corresponding file handler. */
2129 handler = Ffind_file_name_handler(filename, Qfile_symlink_p);
2131 if (!NILP(handler)) {
2132 return call2(handler, Qfile_symlink_p, filename);
2137 buf = ynew_array_and_zero(char, bufsize);
2138 valsize = readlink((char *)XSTRING_DATA(filename),
2140 if (valsize < bufsize) {
2143 /* Buffer was not long enough */
2147 if (valsize == -1) {
2151 val = make_string((Bufbyte*)buf, valsize);
2154 #else /* not S_IFLNK */
2156 #endif /* not S_IFLNK */
2159 DEFUN("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2160 Return t if file FILENAME is the name of a directory as a file.
2161 A directory name spec may be given instead; then the value is t
2162 if the directory so specified exists and really is a directory.
2166 /* This function can GC. GC checked 1997.04.10. */
2167 Lisp_Object abspath;
2169 Lisp_Object handler;
2170 struct gcpro gcpro1;
2172 GCPRO1(current_buffer->directory);
2173 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2176 /* If the file name has special constructs in it,
2177 call the corresponding file handler. */
2179 handler = Ffind_file_name_handler(abspath, Qfile_directory_p);
2182 return call2(handler, Qfile_directory_p, abspath);
2184 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2186 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2189 DEFUN("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2190 Return t if file FILENAME is the name of a directory as a file,
2191 and files in that directory can be opened by you. In order to use a
2192 directory as a buffer's current directory, this predicate must return true.
2193 A directory name spec may be given instead; then the value is t
2194 if the directory so specified exists and really is a readable and
2195 searchable directory.
2199 /* This function can GC. GC checked 1997.04.10. */
2200 Lisp_Object handler;
2202 /* If the file name has special constructs in it,
2203 call the corresponding file handler. */
2205 Ffind_file_name_handler(filename, Qfile_accessible_directory_p);
2207 return call2(handler, Qfile_accessible_directory_p, filename);
2209 if (NILP(Ffile_directory_p(filename)))
2212 return Ffile_executable_p(filename);
2215 DEFUN("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2216 Return t if file FILENAME is the name of a regular file.
2217 This is the sort of file that holds an ordinary stream of data bytes.
2221 /* This function can GC. GC checked 1997.04.10. */
2222 Lisp_Object abspath;
2224 Lisp_Object handler;
2225 struct gcpro gcpro1;
2227 GCPRO1(current_buffer->directory);
2228 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2231 /* If the file name has special constructs in it,
2232 call the corresponding file handler. */
2234 handler = Ffind_file_name_handler(abspath, Qfile_regular_p);
2237 return call2(handler, Qfile_regular_p, abspath);
2239 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2241 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2244 DEFUN("file-modes", Ffile_modes, 1, 1, 0, /*
2245 Return mode bits of file named FILENAME, as an integer.
2249 /* This function can GC. GC checked 1997.04.10. */
2250 Lisp_Object abspath;
2252 Lisp_Object handler;
2253 struct gcpro gcpro1;
2255 GCPRO1(current_buffer->directory);
2256 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2259 /* If the file name has special constructs in it,
2260 call the corresponding file handler. */
2262 handler = Ffind_file_name_handler(abspath, Qfile_modes);
2265 return call2(handler, Qfile_modes, abspath);
2267 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2269 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2271 return make_int(st.st_mode & 07777);
2274 DEFUN("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2275 Set mode bits of file named FILENAME to MODE (an integer).
2276 Only the 12 low bits of MODE are used.
2280 /* This function can GC. GC checked 1997.04.10. */
2281 Lisp_Object abspath;
2282 Lisp_Object handler;
2283 struct gcpro gcpro1;
2285 GCPRO1(current_buffer->directory);
2286 abspath = Fexpand_file_name(filename, current_buffer->directory);
2291 /* If the file name has special constructs in it,
2292 call the corresponding file handler. */
2294 handler = Ffind_file_name_handler(abspath, Qset_file_modes);
2297 return call3(handler, Qset_file_modes, abspath, mode);
2299 if (chmod((char *)XSTRING_DATA(abspath), XINT(mode)) < 0)
2300 report_file_error("Doing chmod", list1(abspath));
2305 DEFUN("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2306 Set the file permission bits for newly created files.
2307 The argument MODE should be an integer; if a bit in MODE is 1,
2308 subsequently created files will not have the permission corresponding
2309 to that bit enabled. Only the low 9 bits are used.
2310 This setting is inherited by subprocesses.
2316 umask((~XINT(mode)) & 0777);
2321 DEFUN("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2322 Return the default file protection for created files.
2323 The umask value determines which permissions are enabled in newly
2324 created files. If a permission's bit in the umask is 1, subsequently
2325 created files will not have that permission enabled.
2334 return make_int((~mode) & 0777);
2337 DEFUN("unix-sync", Funix_sync, 0, 0, "", /*
2338 Tell Unix to finish all pending disk updates.
2346 DEFUN("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2347 Return t if file FILE1 is newer than file FILE2.
2348 If FILE1 does not exist, the answer is nil;
2349 otherwise, if FILE2 does not exist, the answer is t.
2353 /* This function can GC. GC checked 1997.04.10. */
2354 Lisp_Object abspath1, abspath2;
2357 Lisp_Object handler;
2358 struct gcpro gcpro1, gcpro2, gcpro3;
2360 CHECK_STRING(file1);
2361 CHECK_STRING(file2);
2366 GCPRO3(abspath1, abspath2, current_buffer->directory);
2367 abspath1 = expand_and_dir_to_file(file1, current_buffer->directory);
2368 abspath2 = expand_and_dir_to_file(file2, current_buffer->directory);
2370 /* If the file name has special constructs in it,
2371 call the corresponding file handler. */
2372 handler = Ffind_file_name_handler(abspath1, Qfile_newer_than_file_p);
2375 Ffind_file_name_handler(abspath2, Qfile_newer_than_file_p);
2378 return call3(handler, Qfile_newer_than_file_p, abspath1,
2381 if (sxemacs_stat((char *)XSTRING_DATA(abspath1), &st) < 0)
2384 mtime1 = st.st_mtime;
2386 if (sxemacs_stat((char *)XSTRING_DATA(abspath2), &st) < 0)
2389 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2392 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2393 /* #define READ_BUF_SIZE (2 << 16) */
2394 #define READ_BUF_SIZE (1 << 15)
2396 DEFUN("insert-file-contents-internal", Finsert_file_contents_internal, 1, 7, 0, /*
2397 Insert contents of file FILENAME after point; no coding-system frobbing.
2398 This function is identical to `insert-file-contents' except for the
2399 handling of the CODESYS and USED-CODESYS arguments under
2400 SXEmacs/Mule. (When Mule support is not present, both functions are
2401 identical and ignore the CODESYS and USED-CODESYS arguments.)
2403 If support for Mule exists in this Emacs, the file is decoded according
2404 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2405 it should be a symbol, and the actual coding system that was used for the
2406 decoding is stored into it. It will in general be different from CODESYS
2407 if CODESYS specifies automatic encoding detection or end-of-line detection.
2409 Currently START and END refer to byte positions (as opposed to character
2410 positions), even in Mule. (Fixing this is very difficult.)
2412 (filename, visit, start, end, replace, codesys, used_codesys))
2414 /* This function can call lisp */
2418 Charcount inserted = 0;
2420 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2421 Lisp_Object handler = Qnil, val = Qnil;
2423 Bufbyte read_buf[READ_BUF_SIZE];
2425 struct buffer *buf = current_buffer;
2427 int not_regular = 0;
2429 if (UNLIKELY(buf->base_buffer && !NILP(visit))) {
2430 error("Cannot do file visiting in an indirect buffer");
2433 /* No need to call Fbarf_if_buffer_read_only() here.
2434 That's called in begin_multiple_change() or wherever. */
2435 /* #### dmoore - should probably check in various places to see if
2436 curbuf was killed and if so signal an error? */
2437 XSETBUFFER(curbuf, buf);
2439 GCPRO5(filename, val, visit, handler, curbuf);
2441 if (LIKELY(NILP(replace))) {
2442 mc_count = begin_multiple_change(buf, BUF_PT(buf), BUF_PT(buf));
2444 mc_count = begin_multiple_change(buf, BUF_BEG(buf), BUF_Z(buf));
2447 /* begin_multiple_change also adds an unwind_protect */
2448 speccount = specpdl_depth();
2450 filename = Fexpand_file_name(filename, Qnil);
2452 /* If the file name has special constructs in it,
2453 call the corresponding file handler. */
2454 handler = Ffind_file_name_handler(filename, Qinsert_file_contents);
2455 if (!NILP(handler)) {
2456 val = call6(handler, Qinsert_file_contents, filename,
2457 visit, start, end, replace);
2461 if (!NILP(used_codesys))
2462 CHECK_SYMBOL(used_codesys);
2465 if ((!NILP(start) || !NILP(end)) && !NILP(visit))
2466 error("Attempt to visit less than an entire file");
2470 if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) < 0) {
2475 report_file_error("Opening input file",
2481 /* Signal an error if we are accessing a non-regular file, with
2482 REPLACE, START or END being non-nil. */
2483 if (!S_ISREG(st.st_mode)) {
2489 if (!NILP(replace) || !NILP(start) || !NILP(end)) {
2490 end_multiple_change(buf, mc_count);
2493 (Fsignal(Qfile_error,
2494 list2(build_translated_string
2495 ("not a regular file"), filename)));
2498 #endif /* S_IFREG */
2509 if ((fd = interruptible_open((char *)XSTRING_DATA(filename),
2510 O_RDONLY | OPEN_BINARY, 0)) < 0)
2514 /* Replacement should preserve point as it preserves markers. */
2516 record_unwind_protect(restore_point_unwind,
2517 Fpoint_marker(Qnil, Qnil));
2519 record_unwind_protect(close_file_unwind, make_int(fd));
2521 /* Supposedly happens on VMS. */
2523 error("File size is negative");
2527 end = make_int(st.st_size);
2528 if (XINT(end) != st.st_size)
2529 error("Maximum buffer size exceeded");
2533 /* If requested, replace the accessible part of the buffer
2534 with the file contents. Avoid replacing text at the
2535 beginning or end of the buffer that matches the file contents;
2536 that preserves markers pointing to the unchanged parts. */
2537 #if !defined (FILE_CODING)
2538 /* The replace-mode code currently only works when the assumption
2539 'one byte == one char' holds true. This fails Mule because
2540 files may contain multibyte characters. It holds under Windows NT
2541 provided we convert CRLF into LF. */
2542 # define FSFMACS_SPEEDY_INSERT
2543 #endif /* !defined (FILE_CODING) */
2545 #ifndef FSFMACS_SPEEDY_INSERT
2546 if (!NILP(replace)) {
2547 buffer_delete_range(buf, BUF_BEG(buf), BUF_Z(buf),
2548 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2550 #else /* FSFMACS_SPEEDY_INSERT */
2551 if (!NILP(replace)) {
2552 char buffer[1 << 14];
2553 Bufpos same_at_start = BUF_BEGV(buf);
2554 Bufpos same_at_end = BUF_ZV(buf);
2557 /* Count how many chars at the start of the file
2558 match the text at the beginning of the buffer. */
2562 nread = read_allowing_quit(fd, buffer, sizeof buffer);
2564 error("IO error reading %s: %s",
2565 XSTRING_DATA(filename), strerror(errno));
2566 else if (nread == 0)
2569 while (bufpos < nread && same_at_start < BUF_ZV(buf)
2570 && BUF_FETCH_CHAR(buf,
2573 same_at_start++, bufpos++;
2574 /* If we found a discrepancy, stop the scan.
2575 Otherwise loop around and scan the next bufferful. */
2576 if (bufpos != nread)
2579 /* If the file matches the buffer completely,
2580 there's no need to replace anything. */
2581 if (same_at_start - BUF_BEGV(buf) == st.st_size) {
2583 unbind_to(speccount, Qnil);
2584 /* Truncate the buffer to the size of the file. */
2585 buffer_delete_range(buf, same_at_start, same_at_end,
2586 !NILP(visit) ? INSDEL_NO_LOCKING :
2590 /* Count how many chars at the end of the file
2591 match the text at the end of the buffer. */
2593 int total_read, nread;
2594 Bufpos bufpos, curpos, trial;
2596 /* At what file position are we now scanning? */
2597 curpos = st.st_size - (BUF_ZV(buf) - same_at_end);
2598 /* If the entire file matches the buffer tail, stop the scan. */
2601 /* How much can we scan in the next step? */
2602 trial = min(curpos, (Bufpos) sizeof(buffer));
2603 if (lseek(fd, curpos - trial, 0) < 0)
2604 report_file_error("Setting file position",
2608 while (total_read < trial) {
2610 read_allowing_quit(fd, buffer + total_read,
2611 trial - total_read);
2614 ("IO error reading file",
2616 total_read += nread;
2618 /* Scan this bufferful from the end, comparing with
2619 the Emacs buffer. */
2620 bufpos = total_read;
2621 /* Compare with same_at_start to avoid counting some buffer text
2622 as matching both at the file's beginning and at the end. */
2623 while (bufpos > 0 && same_at_end > same_at_start
2624 && BUF_FETCH_CHAR(buf, same_at_end - 1) ==
2626 same_at_end--, bufpos--;
2627 /* If we found a discrepancy, stop the scan.
2628 Otherwise loop around and scan the preceding bufferful. */
2631 /* If display current starts at beginning of line,
2632 keep it that way. */
2633 if (XBUFFER(XWINDOW(Fselected_window(Qnil))->buffer) ==
2635 XWINDOW(Fselected_window(Qnil))->
2637 !NILP(Fbolp(make_buffer(buf)));
2640 /* Don't try to reuse the same piece of text twice. */
2641 overlap = same_at_start - BUF_BEGV(buf) -
2642 (same_at_end + st.st_size - BUF_ZV(buf));
2644 same_at_end += overlap;
2646 /* Arrange to read only the nonmatching middle part of the file. */
2647 start = make_int(same_at_start - BUF_BEGV(buf));
2648 end = make_int(st.st_size - (BUF_ZV(buf) - same_at_end));
2650 buffer_delete_range(buf, same_at_start, same_at_end,
2651 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2652 /* Insert from the file at the proper position. */
2653 BUF_SET_PT(buf, same_at_start);
2655 #endif /* FSFMACS_SPEEDY_INSERT */
2658 total = XINT(end) - XINT(start);
2660 /* Make sure point-max won't overflow after this insertion. */
2661 if (total != XINT(make_int(total)))
2662 error("Maximum buffer size exceeded");
2664 /* For a special file, all we can do is guess. The value of -1
2665 will make the stream functions read as much as possible. */
2668 if (XINT(start) != 0
2669 #ifdef FSFMACS_SPEEDY_INSERT
2670 /* why was this here? asked jwz. The reason is that the replace-mode
2671 connivings above will normally put the file pointer other than
2672 where it should be. */
2674 #endif /* !FSFMACS_SPEEDY_INSERT */
2676 if (lseek(fd, XINT(start), 0) < 0)
2677 report_file_error("Setting file position",
2682 Bufpos cur_point = BUF_PT(buf);
2683 struct gcpro ngcpro1;
2684 Lisp_Object stream = make_filedesc_input_stream(fd, 0, total,
2688 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2691 stream = make_decoding_input_stream
2692 (XLSTREAM(stream), Fget_coding_system(codesys));
2693 Lstream_set_character_mode(XLSTREAM(stream));
2694 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2696 #endif /* FILE_CODING */
2698 record_unwind_protect(delete_stream_unwind, stream);
2700 /* No need to limit the amount of stuff we attempt to read. (It would
2701 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2702 occurs inside of the filedesc stream. */
2704 Lstream_data_count this_len;
2705 Charcount cc_inserted;
2708 this_len = Lstream_read(XLSTREAM(stream), read_buf,
2711 if (this_len <= 0) {
2718 buffer_insert_raw_string_1(buf, cur_point, read_buf,
2719 this_len, !NILP(visit)
2720 ? INSDEL_NO_LOCKING : 0);
2721 inserted += cc_inserted;
2722 cur_point += cc_inserted;
2725 if (!NILP(used_codesys)) {
2727 decoding_stream_coding_system(XLSTREAM(stream));
2728 Fset(used_codesys, XCODING_SYSTEM_NAME(tmp));
2730 #endif /* FILE_CODING */
2734 /* Close the file/stream */
2735 unbind_to(speccount, Qnil);
2737 if (saverrno != 0) {
2738 error("IO error reading %s: %s",
2739 XSTRING_DATA(filename), strerror(saverrno));
2745 end_multiple_change(buf, mc_count);
2748 if (!EQ(buf->undo_list, Qt))
2749 buf->undo_list = Qnil;
2750 if (NILP(handler)) {
2751 buf->modtime = st.st_mtime;
2752 buf->filename = filename;
2753 /* XEmacs addition: */
2754 /* This function used to be in C, ostensibly so that
2755 it could be called here. But that's just silly.
2756 There's no reason C code can't call out to Lisp
2757 code, and it's a lot cleaner this way. */
2758 /* Note: compute-buffer-file-truename is called for
2759 side-effect! Its return value is intentionally
2761 if (!NILP(Ffboundp(Qcompute_buffer_file_truename)))
2762 call1(Qcompute_buffer_file_truename,
2765 BUF_SAVE_MODIFF(buf) = BUF_MODIFF(buf);
2766 buf->auto_save_modified = BUF_MODIFF(buf);
2767 buf->saved_size = make_int(BUF_SIZE(buf));
2768 #ifdef CLASH_DETECTION
2769 if (NILP(handler)) {
2770 if (!NILP(buf->file_truename))
2771 unlock_file(buf->file_truename);
2772 unlock_file(filename);
2774 #endif /* CLASH_DETECTION */
2776 RETURN_UNGCPRO(Fsignal(Qfile_error,
2778 ("not a regular file"),
2781 /* If visiting nonexistent file, return nil. */
2782 if (buf->modtime == -1)
2783 report_file_error("Opening input file",
2787 /* Decode file format */
2789 Lisp_Object insval = call3(Qformat_decode,
2790 Qnil, make_int(inserted), visit);
2792 inserted = XINT(insval);
2797 struct gcpro ngcpro1;
2800 EXTERNAL_LIST_LOOP(p, Vafter_insert_file_functions) {
2801 Lisp_Object insval = call1(XCAR(p), make_int(inserted));
2802 if (!NILP(insval)) {
2803 CHECK_NATNUM(insval);
2804 inserted = XINT(insval);
2816 return (list2(filename, make_int(inserted)));
2819 static int a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
2820 Lisp_Object * annot);
2821 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end);
2823 /* If build_annotations switched buffers, switch back to BUF.
2824 Kill the temporary buffer that was selected in the meantime. */
2826 static Lisp_Object build_annotations_unwind(Lisp_Object buf)
2830 if (XBUFFER(buf) == current_buffer)
2832 tembuf = Fcurrent_buffer();
2834 Fkill_buffer(tembuf);
2838 DEFUN("write-region-internal", Fwrite_region_internal, 3, 7, "r\nFWrite region to file: ", /*
2839 Write current region into specified file; no coding-system frobbing.
2840 This function is identical to `write-region' except for the handling
2841 of the CODESYS argument under SXEmacs/Mule. (When Mule support is not
2842 present, both functions are identical and ignore the CODESYS argument.)
2843 If support for Mule exists in this Emacs, the file is encoded according
2844 to the value of CODESYS. If this is nil, no code conversion occurs.
2846 As a special kludge to support auto-saving, when START is nil START and
2847 END are set to the beginning and end, respectively, of the buffer,
2848 regardless of any restrictions. Don't use this feature. It is documented
2849 here because write-region handler writers need to be aware of it.
2851 (start, end, filename, append, visit, lockname, codesys))
2853 /* This function can call lisp. GC checked 2000-07-28 ben */
2855 int failure, stat_res;
2858 Lisp_Object fn = Qnil;
2859 int speccount = specpdl_depth();
2860 int visiting_other = STRINGP(visit);
2861 int visiting = (EQ(visit, Qt) || visiting_other);
2862 int quietly = (!visiting && !NILP(visit));
2863 Lisp_Object visit_file = Qnil;
2864 Lisp_Object annotations = Qnil;
2865 struct buffer *given_buffer;
2866 Bufpos start1, end1;
2867 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2868 struct gcpro ngcpro1, ngcpro2;
2871 XSETBUFFER(curbuf, current_buffer);
2873 /* start, end, visit, and append are never modified in this fun
2874 so we don't protect them. */
2875 GCPRO5(visit_file, filename, codesys, lockname, annotations);
2876 NGCPRO2(curbuf, fn);
2878 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
2879 we should signal an error rather than blissfully continuing
2880 along. ARGH, this function is going to lose lose lose. We need
2881 to protect the current_buffer from being destroyed, but the
2882 multiple return points make this a pain in the butt. ]] we do
2883 protect curbuf now. --ben */
2886 codesys = Fget_coding_system(codesys);
2887 #endif /* FILE_CODING */
2889 if (current_buffer->base_buffer && !NILP(visit))
2891 ("Cannot do file visiting in an indirect buffer", curbuf);
2893 if (!NILP(start) && !STRINGP(start))
2894 get_buffer_range_char(current_buffer, start, end, &start1,
2898 Lisp_Object handler;
2901 visit_file = Fexpand_file_name(visit, Qnil);
2903 visit_file = filename;
2904 filename = Fexpand_file_name(filename, Qnil);
2907 lockname = visit_file;
2909 /* We used to UNGCPRO here. BAD! visit_file is used below after
2910 more Lisp calling. */
2911 /* If the file name has special constructs in it,
2912 call the corresponding file handler. */
2913 handler = Ffind_file_name_handler(filename, Qwrite_region);
2914 /* If FILENAME has no handler, see if VISIT has one. */
2915 if (NILP(handler) && STRINGP(visit))
2916 handler = Ffind_file_name_handler(visit, Qwrite_region);
2918 if (!NILP(handler)) {
2920 call8(handler, Qwrite_region, start, end,
2921 filename, append, visit, lockname, codesys);
2923 BUF_SAVE_MODIFF(current_buffer) =
2924 BUF_MODIFF(current_buffer);
2925 current_buffer->saved_size =
2926 make_int(BUF_SIZE(current_buffer));
2927 current_buffer->filename = visit_file;
2928 MARK_MODELINE_CHANGED;
2936 #ifdef CLASH_DETECTION
2938 lock_file(lockname);
2939 #endif /* CLASH_DETECTION */
2941 /* Special kludge to simplify auto-saving. */
2943 start1 = BUF_BEG(current_buffer);
2944 end1 = BUF_Z(current_buffer);
2947 record_unwind_protect(build_annotations_unwind, Fcurrent_buffer());
2949 given_buffer = current_buffer;
2950 annotations = build_annotations(start, end);
2951 if (current_buffer != given_buffer) {
2952 start1 = BUF_BEGV(current_buffer);
2953 end1 = BUF_ZV(current_buffer);
2958 if (!NILP(append)) {
2960 open((char *)XSTRING_DATA(fn), O_WRONLY | OPEN_BINARY, 0);
2963 desc = open((char *)XSTRING_DATA(fn),
2964 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
2965 auto_saving ? auto_save_mode_bits : CREAT_MODE);
2969 #ifdef CLASH_DETECTION
2972 unlock_file(lockname);
2974 #endif /* CLASH_DETECTION */
2975 report_file_error("Opening output file", list1(filename));
2979 Lisp_Object desc_locative = Fcons(make_int(desc), Qnil);
2980 Lisp_Object instream = Qnil, outstream = Qnil;
2981 struct gcpro nngcpro1, nngcpro2;
2982 /* need to gcpro; QUIT could happen out of call to write() */
2983 NNGCPRO2(instream, outstream);
2985 record_unwind_protect(close_file_unwind, desc_locative);
2987 if (!NILP(append)) {
2988 if (lseek(desc, 0, 2) < 0) {
2989 #ifdef CLASH_DETECTION
2991 unlock_file(lockname);
2992 #endif /* CLASH_DETECTION */
2993 report_file_error("Lseek error",
3000 /* Note: I tried increasing the buffering size, along with
3001 various other tricks, but nothing seemed to make much of
3002 a difference in the time it took to save a large file.
3003 (Actually that's not true. With a local disk, changing
3004 the buffer size doesn't seem to make much difference.
3005 With an NFS-mounted disk, it could make a lot of difference
3006 because you're affecting the number of network requests
3007 that need to be made, and there could be a large latency
3008 for each request. So I've increased the buffer size
3010 outstream = make_filedesc_output_stream(desc, 0, -1, 0);
3011 Lstream_set_buffering(XLSTREAM(outstream),
3012 LSTREAM_BLOCKN_BUFFERED, 65536);
3015 make_encoding_output_stream(XLSTREAM(outstream), codesys);
3016 Lstream_set_buffering(XLSTREAM(outstream),
3017 LSTREAM_BLOCKN_BUFFERED, 65536);
3018 #endif /* FILE_CODING */
3019 if (STRINGP(start)) {
3020 instream = make_lisp_string_input_stream(start, 0, -1);
3024 make_lisp_buffer_input_stream(current_buffer,
3027 LSTR_IGNORE_ACCESSIBLE);
3029 (0 > (a_write(outstream, instream, start1, &annotations)));
3031 /* Note that this doesn't close the desc since we created the
3032 stream without the LSTR_CLOSING flag, but it does
3033 flush out any buffered data. */
3034 if (Lstream_close(XLSTREAM(outstream)) < 0) {
3038 Lstream_close(XLSTREAM(instream));
3041 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3042 Disk full in NFS may be reported here. */
3043 /* mib says that closing the file will try to write as fast as NFS can do
3044 it, and that means the fsync here is not crucial for autosave files. */
3045 if (!auto_saving && fsync(desc) < 0
3046 /* If fsync fails with EINTR, don't treat that as serious. */
3047 && errno != EINTR) {
3051 #endif /* HAVE_FSYNC */
3053 /* Spurious "file has changed on disk" warnings used to be seen on
3054 systems where close() can change the modtime. This is known to
3055 happen on various NFS file systems, on Windows, and on Linux.
3056 Rather than handling this on a per-system basis, we
3057 unconditionally do the sxemacs_stat() after the close(). */
3059 /* NFS can report a write failure now. */
3060 if (close(desc) < 0) {
3065 /* Discard the close unwind-protect. Execute the one for
3066 build_annotations (switches back to the original current buffer
3068 XCAR(desc_locative) = Qnil;
3069 unbind_to(speccount, Qnil);
3074 stat_res = sxemacs_stat((char *)XSTRING_DATA(fn), &st);
3076 #ifdef CLASH_DETECTION
3078 unlock_file(lockname);
3079 #endif /* CLASH_DETECTION */
3081 /* Do this before reporting IO error
3082 to avoid a "file has changed on disk" warning on
3083 next attempt to save. */
3086 current_buffer->modtime = st.st_mtime;
3088 If sxemacs_stat failed, we have bigger problems, and
3089 most likely the file is gone, so the error next time is
3095 report_file_error("Writing file", list1(fn));
3099 BUF_SAVE_MODIFF(current_buffer) = BUF_MODIFF(current_buffer);
3100 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3101 current_buffer->filename = visit_file;
3102 MARK_MODELINE_CHANGED;
3103 } else if (quietly) {
3111 message("Wrote %s", XSTRING_DATA(visit_file));
3113 Lisp_Object fsp = Qnil;
3114 struct gcpro nngcpro1;
3117 fsp = Ffile_symlink_p(fn);
3119 message("Wrote %s", XSTRING_DATA(fn));
3121 message("Wrote %s (symlink to %s)",
3122 XSTRING_DATA(fn), XSTRING_DATA(fsp));
3131 /* #### This is such a load of shit!!!! There is no way we should define
3132 something so stupid as a subr, just sort the fucking list more
3134 DEFUN("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3135 Return t if (car A) is numerically less than (car B).
3139 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcar(a), Fcar(b)))
3145 /* Heh heh heh, let's define this too, just to aggravate the person who
3146 wrote the above comment. */
3147 DEFUN("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3148 Return t if (cdr A) is numerically less than (cdr B).
3152 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcdr(a), Fcdr(b)))
3158 /* Build the complete list of annotations appropriate for writing out
3159 the text between START and END, by calling all the functions in
3160 write-region-annotate-functions and merging the lists they return.
3161 If one of these functions switches to a different buffer, we assume
3162 that buffer contains altered text. Therefore, the caller must
3163 make sure to restore the current buffer in all cases,
3164 as save-excursion would do. */
3166 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end)
3168 /* This function can GC */
3169 Lisp_Object annotations;
3171 struct gcpro gcpro1, gcpro2;
3172 Lisp_Object original_buffer;
3174 XSETBUFFER(original_buffer, current_buffer);
3177 p = Vwrite_region_annotate_functions;
3178 GCPRO2(annotations, p);
3180 struct buffer *given_buffer = current_buffer;
3181 Vwrite_region_annotations_so_far = annotations;
3182 res = call2(Fcar(p), start, end);
3183 /* If the function makes a different buffer current,
3184 assume that means this buffer contains altered text to be output.
3185 Reset START and END from the buffer bounds
3186 and discard all previous annotations because they should have
3187 been dealt with by this function. */
3188 if (current_buffer != given_buffer) {
3189 start = make_int(BUF_BEGV(current_buffer));
3190 end = make_int(BUF_ZV(current_buffer));
3193 Flength(res); /* Check basic validity of return value */
3194 annotations = merge(annotations, res, Qcar_less_than_car);
3198 /* Now do the same for annotation functions implied by the file-format */
3199 if (auto_saving && (!EQ(Vauto_save_file_format, Qt)))
3200 p = Vauto_save_file_format;
3202 p = current_buffer->file_format;
3204 struct buffer *given_buffer = current_buffer;
3205 Vwrite_region_annotations_so_far = annotations;
3206 res = call4(Qformat_annotate_function, Fcar(p), start, end,
3208 if (current_buffer != given_buffer) {
3209 start = make_int(BUF_BEGV(current_buffer));
3210 end = make_int(BUF_ZV(current_buffer));
3214 annotations = merge(annotations, res, Qcar_less_than_car);
3221 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3222 EOF is encountered), assuming they start at position POS in the buffer
3223 of string that STREAM refers to. Intersperse with them the annotations
3224 from *ANNOT that fall into the range of positions we are reading from,
3225 each at its appropriate position.
3227 Modify *ANNOT by discarding elements as we output them.
3228 The return value is negative in case of system call failure. */
3230 /* 4K should probably be fine. We just need to reduce the number of
3231 function calls to reasonable level. The Lstream stuff itself will
3232 batch to 64K to reduce the number of system calls. */
3234 #define A_WRITE_BATCH_SIZE 4096
3237 a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
3238 Lisp_Object * annot)
3242 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3243 Lstream *instr = XLSTREAM(instream);
3244 Lstream *outstr = XLSTREAM(outstream);
3246 while (LISTP(*annot)) {
3247 tem = Fcar_safe(Fcar(*annot));
3249 nextpos = XINT(tem);
3253 /* If there are annotations left and we have Mule, then we
3254 have to do the I/O one emchar at a time so we can
3255 determine when to insert the annotation. */
3256 if (!NILP(*annot)) {
3258 while (pos != nextpos
3259 && (ch = Lstream_get_emchar(instr)) != EOF) {
3260 if (Lstream_put_emchar(outstr, ch) < 0)
3267 while (pos != nextpos) {
3268 /* Otherwise there is no point to that. Just go in batches. */
3270 min(nextpos - pos, A_WRITE_BATCH_SIZE);
3272 chunk = Lstream_read(instr, largebuf, chunk);
3275 if (chunk == 0) /* EOF */
3277 if (Lstream_write(outstr, largebuf, chunk) <
3283 if (pos == nextpos) {
3284 tem = Fcdr(Fcar(*annot));
3286 if (Lstream_write(outstr, XSTRING_DATA(tem),
3287 XSTRING_LENGTH(tem)) < 0)
3290 *annot = Fcdr(*annot);
3297 DEFUN("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3298 Return t if last mod time of BUFFER's visited file matches what BUFFER records.
3299 This means that the file has not been changed since it was visited or saved.
3303 /* This function can call lisp; GC checked 2000-07-11 ben */
3306 Lisp_Object handler;
3308 CHECK_BUFFER(buffer);
3309 b = XBUFFER(buffer);
3311 if (!STRINGP(b->filename))
3313 if (b->modtime == 0)
3316 /* If the file name has special constructs in it,
3317 call the corresponding file handler. */
3318 handler = Ffind_file_name_handler(b->filename,
3319 Qverify_visited_file_modtime);
3321 return call2(handler, Qverify_visited_file_modtime, buffer);
3323 if (sxemacs_stat((char *)XSTRING_DATA(b->filename), &st) < 0) {
3324 /* If the file doesn't exist now and didn't exist before,
3325 we say that it isn't modified, provided the error is a tame one. */
3326 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3331 if (st.st_mtime == b->modtime
3332 /* If both are positive, accept them if they are off by one second. */
3333 || (st.st_mtime > 0 && b->modtime > 0
3334 && (st.st_mtime == b->modtime + 1
3335 || st.st_mtime == b->modtime - 1)))
3340 DEFUN("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3341 Clear out records of last mod time of visited file.
3342 Next attempt to save will certainly not complain of a discrepancy.
3346 current_buffer->modtime = 0;
3350 DEFUN("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3351 Return the current buffer's recorded visited file modification time.
3352 The value is a list of the form (HIGH . LOW), like the time values
3353 that `file-attributes' returns.
3357 return time_to_lisp((time_t) current_buffer->modtime);
3360 DEFUN("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3361 Update buffer's recorded modification time from the visited file's time.
3362 Useful if the buffer was not read from the file normally
3363 or if the file itself has been changed for some known benign reason.
3364 An argument specifies the modification time value to use
3365 \(instead of that of the visited file), in the form of a list
3366 \(HIGH . LOW) or (HIGH LOW).
3370 /* This function can call lisp */
3371 if (!NILP(time_list)) {
3373 lisp_to_time(time_list, &the_time);
3374 current_buffer->modtime = (int)the_time;
3376 Lisp_Object filename = Qnil;
3378 Lisp_Object handler;
3379 struct gcpro gcpro1, gcpro2, gcpro3;
3381 GCPRO3(filename, time_list, current_buffer->filename);
3382 filename = Fexpand_file_name(current_buffer->filename, Qnil);
3384 /* If the file name has special constructs in it,
3385 call the corresponding file handler. */
3387 Ffind_file_name_handler(filename,
3388 Qset_visited_file_modtime);
3391 /* The handler can find the file name the same way we did. */
3392 return call2(handler, Qset_visited_file_modtime, Qnil);
3393 else if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) >= 0)
3394 current_buffer->modtime = st.st_mtime;
3401 auto_save_error(Lisp_Object condition_object, Lisp_Object ignored)
3403 /* This function can call lisp */
3406 /* Don't try printing an error message after everything is gone! */
3407 if (preparing_for_armageddon)
3409 clear_echo_area(selected_frame(), Qauto_saving, 1);
3410 Fding(Qt, Qauto_save_error, Qnil);
3411 message("Auto-saving...error for %s",
3412 XSTRING_DATA(current_buffer->name));
3413 Fsleep_for(make_int(1));
3414 message("Auto-saving...error!for %s",
3415 XSTRING_DATA(current_buffer->name));
3416 Fsleep_for(make_int(1));
3417 message("Auto-saving...error for %s",
3418 XSTRING_DATA(current_buffer->name));
3419 Fsleep_for(make_int(1));
3423 static Lisp_Object auto_save_1(Lisp_Object ignored)
3425 /* This function can call lisp */
3426 /* #### I think caller is protecting current_buffer? */
3428 Lisp_Object fn = current_buffer->filename;
3429 Lisp_Object a = current_buffer->auto_save_file_name;
3434 /* Get visited file's mode to become the auto save file's mode. */
3435 if (STRINGP(fn) && sxemacs_stat((char *)XSTRING_DATA(fn), &st) >= 0)
3436 /* But make sure we can overwrite it later! */
3437 auto_save_mode_bits = st.st_mode | 0600;
3439 /* default mode for auto-save files of buffers with no file is
3440 readable by owner only. This may annoy some small number of
3441 people, but the alternative removes all privacy from email. */
3442 auto_save_mode_bits = 0600;
3445 /* !!#### need to deal with this 'escape-quoted everywhere */
3446 Fwrite_region_internal(Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3448 current_buffer->buffer_file_coding_system
3456 auto_save_expand_name_error(Lisp_Object condition_object, Lisp_Object ignored)
3458 /* #### this function should spew an error message about not being
3459 able to open the .saves file. */
3463 static Lisp_Object auto_save_expand_name(Lisp_Object name)
3465 struct gcpro gcpro1;
3467 /* note that caller did NOT gc protect name, so we do it. */
3468 /* #### dmoore - this might not be necessary, if condition_case_1
3469 protects it. but I don't think it does. */
3471 RETURN_UNGCPRO(Fexpand_file_name(name, Qnil));
3474 static Lisp_Object do_auto_save_unwind(Lisp_Object fd)
3480 static Lisp_Object do_auto_save_unwind_2(Lisp_Object old_auto_saving)
3482 auto_saving = XINT(old_auto_saving);
3486 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3487 and if so, tries to avoid touching lisp objects.
3489 The only time that Fdo_auto_save() is called while GC is in progress
3490 is if we're going down, as a result of an abort() or a kill signal.
3491 It's fairly important that we generate autosave files in that case!
3494 DEFUN("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3495 Auto-save all buffers that need it.
3496 This is all buffers that have auto-saving enabled
3497 and are changed since last auto-saved.
3498 Auto-saving writes the buffer into a file
3499 so that your editing is not lost if the system crashes.
3500 This file is not the file you visited; that changes only when you save.
3501 Normally we run the normal hook `auto-save-hook' before saving.
3503 Non-nil first argument means do not print any message if successful.
3504 Non-nil second argument means save only current buffer.
3506 (no_message, current_only))
3508 /* This function can call lisp */
3510 Lisp_Object tail, buf;
3512 int do_handled_files;
3513 Lisp_Object oquit = Qnil;
3514 Lisp_Object listfile = Qnil;
3517 int speccount = specpdl_depth();
3518 struct gcpro gcpro1, gcpro2, gcpro3;
3520 XSETBUFFER(old, current_buffer);
3521 GCPRO3(oquit, listfile, old);
3522 check_quit(); /* make Vquit_flag accurate */
3523 /* Ordinarily don't quit within this function,
3524 but don't make it impossible to quit (in case we get hung in I/O). */
3528 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3529 variables point to non-strings reached from Vbuffer_alist. */
3531 if (minibuf_level != 0 || preparing_for_armageddon)
3534 run_hook(Qauto_save_hook);
3536 if (STRINGP(Vauto_save_list_file_name))
3537 listfile = condition_case_1(Qt,
3538 auto_save_expand_name,
3539 Vauto_save_list_file_name,
3540 auto_save_expand_name_error, Qnil);
3542 /* Make sure auto_saving is reset. */
3543 record_unwind_protect(do_auto_save_unwind_2, make_int(auto_saving));
3547 /* First, save all files which don't have handlers. If Emacs is
3548 crashing, the handlers may tweak what is causing Emacs to crash
3549 in the first place, and it would be a shame if Emacs failed to
3550 autosave perfectly ordinary files because it couldn't handle some
3552 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) {
3553 for (tail = Vbuffer_alist; CONSP(tail); tail = XCDR(tail)) {
3554 buf = XCDR(XCAR(tail));
3557 if (!NILP(current_only)
3558 && b != current_buffer)
3561 /* Don't auto-save indirect buffers.
3562 The base buffer takes care of it. */
3566 /* Check for auto save enabled
3567 and file changed since last auto save
3568 and file changed since last real save. */
3569 if (STRINGP(b->auto_save_file_name)
3570 && BUF_SAVE_MODIFF(b) < BUF_MODIFF(b)
3571 && b->auto_save_modified < BUF_MODIFF(b)
3572 /* -1 means we've turned off autosaving for a while--see below. */
3573 && XINT(b->saved_size) >= 0
3574 && (do_handled_files
3576 NILP(Ffind_file_name_handler
3577 (b->auto_save_file_name,
3579 EMACS_TIME before_time, after_time;
3581 EMACS_GET_TIME(before_time);
3582 /* If we had a failure, don't try again for 20 minutes. */
3583 if (!preparing_for_armageddon
3584 && b->auto_save_failure_time >= 0
3585 && (EMACS_SECS(before_time) -
3586 b->auto_save_failure_time < 1200))
3589 if (!preparing_for_armageddon &&
3590 (XINT(b->saved_size) * 10
3591 > (BUF_Z(b) - BUF_BEG(b)) * 13)
3592 /* A short file is likely to change a large fraction;
3593 spare the user annoying messages. */
3594 && XINT(b->saved_size) > 5000
3595 /* These messages are frequent and annoying for `*mail*'. */
3596 && !NILP(b->filename)
3598 && disable_auto_save_when_buffer_shrinks) {
3599 /* It has shrunk too much; turn off auto-saving here.
3600 Unless we're about to crash, in which case auto-save it
3604 ("Buffer %s has shrunk a lot; auto save turned off there",
3605 XSTRING_DATA(b->name));
3606 /* Turn off auto-saving until there's a real save,
3607 and prevent any more warnings. */
3608 b->saved_size = make_int(-1);
3609 if (!gc_in_progress)
3610 Fsleep_for(make_int(1));
3613 set_buffer_internal(b);
3614 if (!auto_saved && NILP(no_message)) {
3615 static const unsigned char *msg
3617 (const unsigned char *)
3619 echo_area_message(selected_frame(), msg,
3621 strlen((const char *)
3626 /* Open the auto-save list file, if necessary.
3627 We only do this now so that the file only exists
3628 if we actually auto-saved any files. */
3629 if (!auto_saved && !inhibit_auto_save_session
3630 && !NILP(Vauto_save_list_file_prefix)
3631 && STRINGP(listfile) && listdesc < 0) {
3633 open((char *)XSTRING_DATA(listfile),
3634 O_WRONLY | O_TRUNC | O_CREAT |
3635 OPEN_BINARY, CREAT_MODE);
3637 /* Arrange to close that file whether or not we get
3640 record_unwind_protect
3641 (do_auto_save_unwind,
3642 make_int(listdesc));
3645 /* Record all the buffers that we are auto-saving in
3646 the special file that lists them. For each of
3647 these buffers, record visited name (if any) and
3649 if (listdesc >= 0) {
3650 const Extbyte *auto_save_file_name_ext;
3651 Extcount auto_save_file_name_ext_len;
3653 TO_EXTERNAL_FORMAT(LISP_STRING,
3655 auto_save_file_name,
3657 (auto_save_file_name_ext,
3658 auto_save_file_name_ext_len),
3660 if (!NILP(b->filename)) {
3661 const Extbyte *filename_ext;
3662 Extcount filename_ext_len;
3664 TO_EXTERNAL_FORMAT(LISP_STRING,
3670 write(listdesc, filename_ext,
3673 write(listdesc, "\n", 1);
3674 write(listdesc, auto_save_file_name_ext,
3675 auto_save_file_name_ext_len);
3676 write(listdesc, "\n", 1);
3679 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
3680 based on values in Vbuffer_alist. auto_save_1 may
3681 cause lisp handlers to run. Those handlers may kill
3682 the buffer and then GC. Since the buffer is killed,
3683 it's no longer in Vbuffer_alist so it might get reaped
3684 by the GC. We also need to protect tail. */
3685 /* #### There is probably a lot of other code which has
3686 pointers into buffers which may get blown away by
3689 struct gcpro ngcpro1, ngcpro2;
3691 condition_case_1(Qt,
3693 auto_save_error, Qnil);
3696 /* Handler killed our saved current-buffer! Pick any. */
3697 if (!BUFFER_LIVE_P(XBUFFER(old)))
3698 XSETBUFFER(old, current_buffer);
3700 set_buffer_internal(XBUFFER(old));
3703 /* Handler killed their own buffer! */
3704 if (!BUFFER_LIVE_P(b))
3707 b->auto_save_modified = BUF_MODIFF(b);
3708 b->saved_size = make_int(BUF_SIZE(b));
3709 EMACS_GET_TIME(after_time);
3710 /* If auto-save took more than 60 seconds,
3711 assume it was an NFS failure that got a timeout. */
3712 if (EMACS_SECS(after_time) -
3713 EMACS_SECS(before_time) > 60)
3714 b->auto_save_failure_time =
3715 EMACS_SECS(after_time);
3720 /* Prevent another auto save till enough input events come in. */
3724 /* If we didn't save anything into the listfile, remove the old
3725 one because nothing needed to be auto-saved. Do this afterwards
3726 rather than before in case we get a crash attempting to autosave
3727 (in that case we'd still want the old one around). */
3728 if (listdesc < 0 && !auto_saved && STRINGP(listfile))
3729 unlink((char *)XSTRING_DATA(listfile));
3734 /* Show "...done" only if the echo area would otherwise be empty. */
3735 if (auto_saved && NILP(no_message)
3736 && NILP(clear_echo_area(selected_frame(), Qauto_saving, 0))) {
3737 static const unsigned char *msg
3738 = (const unsigned char *)"Auto-saving...done";
3739 echo_area_message(selected_frame(), msg, Qnil, 0,
3740 strlen((const char *)msg), Qauto_saving);
3745 RETURN_UNGCPRO(unbind_to(speccount, Qnil));
3748 DEFUN("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
3749 Mark current buffer as auto-saved with its current text.
3750 No auto-save file will be written until the buffer changes again.
3754 current_buffer->auto_save_modified = BUF_MODIFF(current_buffer);
3755 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3756 current_buffer->auto_save_failure_time = -1;
3760 DEFUN("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
3761 Clear any record of a recent auto-save failure in the current buffer.
3765 current_buffer->auto_save_failure_time = -1;
3769 DEFUN("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
3770 Return t if buffer has been auto-saved since last read in or saved.
3774 return (BUF_SAVE_MODIFF(current_buffer) <
3775 current_buffer->auto_save_modified) ? Qt : Qnil;
3778 /************************************************************************/
3779 /* initialization */
3780 /************************************************************************/
3782 void syms_of_fileio(void)
3784 defsymbol(&Qexpand_file_name, "expand-file-name");
3785 defsymbol(&Qfile_truename, "file-truename");
3786 defsymbol(&Qsubstitute_in_file_name, "substitute-in-file-name");
3787 defsymbol(&Qdirectory_file_name, "directory-file-name");
3788 defsymbol(&Qfile_dirname, "file-dirname");
3789 defsymbol(&Qfile_basename, "file-basename");
3790 defsymbol(&Qfile_name_directory, "file-name-directory");
3791 defsymbol(&Qfile_name_nondirectory, "file-name-nondirectory");
3792 defsymbol(&Qunhandled_file_name_directory,
3793 "unhandled-file-name-directory");
3794 defsymbol(&Qfile_name_as_directory, "file-name-as-directory");
3795 defsymbol(&Qcopy_file, "copy-file");
3796 defsymbol(&Qmake_directory_internal, "make-directory-internal");
3797 defsymbol(&Qdelete_directory, "delete-directory");
3798 defsymbol(&Qdelete_file, "delete-file");
3799 defsymbol(&Qrename_file, "rename-file");
3800 defsymbol(&Qadd_name_to_file, "add-name-to-file");
3801 defsymbol(&Qmake_symbolic_link, "make-symbolic-link");
3802 defsymbol(&Qfile_exists_p, "file-exists-p");
3803 defsymbol(&Qfile_executable_p, "file-executable-p");
3804 defsymbol(&Qfile_readable_p, "file-readable-p");
3805 defsymbol(&Qfile_symlink_p, "file-symlink-p");
3806 defsymbol(&Qfile_writable_p, "file-writable-p");
3807 defsymbol(&Qfile_directory_p, "file-directory-p");
3808 defsymbol(&Qfile_regular_p, "file-regular-p");
3809 defsymbol(&Qfile_accessible_directory_p, "file-accessible-directory-p");
3810 defsymbol(&Qfile_modes, "file-modes");
3811 defsymbol(&Qset_file_modes, "set-file-modes");
3812 defsymbol(&Qfile_newer_than_file_p, "file-newer-than-file-p");
3813 defsymbol(&Qinsert_file_contents, "insert-file-contents");
3814 defsymbol(&Qwrite_region, "write-region");
3815 defsymbol(&Qverify_visited_file_modtime, "verify-visited-file-modtime");
3816 defsymbol(&Qset_visited_file_modtime, "set-visited-file-modtime");
3817 defsymbol(&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
3819 defsymbol(&Qauto_save_hook, "auto-save-hook");
3820 defsymbol(&Qauto_save_error, "auto-save-error");
3821 defsymbol(&Qauto_saving, "auto-saving");
3823 defsymbol(&Qformat_decode, "format-decode");
3824 defsymbol(&Qformat_annotate_function, "format-annotate-function");
3826 defsymbol(&Qcompute_buffer_file_truename,
3827 "compute-buffer-file-truename");
3828 DEFERROR_STANDARD(Qfile_error, Qio_error);
3829 DEFERROR_STANDARD(Qfile_already_exists, Qfile_error);
3831 DEFSUBR(Ffind_file_name_handler);
3833 DEFSUBR(Ffile_name_directory);
3834 DEFSUBR(Ffile_name_nondirectory);
3835 DEFSUBR(Ffile_basename);
3836 DEFSUBR(Ffile_dirname);
3837 DEFSUBR(Funhandled_file_name_directory);
3838 DEFSUBR(Ffile_name_as_directory);
3839 DEFSUBR(Fdirectory_file_name);
3840 DEFSUBR(Fmake_temp_name);
3841 DEFSUBR(Fexpand_file_name);
3842 DEFSUBR(Ffile_truename);
3843 DEFSUBR(Fsubstitute_in_file_name);
3844 DEFSUBR(Fcopy_file);
3845 DEFSUBR(Fmake_directory_internal);
3846 DEFSUBR(Fdelete_directory);
3847 DEFSUBR(Fdelete_file);
3848 DEFSUBR(Frename_file);
3849 DEFSUBR(Fadd_name_to_file);
3850 DEFSUBR(Fmake_symbolic_link);
3852 DEFSUBR(Fsysnetunam);
3853 #endif /* HPUX_NET */
3854 DEFSUBR(Ffile_name_absolute_p);
3855 DEFSUBR(Ffile_exists_p);
3856 DEFSUBR(Ffile_executable_p);
3857 DEFSUBR(Ffile_readable_p);
3858 DEFSUBR(Ffile_writable_p);
3859 DEFSUBR(Ffile_symlink_p);
3860 DEFSUBR(Ffile_directory_p);
3861 DEFSUBR(Ffile_accessible_directory_p);
3862 DEFSUBR(Ffile_regular_p);
3863 DEFSUBR(Ffile_modes);
3864 DEFSUBR(Fset_file_modes);
3865 DEFSUBR(Fset_default_file_modes);
3866 DEFSUBR(Fdefault_file_modes);
3867 DEFSUBR(Funix_sync);
3868 DEFSUBR(Ffile_newer_than_file_p);
3869 DEFSUBR(Finsert_file_contents_internal);
3870 DEFSUBR(Fwrite_region_internal);
3871 DEFSUBR(Fcar_less_than_car); /* Vomitous! */
3872 DEFSUBR(Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
3873 DEFSUBR(Fverify_visited_file_modtime);
3874 DEFSUBR(Fclear_visited_file_modtime);
3875 DEFSUBR(Fvisited_file_modtime);
3876 DEFSUBR(Fset_visited_file_modtime);
3878 DEFSUBR(Fdo_auto_save);
3879 DEFSUBR(Fset_buffer_auto_saved);
3880 DEFSUBR(Fclear_buffer_auto_save_failure);
3881 DEFSUBR(Frecent_auto_save_p);
3884 void vars_of_fileio(void)
3886 DEFVAR_LISP("auto-save-file-format", &Vauto_save_file_format /*
3887 *Format in which to write auto-save files.
3888 Should be a list of symbols naming formats that are defined in `format-alist'.
3889 If it is t, which is the default, auto-save files are written in the
3890 same format as a regular save would use.
3892 Vauto_save_file_format = Qt;
3894 DEFVAR_LISP("file-name-handler-alist", &Vfile_name_handler_alist /*
3895 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
3896 If a file name matches REGEXP, then all I/O on that file is done by calling
3899 The first argument given to HANDLER is the name of the I/O primitive
3900 to be handled; the remaining arguments are the arguments that were
3901 passed to that primitive. For example, if you do
3902 (file-exists-p FILENAME)
3903 and FILENAME is handled by HANDLER, then HANDLER is called like this:
3904 (funcall HANDLER 'file-exists-p FILENAME)
3905 The function `find-file-name-handler' checks this list for a handler
3908 Vfile_name_handler_alist = Qnil;
3910 DEFVAR_LISP("after-insert-file-functions", &Vafter_insert_file_functions /*
3911 A list of functions to be called at the end of `insert-file-contents'.
3912 Each is passed one argument, the number of bytes inserted. It should return
3913 the new byte count, and leave point the same. If `insert-file-contents' is
3914 intercepted by a handler from `file-name-handler-alist', that handler is
3915 responsible for calling the after-insert-file-functions if appropriate.
3917 Vafter_insert_file_functions = Qnil;
3919 DEFVAR_LISP("write-region-annotate-functions", &Vwrite_region_annotate_functions /*
3920 A list of functions to be called at the start of `write-region'.
3921 Each is passed two arguments, START and END, as for `write-region'.
3922 It should return a list of pairs (POSITION . STRING) of strings to be
3923 effectively inserted at the specified positions of the file being written
3924 \(1 means to insert before the first byte written). The POSITIONs must be
3925 sorted into increasing order. If there are several functions in the list,
3926 the several lists are merged destructively.
3928 Vwrite_region_annotate_functions = Qnil;
3930 DEFVAR_LISP("write-region-annotations-so-far", &Vwrite_region_annotations_so_far /*
3931 When an annotation function is called, this holds the previous annotations.
3932 These are the annotations made by other annotation functions
3933 that were already called. See also `write-region-annotate-functions'.
3935 Vwrite_region_annotations_so_far = Qnil;
3937 DEFVAR_LISP("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
3938 A list of file name handlers that temporarily should not be used.
3939 This applies only to the operation `inhibit-file-name-operation'.
3941 Vinhibit_file_name_handlers = Qnil;
3943 DEFVAR_LISP("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
3944 The operation for which `inhibit-file-name-handlers' is applicable.
3946 Vinhibit_file_name_operation = Qnil;
3948 DEFVAR_LISP("auto-save-list-file-name", &Vauto_save_list_file_name /*
3949 File name in which we write a list of all auto save file names.
3951 Vauto_save_list_file_name = Qnil;
3953 DEFVAR_LISP("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
3954 Prefix for generating auto-save-list-file-name.
3955 Emacs's pid and the system name will be appended to
3956 this prefix to create a unique file name.
3958 Vauto_save_list_file_prefix = build_string("~/.saves-");
3960 DEFVAR_BOOL("inhibit-auto-save-session", &inhibit_auto_save_session /*
3961 When non-nil, inhibit auto save list file creation.
3963 inhibit_auto_save_session = 0;
3965 DEFVAR_BOOL("disable-auto-save-when-buffer-shrinks", &disable_auto_save_when_buffer_shrinks /*
3966 If non-nil, auto-saving is disabled when a buffer shrinks too much.
3967 This is to prevent you from losing your edits if you accidentally
3968 delete a large chunk of the buffer and don't notice it until too late.
3969 Saving the buffer normally turns auto-save back on.
3971 disable_auto_save_when_buffer_shrinks = 1;
3973 DEFVAR_LISP("directory-sep-char", &Vdirectory_sep_char /*
3974 Directory separator character for built-in functions that return file names.
3975 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
3976 This variable affects the built-in functions only on Windows,
3977 on other platforms, it is initialized so that Lisp code can find out
3978 what the normal separator is.
3980 Vdirectory_sep_char = make_char('/');
3982 reinit_vars_of_fileio();
3985 void reinit_vars_of_fileio(void)
3987 /* We want temp_name_rand to be initialized to a value likely to be
3988 unique to the process, not to the executable. The danger is that
3989 two different SXEmacs processes using the same binary on different
3990 machines creating temp files in the same directory will be
3991 unlucky enough to have the same pid. If we randomize using
3992 process startup time, then in practice they will be unlikely to
3993 collide. We use the microseconds field so that scripts that start
3994 simultaneous SXEmacs processes on multiple machines will have less
3995 chance of collision. */
3999 EMACS_GET_TIME(thyme);
4001 (unsigned int)(EMACS_SECS(thyme) ^ EMACS_USECS(thyme));