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, char *in)
606 /* This function cannot GC */
607 int size = strlen(in);
611 out[1] = DIRECTORY_SEP;
615 /* Append a slash if necessary */
616 if (!IS_ANY_SEP(out[size - 1])) {
617 out[size] = DIRECTORY_SEP;
618 out[size + 1] = '\0';
624 DEFUN("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /*
625 Return a string representing file FILENAME interpreted as a directory.
626 This operation exists because a directory is also a file, but its name as
627 a directory is different from its name as a file.
628 The result can be used as the value of `default-directory'
629 or passed as second argument to `expand-file-name'.
630 For a Unix-syntax file name, just appends a slash,
631 except for (file-name-as-directory \"\") => \"./\".
635 /* This function can GC. GC checked 2000-07-28 ben */
639 CHECK_STRING(filename);
641 /* If the file name has special constructs in it,
642 call the corresponding file handler. */
643 handler = Ffind_file_name_handler(filename, Qfile_name_as_directory);
645 return call2_check_string(handler, Qfile_name_as_directory,
648 buf = (char *)alloca(XSTRING_LENGTH(filename) + 10);
649 return build_string(file_name_as_directory
650 (buf, (char *)XSTRING_DATA(filename)));
654 * Convert from directory name to filename.
655 * On UNIX, it's simple: just make sure there isn't a terminating /
657 * Value is nonzero if the string output is different from the input.
660 static int directory_file_name(const char *src, char *dst)
662 /* This function cannot GC */
663 long slen = strlen(src);
664 /* Process as Unix format: just remove any final slash.
665 But leave "/" unchanged; do not change it to "". */
667 if (slen > 1 && IS_DIRECTORY_SEP(dst[slen - 1])
673 DEFUN("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
674 Return the file name of the directory named DIRECTORY.
675 This is the name of the file that holds the data for the directory.
676 This operation exists because a directory is also a file, but its name as
677 a directory is different from its name as a file.
678 In Unix-syntax, this function just removes the final slash.
682 /* This function can GC. GC checked 2000-07-28 ben */
686 CHECK_STRING(directory);
688 #if 0 /* #### WTF? */
693 /* If the file name has special constructs in it,
694 call the corresponding file handler. */
695 handler = Ffind_file_name_handler(directory, Qdirectory_file_name);
697 return call2_check_string(handler, Qdirectory_file_name,
699 buf = (char *)alloca(XSTRING_LENGTH(directory) + 20);
700 directory_file_name((char *)XSTRING_DATA(directory), buf);
701 return build_string(buf);
704 /* Fmake_temp_name used to be a simple wrapper around mktemp(), but it
705 proved too broken for our purposes (it supported only 26 or 62
706 unique names under some implementations). For example, this
707 arbitrary limit broke generation of Gnus Incoming* files.
709 This implementation is better than what one usually finds in libc.
712 static unsigned int temp_name_rand;
714 DEFUN("make-temp-name", Fmake_temp_name, 1, 1, 0, /*
715 Generate a temporary file name starting with PREFIX.
716 The Emacs process number forms part of the result, so there is no
717 danger of generating a name being used by another process.
719 In addition, this function makes an attempt to choose a name that
720 does not specify an existing file. To make this work, PREFIX should
721 be an absolute file name.
725 static const char tbl[64] = {
726 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
727 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
728 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
729 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f',
730 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
731 'o', 'p', 'q', 'r', 's', 't', 'u', 'v',
732 'w', 'x', 'y', 'z', '0', '1', '2', '3',
733 '4', '5', '6', '7', '8', '9', '-', '_'
740 CHECK_STRING(prefix);
742 /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's
745 1) It might change the prefix, so the resulting string might not
746 begin with PREFIX. This violates the principle of least
749 2) It breaks under many unforeseeable circumstances, such as with
750 the code that uses (make-temp-name "") instead of
751 (make-temp-name "./").
753 3) It might yield unexpected (to stat(2)) results in the presence
754 of EFS and file name handlers. */
756 len = XSTRING_LENGTH(prefix);
757 val = make_uninit_string(len + 6);
758 data = XSTRING_DATA(val);
759 memcpy(data, XSTRING_DATA(prefix), len);
762 /* VAL is created by adding 6 characters to PREFIX. The first three
763 are the PID of this process, in base 64, and the second three are
764 a pseudo-random number seeded from process startup time. This
765 ensures 262144 unique file names per PID per PREFIX per machine. */
768 unsigned int pid = (unsigned int)getpid();
769 *p++ = tbl[(pid >> 0) & 63];
770 *p++ = tbl[(pid >> 6) & 63];
771 *p++ = tbl[(pid >> 12) & 63];
774 /* Here we try to minimize useless stat'ing when this function is
775 invoked many times successively with the same PREFIX. We achieve
776 this by using a very pseudo-random number generator to generate
777 file names unique to this process, with a very long cycle. */
782 p[0] = tbl[(temp_name_rand >> 0) & 63];
783 p[1] = tbl[(temp_name_rand >> 6) & 63];
784 p[2] = tbl[(temp_name_rand >> 12) & 63];
786 /* Poor man's congruential RN generator. Replace with ++count
788 temp_name_rand += 25229;
789 temp_name_rand %= 225307;
793 if (sxemacs_stat((const char *)data, &ignored) < 0) {
794 /* We want to return only if errno is ENOENT. */
798 /* The error here is dubious, but there is little else we
799 can do. The alternatives are to return nil, which is
800 as bad as (and in many cases worse than) throwing the
801 error, or to ignore the error, which will likely result
804 ("Cannot create temporary name for prefix",
806 return Qnil; /* not reached */
811 DEFUN("expand-file-name", Fexpand_file_name, 1, 2, 0, /*
812 Convert filename NAME to absolute, and canonicalize it.
813 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
814 (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
815 the current buffer's value of `default-directory' is used.
816 File name components that are `.' are removed, and
817 so are file name components followed by `..', along with the `..' itself;
818 note that these simplifications are done without checking the resulting
819 file names in the file system.
820 An initial `~/' expands to your home directory.
821 An initial `~USER/' expands to USER's home directory.
822 See also the function `substitute-in-file-name'.
824 (name, default_directory))
826 /* This function can GC. GC-checked 2000-11-18 */
829 Bufbyte *newdir, *p, *o;
834 Lisp_Object handler = Qnil;
835 struct gcpro gcpro1, gcpro2, gcpro3;
837 /* both of these get set below */
838 GCPRO3(name, default_directory, handler);
842 /* If the file name has special constructs in it,
843 call the corresponding file handler. */
844 handler = Ffind_file_name_handler(name, Qexpand_file_name);
846 RETURN_UNGCPRO(call3_check_string(handler, Qexpand_file_name,
847 name, default_directory));
849 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
850 if (NILP(default_directory))
851 default_directory = current_buffer->directory;
852 if (!STRINGP(default_directory))
853 default_directory = build_string("/");
855 if (!NILP(default_directory)) {
857 Ffind_file_name_handler(default_directory,
860 RETURN_UNGCPRO(call3(handler, Qexpand_file_name,
861 name, default_directory));
864 o = XSTRING_DATA(default_directory);
866 /* Make sure DEFAULT_DIRECTORY is properly expanded.
867 It would be better to do this down below where we actually use
868 default_directory. Unfortunately, calling Fexpand_file_name recursively
869 could invoke GC, and the strings might be relocated. This would
870 be annoying because we have pointers into strings lying around
871 that would need adjusting, and people would add new pointers to
872 the code and forget to adjust them, resulting in intermittent bugs.
873 Putting this call here avoids all that crud.
875 The EQ test avoids infinite recursion. */
876 if (!NILP(default_directory) && !EQ(default_directory, name)
877 /* Save time in some common cases - as long as default_directory
878 is not relative, it can be canonicalized with name below (if it
879 is needed at all) without requiring it to be expanded now. */
880 /* Detect Unix absolute file names (/... alone is not absolute on
882 && !(IS_DIRECTORY_SEP(o[0]))
885 default_directory = Fexpand_file_name(default_directory, Qnil);
887 #ifdef FILE_SYSTEM_CASE
888 name = FILE_SYSTEM_CASE(name);
891 /* #### dmoore - this is ugly, clean this up. Looks like nm pointing
892 into name should be safe during all of this, though. */
893 nm = XSTRING_DATA(name);
895 /* If nm is absolute, look for /./ or /../ sequences; if none are
896 found, we can probably return right away. We will avoid allocating
897 a new string if name is already fully expanded. */
898 if (IS_DIRECTORY_SEP(nm[0])) {
899 /* If it turns out that the filename we want to return is just a
900 suffix of FILENAME, we don't need to go through and edit
901 things; we just need to construct a new string using data
902 starting at the middle of FILENAME. If we set lose to a
903 non-zero value, that means we've discovered that we can't do
909 /* Since we know the name is absolute, we can assume
910 that each element starts with a "/". */
912 /* "." and ".." are hairy. */
913 if (IS_DIRECTORY_SEP(p[0])
914 && p[1] == '.' && (IS_DIRECTORY_SEP(p[2])
917 && (IS_DIRECTORY_SEP(p[3])
924 if (nm == XSTRING_DATA(name)) {
925 RETURN_UNGCPRO(name);
927 RETURN_UNGCPRO(build_string((char*)nm));
931 /* At this point, nm might or might not be an absolute file name. We
932 need to expand ~ or ~user if present, otherwise prefix nm with
933 default_directory if nm is not absolute, and finally collapse /./
934 and /foo/../ sequences.
936 We set newdir to be the appropriate prefix if one is needed:
937 - the relevant user directory if nm starts with ~ or ~user
938 - the specified drive's working dir (DOS/NT only) if nm does not
940 - the value of default_directory.
942 Note that these prefixes are not guaranteed to be absolute (except
943 for the working dir of a drive). Therefore, to ensure we always
944 return an absolute name, if the final prefix is not absolute we
945 append it to the current working directory. */
949 if (nm[0] == '~') { /* prefix ~ */
950 if (IS_DIRECTORY_SEP(nm[1]) || nm[1] == 0) {
952 Extbyte *newdir_external = get_home_directory();
954 if (newdir_external == NULL) {
955 newdir = (Bufbyte *) "";
957 /* aint that a bit weird just to get the
958 * signedness correct? */
959 Extbyte *newdir_cpy = (Extbyte*)newdir;
961 C_STRING, newdir_external,
965 newdir = (Bufbyte*)newdir_cpy;
968 } else { /* ~user/filename */
970 for (p = nm; *p && (!IS_DIRECTORY_SEP(*p)); p++)
972 o = (Bufbyte *) alloca(p - nm + 1);
973 memcpy(o, (char *)nm, p - nm);
976 /* #### While NT is single-user (for the moment) you still
977 can have multiple user profiles users defined, each with
978 its HOME. So maybe possibly we should think about handling
980 /* Jamie reports that getpwnam() can get wedged
981 by SIGIO/SIGALARM occurring in it. (It can call
983 slow_down_interrupts();
984 pw = (struct passwd *)getpwnam((char *)o + 1);
985 speed_up_interrupts();
987 newdir = (Bufbyte *) pw->pw_dir;
991 /* If we don't find a user of that name, leave the name
992 unchanged; don't move nm forward to p. */
996 /* Finally, if no prefix has been specified and nm is not absolute,
997 then it must be expanded relative to default_directory. */
1000 /* /... alone is not absolute on DOS and Windows. */
1001 && !IS_DIRECTORY_SEP(nm[0])
1003 newdir = XSTRING_DATA(default_directory);
1007 /* Get rid of any slash at the end of newdir, unless newdir is
1008 just // (an incomplete UNC name). */
1009 length = strlen((char *)newdir);
1010 if (length > 1 && IS_DIRECTORY_SEP(newdir[length - 1])) {
1011 Bufbyte *temp = (Bufbyte *) alloca(length);
1012 memcpy(temp, newdir, length - 1);
1013 temp[length - 1] = 0;
1020 /* Now concatenate the directory and name to new space in the stack frame */
1021 tlen += strlen((char *)nm) + 1;
1022 target = (Bufbyte *) alloca(tlen);
1026 if (nm[0] == 0 || IS_DIRECTORY_SEP(nm[0]))
1027 strcpy((char *)target, (char *)newdir);
1029 file_name_as_directory((char *)target, (char *)newdir);
1032 strcat((char *)target, (char *)nm);
1034 /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
1036 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1042 if (!IS_DIRECTORY_SEP(*p)) {
1044 } else if (IS_DIRECTORY_SEP(p[0])
1045 && p[1] == '.' && (IS_DIRECTORY_SEP(p[2])
1047 /* If "/." is the entire filename, keep the "/". Otherwise,
1048 just delete the whole "/.". */
1049 if (o == target && p[2] == '\0')
1052 } else if (IS_DIRECTORY_SEP(p[0]) && p[1] == '.' && p[2] == '.'
1053 /* `/../' is the "superroot" on certain file systems. */
1055 && (IS_DIRECTORY_SEP(p[3]) || p[3] == 0)) {
1056 while (o != target && (--o) && !IS_DIRECTORY_SEP(*o)) ;
1057 /* Keep initial / only if this is the whole name. */
1058 if (o == target && IS_ANY_SEP(*o) && p[3] == 0)
1067 RETURN_UNGCPRO(make_string(target, o - target));
1070 DEFUN("file-truename", Ffile_truename, 1, 2, 0, /*
1071 Return the canonical name of FILENAME.
1072 Second arg DEFAULT is directory to start with if FILENAME is relative
1073 (does not start with slash); if DEFAULT is nil or missing,
1074 the current buffer's value of `default-directory' is used.
1075 No component of the resulting pathname will be a symbolic link, as
1076 in the realpath() function.
1078 (filename, default_))
1080 /* This function can GC. GC checked 2000-07-28 ben. */
1081 Lisp_Object expanded_name;
1082 struct gcpro gcpro1;
1084 CHECK_STRING(filename);
1086 expanded_name = Fexpand_file_name(filename, default_);
1088 if (!STRINGP(expanded_name))
1091 GCPRO1(expanded_name);
1094 Lisp_Object handler =
1095 Ffind_file_name_handler(expanded_name, Qfile_truename);
1100 (handler, Qfile_truename, expanded_name));
1104 char resolved_path[MAXPATHLEN];
1105 Extbyte *path = NULL;
1109 TO_EXTERNAL_FORMAT(LISP_STRING, expanded_name,
1110 ALLOCA, (path, elen), Qfile_name);
1113 if (elen > MAXPATHLEN)
1116 /* Try doing it all at once. */
1117 /* !! Does realpath() Mule-encapsulate? Answer: Nope!
1118 So we do it above */
1119 if (path != NULL && !xrealpath((char *)path, resolved_path)) {
1120 /* Didn't resolve it -- have to do it one
1121 component at a time.
1123 "realpath" is a typically useless, stupid
1124 un*x piece of crap. It claims to return a
1125 useful value in the "error" case, but since
1126 there is no indication provided of how far
1127 along the pathname the function went before
1128 erring, there is no way to use the partial
1129 result returned. What a piece of junk.
1131 The above comment refers to historical
1132 versions of realpath(). The Unix98 specs
1135 "On successful completion, realpath()
1136 returns a pointer to the resolved
1137 name. Otherwise, realpath() returns a null
1138 pointer and sets errno to indicate the
1139 error, and the contents of the buffer
1140 pointed to by resolved_name are undefined."
1142 Since we depend on undocumented semantics
1143 of various system realpath()s, we just use
1144 our own version in realpath.c.
1147 Extbyte *pos = NULL;
1149 for (pos = p + 1; pos < path + elen; pos++) {
1150 if (IS_DIRECTORY_SEP(*pos)) {
1158 if (xrealpath((char *)path, resolved_path)) {
1164 } else if (errno == ENOENT || errno == EACCES) {
1165 /* Failed on this component.
1166 Just tack on the rest of
1167 the string and we are
1169 int rlen = strlen(resolved_path);
1171 /* "On failure, it returns
1173 indicate the error, and
1174 places in resolved_path the
1175 absolute pathname of the
1176 path component which could
1182 int plen = elen - (p - path);
1186 (resolved_path[rlen - 1]))
1189 if ((plen + rlen + 1) >
1190 countof(resolved_path))
1193 resolved_path[rlen] = DIRECTORY_SEP;
1194 memcpy(resolved_path + rlen + 1,
1195 p + 1, plen + 1 - 1);
1203 Lisp_Object resolved_name;
1204 int rlen = strlen(resolved_path);
1207 && IS_DIRECTORY_SEP(
1208 XSTRING_BYTE(expanded_name, elen-1))
1210 IS_DIRECTORY_SEP(resolved_path[rlen-1]))) {
1211 if (rlen + 1 > countof(resolved_path))
1213 resolved_path[rlen++] = DIRECTORY_SEP;
1214 resolved_path[rlen] = '\0';
1216 TO_INTERNAL_FORMAT(DATA, (resolved_path, rlen),
1217 LISP_STRING, resolved_name,
1219 RETURN_UNGCPRO(resolved_name);
1223 errno = ENAMETOOLONG;
1226 report_file_error("Finding truename", list1(expanded_name));
1228 RETURN_UNGCPRO(Qnil);
1231 DEFUN("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1232 Substitute environment variables referred to in FILENAME.
1233 `$FOO' where FOO is an environment variable name means to substitute
1234 the value of that variable. The variable name should be terminated
1235 with a character, not a letter, digit or underscore; otherwise, enclose
1236 the entire variable name in braces.
1237 If `/~' appears, all of FILENAME through that `/' is discarded.
1241 /* This function can GC. GC checked 2000-07-28 ben. */
1244 Bufbyte *s, *p, *o, *x, *endp;
1245 Bufbyte *target = 0;
1247 int substituted = 0;
1249 Lisp_Object handler;
1251 CHECK_STRING(filename);
1253 /* If the file name has special constructs in it,
1254 call the corresponding file handler. */
1255 handler = Ffind_file_name_handler(filename, Qsubstitute_in_file_name);
1257 return call2_check_string_or_nil(handler,
1258 Qsubstitute_in_file_name,
1261 nm = XSTRING_DATA(filename);
1262 endp = nm + XSTRING_LENGTH(filename);
1264 /* If /~ or // appears, discard everything through first slash. */
1266 for (p = nm; p != endp; p++) {
1268 || IS_DIRECTORY_SEP(p[0])
1270 && p != nm && (IS_DIRECTORY_SEP(p[-1]))) {
1276 /* See if any variables are substituted into the string
1277 and find the total length of their values in `total' */
1279 for (p = nm; p != endp;)
1286 else if (*p == '$') {
1287 /* "$$" means a single "$" */
1292 } else if (*p == '{') {
1294 while (p != endp && *p != '}')
1301 while (p != endp && (isalnum(*p) || *p == '_'))
1306 /* Copy out the variable name */
1307 target = (Bufbyte *) alloca(s - o + 1);
1308 strncpy((char *)target, (char *)o, s - o);
1309 target[s - o] = '\0';
1311 /* Get variable value */
1312 o = (Bufbyte *) egetenv((char *)target);
1315 total += strlen((char *)o);
1322 /* If substitution required, recopy the filename and do it */
1323 /* Make space in stack frame for the new copy */
1324 xnm = (Bufbyte *) alloca(XSTRING_LENGTH(filename) + total + 1);
1327 /* Copy the rest of the name through, replacing $ constructs with values */
1335 else if (*p == '$') {
1338 } else if (*p == '{') {
1340 while (p != endp && *p != '}')
1347 while (p != endp && (isalnum(*p) || *p == '_'))
1352 /* Copy out the variable name */
1353 target = (Bufbyte *) alloca(s - o + 1);
1354 strncpy((char *)target, (char *)o, s - o);
1355 target[s - o] = '\0';
1357 /* Get variable value */
1358 o = (Bufbyte *) egetenv((char *)target);
1362 strcpy((char *)x, (char *)o);
1363 x += strlen((char *)o);
1368 /* If /~ or // appears, discard everything through first slash. */
1370 for (p = xnm; p != x; p++)
1372 || IS_DIRECTORY_SEP(p[0])
1374 /* don't do p[-1] if that would go off the beginning --jwz */
1375 && p != nm && p > xnm && IS_DIRECTORY_SEP(p[-1]))
1378 return make_string(xnm, x - xnm);
1381 syntax_error("Bad format environment-variable substitution", filename);
1383 syntax_error("Missing \"}\" in environment-variable substitution",
1386 syntax_error_2("Substituting nonexistent environment variable",
1387 filename, build_string((char *)target));
1390 return Qnil; /* suppress compiler warning */
1393 /* A slightly faster and more convenient way to get
1394 (directory-file-name (expand-file-name FOO)). */
1396 Lisp_Object expand_and_dir_to_file(Lisp_Object filename, Lisp_Object defdir)
1398 /* This function can call Lisp. GC checked 2000-07-28 ben */
1399 Lisp_Object abspath;
1400 struct gcpro gcpro1;
1402 abspath = Fexpand_file_name(filename, defdir);
1404 /* Remove final slash, if any (unless path is root).
1405 stat behaves differently depending! */
1406 if (XSTRING_LENGTH(abspath) > 1
1408 IS_DIRECTORY_SEP(XSTRING_BYTE(abspath, XSTRING_LENGTH(abspath) - 1))
1410 !IS_DEVICE_SEP(XSTRING_BYTE(abspath, XSTRING_LENGTH(abspath) - 2)))
1411 /* We cannot take shortcuts; they might be wrong for magic file names. */
1412 abspath = Fdirectory_file_name(abspath);
1417 /* Signal an error if the file ABSNAME already exists.
1418 If INTERACTIVE is nonzero, ask the user whether to proceed,
1419 and bypass the error if the user says to go ahead.
1420 QUERYSTRING is a name for the action that is being considered
1422 *STATPTR is used to store the stat information if the file exists.
1423 If the file does not exist, STATPTR->st_mode is set to 0. */
1426 barf_or_query_if_file_exists(Lisp_Object absname, const char *querystring,
1427 int interactive, struct stat *statptr)
1429 /* This function can call Lisp. GC checked 2000-07-28 ben */
1430 struct stat statbuf;
1432 /* stat is a good way to tell whether the file exists,
1433 regardless of what access permissions it has. */
1434 if (sxemacs_stat((char *)XSTRING_DATA(absname), &statbuf) >= 0) {
1439 struct gcpro gcpro1;
1441 prompt = emacs_doprnt_string_c
1443 GETTEXT("File %s already exists; %s anyway? "),
1444 Qnil, -1, XSTRING_DATA(absname),
1445 GETTEXT(querystring));
1448 tem = call1(Qyes_or_no_p, prompt);
1454 Fsignal(Qfile_already_exists,
1455 list2(build_translated_string
1456 ("File already exists"), absname));
1461 statptr->st_mode = 0;
1466 DEFUN("copy-file", Fcopy_file, 2, 4, "fCopy file: \nFCopy %s to file: \np\nP", /*
1467 Copy FILENAME to NEWNAME. Both args must be strings.
1468 Signals a `file-already-exists' error if file NEWNAME already exists,
1469 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1470 A number as third arg means request confirmation if NEWNAME already exists.
1471 This is what happens in interactive use with M-x.
1472 Fourth arg KEEP-TIME non-nil means give the new file the same
1473 last-modified time as the old one. (This works on only some systems.)
1474 A prefix arg makes KEEP-TIME non-nil.
1476 (filename, newname, ok_if_already_exists, keep_time))
1478 /* This function can call Lisp. GC checked 2000-07-28 ben */
1480 char buf[16 * 1024];
1481 struct stat st, out_st;
1482 Lisp_Object handler;
1483 int speccount = specpdl_depth();
1484 struct gcpro gcpro1, gcpro2;
1485 /* Lisp_Object args[6]; */
1486 int input_file_statable_p;
1488 GCPRO2(filename, newname);
1489 CHECK_STRING(filename);
1490 CHECK_STRING(newname);
1491 filename = Fexpand_file_name(filename, Qnil);
1492 newname = Fexpand_file_name(newname, Qnil);
1494 /* If the input file name has special constructs in it,
1495 call the corresponding file handler. */
1496 handler = Ffind_file_name_handler(filename, Qcopy_file);
1497 /* Likewise for output file name. */
1499 handler = Ffind_file_name_handler(newname, Qcopy_file);
1500 if (!NILP(handler)) {
1502 return call5(handler, Qcopy_file, filename, newname,
1503 ok_if_already_exists, keep_time);
1506 /* When second argument is a directory, copy the file into it.
1507 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1509 if (!NILP(Ffile_directory_p(newname))) {
1510 Lisp_Object args[3] = {newname, Qnil, Qnil};
1511 struct gcpro ngcpro1;
1514 NGCPROn(args, countof(args));
1515 if (!IS_DIRECTORY_SEP(
1516 XSTRING_BYTE(newname,
1517 XSTRING_LENGTH(newname) - 1))) {
1518 args[i++] = Fchar_to_string(Vdirectory_sep_char);
1520 args[i++] = Ffile_name_nondirectory(filename);
1521 newname = Fconcat(i, args);
1525 if (NILP(ok_if_already_exists)
1526 || INTP(ok_if_already_exists))
1527 barf_or_query_if_file_exists(newname, "copy to it",
1528 INTP(ok_if_already_exists),
1530 else if (sxemacs_stat((const char *)XSTRING_DATA(newname), &out_st) < 0)
1533 ifd = interruptible_open((char *)XSTRING_DATA(filename),
1534 O_RDONLY | OPEN_BINARY, 0);
1536 report_file_error("Opening input file", list1(filename));
1539 record_unwind_protect(close_file_unwind, make_int(ifd));
1541 /* We can only copy regular files and symbolic links. Other files are not
1543 input_file_statable_p = (fstat(ifd, &st) >= 0);
1545 if (out_st.st_mode != 0
1546 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) {
1548 report_file_error("Input and output files are the same",
1549 list2(filename, newname));
1552 #if defined (S_ISREG) && defined (S_ISLNK)
1553 if (input_file_statable_p) {
1554 if (!(S_ISREG(st.st_mode))
1555 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1557 && !(S_ISCHR(st.st_mode))
1559 && !(S_ISLNK(st.st_mode))) {
1560 #if defined (EISDIR)
1561 /* Get a better looking error message. */
1564 report_file_error("Non-regular file", list1(filename));
1567 #endif /* S_ISREG && S_ISLNK */
1569 ofd = open((char *)XSTRING_DATA(newname),
1570 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1572 report_file_error("Opening output file", list1(newname));
1575 Lisp_Object ofd_locative = noseeum_cons(make_int(ofd), Qnil);
1577 record_unwind_protect(close_file_unwind, ofd_locative);
1579 while ((n = read_allowing_quit(ifd, buf, sizeof(buf))) > 0) {
1580 if (write_allowing_quit(ofd, buf, n) != n)
1581 report_file_error("I/O error", list1(newname));
1585 report_file_error("I/O error", list1(filename));
1586 /* Closing the output clobbers the file times on some systems. */
1588 report_file_error("I/O error", list1(newname));
1590 if (input_file_statable_p) {
1591 if (!NILP(keep_time)) {
1592 EMACS_TIME atime, mtime;
1593 EMACS_SET_SECS_USECS(atime, st.st_atime, 0);
1594 EMACS_SET_SECS_USECS(mtime, st.st_mtime, 0);
1595 if (set_file_times(newname, atime, mtime))
1596 report_file_error("I/O error",
1599 chmod((const char *)XSTRING_DATA(newname),
1600 st.st_mode & 07777);
1603 /* We'll close it by hand */
1604 XCAR(ofd_locative) = Qnil;
1607 unbind_to(speccount, Qnil);
1614 DEFUN("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1615 Create a directory. One argument, a file name string.
1619 /* This function can GC. GC checked 1997.04.06. */
1620 char dir[MAXPATHLEN];
1621 Lisp_Object handler;
1622 struct gcpro gcpro1;
1624 CHECK_STRING(dirname_);
1625 dirname_ = Fexpand_file_name(dirname_, Qnil);
1628 handler = Ffind_file_name_handler(dirname_, Qmake_directory_internal);
1631 return (call2(handler, Qmake_directory_internal, dirname_));
1633 if (XSTRING_LENGTH(dirname_) > (Bytecount) (sizeof(dir) - 1)) {
1634 return Fsignal(Qfile_error,
1635 list3(build_translated_string
1636 ("Creating directory"),
1637 build_translated_string
1638 ("pathname too long"), dirname_));
1640 strncpy(dir, (char *)XSTRING_DATA(dirname_),
1641 XSTRING_LENGTH(dirname_) + 1);
1642 dir[XSTRING_LENGTH(dirname_)]='\0';
1643 if (dir[XSTRING_LENGTH(dirname_) - 1] == '/')
1644 dir[XSTRING_LENGTH(dirname_) - 1] = '\0';
1646 if (mkdir(dir, 0777) != 0)
1647 report_file_error("Creating directory", list1(dirname_));
1652 DEFUN("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1653 Delete a directory. One argument, a file name or directory name string.
1657 /* This function can GC. GC checked 1997.04.06. */
1658 Lisp_Object handler;
1659 struct gcpro gcpro1;
1661 CHECK_STRING(dirname_);
1664 dirname_ = Fexpand_file_name(dirname_, Qnil);
1665 dirname_ = Fdirectory_file_name(dirname_);
1667 handler = Ffind_file_name_handler(dirname_, Qdelete_directory);
1670 return (call2(handler, Qdelete_directory, dirname_));
1672 if (rmdir((char *)XSTRING_DATA(dirname_)) != 0)
1673 report_file_error("Removing directory", list1(dirname_));
1678 DEFUN("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1679 Delete the file named FILENAME (a string).
1680 If FILENAME has multiple names, it continues to exist with the other names.
1684 /* This function can GC. GC checked 1997.04.06. */
1685 Lisp_Object handler;
1686 struct gcpro gcpro1;
1688 CHECK_STRING(filename);
1689 filename = Fexpand_file_name(filename, Qnil);
1692 handler = Ffind_file_name_handler(filename, Qdelete_file);
1695 return call2(handler, Qdelete_file, filename);
1697 if (0 > unlink((char *)XSTRING_DATA(filename)))
1698 report_file_error("Removing old name", list1(filename));
1703 internal_delete_file_1(Lisp_Object ignore, Lisp_Object ignore2)
1708 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1710 int internal_delete_file(Lisp_Object filename)
1712 /* This function can GC. GC checked 1997.04.06. */
1713 return NILP(condition_case_1(Qt, Fdelete_file, filename,
1714 internal_delete_file_1, Qnil));
1717 DEFUN("rename-file", Frename_file, 2, 3, "fRename file: \nFRename %s to file: \np", /*
1718 Rename FILENAME as NEWNAME. Both args must be strings.
1719 If file has names other than FILENAME, it continues to have those names.
1720 Signals a `file-already-exists' error if a file NEWNAME already exists
1721 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1722 A number as third arg means request confirmation if NEWNAME already exists.
1723 This is what happens in interactive use with M-x.
1725 (filename, newname, ok_if_already_exists))
1727 /* This function can GC. GC checked 1997.04.06. */
1728 Lisp_Object handler;
1729 struct gcpro gcpro1, gcpro2;
1731 GCPRO2(filename, newname);
1732 CHECK_STRING(filename);
1733 CHECK_STRING(newname);
1734 filename = Fexpand_file_name(filename, Qnil);
1735 newname = Fexpand_file_name(newname, Qnil);
1737 /* If the file name has special constructs in it,
1738 call the corresponding file handler. */
1739 handler = Ffind_file_name_handler(filename, Qrename_file);
1741 handler = Ffind_file_name_handler(newname, Qrename_file);
1742 if (!NILP(handler)) {
1744 return call4(handler, Qrename_file,
1745 filename, newname, ok_if_already_exists);
1748 /* When second argument is a directory, rename the file into it.
1749 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1751 if (!NILP(Ffile_directory_p(newname))) {
1752 Lisp_Object args[3] = {newname, Qnil, Qnil};
1753 struct gcpro ngcpro1;
1756 NGCPROn(args, countof(args));
1757 if (XSTRING_BYTE(newname, XSTRING_LENGTH(newname) - 1) != '/') {
1758 args[i++] = build_string("/");
1760 args[i++] = Ffile_name_nondirectory(filename);
1761 newname = Fconcat(i, args);
1765 if (NILP(ok_if_already_exists)
1766 || INTP(ok_if_already_exists))
1767 barf_or_query_if_file_exists(newname, "rename to it",
1768 INTP(ok_if_already_exists), 0);
1770 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1771 WIN32_NATIVE here; I've removed it. --marcpa */
1773 /* We have configure check for rename() and emulate using
1774 link()/unlink() if necessary. */
1775 if (0 > rename((char *)XSTRING_DATA(filename),
1776 (char *)XSTRING_DATA(newname))) {
1777 if (errno == EXDEV) {
1778 Fcopy_file(filename, newname,
1779 /* We have already prompted if it was an integer,
1780 so don't have copy-file prompt again. */
1781 (NILP(ok_if_already_exists) ? Qnil : Qt),
1783 Fdelete_file(filename);
1785 report_file_error("Renaming", list2(filename, newname));
1792 DEFUN("add-name-to-file", Fadd_name_to_file, 2, 3, "fAdd name to file: \nFName to add to %s: \np", /*
1793 Give FILENAME additional name NEWNAME. Both args must be strings.
1794 Signals a `file-already-exists' error if a file NEWNAME already exists
1795 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1796 A number as third arg means request confirmation if NEWNAME already exists.
1797 This is what happens in interactive use with M-x.
1799 (filename, newname, ok_if_already_exists))
1801 /* This function can GC. GC checked 1997.04.06. */
1802 Lisp_Object handler;
1803 struct gcpro gcpro1, gcpro2;
1805 GCPRO2(filename, newname);
1806 CHECK_STRING(filename);
1807 CHECK_STRING(newname);
1808 filename = Fexpand_file_name(filename, Qnil);
1809 newname = Fexpand_file_name(newname, Qnil);
1811 /* If the file name has special constructs in it,
1812 call the corresponding file handler. */
1813 handler = Ffind_file_name_handler(filename, Qadd_name_to_file);
1815 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1816 newname, ok_if_already_exists));
1818 /* If the new name has special constructs in it,
1819 call the corresponding file handler. */
1820 handler = Ffind_file_name_handler(newname, Qadd_name_to_file);
1822 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1823 newname, ok_if_already_exists));
1825 if (NILP(ok_if_already_exists)
1826 || INTP(ok_if_already_exists))
1827 barf_or_query_if_file_exists(newname, "make it a new name",
1828 INTP(ok_if_already_exists), 0);
1829 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
1830 on NT here. --marcpa */
1831 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
1832 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
1833 Reverted to previous behavior pending a working fix. (jhar) */
1835 unlink((char *)XSTRING_DATA(newname));
1836 if (0 > link((char *)XSTRING_DATA(filename),
1837 (char *)XSTRING_DATA(newname))) {
1838 report_file_error("Adding new name", list2(filename, newname));
1845 DEFUN("make-symbolic-link", Fmake_symbolic_link, 2, 3, "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
1846 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
1847 Signals a `file-already-exists' error if a file LINKNAME already exists
1848 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1849 A number as third arg means request confirmation if LINKNAME already exists.
1850 This happens for interactive use with M-x.
1852 (filename, linkname, ok_if_already_exists))
1854 /* This function can GC. GC checked 1997.06.04. */
1855 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
1856 Lisp_Object handler;
1857 struct gcpro gcpro1, gcpro2;
1859 GCPRO2(filename, linkname);
1860 CHECK_STRING(filename);
1861 CHECK_STRING(linkname);
1862 /* If the link target has a ~, we must expand it to get
1863 a truly valid file name. Otherwise, do not expand;
1864 we want to permit links to relative file names. */
1865 if (XSTRING_BYTE(filename, 0) == '~')
1866 filename = Fexpand_file_name(filename, Qnil);
1867 linkname = Fexpand_file_name(linkname, Qnil);
1869 /* If the file name has special constructs in it,
1870 call the corresponding file handler. */
1871 handler = Ffind_file_name_handler(filename, Qmake_symbolic_link);
1873 RETURN_UNGCPRO(call4
1874 (handler, Qmake_symbolic_link, filename,
1875 linkname, ok_if_already_exists));
1877 /* If the new link name has special constructs in it,
1878 call the corresponding file handler. */
1879 handler = Ffind_file_name_handler(linkname, Qmake_symbolic_link);
1881 RETURN_UNGCPRO(call4(handler, Qmake_symbolic_link, filename,
1882 linkname, ok_if_already_exists));
1885 if (NILP(ok_if_already_exists)
1886 || INTP(ok_if_already_exists))
1887 barf_or_query_if_file_exists(linkname, "make it a link",
1888 INTP(ok_if_already_exists), 0);
1890 unlink((char *)XSTRING_DATA(linkname));
1891 if (0 > symlink((char *)XSTRING_DATA(filename),
1892 (char *)XSTRING_DATA(linkname))) {
1893 report_file_error("Making symbolic link",
1894 list2(filename, linkname));
1896 #endif /* S_IFLNK */
1904 DEFUN("sysnetunam", Fsysnetunam, 2, 2, 0, /*
1905 Open a network connection to PATH using LOGIN as the login string.
1910 const char *path_ext;
1911 const char *login_ext;
1914 CHECK_STRING(login);
1916 /* netunam, being a strange-o system call only used once, is not
1919 LISP_STRING_TO_EXTERNAL(path, path_ext, Qfile_name);
1920 LISP_STRING_TO_EXTERNAL(login, login_ext, Qnative);
1922 netresult = netunam(path_ext, login_ext);
1924 return netresult == -1 ? Qnil : Qt;
1926 #endif /* HPUX_NET */
1928 DEFUN("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
1929 Return t if file FILENAME specifies an absolute path name.
1930 On Unix, this is a name starting with a `/' or a `~'.
1934 /* This function does not GC */
1937 CHECK_STRING(filename);
1938 ptr = XSTRING_DATA(filename);
1939 return (IS_DIRECTORY_SEP(*ptr) || *ptr == '~'
1943 /* Return nonzero if file FILENAME exists and can be executed. */
1945 static int check_executable(char *filename)
1948 return eaccess(filename, X_OK) >= 0;
1950 /* Access isn't quite right because it uses the real uid
1951 and we really want to test with the effective uid.
1952 But Unix doesn't give us a right way to do it. */
1953 return access(filename, X_OK) >= 0;
1954 #endif /* HAVE_EACCESS */
1957 /* Return nonzero if file FILENAME exists and can be written. */
1959 static int check_writable(const char *filename)
1962 return (eaccess(filename, W_OK) >= 0);
1964 /* Access isn't quite right because it uses the real uid
1965 and we really want to test with the effective uid.
1966 But Unix doesn't give us a right way to do it.
1967 Opening with O_WRONLY could work for an ordinary file,
1968 but would lose for directories. */
1969 return (access(filename, W_OK) >= 0);
1973 DEFUN("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
1974 Return t if file FILENAME exists. (This does not mean you can read it.)
1975 See also `file-readable-p' and `file-attributes'.
1979 /* This function can call lisp; GC checked 2000-07-11 ben */
1980 Lisp_Object abspath;
1981 Lisp_Object handler;
1982 struct stat statbuf;
1983 struct gcpro gcpro1;
1985 CHECK_STRING(filename);
1986 abspath = Fexpand_file_name(filename, Qnil);
1988 /* If the file name has special constructs in it,
1989 call the corresponding file handler. */
1991 handler = Ffind_file_name_handler(abspath, Qfile_exists_p);
1994 return call2(handler, Qfile_exists_p, abspath);
1996 return sxemacs_stat((char *)XSTRING_DATA(abspath),
1997 &statbuf) >= 0 ? Qt : Qnil;
2000 DEFUN("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
2001 Return t if FILENAME can be executed by you.
2002 For a directory, this means you can access files in that directory.
2006 /* This function can GC. GC checked 07-11-2000 ben. */
2007 Lisp_Object abspath;
2008 Lisp_Object handler;
2009 struct gcpro gcpro1;
2011 CHECK_STRING(filename);
2012 abspath = Fexpand_file_name(filename, Qnil);
2014 /* If the file name has special constructs in it,
2015 call the corresponding file handler. */
2017 handler = Ffind_file_name_handler(abspath, Qfile_executable_p);
2020 return call2(handler, Qfile_executable_p, abspath);
2022 return check_executable((char *)XSTRING_DATA(abspath)) ? Qt : Qnil;
2025 DEFUN("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2026 Return t if file FILENAME exists and you can read it.
2027 See also `file-exists-p' and `file-attributes'.
2031 /* This function can GC */
2032 Lisp_Object abspath = Qnil;
2033 Lisp_Object handler;
2034 struct gcpro gcpro1;
2037 CHECK_STRING(filename);
2038 abspath = Fexpand_file_name(filename, Qnil);
2040 /* If the file name has special constructs in it,
2041 call the corresponding file handler. */
2042 handler = Ffind_file_name_handler(abspath, Qfile_readable_p);
2044 RETURN_UNGCPRO(call2(handler, Qfile_readable_p, abspath));
2048 interruptible_open((char *)XSTRING_DATA(abspath),
2049 O_RDONLY | OPEN_BINARY, 0);
2058 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2060 DEFUN("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2061 Return t if file FILENAME can be written or created by you.
2065 /* This function can GC. GC checked 1997.04.10. */
2066 Lisp_Object abspath, dir;
2067 Lisp_Object handler;
2068 struct stat statbuf;
2069 struct gcpro gcpro1;
2071 CHECK_STRING(filename);
2072 abspath = Fexpand_file_name(filename, Qnil);
2074 /* If the file name has special constructs in it,
2075 call the corresponding file handler. */
2077 handler = Ffind_file_name_handler(abspath, Qfile_writable_p);
2080 return call2(handler, Qfile_writable_p, abspath);
2082 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &statbuf) >= 0)
2083 return (check_writable((char *)XSTRING_DATA(abspath))
2087 dir = Ffile_name_directory(abspath);
2089 return (check_writable(!NILP(dir) ? (char *)XSTRING_DATA(dir)
2094 DEFUN("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2095 Return non-nil if file FILENAME is the name of a symbolic link.
2096 The value is the name of the file to which it is linked.
2097 Otherwise returns nil.
2101 /* This function can GC. GC checked 1997.04.10. */
2102 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2109 Lisp_Object handler;
2110 struct gcpro gcpro1;
2112 CHECK_STRING(filename);
2113 filename = Fexpand_file_name(filename, Qnil);
2115 /* If the file name has special constructs in it,
2116 call the corresponding file handler. */
2118 handler = Ffind_file_name_handler(filename, Qfile_symlink_p);
2120 if (!NILP(handler)) {
2121 return call2(handler, Qfile_symlink_p, filename);
2126 buf = ynew_array_and_zero(char, bufsize);
2127 valsize = readlink((char *)XSTRING_DATA(filename),
2129 if (valsize < bufsize) {
2132 /* Buffer was not long enough */
2136 if (valsize == -1) {
2140 val = make_string((Bufbyte*)buf, valsize);
2143 #else /* not S_IFLNK */
2145 #endif /* not S_IFLNK */
2148 DEFUN("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2149 Return t if file FILENAME is the name of a directory as a file.
2150 A directory name spec may be given instead; then the value is t
2151 if the directory so specified exists and really is a directory.
2155 /* This function can GC. GC checked 1997.04.10. */
2156 Lisp_Object abspath;
2158 Lisp_Object handler;
2159 struct gcpro gcpro1;
2161 GCPRO1(current_buffer->directory);
2162 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2165 /* If the file name has special constructs in it,
2166 call the corresponding file handler. */
2168 handler = Ffind_file_name_handler(abspath, Qfile_directory_p);
2171 return call2(handler, Qfile_directory_p, abspath);
2173 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2175 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2178 DEFUN("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2179 Return t if file FILENAME is the name of a directory as a file,
2180 and files in that directory can be opened by you. In order to use a
2181 directory as a buffer's current directory, this predicate must return true.
2182 A directory name spec may be given instead; then the value is t
2183 if the directory so specified exists and really is a readable and
2184 searchable directory.
2188 /* This function can GC. GC checked 1997.04.10. */
2189 Lisp_Object handler;
2191 /* If the file name has special constructs in it,
2192 call the corresponding file handler. */
2194 Ffind_file_name_handler(filename, Qfile_accessible_directory_p);
2196 return call2(handler, Qfile_accessible_directory_p, filename);
2198 if (NILP(Ffile_directory_p(filename)))
2201 return Ffile_executable_p(filename);
2204 DEFUN("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2205 Return t if file FILENAME is the name of a regular file.
2206 This is the sort of file that holds an ordinary stream of data bytes.
2210 /* This function can GC. GC checked 1997.04.10. */
2211 Lisp_Object abspath;
2213 Lisp_Object handler;
2214 struct gcpro gcpro1;
2216 GCPRO1(current_buffer->directory);
2217 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2220 /* If the file name has special constructs in it,
2221 call the corresponding file handler. */
2223 handler = Ffind_file_name_handler(abspath, Qfile_regular_p);
2226 return call2(handler, Qfile_regular_p, abspath);
2228 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2230 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2233 DEFUN("file-modes", Ffile_modes, 1, 1, 0, /*
2234 Return mode bits of file named FILENAME, as an integer.
2238 /* This function can GC. GC checked 1997.04.10. */
2239 Lisp_Object abspath;
2241 Lisp_Object handler;
2242 struct gcpro gcpro1;
2244 GCPRO1(current_buffer->directory);
2245 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2248 /* If the file name has special constructs in it,
2249 call the corresponding file handler. */
2251 handler = Ffind_file_name_handler(abspath, Qfile_modes);
2254 return call2(handler, Qfile_modes, abspath);
2256 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2258 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2260 return make_int(st.st_mode & 07777);
2263 DEFUN("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2264 Set mode bits of file named FILENAME to MODE (an integer).
2265 Only the 12 low bits of MODE are used.
2269 /* This function can GC. GC checked 1997.04.10. */
2270 Lisp_Object abspath;
2271 Lisp_Object handler;
2272 struct gcpro gcpro1;
2274 GCPRO1(current_buffer->directory);
2275 abspath = Fexpand_file_name(filename, current_buffer->directory);
2280 /* If the file name has special constructs in it,
2281 call the corresponding file handler. */
2283 handler = Ffind_file_name_handler(abspath, Qset_file_modes);
2286 return call3(handler, Qset_file_modes, abspath, mode);
2288 if (chmod((char *)XSTRING_DATA(abspath), XINT(mode)) < 0)
2289 report_file_error("Doing chmod", list1(abspath));
2294 DEFUN("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2295 Set the file permission bits for newly created files.
2296 The argument MODE should be an integer; if a bit in MODE is 1,
2297 subsequently created files will not have the permission corresponding
2298 to that bit enabled. Only the low 9 bits are used.
2299 This setting is inherited by subprocesses.
2305 umask((~XINT(mode)) & 0777);
2310 DEFUN("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2311 Return the default file protection for created files.
2312 The umask value determines which permissions are enabled in newly
2313 created files. If a permission's bit in the umask is 1, subsequently
2314 created files will not have that permission enabled.
2323 return make_int((~mode) & 0777);
2326 DEFUN("unix-sync", Funix_sync, 0, 0, "", /*
2327 Tell Unix to finish all pending disk updates.
2335 DEFUN("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2336 Return t if file FILE1 is newer than file FILE2.
2337 If FILE1 does not exist, the answer is nil;
2338 otherwise, if FILE2 does not exist, the answer is t.
2342 /* This function can GC. GC checked 1997.04.10. */
2343 Lisp_Object abspath1, abspath2;
2346 Lisp_Object handler;
2347 struct gcpro gcpro1, gcpro2, gcpro3;
2349 CHECK_STRING(file1);
2350 CHECK_STRING(file2);
2355 GCPRO3(abspath1, abspath2, current_buffer->directory);
2356 abspath1 = expand_and_dir_to_file(file1, current_buffer->directory);
2357 abspath2 = expand_and_dir_to_file(file2, current_buffer->directory);
2359 /* If the file name has special constructs in it,
2360 call the corresponding file handler. */
2361 handler = Ffind_file_name_handler(abspath1, Qfile_newer_than_file_p);
2364 Ffind_file_name_handler(abspath2, Qfile_newer_than_file_p);
2367 return call3(handler, Qfile_newer_than_file_p, abspath1,
2370 if (sxemacs_stat((char *)XSTRING_DATA(abspath1), &st) < 0)
2373 mtime1 = st.st_mtime;
2375 if (sxemacs_stat((char *)XSTRING_DATA(abspath2), &st) < 0)
2378 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2381 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2382 /* #define READ_BUF_SIZE (2 << 16) */
2383 #define READ_BUF_SIZE (1 << 15)
2385 DEFUN("insert-file-contents-internal", Finsert_file_contents_internal, 1, 7, 0, /*
2386 Insert contents of file FILENAME after point; no coding-system frobbing.
2387 This function is identical to `insert-file-contents' except for the
2388 handling of the CODESYS and USED-CODESYS arguments under
2389 SXEmacs/Mule. (When Mule support is not present, both functions are
2390 identical and ignore the CODESYS and USED-CODESYS arguments.)
2392 If support for Mule exists in this Emacs, the file is decoded according
2393 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2394 it should be a symbol, and the actual coding system that was used for the
2395 decoding is stored into it. It will in general be different from CODESYS
2396 if CODESYS specifies automatic encoding detection or end-of-line detection.
2398 Currently START and END refer to byte positions (as opposed to character
2399 positions), even in Mule. (Fixing this is very difficult.)
2401 (filename, visit, start, end, replace, codesys, used_codesys))
2403 /* This function can call lisp */
2407 Charcount inserted = 0;
2409 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2410 Lisp_Object handler = Qnil, val = Qnil;
2412 Bufbyte read_buf[READ_BUF_SIZE];
2414 struct buffer *buf = current_buffer;
2416 int not_regular = 0;
2418 if (UNLIKELY(buf->base_buffer && !NILP(visit))) {
2419 error("Cannot do file visiting in an indirect buffer");
2422 /* No need to call Fbarf_if_buffer_read_only() here.
2423 That's called in begin_multiple_change() or wherever. */
2424 /* #### dmoore - should probably check in various places to see if
2425 curbuf was killed and if so signal an error? */
2426 XSETBUFFER(curbuf, buf);
2428 GCPRO5(filename, val, visit, handler, curbuf);
2430 if (LIKELY(NILP(replace))) {
2431 mc_count = begin_multiple_change(buf, BUF_PT(buf), BUF_PT(buf));
2433 mc_count = begin_multiple_change(buf, BUF_BEG(buf), BUF_Z(buf));
2436 /* begin_multiple_change also adds an unwind_protect */
2437 speccount = specpdl_depth();
2439 filename = Fexpand_file_name(filename, Qnil);
2441 /* If the file name has special constructs in it,
2442 call the corresponding file handler. */
2443 handler = Ffind_file_name_handler(filename, Qinsert_file_contents);
2444 if (!NILP(handler)) {
2445 val = call6(handler, Qinsert_file_contents, filename,
2446 visit, start, end, replace);
2450 if (!NILP(used_codesys))
2451 CHECK_SYMBOL(used_codesys);
2454 if ((!NILP(start) || !NILP(end)) && !NILP(visit))
2455 error("Attempt to visit less than an entire file");
2459 if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) < 0) {
2464 report_file_error("Opening input file",
2470 /* Signal an error if we are accessing a non-regular file, with
2471 REPLACE, START or END being non-nil. */
2472 if (!S_ISREG(st.st_mode)) {
2478 if (!NILP(replace) || !NILP(start) || !NILP(end)) {
2479 end_multiple_change(buf, mc_count);
2482 (Fsignal(Qfile_error,
2483 list2(build_translated_string
2484 ("not a regular file"), filename)));
2487 #endif /* S_IFREG */
2498 if ((fd = interruptible_open((char *)XSTRING_DATA(filename),
2499 O_RDONLY | OPEN_BINARY, 0)) < 0)
2503 /* Replacement should preserve point as it preserves markers. */
2505 record_unwind_protect(restore_point_unwind,
2506 Fpoint_marker(Qnil, Qnil));
2508 record_unwind_protect(close_file_unwind, make_int(fd));
2510 /* Supposedly happens on VMS. */
2512 error("File size is negative");
2516 end = make_int(st.st_size);
2517 if (XINT(end) != st.st_size)
2518 error("Maximum buffer size exceeded");
2522 /* If requested, replace the accessible part of the buffer
2523 with the file contents. Avoid replacing text at the
2524 beginning or end of the buffer that matches the file contents;
2525 that preserves markers pointing to the unchanged parts. */
2526 #if !defined (FILE_CODING)
2527 /* The replace-mode code currently only works when the assumption
2528 'one byte == one char' holds true. This fails Mule because
2529 files may contain multibyte characters. It holds under Windows NT
2530 provided we convert CRLF into LF. */
2531 # define FSFMACS_SPEEDY_INSERT
2532 #endif /* !defined (FILE_CODING) */
2534 #ifndef FSFMACS_SPEEDY_INSERT
2535 if (!NILP(replace)) {
2536 buffer_delete_range(buf, BUF_BEG(buf), BUF_Z(buf),
2537 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2539 #else /* FSFMACS_SPEEDY_INSERT */
2540 if (!NILP(replace)) {
2541 char buffer[1 << 14];
2542 Bufpos same_at_start = BUF_BEGV(buf);
2543 Bufpos same_at_end = BUF_ZV(buf);
2546 /* Count how many chars at the start of the file
2547 match the text at the beginning of the buffer. */
2551 nread = read_allowing_quit(fd, buffer, sizeof buffer);
2553 error("IO error reading %s: %s",
2554 XSTRING_DATA(filename), strerror(errno));
2555 else if (nread == 0)
2558 while (bufpos < nread && same_at_start < BUF_ZV(buf)
2559 && BUF_FETCH_CHAR(buf,
2562 same_at_start++, bufpos++;
2563 /* If we found a discrepancy, stop the scan.
2564 Otherwise loop around and scan the next bufferful. */
2565 if (bufpos != nread)
2568 /* If the file matches the buffer completely,
2569 there's no need to replace anything. */
2570 if (same_at_start - BUF_BEGV(buf) == st.st_size) {
2572 unbind_to(speccount, Qnil);
2573 /* Truncate the buffer to the size of the file. */
2574 buffer_delete_range(buf, same_at_start, same_at_end,
2575 !NILP(visit) ? INSDEL_NO_LOCKING :
2579 /* Count how many chars at the end of the file
2580 match the text at the end of the buffer. */
2582 int total_read, nread;
2583 Bufpos bufpos, curpos, trial;
2585 /* At what file position are we now scanning? */
2586 curpos = st.st_size - (BUF_ZV(buf) - same_at_end);
2587 /* If the entire file matches the buffer tail, stop the scan. */
2590 /* How much can we scan in the next step? */
2591 trial = min(curpos, (Bufpos) sizeof(buffer));
2592 if (lseek(fd, curpos - trial, 0) < 0)
2593 report_file_error("Setting file position",
2597 while (total_read < trial) {
2599 read_allowing_quit(fd, buffer + total_read,
2600 trial - total_read);
2603 ("IO error reading file",
2605 total_read += nread;
2607 /* Scan this bufferful from the end, comparing with
2608 the Emacs buffer. */
2609 bufpos = total_read;
2610 /* Compare with same_at_start to avoid counting some buffer text
2611 as matching both at the file's beginning and at the end. */
2612 while (bufpos > 0 && same_at_end > same_at_start
2613 && BUF_FETCH_CHAR(buf, same_at_end - 1) ==
2615 same_at_end--, bufpos--;
2616 /* If we found a discrepancy, stop the scan.
2617 Otherwise loop around and scan the preceding bufferful. */
2620 /* If display current starts at beginning of line,
2621 keep it that way. */
2622 if (XBUFFER(XWINDOW(Fselected_window(Qnil))->buffer) ==
2624 XWINDOW(Fselected_window(Qnil))->
2626 !NILP(Fbolp(make_buffer(buf)));
2629 /* Don't try to reuse the same piece of text twice. */
2630 overlap = same_at_start - BUF_BEGV(buf) -
2631 (same_at_end + st.st_size - BUF_ZV(buf));
2633 same_at_end += overlap;
2635 /* Arrange to read only the nonmatching middle part of the file. */
2636 start = make_int(same_at_start - BUF_BEGV(buf));
2637 end = make_int(st.st_size - (BUF_ZV(buf) - same_at_end));
2639 buffer_delete_range(buf, same_at_start, same_at_end,
2640 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2641 /* Insert from the file at the proper position. */
2642 BUF_SET_PT(buf, same_at_start);
2644 #endif /* FSFMACS_SPEEDY_INSERT */
2647 total = XINT(end) - XINT(start);
2649 /* Make sure point-max won't overflow after this insertion. */
2650 if (total != XINT(make_int(total)))
2651 error("Maximum buffer size exceeded");
2653 /* For a special file, all we can do is guess. The value of -1
2654 will make the stream functions read as much as possible. */
2657 if (XINT(start) != 0
2658 #ifdef FSFMACS_SPEEDY_INSERT
2659 /* why was this here? asked jwz. The reason is that the replace-mode
2660 connivings above will normally put the file pointer other than
2661 where it should be. */
2663 #endif /* !FSFMACS_SPEEDY_INSERT */
2665 if (lseek(fd, XINT(start), 0) < 0)
2666 report_file_error("Setting file position",
2671 Bufpos cur_point = BUF_PT(buf);
2672 struct gcpro ngcpro1;
2673 Lisp_Object stream = make_filedesc_input_stream(fd, 0, total,
2677 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2680 stream = make_decoding_input_stream
2681 (XLSTREAM(stream), Fget_coding_system(codesys));
2682 Lstream_set_character_mode(XLSTREAM(stream));
2683 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2685 #endif /* FILE_CODING */
2687 record_unwind_protect(delete_stream_unwind, stream);
2689 /* No need to limit the amount of stuff we attempt to read. (It would
2690 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2691 occurs inside of the filedesc stream. */
2693 Lstream_data_count this_len;
2694 Charcount cc_inserted;
2697 this_len = Lstream_read(XLSTREAM(stream), read_buf,
2700 if (this_len <= 0) {
2707 buffer_insert_raw_string_1(buf, cur_point, read_buf,
2708 this_len, !NILP(visit)
2709 ? INSDEL_NO_LOCKING : 0);
2710 inserted += cc_inserted;
2711 cur_point += cc_inserted;
2714 if (!NILP(used_codesys)) {
2716 decoding_stream_coding_system(XLSTREAM(stream));
2717 Fset(used_codesys, XCODING_SYSTEM_NAME(tmp));
2719 #endif /* FILE_CODING */
2723 /* Close the file/stream */
2724 unbind_to(speccount, Qnil);
2726 if (saverrno != 0) {
2727 error("IO error reading %s: %s",
2728 XSTRING_DATA(filename), strerror(saverrno));
2734 end_multiple_change(buf, mc_count);
2737 if (!EQ(buf->undo_list, Qt))
2738 buf->undo_list = Qnil;
2739 if (NILP(handler)) {
2740 buf->modtime = st.st_mtime;
2741 buf->filename = filename;
2742 /* XEmacs addition: */
2743 /* This function used to be in C, ostensibly so that
2744 it could be called here. But that's just silly.
2745 There's no reason C code can't call out to Lisp
2746 code, and it's a lot cleaner this way. */
2747 /* Note: compute-buffer-file-truename is called for
2748 side-effect! Its return value is intentionally
2750 if (!NILP(Ffboundp(Qcompute_buffer_file_truename)))
2751 call1(Qcompute_buffer_file_truename,
2754 BUF_SAVE_MODIFF(buf) = BUF_MODIFF(buf);
2755 buf->auto_save_modified = BUF_MODIFF(buf);
2756 buf->saved_size = make_int(BUF_SIZE(buf));
2757 #ifdef CLASH_DETECTION
2758 if (NILP(handler)) {
2759 if (!NILP(buf->file_truename))
2760 unlock_file(buf->file_truename);
2761 unlock_file(filename);
2763 #endif /* CLASH_DETECTION */
2765 RETURN_UNGCPRO(Fsignal(Qfile_error,
2767 ("not a regular file"),
2770 /* If visiting nonexistent file, return nil. */
2771 if (buf->modtime == -1)
2772 report_file_error("Opening input file",
2776 /* Decode file format */
2778 Lisp_Object insval = call3(Qformat_decode,
2779 Qnil, make_int(inserted), visit);
2781 inserted = XINT(insval);
2786 struct gcpro ngcpro1;
2789 EXTERNAL_LIST_LOOP(p, Vafter_insert_file_functions) {
2790 Lisp_Object insval = call1(XCAR(p), make_int(inserted));
2791 if (!NILP(insval)) {
2792 CHECK_NATNUM(insval);
2793 inserted = XINT(insval);
2805 return (list2(filename, make_int(inserted)));
2808 static int a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
2809 Lisp_Object * annot);
2810 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end);
2812 /* If build_annotations switched buffers, switch back to BUF.
2813 Kill the temporary buffer that was selected in the meantime. */
2815 static Lisp_Object build_annotations_unwind(Lisp_Object buf)
2819 if (XBUFFER(buf) == current_buffer)
2821 tembuf = Fcurrent_buffer();
2823 Fkill_buffer(tembuf);
2827 DEFUN("write-region-internal", Fwrite_region_internal, 3, 7, "r\nFWrite region to file: ", /*
2828 Write current region into specified file; no coding-system frobbing.
2829 This function is identical to `write-region' except for the handling
2830 of the CODESYS argument under SXEmacs/Mule. (When Mule support is not
2831 present, both functions are identical and ignore the CODESYS argument.)
2832 If support for Mule exists in this Emacs, the file is encoded according
2833 to the value of CODESYS. If this is nil, no code conversion occurs.
2835 As a special kludge to support auto-saving, when START is nil START and
2836 END are set to the beginning and end, respectively, of the buffer,
2837 regardless of any restrictions. Don't use this feature. It is documented
2838 here because write-region handler writers need to be aware of it.
2840 (start, end, filename, append, visit, lockname, codesys))
2842 /* This function can call lisp. GC checked 2000-07-28 ben */
2844 int failure, stat_res;
2847 Lisp_Object fn = Qnil;
2848 int speccount = specpdl_depth();
2849 int visiting_other = STRINGP(visit);
2850 int visiting = (EQ(visit, Qt) || visiting_other);
2851 int quietly = (!visiting && !NILP(visit));
2852 Lisp_Object visit_file = Qnil;
2853 Lisp_Object annotations = Qnil;
2854 struct buffer *given_buffer;
2855 Bufpos start1, end1;
2856 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2857 struct gcpro ngcpro1, ngcpro2;
2860 XSETBUFFER(curbuf, current_buffer);
2862 /* start, end, visit, and append are never modified in this fun
2863 so we don't protect them. */
2864 GCPRO5(visit_file, filename, codesys, lockname, annotations);
2865 NGCPRO2(curbuf, fn);
2867 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
2868 we should signal an error rather than blissfully continuing
2869 along. ARGH, this function is going to lose lose lose. We need
2870 to protect the current_buffer from being destroyed, but the
2871 multiple return points make this a pain in the butt. ]] we do
2872 protect curbuf now. --ben */
2875 codesys = Fget_coding_system(codesys);
2876 #endif /* FILE_CODING */
2878 if (current_buffer->base_buffer && !NILP(visit))
2880 ("Cannot do file visiting in an indirect buffer", curbuf);
2882 if (!NILP(start) && !STRINGP(start))
2883 get_buffer_range_char(current_buffer, start, end, &start1,
2887 Lisp_Object handler;
2890 visit_file = Fexpand_file_name(visit, Qnil);
2892 visit_file = filename;
2893 filename = Fexpand_file_name(filename, Qnil);
2896 lockname = visit_file;
2898 /* We used to UNGCPRO here. BAD! visit_file is used below after
2899 more Lisp calling. */
2900 /* If the file name has special constructs in it,
2901 call the corresponding file handler. */
2902 handler = Ffind_file_name_handler(filename, Qwrite_region);
2903 /* If FILENAME has no handler, see if VISIT has one. */
2904 if (NILP(handler) && STRINGP(visit))
2905 handler = Ffind_file_name_handler(visit, Qwrite_region);
2907 if (!NILP(handler)) {
2909 call8(handler, Qwrite_region, start, end,
2910 filename, append, visit, lockname, codesys);
2912 BUF_SAVE_MODIFF(current_buffer) =
2913 BUF_MODIFF(current_buffer);
2914 current_buffer->saved_size =
2915 make_int(BUF_SIZE(current_buffer));
2916 current_buffer->filename = visit_file;
2917 MARK_MODELINE_CHANGED;
2925 #ifdef CLASH_DETECTION
2927 lock_file(lockname);
2928 #endif /* CLASH_DETECTION */
2930 /* Special kludge to simplify auto-saving. */
2932 start1 = BUF_BEG(current_buffer);
2933 end1 = BUF_Z(current_buffer);
2936 record_unwind_protect(build_annotations_unwind, Fcurrent_buffer());
2938 given_buffer = current_buffer;
2939 annotations = build_annotations(start, end);
2940 if (current_buffer != given_buffer) {
2941 start1 = BUF_BEGV(current_buffer);
2942 end1 = BUF_ZV(current_buffer);
2947 if (!NILP(append)) {
2949 open((char *)XSTRING_DATA(fn), O_WRONLY | OPEN_BINARY, 0);
2952 desc = open((char *)XSTRING_DATA(fn),
2953 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
2954 auto_saving ? auto_save_mode_bits : CREAT_MODE);
2958 #ifdef CLASH_DETECTION
2961 unlock_file(lockname);
2963 #endif /* CLASH_DETECTION */
2964 report_file_error("Opening output file", list1(filename));
2968 Lisp_Object desc_locative = Fcons(make_int(desc), Qnil);
2969 Lisp_Object instream = Qnil, outstream = Qnil;
2970 struct gcpro nngcpro1, nngcpro2;
2971 /* need to gcpro; QUIT could happen out of call to write() */
2972 NNGCPRO2(instream, outstream);
2974 record_unwind_protect(close_file_unwind, desc_locative);
2976 if (!NILP(append)) {
2977 if (lseek(desc, 0, 2) < 0) {
2978 #ifdef CLASH_DETECTION
2980 unlock_file(lockname);
2981 #endif /* CLASH_DETECTION */
2982 report_file_error("Lseek error",
2989 /* Note: I tried increasing the buffering size, along with
2990 various other tricks, but nothing seemed to make much of
2991 a difference in the time it took to save a large file.
2992 (Actually that's not true. With a local disk, changing
2993 the buffer size doesn't seem to make much difference.
2994 With an NFS-mounted disk, it could make a lot of difference
2995 because you're affecting the number of network requests
2996 that need to be made, and there could be a large latency
2997 for each request. So I've increased the buffer size
2999 outstream = make_filedesc_output_stream(desc, 0, -1, 0);
3000 Lstream_set_buffering(XLSTREAM(outstream),
3001 LSTREAM_BLOCKN_BUFFERED, 65536);
3004 make_encoding_output_stream(XLSTREAM(outstream), codesys);
3005 Lstream_set_buffering(XLSTREAM(outstream),
3006 LSTREAM_BLOCKN_BUFFERED, 65536);
3007 #endif /* FILE_CODING */
3008 if (STRINGP(start)) {
3009 instream = make_lisp_string_input_stream(start, 0, -1);
3013 make_lisp_buffer_input_stream(current_buffer,
3016 LSTR_IGNORE_ACCESSIBLE);
3018 (0 > (a_write(outstream, instream, start1, &annotations)));
3020 /* Note that this doesn't close the desc since we created the
3021 stream without the LSTR_CLOSING flag, but it does
3022 flush out any buffered data. */
3023 if (Lstream_close(XLSTREAM(outstream)) < 0) {
3027 Lstream_close(XLSTREAM(instream));
3030 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3031 Disk full in NFS may be reported here. */
3032 /* mib says that closing the file will try to write as fast as NFS can do
3033 it, and that means the fsync here is not crucial for autosave files. */
3034 if (!auto_saving && fsync(desc) < 0
3035 /* If fsync fails with EINTR, don't treat that as serious. */
3036 && errno != EINTR) {
3040 #endif /* HAVE_FSYNC */
3042 /* Spurious "file has changed on disk" warnings used to be seen on
3043 systems where close() can change the modtime. This is known to
3044 happen on various NFS file systems, on Windows, and on Linux.
3045 Rather than handling this on a per-system basis, we
3046 unconditionally do the sxemacs_stat() after the close(). */
3048 /* NFS can report a write failure now. */
3049 if (close(desc) < 0) {
3054 /* Discard the close unwind-protect. Execute the one for
3055 build_annotations (switches back to the original current buffer
3057 XCAR(desc_locative) = Qnil;
3058 unbind_to(speccount, Qnil);
3063 stat_res = sxemacs_stat((char *)XSTRING_DATA(fn), &st);
3065 #ifdef CLASH_DETECTION
3067 unlock_file(lockname);
3068 #endif /* CLASH_DETECTION */
3070 /* Do this before reporting IO error
3071 to avoid a "file has changed on disk" warning on
3072 next attempt to save. */
3075 current_buffer->modtime = st.st_mtime;
3077 If sxemacs_stat failed, we have bigger problems, and
3078 most likely the file is gone, so the error next time is
3084 report_file_error("Writing file", list1(fn));
3088 BUF_SAVE_MODIFF(current_buffer) = BUF_MODIFF(current_buffer);
3089 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3090 current_buffer->filename = visit_file;
3091 MARK_MODELINE_CHANGED;
3092 } else if (quietly) {
3100 message("Wrote %s", XSTRING_DATA(visit_file));
3102 Lisp_Object fsp = Qnil;
3103 struct gcpro nngcpro1;
3106 fsp = Ffile_symlink_p(fn);
3108 message("Wrote %s", XSTRING_DATA(fn));
3110 message("Wrote %s (symlink to %s)",
3111 XSTRING_DATA(fn), XSTRING_DATA(fsp));
3120 /* #### This is such a load of shit!!!! There is no way we should define
3121 something so stupid as a subr, just sort the fucking list more
3123 DEFUN("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3124 Return t if (car A) is numerically less than (car B).
3128 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcar(a), Fcar(b)))
3134 /* Heh heh heh, let's define this too, just to aggravate the person who
3135 wrote the above comment. */
3136 DEFUN("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3137 Return t if (cdr A) is numerically less than (cdr B).
3141 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcdr(a), Fcdr(b)))
3147 /* Build the complete list of annotations appropriate for writing out
3148 the text between START and END, by calling all the functions in
3149 write-region-annotate-functions and merging the lists they return.
3150 If one of these functions switches to a different buffer, we assume
3151 that buffer contains altered text. Therefore, the caller must
3152 make sure to restore the current buffer in all cases,
3153 as save-excursion would do. */
3155 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end)
3157 /* This function can GC */
3158 Lisp_Object annotations;
3160 struct gcpro gcpro1, gcpro2;
3161 Lisp_Object original_buffer;
3163 XSETBUFFER(original_buffer, current_buffer);
3166 p = Vwrite_region_annotate_functions;
3167 GCPRO2(annotations, p);
3169 struct buffer *given_buffer = current_buffer;
3170 Vwrite_region_annotations_so_far = annotations;
3171 res = call2(Fcar(p), start, end);
3172 /* If the function makes a different buffer current,
3173 assume that means this buffer contains altered text to be output.
3174 Reset START and END from the buffer bounds
3175 and discard all previous annotations because they should have
3176 been dealt with by this function. */
3177 if (current_buffer != given_buffer) {
3178 start = make_int(BUF_BEGV(current_buffer));
3179 end = make_int(BUF_ZV(current_buffer));
3182 Flength(res); /* Check basic validity of return value */
3183 annotations = merge(annotations, res, Qcar_less_than_car);
3187 /* Now do the same for annotation functions implied by the file-format */
3188 if (auto_saving && (!EQ(Vauto_save_file_format, Qt)))
3189 p = Vauto_save_file_format;
3191 p = current_buffer->file_format;
3193 struct buffer *given_buffer = current_buffer;
3194 Vwrite_region_annotations_so_far = annotations;
3195 res = call4(Qformat_annotate_function, Fcar(p), start, end,
3197 if (current_buffer != given_buffer) {
3198 start = make_int(BUF_BEGV(current_buffer));
3199 end = make_int(BUF_ZV(current_buffer));
3203 annotations = merge(annotations, res, Qcar_less_than_car);
3210 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3211 EOF is encountered), assuming they start at position POS in the buffer
3212 of string that STREAM refers to. Intersperse with them the annotations
3213 from *ANNOT that fall into the range of positions we are reading from,
3214 each at its appropriate position.
3216 Modify *ANNOT by discarding elements as we output them.
3217 The return value is negative in case of system call failure. */
3219 /* 4K should probably be fine. We just need to reduce the number of
3220 function calls to reasonable level. The Lstream stuff itself will
3221 batch to 64K to reduce the number of system calls. */
3223 #define A_WRITE_BATCH_SIZE 4096
3226 a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
3227 Lisp_Object * annot)
3231 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3232 Lstream *instr = XLSTREAM(instream);
3233 Lstream *outstr = XLSTREAM(outstream);
3235 while (LISTP(*annot)) {
3236 tem = Fcar_safe(Fcar(*annot));
3238 nextpos = XINT(tem);
3242 /* If there are annotations left and we have Mule, then we
3243 have to do the I/O one emchar at a time so we can
3244 determine when to insert the annotation. */
3245 if (!NILP(*annot)) {
3247 while (pos != nextpos
3248 && (ch = Lstream_get_emchar(instr)) != EOF) {
3249 if (Lstream_put_emchar(outstr, ch) < 0)
3256 while (pos != nextpos) {
3257 /* Otherwise there is no point to that. Just go in batches. */
3259 min(nextpos - pos, A_WRITE_BATCH_SIZE);
3261 chunk = Lstream_read(instr, largebuf, chunk);
3264 if (chunk == 0) /* EOF */
3266 if (Lstream_write(outstr, largebuf, chunk) <
3272 if (pos == nextpos) {
3273 tem = Fcdr(Fcar(*annot));
3275 if (Lstream_write(outstr, XSTRING_DATA(tem),
3276 XSTRING_LENGTH(tem)) < 0)
3279 *annot = Fcdr(*annot);
3286 DEFUN("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3287 Return t if last mod time of BUFFER's visited file matches what BUFFER records.
3288 This means that the file has not been changed since it was visited or saved.
3292 /* This function can call lisp; GC checked 2000-07-11 ben */
3295 Lisp_Object handler;
3297 CHECK_BUFFER(buffer);
3298 b = XBUFFER(buffer);
3300 if (!STRINGP(b->filename))
3302 if (b->modtime == 0)
3305 /* If the file name has special constructs in it,
3306 call the corresponding file handler. */
3307 handler = Ffind_file_name_handler(b->filename,
3308 Qverify_visited_file_modtime);
3310 return call2(handler, Qverify_visited_file_modtime, buffer);
3312 if (sxemacs_stat((char *)XSTRING_DATA(b->filename), &st) < 0) {
3313 /* If the file doesn't exist now and didn't exist before,
3314 we say that it isn't modified, provided the error is a tame one. */
3315 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3320 if (st.st_mtime == b->modtime
3321 /* If both are positive, accept them if they are off by one second. */
3322 || (st.st_mtime > 0 && b->modtime > 0
3323 && (st.st_mtime == b->modtime + 1
3324 || st.st_mtime == b->modtime - 1)))
3329 DEFUN("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3330 Clear out records of last mod time of visited file.
3331 Next attempt to save will certainly not complain of a discrepancy.
3335 current_buffer->modtime = 0;
3339 DEFUN("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3340 Return the current buffer's recorded visited file modification time.
3341 The value is a list of the form (HIGH . LOW), like the time values
3342 that `file-attributes' returns.
3346 return time_to_lisp((time_t) current_buffer->modtime);
3349 DEFUN("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3350 Update buffer's recorded modification time from the visited file's time.
3351 Useful if the buffer was not read from the file normally
3352 or if the file itself has been changed for some known benign reason.
3353 An argument specifies the modification time value to use
3354 \(instead of that of the visited file), in the form of a list
3355 \(HIGH . LOW) or (HIGH LOW).
3359 /* This function can call lisp */
3360 if (!NILP(time_list)) {
3362 lisp_to_time(time_list, &the_time);
3363 current_buffer->modtime = (int)the_time;
3365 Lisp_Object filename = Qnil;
3367 Lisp_Object handler;
3368 struct gcpro gcpro1, gcpro2, gcpro3;
3370 GCPRO3(filename, time_list, current_buffer->filename);
3371 filename = Fexpand_file_name(current_buffer->filename, Qnil);
3373 /* If the file name has special constructs in it,
3374 call the corresponding file handler. */
3376 Ffind_file_name_handler(filename,
3377 Qset_visited_file_modtime);
3380 /* The handler can find the file name the same way we did. */
3381 return call2(handler, Qset_visited_file_modtime, Qnil);
3382 else if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) >= 0)
3383 current_buffer->modtime = st.st_mtime;
3390 auto_save_error(Lisp_Object condition_object, Lisp_Object ignored)
3392 /* This function can call lisp */
3395 /* Don't try printing an error message after everything is gone! */
3396 if (preparing_for_armageddon)
3398 clear_echo_area(selected_frame(), Qauto_saving, 1);
3399 Fding(Qt, Qauto_save_error, Qnil);
3400 message("Auto-saving...error for %s",
3401 XSTRING_DATA(current_buffer->name));
3402 Fsleep_for(make_int(1));
3403 message("Auto-saving...error!for %s",
3404 XSTRING_DATA(current_buffer->name));
3405 Fsleep_for(make_int(1));
3406 message("Auto-saving...error for %s",
3407 XSTRING_DATA(current_buffer->name));
3408 Fsleep_for(make_int(1));
3412 static Lisp_Object auto_save_1(Lisp_Object ignored)
3414 /* This function can call lisp */
3415 /* #### I think caller is protecting current_buffer? */
3417 Lisp_Object fn = current_buffer->filename;
3418 Lisp_Object a = current_buffer->auto_save_file_name;
3423 /* Get visited file's mode to become the auto save file's mode. */
3424 if (STRINGP(fn) && sxemacs_stat((char *)XSTRING_DATA(fn), &st) >= 0)
3425 /* But make sure we can overwrite it later! */
3426 auto_save_mode_bits = st.st_mode | 0600;
3428 /* default mode for auto-save files of buffers with no file is
3429 readable by owner only. This may annoy some small number of
3430 people, but the alternative removes all privacy from email. */
3431 auto_save_mode_bits = 0600;
3434 /* !!#### need to deal with this 'escape-quoted everywhere */
3435 Fwrite_region_internal(Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3437 current_buffer->buffer_file_coding_system
3445 auto_save_expand_name_error(Lisp_Object condition_object, Lisp_Object ignored)
3447 /* #### this function should spew an error message about not being
3448 able to open the .saves file. */
3452 static Lisp_Object auto_save_expand_name(Lisp_Object name)
3454 struct gcpro gcpro1;
3456 /* note that caller did NOT gc protect name, so we do it. */
3457 /* #### dmoore - this might not be necessary, if condition_case_1
3458 protects it. but I don't think it does. */
3460 RETURN_UNGCPRO(Fexpand_file_name(name, Qnil));
3463 static Lisp_Object do_auto_save_unwind(Lisp_Object fd)
3469 static Lisp_Object do_auto_save_unwind_2(Lisp_Object old_auto_saving)
3471 auto_saving = XINT(old_auto_saving);
3475 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3476 and if so, tries to avoid touching lisp objects.
3478 The only time that Fdo_auto_save() is called while GC is in progress
3479 is if we're going down, as a result of an abort() or a kill signal.
3480 It's fairly important that we generate autosave files in that case!
3483 DEFUN("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3484 Auto-save all buffers that need it.
3485 This is all buffers that have auto-saving enabled
3486 and are changed since last auto-saved.
3487 Auto-saving writes the buffer into a file
3488 so that your editing is not lost if the system crashes.
3489 This file is not the file you visited; that changes only when you save.
3490 Normally we run the normal hook `auto-save-hook' before saving.
3492 Non-nil first argument means do not print any message if successful.
3493 Non-nil second argument means save only current buffer.
3495 (no_message, current_only))
3497 /* This function can call lisp */
3499 Lisp_Object tail, buf;
3501 int do_handled_files;
3502 Lisp_Object oquit = Qnil;
3503 Lisp_Object listfile = Qnil;
3506 int speccount = specpdl_depth();
3507 struct gcpro gcpro1, gcpro2, gcpro3;
3509 XSETBUFFER(old, current_buffer);
3510 GCPRO3(oquit, listfile, old);
3511 check_quit(); /* make Vquit_flag accurate */
3512 /* Ordinarily don't quit within this function,
3513 but don't make it impossible to quit (in case we get hung in I/O). */
3517 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3518 variables point to non-strings reached from Vbuffer_alist. */
3520 if (minibuf_level != 0 || preparing_for_armageddon)
3523 run_hook(Qauto_save_hook);
3525 if (STRINGP(Vauto_save_list_file_name))
3526 listfile = condition_case_1(Qt,
3527 auto_save_expand_name,
3528 Vauto_save_list_file_name,
3529 auto_save_expand_name_error, Qnil);
3531 /* Make sure auto_saving is reset. */
3532 record_unwind_protect(do_auto_save_unwind_2, make_int(auto_saving));
3536 /* First, save all files which don't have handlers. If Emacs is
3537 crashing, the handlers may tweak what is causing Emacs to crash
3538 in the first place, and it would be a shame if Emacs failed to
3539 autosave perfectly ordinary files because it couldn't handle some
3541 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) {
3542 for (tail = Vbuffer_alist; CONSP(tail); tail = XCDR(tail)) {
3543 buf = XCDR(XCAR(tail));
3546 if (!NILP(current_only)
3547 && b != current_buffer)
3550 /* Don't auto-save indirect buffers.
3551 The base buffer takes care of it. */
3555 /* Check for auto save enabled
3556 and file changed since last auto save
3557 and file changed since last real save. */
3558 if (STRINGP(b->auto_save_file_name)
3559 && BUF_SAVE_MODIFF(b) < BUF_MODIFF(b)
3560 && b->auto_save_modified < BUF_MODIFF(b)
3561 /* -1 means we've turned off autosaving for a while--see below. */
3562 && XINT(b->saved_size) >= 0
3563 && (do_handled_files
3565 NILP(Ffind_file_name_handler
3566 (b->auto_save_file_name,
3568 EMACS_TIME before_time, after_time;
3570 EMACS_GET_TIME(before_time);
3571 /* If we had a failure, don't try again for 20 minutes. */
3572 if (!preparing_for_armageddon
3573 && b->auto_save_failure_time >= 0
3574 && (EMACS_SECS(before_time) -
3575 b->auto_save_failure_time < 1200))
3578 if (!preparing_for_armageddon &&
3579 (XINT(b->saved_size) * 10
3580 > (BUF_Z(b) - BUF_BEG(b)) * 13)
3581 /* A short file is likely to change a large fraction;
3582 spare the user annoying messages. */
3583 && XINT(b->saved_size) > 5000
3584 /* These messages are frequent and annoying for `*mail*'. */
3585 && !NILP(b->filename)
3587 && disable_auto_save_when_buffer_shrinks) {
3588 /* It has shrunk too much; turn off auto-saving here.
3589 Unless we're about to crash, in which case auto-save it
3593 ("Buffer %s has shrunk a lot; auto save turned off there",
3594 XSTRING_DATA(b->name));
3595 /* Turn off auto-saving until there's a real save,
3596 and prevent any more warnings. */
3597 b->saved_size = make_int(-1);
3598 if (!gc_in_progress)
3599 Fsleep_for(make_int(1));
3602 set_buffer_internal(b);
3603 if (!auto_saved && NILP(no_message)) {
3604 static const unsigned char *msg
3606 (const unsigned char *)
3608 echo_area_message(selected_frame(), msg,
3610 strlen((const char *)
3615 /* Open the auto-save list file, if necessary.
3616 We only do this now so that the file only exists
3617 if we actually auto-saved any files. */
3618 if (!auto_saved && !inhibit_auto_save_session
3619 && !NILP(Vauto_save_list_file_prefix)
3620 && STRINGP(listfile) && listdesc < 0) {
3622 open((char *)XSTRING_DATA(listfile),
3623 O_WRONLY | O_TRUNC | O_CREAT |
3624 OPEN_BINARY, CREAT_MODE);
3626 /* Arrange to close that file whether or not we get
3629 record_unwind_protect
3630 (do_auto_save_unwind,
3631 make_int(listdesc));
3634 /* Record all the buffers that we are auto-saving in
3635 the special file that lists them. For each of
3636 these buffers, record visited name (if any) and
3638 if (listdesc >= 0) {
3639 const Extbyte *auto_save_file_name_ext;
3640 Extcount auto_save_file_name_ext_len;
3642 TO_EXTERNAL_FORMAT(LISP_STRING,
3644 auto_save_file_name,
3646 (auto_save_file_name_ext,
3647 auto_save_file_name_ext_len),
3649 if (!NILP(b->filename)) {
3650 const Extbyte *filename_ext;
3651 Extcount filename_ext_len;
3653 TO_EXTERNAL_FORMAT(LISP_STRING,
3659 write(listdesc, filename_ext,
3662 write(listdesc, "\n", 1);
3663 write(listdesc, auto_save_file_name_ext,
3664 auto_save_file_name_ext_len);
3665 write(listdesc, "\n", 1);
3668 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
3669 based on values in Vbuffer_alist. auto_save_1 may
3670 cause lisp handlers to run. Those handlers may kill
3671 the buffer and then GC. Since the buffer is killed,
3672 it's no longer in Vbuffer_alist so it might get reaped
3673 by the GC. We also need to protect tail. */
3674 /* #### There is probably a lot of other code which has
3675 pointers into buffers which may get blown away by
3678 struct gcpro ngcpro1, ngcpro2;
3680 condition_case_1(Qt,
3682 auto_save_error, Qnil);
3685 /* Handler killed our saved current-buffer! Pick any. */
3686 if (!BUFFER_LIVE_P(XBUFFER(old)))
3687 XSETBUFFER(old, current_buffer);
3689 set_buffer_internal(XBUFFER(old));
3692 /* Handler killed their own buffer! */
3693 if (!BUFFER_LIVE_P(b))
3696 b->auto_save_modified = BUF_MODIFF(b);
3697 b->saved_size = make_int(BUF_SIZE(b));
3698 EMACS_GET_TIME(after_time);
3699 /* If auto-save took more than 60 seconds,
3700 assume it was an NFS failure that got a timeout. */
3701 if (EMACS_SECS(after_time) -
3702 EMACS_SECS(before_time) > 60)
3703 b->auto_save_failure_time =
3704 EMACS_SECS(after_time);
3709 /* Prevent another auto save till enough input events come in. */
3713 /* If we didn't save anything into the listfile, remove the old
3714 one because nothing needed to be auto-saved. Do this afterwards
3715 rather than before in case we get a crash attempting to autosave
3716 (in that case we'd still want the old one around). */
3717 if (listdesc < 0 && !auto_saved && STRINGP(listfile))
3718 unlink((char *)XSTRING_DATA(listfile));
3723 /* Show "...done" only if the echo area would otherwise be empty. */
3724 if (auto_saved && NILP(no_message)
3725 && NILP(clear_echo_area(selected_frame(), Qauto_saving, 0))) {
3726 static const unsigned char *msg
3727 = (const unsigned char *)"Auto-saving...done";
3728 echo_area_message(selected_frame(), msg, Qnil, 0,
3729 strlen((const char *)msg), Qauto_saving);
3734 RETURN_UNGCPRO(unbind_to(speccount, Qnil));
3737 DEFUN("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
3738 Mark current buffer as auto-saved with its current text.
3739 No auto-save file will be written until the buffer changes again.
3743 current_buffer->auto_save_modified = BUF_MODIFF(current_buffer);
3744 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3745 current_buffer->auto_save_failure_time = -1;
3749 DEFUN("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
3750 Clear any record of a recent auto-save failure in the current buffer.
3754 current_buffer->auto_save_failure_time = -1;
3758 DEFUN("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
3759 Return t if buffer has been auto-saved since last read in or saved.
3763 return (BUF_SAVE_MODIFF(current_buffer) <
3764 current_buffer->auto_save_modified) ? Qt : Qnil;
3767 /************************************************************************/
3768 /* initialization */
3769 /************************************************************************/
3771 void syms_of_fileio(void)
3773 defsymbol(&Qexpand_file_name, "expand-file-name");
3774 defsymbol(&Qfile_truename, "file-truename");
3775 defsymbol(&Qsubstitute_in_file_name, "substitute-in-file-name");
3776 defsymbol(&Qdirectory_file_name, "directory-file-name");
3777 defsymbol(&Qfile_dirname, "file-dirname");
3778 defsymbol(&Qfile_basename, "file-basename");
3779 defsymbol(&Qfile_name_directory, "file-name-directory");
3780 defsymbol(&Qfile_name_nondirectory, "file-name-nondirectory");
3781 defsymbol(&Qunhandled_file_name_directory,
3782 "unhandled-file-name-directory");
3783 defsymbol(&Qfile_name_as_directory, "file-name-as-directory");
3784 defsymbol(&Qcopy_file, "copy-file");
3785 defsymbol(&Qmake_directory_internal, "make-directory-internal");
3786 defsymbol(&Qdelete_directory, "delete-directory");
3787 defsymbol(&Qdelete_file, "delete-file");
3788 defsymbol(&Qrename_file, "rename-file");
3789 defsymbol(&Qadd_name_to_file, "add-name-to-file");
3790 defsymbol(&Qmake_symbolic_link, "make-symbolic-link");
3791 defsymbol(&Qfile_exists_p, "file-exists-p");
3792 defsymbol(&Qfile_executable_p, "file-executable-p");
3793 defsymbol(&Qfile_readable_p, "file-readable-p");
3794 defsymbol(&Qfile_symlink_p, "file-symlink-p");
3795 defsymbol(&Qfile_writable_p, "file-writable-p");
3796 defsymbol(&Qfile_directory_p, "file-directory-p");
3797 defsymbol(&Qfile_regular_p, "file-regular-p");
3798 defsymbol(&Qfile_accessible_directory_p, "file-accessible-directory-p");
3799 defsymbol(&Qfile_modes, "file-modes");
3800 defsymbol(&Qset_file_modes, "set-file-modes");
3801 defsymbol(&Qfile_newer_than_file_p, "file-newer-than-file-p");
3802 defsymbol(&Qinsert_file_contents, "insert-file-contents");
3803 defsymbol(&Qwrite_region, "write-region");
3804 defsymbol(&Qverify_visited_file_modtime, "verify-visited-file-modtime");
3805 defsymbol(&Qset_visited_file_modtime, "set-visited-file-modtime");
3806 defsymbol(&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
3808 defsymbol(&Qauto_save_hook, "auto-save-hook");
3809 defsymbol(&Qauto_save_error, "auto-save-error");
3810 defsymbol(&Qauto_saving, "auto-saving");
3812 defsymbol(&Qformat_decode, "format-decode");
3813 defsymbol(&Qformat_annotate_function, "format-annotate-function");
3815 defsymbol(&Qcompute_buffer_file_truename,
3816 "compute-buffer-file-truename");
3817 DEFERROR_STANDARD(Qfile_error, Qio_error);
3818 DEFERROR_STANDARD(Qfile_already_exists, Qfile_error);
3820 DEFSUBR(Ffind_file_name_handler);
3822 DEFSUBR(Ffile_name_directory);
3823 DEFSUBR(Ffile_name_nondirectory);
3824 DEFSUBR(Ffile_basename);
3825 DEFSUBR(Ffile_dirname);
3826 DEFSUBR(Funhandled_file_name_directory);
3827 DEFSUBR(Ffile_name_as_directory);
3828 DEFSUBR(Fdirectory_file_name);
3829 DEFSUBR(Fmake_temp_name);
3830 DEFSUBR(Fexpand_file_name);
3831 DEFSUBR(Ffile_truename);
3832 DEFSUBR(Fsubstitute_in_file_name);
3833 DEFSUBR(Fcopy_file);
3834 DEFSUBR(Fmake_directory_internal);
3835 DEFSUBR(Fdelete_directory);
3836 DEFSUBR(Fdelete_file);
3837 DEFSUBR(Frename_file);
3838 DEFSUBR(Fadd_name_to_file);
3839 DEFSUBR(Fmake_symbolic_link);
3841 DEFSUBR(Fsysnetunam);
3842 #endif /* HPUX_NET */
3843 DEFSUBR(Ffile_name_absolute_p);
3844 DEFSUBR(Ffile_exists_p);
3845 DEFSUBR(Ffile_executable_p);
3846 DEFSUBR(Ffile_readable_p);
3847 DEFSUBR(Ffile_writable_p);
3848 DEFSUBR(Ffile_symlink_p);
3849 DEFSUBR(Ffile_directory_p);
3850 DEFSUBR(Ffile_accessible_directory_p);
3851 DEFSUBR(Ffile_regular_p);
3852 DEFSUBR(Ffile_modes);
3853 DEFSUBR(Fset_file_modes);
3854 DEFSUBR(Fset_default_file_modes);
3855 DEFSUBR(Fdefault_file_modes);
3856 DEFSUBR(Funix_sync);
3857 DEFSUBR(Ffile_newer_than_file_p);
3858 DEFSUBR(Finsert_file_contents_internal);
3859 DEFSUBR(Fwrite_region_internal);
3860 DEFSUBR(Fcar_less_than_car); /* Vomitous! */
3861 DEFSUBR(Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
3862 DEFSUBR(Fverify_visited_file_modtime);
3863 DEFSUBR(Fclear_visited_file_modtime);
3864 DEFSUBR(Fvisited_file_modtime);
3865 DEFSUBR(Fset_visited_file_modtime);
3867 DEFSUBR(Fdo_auto_save);
3868 DEFSUBR(Fset_buffer_auto_saved);
3869 DEFSUBR(Fclear_buffer_auto_save_failure);
3870 DEFSUBR(Frecent_auto_save_p);
3873 void vars_of_fileio(void)
3875 DEFVAR_LISP("auto-save-file-format", &Vauto_save_file_format /*
3876 *Format in which to write auto-save files.
3877 Should be a list of symbols naming formats that are defined in `format-alist'.
3878 If it is t, which is the default, auto-save files are written in the
3879 same format as a regular save would use.
3881 Vauto_save_file_format = Qt;
3883 DEFVAR_LISP("file-name-handler-alist", &Vfile_name_handler_alist /*
3884 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
3885 If a file name matches REGEXP, then all I/O on that file is done by calling
3888 The first argument given to HANDLER is the name of the I/O primitive
3889 to be handled; the remaining arguments are the arguments that were
3890 passed to that primitive. For example, if you do
3891 (file-exists-p FILENAME)
3892 and FILENAME is handled by HANDLER, then HANDLER is called like this:
3893 (funcall HANDLER 'file-exists-p FILENAME)
3894 The function `find-file-name-handler' checks this list for a handler
3897 Vfile_name_handler_alist = Qnil;
3899 DEFVAR_LISP("after-insert-file-functions", &Vafter_insert_file_functions /*
3900 A list of functions to be called at the end of `insert-file-contents'.
3901 Each is passed one argument, the number of bytes inserted. It should return
3902 the new byte count, and leave point the same. If `insert-file-contents' is
3903 intercepted by a handler from `file-name-handler-alist', that handler is
3904 responsible for calling the after-insert-file-functions if appropriate.
3906 Vafter_insert_file_functions = Qnil;
3908 DEFVAR_LISP("write-region-annotate-functions", &Vwrite_region_annotate_functions /*
3909 A list of functions to be called at the start of `write-region'.
3910 Each is passed two arguments, START and END, as for `write-region'.
3911 It should return a list of pairs (POSITION . STRING) of strings to be
3912 effectively inserted at the specified positions of the file being written
3913 \(1 means to insert before the first byte written). The POSITIONs must be
3914 sorted into increasing order. If there are several functions in the list,
3915 the several lists are merged destructively.
3917 Vwrite_region_annotate_functions = Qnil;
3919 DEFVAR_LISP("write-region-annotations-so-far", &Vwrite_region_annotations_so_far /*
3920 When an annotation function is called, this holds the previous annotations.
3921 These are the annotations made by other annotation functions
3922 that were already called. See also `write-region-annotate-functions'.
3924 Vwrite_region_annotations_so_far = Qnil;
3926 DEFVAR_LISP("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
3927 A list of file name handlers that temporarily should not be used.
3928 This applies only to the operation `inhibit-file-name-operation'.
3930 Vinhibit_file_name_handlers = Qnil;
3932 DEFVAR_LISP("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
3933 The operation for which `inhibit-file-name-handlers' is applicable.
3935 Vinhibit_file_name_operation = Qnil;
3937 DEFVAR_LISP("auto-save-list-file-name", &Vauto_save_list_file_name /*
3938 File name in which we write a list of all auto save file names.
3940 Vauto_save_list_file_name = Qnil;
3942 DEFVAR_LISP("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
3943 Prefix for generating auto-save-list-file-name.
3944 Emacs's pid and the system name will be appended to
3945 this prefix to create a unique file name.
3947 Vauto_save_list_file_prefix = build_string("~/.saves-");
3949 DEFVAR_BOOL("inhibit-auto-save-session", &inhibit_auto_save_session /*
3950 When non-nil, inhibit auto save list file creation.
3952 inhibit_auto_save_session = 0;
3954 DEFVAR_BOOL("disable-auto-save-when-buffer-shrinks", &disable_auto_save_when_buffer_shrinks /*
3955 If non-nil, auto-saving is disabled when a buffer shrinks too much.
3956 This is to prevent you from losing your edits if you accidentally
3957 delete a large chunk of the buffer and don't notice it until too late.
3958 Saving the buffer normally turns auto-save back on.
3960 disable_auto_save_when_buffer_shrinks = 1;
3962 DEFVAR_LISP("directory-sep-char", &Vdirectory_sep_char /*
3963 Directory separator character for built-in functions that return file names.
3964 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
3965 This variable affects the built-in functions only on Windows,
3966 on other platforms, it is initialized so that Lisp code can find out
3967 what the normal separator is.
3969 Vdirectory_sep_char = make_char('/');
3971 reinit_vars_of_fileio();
3974 void reinit_vars_of_fileio(void)
3976 /* We want temp_name_rand to be initialized to a value likely to be
3977 unique to the process, not to the executable. The danger is that
3978 two different SXEmacs processes using the same binary on different
3979 machines creating temp files in the same directory will be
3980 unlucky enough to have the same pid. If we randomize using
3981 process startup time, then in practice they will be unlikely to
3982 collide. We use the microseconds field so that scripts that start
3983 simultaneous SXEmacs processes on multiple machines will have less
3984 chance of collision. */
3988 EMACS_GET_TIME(thyme);
3990 (unsigned int)(EMACS_SECS(thyme) ^ EMACS_USECS(thyme));