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));
1538 record_unwind_protect(close_file_unwind, make_int(ifd));
1540 /* We can only copy regular files and symbolic links. Other files are not
1542 input_file_statable_p = (fstat(ifd, &st) >= 0);
1544 if (out_st.st_mode != 0
1545 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) {
1547 report_file_error("Input and output files are the same",
1548 list2(filename, newname));
1551 #if defined (S_ISREG) && defined (S_ISLNK)
1552 if (input_file_statable_p) {
1553 if (!(S_ISREG(st.st_mode))
1554 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1556 && !(S_ISCHR(st.st_mode))
1558 && !(S_ISLNK(st.st_mode))) {
1559 #if defined (EISDIR)
1560 /* Get a better looking error message. */
1563 report_file_error("Non-regular file", list1(filename));
1566 #endif /* S_ISREG && S_ISLNK */
1568 ofd = open((char *)XSTRING_DATA(newname),
1569 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1571 report_file_error("Opening output file", list1(newname));
1574 Lisp_Object ofd_locative = noseeum_cons(make_int(ofd), Qnil);
1576 record_unwind_protect(close_file_unwind, ofd_locative);
1578 while ((n = read_allowing_quit(ifd, buf, sizeof(buf))) > 0) {
1579 if (write_allowing_quit(ofd, buf, n) != n)
1580 report_file_error("I/O error", list1(newname));
1583 /* Closing the output clobbers the file times on some systems. */
1585 report_file_error("I/O error", list1(newname));
1587 if (input_file_statable_p) {
1588 if (!NILP(keep_time)) {
1589 EMACS_TIME atime, mtime;
1590 EMACS_SET_SECS_USECS(atime, st.st_atime, 0);
1591 EMACS_SET_SECS_USECS(mtime, st.st_mtime, 0);
1592 if (set_file_times(newname, atime, mtime))
1593 report_file_error("I/O error",
1596 chmod((const char *)XSTRING_DATA(newname),
1597 st.st_mode & 07777);
1600 /* We'll close it by hand */
1601 XCAR(ofd_locative) = Qnil;
1604 unbind_to(speccount, Qnil);
1611 DEFUN("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1612 Create a directory. One argument, a file name string.
1616 /* This function can GC. GC checked 1997.04.06. */
1617 char dir[MAXPATHLEN];
1618 Lisp_Object handler;
1619 struct gcpro gcpro1;
1621 CHECK_STRING(dirname_);
1622 dirname_ = Fexpand_file_name(dirname_, Qnil);
1625 handler = Ffind_file_name_handler(dirname_, Qmake_directory_internal);
1628 return (call2(handler, Qmake_directory_internal, dirname_));
1630 if (XSTRING_LENGTH(dirname_) > (Bytecount) (sizeof(dir) - 1)) {
1631 return Fsignal(Qfile_error,
1632 list3(build_translated_string
1633 ("Creating directory"),
1634 build_translated_string
1635 ("pathname too long"), dirname_));
1637 strncpy(dir, (char *)XSTRING_DATA(dirname_),
1638 XSTRING_LENGTH(dirname_) + 1);
1639 dir[XSTRING_LENGTH(dirname_)]='\0';
1640 if (dir[XSTRING_LENGTH(dirname_) - 1] == '/')
1641 dir[XSTRING_LENGTH(dirname_) - 1] = '\0';
1643 if (mkdir(dir, 0777) != 0)
1644 report_file_error("Creating directory", list1(dirname_));
1649 DEFUN("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1650 Delete a directory. One argument, a file name or directory name string.
1654 /* This function can GC. GC checked 1997.04.06. */
1655 Lisp_Object handler;
1656 struct gcpro gcpro1;
1658 CHECK_STRING(dirname_);
1661 dirname_ = Fexpand_file_name(dirname_, Qnil);
1662 dirname_ = Fdirectory_file_name(dirname_);
1664 handler = Ffind_file_name_handler(dirname_, Qdelete_directory);
1667 return (call2(handler, Qdelete_directory, dirname_));
1669 if (rmdir((char *)XSTRING_DATA(dirname_)) != 0)
1670 report_file_error("Removing directory", list1(dirname_));
1675 DEFUN("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1676 Delete the file named FILENAME (a string).
1677 If FILENAME has multiple names, it continues to exist with the other names.
1681 /* This function can GC. GC checked 1997.04.06. */
1682 Lisp_Object handler;
1683 struct gcpro gcpro1;
1685 CHECK_STRING(filename);
1686 filename = Fexpand_file_name(filename, Qnil);
1689 handler = Ffind_file_name_handler(filename, Qdelete_file);
1692 return call2(handler, Qdelete_file, filename);
1694 if (0 > unlink((char *)XSTRING_DATA(filename)))
1695 report_file_error("Removing old name", list1(filename));
1700 internal_delete_file_1(Lisp_Object ignore, Lisp_Object ignore2)
1705 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1707 int internal_delete_file(Lisp_Object filename)
1709 /* This function can GC. GC checked 1997.04.06. */
1710 return NILP(condition_case_1(Qt, Fdelete_file, filename,
1711 internal_delete_file_1, Qnil));
1714 DEFUN("rename-file", Frename_file, 2, 3, "fRename file: \nFRename %s to file: \np", /*
1715 Rename FILENAME as NEWNAME. Both args must be strings.
1716 If file has names other than FILENAME, it continues to have those names.
1717 Signals a `file-already-exists' error if a file NEWNAME already exists
1718 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1719 A number as third arg means request confirmation if NEWNAME already exists.
1720 This is what happens in interactive use with M-x.
1722 (filename, newname, ok_if_already_exists))
1724 /* This function can GC. GC checked 1997.04.06. */
1725 Lisp_Object handler;
1726 struct gcpro gcpro1, gcpro2;
1728 GCPRO2(filename, newname);
1729 CHECK_STRING(filename);
1730 CHECK_STRING(newname);
1731 filename = Fexpand_file_name(filename, Qnil);
1732 newname = Fexpand_file_name(newname, Qnil);
1734 /* If the file name has special constructs in it,
1735 call the corresponding file handler. */
1736 handler = Ffind_file_name_handler(filename, Qrename_file);
1738 handler = Ffind_file_name_handler(newname, Qrename_file);
1739 if (!NILP(handler)) {
1741 return call4(handler, Qrename_file,
1742 filename, newname, ok_if_already_exists);
1745 /* When second argument is a directory, rename the file into it.
1746 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1748 if (!NILP(Ffile_directory_p(newname))) {
1749 Lisp_Object args[3] = {newname, Qnil, Qnil};
1750 struct gcpro ngcpro1;
1753 NGCPROn(args, countof(args));
1754 if (XSTRING_BYTE(newname, XSTRING_LENGTH(newname) - 1) != '/') {
1755 args[i++] = build_string("/");
1757 args[i++] = Ffile_name_nondirectory(filename);
1758 newname = Fconcat(i, args);
1762 if (NILP(ok_if_already_exists)
1763 || INTP(ok_if_already_exists))
1764 barf_or_query_if_file_exists(newname, "rename to it",
1765 INTP(ok_if_already_exists), 0);
1767 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1768 WIN32_NATIVE here; I've removed it. --marcpa */
1770 /* We have configure check for rename() and emulate using
1771 link()/unlink() if necessary. */
1772 if (0 > rename((char *)XSTRING_DATA(filename),
1773 (char *)XSTRING_DATA(newname))) {
1774 if (errno == EXDEV) {
1775 Fcopy_file(filename, newname,
1776 /* We have already prompted if it was an integer,
1777 so don't have copy-file prompt again. */
1778 (NILP(ok_if_already_exists) ? Qnil : Qt),
1780 Fdelete_file(filename);
1782 report_file_error("Renaming", list2(filename, newname));
1789 DEFUN("add-name-to-file", Fadd_name_to_file, 2, 3, "fAdd name to file: \nFName to add to %s: \np", /*
1790 Give FILENAME additional name NEWNAME. Both args must be strings.
1791 Signals a `file-already-exists' error if a file NEWNAME already exists
1792 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1793 A number as third arg means request confirmation if NEWNAME already exists.
1794 This is what happens in interactive use with M-x.
1796 (filename, newname, ok_if_already_exists))
1798 /* This function can GC. GC checked 1997.04.06. */
1799 Lisp_Object handler;
1800 struct gcpro gcpro1, gcpro2;
1802 GCPRO2(filename, newname);
1803 CHECK_STRING(filename);
1804 CHECK_STRING(newname);
1805 filename = Fexpand_file_name(filename, Qnil);
1806 newname = Fexpand_file_name(newname, Qnil);
1808 /* If the file name has special constructs in it,
1809 call the corresponding file handler. */
1810 handler = Ffind_file_name_handler(filename, Qadd_name_to_file);
1812 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1813 newname, ok_if_already_exists));
1815 /* If the new name has special constructs in it,
1816 call the corresponding file handler. */
1817 handler = Ffind_file_name_handler(newname, Qadd_name_to_file);
1819 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1820 newname, ok_if_already_exists));
1822 if (NILP(ok_if_already_exists)
1823 || INTP(ok_if_already_exists))
1824 barf_or_query_if_file_exists(newname, "make it a new name",
1825 INTP(ok_if_already_exists), 0);
1826 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
1827 on NT here. --marcpa */
1828 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
1829 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
1830 Reverted to previous behavior pending a working fix. (jhar) */
1832 unlink((char *)XSTRING_DATA(newname));
1833 if (0 > link((char *)XSTRING_DATA(filename),
1834 (char *)XSTRING_DATA(newname))) {
1835 report_file_error("Adding new name", list2(filename, newname));
1842 DEFUN("make-symbolic-link", Fmake_symbolic_link, 2, 3, "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
1843 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
1844 Signals a `file-already-exists' error if a file LINKNAME already exists
1845 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1846 A number as third arg means request confirmation if LINKNAME already exists.
1847 This happens for interactive use with M-x.
1849 (filename, linkname, ok_if_already_exists))
1851 /* This function can GC. GC checked 1997.06.04. */
1852 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
1853 Lisp_Object handler;
1854 struct gcpro gcpro1, gcpro2;
1856 GCPRO2(filename, linkname);
1857 CHECK_STRING(filename);
1858 CHECK_STRING(linkname);
1859 /* If the link target has a ~, we must expand it to get
1860 a truly valid file name. Otherwise, do not expand;
1861 we want to permit links to relative file names. */
1862 if (XSTRING_BYTE(filename, 0) == '~')
1863 filename = Fexpand_file_name(filename, Qnil);
1864 linkname = Fexpand_file_name(linkname, Qnil);
1866 /* If the file name has special constructs in it,
1867 call the corresponding file handler. */
1868 handler = Ffind_file_name_handler(filename, Qmake_symbolic_link);
1870 RETURN_UNGCPRO(call4
1871 (handler, Qmake_symbolic_link, filename,
1872 linkname, ok_if_already_exists));
1874 /* If the new link name has special constructs in it,
1875 call the corresponding file handler. */
1876 handler = Ffind_file_name_handler(linkname, Qmake_symbolic_link);
1878 RETURN_UNGCPRO(call4(handler, Qmake_symbolic_link, filename,
1879 linkname, ok_if_already_exists));
1882 if (NILP(ok_if_already_exists)
1883 || INTP(ok_if_already_exists))
1884 barf_or_query_if_file_exists(linkname, "make it a link",
1885 INTP(ok_if_already_exists), 0);
1887 unlink((char *)XSTRING_DATA(linkname));
1888 if (0 > symlink((char *)XSTRING_DATA(filename),
1889 (char *)XSTRING_DATA(linkname))) {
1890 report_file_error("Making symbolic link",
1891 list2(filename, linkname));
1893 #endif /* S_IFLNK */
1901 DEFUN("sysnetunam", Fsysnetunam, 2, 2, 0, /*
1902 Open a network connection to PATH using LOGIN as the login string.
1907 const char *path_ext;
1908 const char *login_ext;
1911 CHECK_STRING(login);
1913 /* netunam, being a strange-o system call only used once, is not
1916 LISP_STRING_TO_EXTERNAL(path, path_ext, Qfile_name);
1917 LISP_STRING_TO_EXTERNAL(login, login_ext, Qnative);
1919 netresult = netunam(path_ext, login_ext);
1921 return netresult == -1 ? Qnil : Qt;
1923 #endif /* HPUX_NET */
1925 DEFUN("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
1926 Return t if file FILENAME specifies an absolute path name.
1927 On Unix, this is a name starting with a `/' or a `~'.
1931 /* This function does not GC */
1934 CHECK_STRING(filename);
1935 ptr = XSTRING_DATA(filename);
1936 return (IS_DIRECTORY_SEP(*ptr) || *ptr == '~'
1940 /* Return nonzero if file FILENAME exists and can be executed. */
1942 static int check_executable(char *filename)
1945 return eaccess(filename, X_OK) >= 0;
1947 /* Access isn't quite right because it uses the real uid
1948 and we really want to test with the effective uid.
1949 But Unix doesn't give us a right way to do it. */
1950 return access(filename, X_OK) >= 0;
1951 #endif /* HAVE_EACCESS */
1954 /* Return nonzero if file FILENAME exists and can be written. */
1956 static int check_writable(const char *filename)
1959 return (eaccess(filename, W_OK) >= 0);
1961 /* Access isn't quite right because it uses the real uid
1962 and we really want to test with the effective uid.
1963 But Unix doesn't give us a right way to do it.
1964 Opening with O_WRONLY could work for an ordinary file,
1965 but would lose for directories. */
1966 return (access(filename, W_OK) >= 0);
1970 DEFUN("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
1971 Return t if file FILENAME exists. (This does not mean you can read it.)
1972 See also `file-readable-p' and `file-attributes'.
1976 /* This function can call lisp; GC checked 2000-07-11 ben */
1977 Lisp_Object abspath;
1978 Lisp_Object handler;
1979 struct stat statbuf;
1980 struct gcpro gcpro1;
1982 CHECK_STRING(filename);
1983 abspath = Fexpand_file_name(filename, Qnil);
1985 /* If the file name has special constructs in it,
1986 call the corresponding file handler. */
1988 handler = Ffind_file_name_handler(abspath, Qfile_exists_p);
1991 return call2(handler, Qfile_exists_p, abspath);
1993 return sxemacs_stat((char *)XSTRING_DATA(abspath),
1994 &statbuf) >= 0 ? Qt : Qnil;
1997 DEFUN("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
1998 Return t if FILENAME can be executed by you.
1999 For a directory, this means you can access files in that directory.
2003 /* This function can GC. GC checked 07-11-2000 ben. */
2004 Lisp_Object abspath;
2005 Lisp_Object handler;
2006 struct gcpro gcpro1;
2008 CHECK_STRING(filename);
2009 abspath = Fexpand_file_name(filename, Qnil);
2011 /* If the file name has special constructs in it,
2012 call the corresponding file handler. */
2014 handler = Ffind_file_name_handler(abspath, Qfile_executable_p);
2017 return call2(handler, Qfile_executable_p, abspath);
2019 return check_executable((char *)XSTRING_DATA(abspath)) ? Qt : Qnil;
2022 DEFUN("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2023 Return t if file FILENAME exists and you can read it.
2024 See also `file-exists-p' and `file-attributes'.
2028 /* This function can GC */
2029 Lisp_Object abspath = Qnil;
2030 Lisp_Object handler;
2031 struct gcpro gcpro1;
2034 CHECK_STRING(filename);
2035 abspath = Fexpand_file_name(filename, Qnil);
2037 /* If the file name has special constructs in it,
2038 call the corresponding file handler. */
2039 handler = Ffind_file_name_handler(abspath, Qfile_readable_p);
2041 RETURN_UNGCPRO(call2(handler, Qfile_readable_p, abspath));
2045 interruptible_open((char *)XSTRING_DATA(abspath),
2046 O_RDONLY | OPEN_BINARY, 0);
2055 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2057 DEFUN("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2058 Return t if file FILENAME can be written or created by you.
2062 /* This function can GC. GC checked 1997.04.10. */
2063 Lisp_Object abspath, dir;
2064 Lisp_Object handler;
2065 struct stat statbuf;
2066 struct gcpro gcpro1;
2068 CHECK_STRING(filename);
2069 abspath = Fexpand_file_name(filename, Qnil);
2071 /* If the file name has special constructs in it,
2072 call the corresponding file handler. */
2074 handler = Ffind_file_name_handler(abspath, Qfile_writable_p);
2077 return call2(handler, Qfile_writable_p, abspath);
2079 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &statbuf) >= 0)
2080 return (check_writable((char *)XSTRING_DATA(abspath))
2084 dir = Ffile_name_directory(abspath);
2086 return (check_writable(!NILP(dir) ? (char *)XSTRING_DATA(dir)
2091 DEFUN("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2092 Return non-nil if file FILENAME is the name of a symbolic link.
2093 The value is the name of the file to which it is linked.
2094 Otherwise returns nil.
2098 /* This function can GC. GC checked 1997.04.10. */
2099 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2106 Lisp_Object handler;
2107 struct gcpro gcpro1;
2109 CHECK_STRING(filename);
2110 filename = Fexpand_file_name(filename, Qnil);
2112 /* If the file name has special constructs in it,
2113 call the corresponding file handler. */
2115 handler = Ffind_file_name_handler(filename, Qfile_symlink_p);
2117 if (!NILP(handler)) {
2118 return call2(handler, Qfile_symlink_p, filename);
2123 buf = ynew_array_and_zero(char, bufsize);
2124 valsize = readlink((char *)XSTRING_DATA(filename),
2126 if (valsize < bufsize) {
2129 /* Buffer was not long enough */
2133 if (valsize == -1) {
2137 val = make_string((Bufbyte*)buf, valsize);
2140 #else /* not S_IFLNK */
2142 #endif /* not S_IFLNK */
2145 DEFUN("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2146 Return t if file FILENAME is the name of a directory as a file.
2147 A directory name spec may be given instead; then the value is t
2148 if the directory so specified exists and really is a directory.
2152 /* This function can GC. GC checked 1997.04.10. */
2153 Lisp_Object abspath;
2155 Lisp_Object handler;
2156 struct gcpro gcpro1;
2158 GCPRO1(current_buffer->directory);
2159 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2162 /* If the file name has special constructs in it,
2163 call the corresponding file handler. */
2165 handler = Ffind_file_name_handler(abspath, Qfile_directory_p);
2168 return call2(handler, Qfile_directory_p, abspath);
2170 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2172 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2175 DEFUN("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2176 Return t if file FILENAME is the name of a directory as a file,
2177 and files in that directory can be opened by you. In order to use a
2178 directory as a buffer's current directory, this predicate must return true.
2179 A directory name spec may be given instead; then the value is t
2180 if the directory so specified exists and really is a readable and
2181 searchable directory.
2185 /* This function can GC. GC checked 1997.04.10. */
2186 Lisp_Object handler;
2188 /* If the file name has special constructs in it,
2189 call the corresponding file handler. */
2191 Ffind_file_name_handler(filename, Qfile_accessible_directory_p);
2193 return call2(handler, Qfile_accessible_directory_p, filename);
2195 if (NILP(Ffile_directory_p(filename)))
2198 return Ffile_executable_p(filename);
2201 DEFUN("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2202 Return t if file FILENAME is the name of a regular file.
2203 This is the sort of file that holds an ordinary stream of data bytes.
2207 /* This function can GC. GC checked 1997.04.10. */
2208 Lisp_Object abspath;
2210 Lisp_Object handler;
2211 struct gcpro gcpro1;
2213 GCPRO1(current_buffer->directory);
2214 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2217 /* If the file name has special constructs in it,
2218 call the corresponding file handler. */
2220 handler = Ffind_file_name_handler(abspath, Qfile_regular_p);
2223 return call2(handler, Qfile_regular_p, abspath);
2225 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2227 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2230 DEFUN("file-modes", Ffile_modes, 1, 1, 0, /*
2231 Return mode bits of file named FILENAME, as an integer.
2235 /* This function can GC. GC checked 1997.04.10. */
2236 Lisp_Object abspath;
2238 Lisp_Object handler;
2239 struct gcpro gcpro1;
2241 GCPRO1(current_buffer->directory);
2242 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2245 /* If the file name has special constructs in it,
2246 call the corresponding file handler. */
2248 handler = Ffind_file_name_handler(abspath, Qfile_modes);
2251 return call2(handler, Qfile_modes, abspath);
2253 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2255 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2257 return make_int(st.st_mode & 07777);
2260 DEFUN("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2261 Set mode bits of file named FILENAME to MODE (an integer).
2262 Only the 12 low bits of MODE are used.
2266 /* This function can GC. GC checked 1997.04.10. */
2267 Lisp_Object abspath;
2268 Lisp_Object handler;
2269 struct gcpro gcpro1;
2271 GCPRO1(current_buffer->directory);
2272 abspath = Fexpand_file_name(filename, current_buffer->directory);
2277 /* If the file name has special constructs in it,
2278 call the corresponding file handler. */
2280 handler = Ffind_file_name_handler(abspath, Qset_file_modes);
2283 return call3(handler, Qset_file_modes, abspath, mode);
2285 if (chmod((char *)XSTRING_DATA(abspath), XINT(mode)) < 0)
2286 report_file_error("Doing chmod", list1(abspath));
2291 DEFUN("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2292 Set the file permission bits for newly created files.
2293 The argument MODE should be an integer; if a bit in MODE is 1,
2294 subsequently created files will not have the permission corresponding
2295 to that bit enabled. Only the low 9 bits are used.
2296 This setting is inherited by subprocesses.
2302 umask((~XINT(mode)) & 0777);
2307 DEFUN("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2308 Return the default file protection for created files.
2309 The umask value determines which permissions are enabled in newly
2310 created files. If a permission's bit in the umask is 1, subsequently
2311 created files will not have that permission enabled.
2320 return make_int((~mode) & 0777);
2323 DEFUN("unix-sync", Funix_sync, 0, 0, "", /*
2324 Tell Unix to finish all pending disk updates.
2332 DEFUN("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2333 Return t if file FILE1 is newer than file FILE2.
2334 If FILE1 does not exist, the answer is nil;
2335 otherwise, if FILE2 does not exist, the answer is t.
2339 /* This function can GC. GC checked 1997.04.10. */
2340 Lisp_Object abspath1, abspath2;
2343 Lisp_Object handler;
2344 struct gcpro gcpro1, gcpro2, gcpro3;
2346 CHECK_STRING(file1);
2347 CHECK_STRING(file2);
2352 GCPRO3(abspath1, abspath2, current_buffer->directory);
2353 abspath1 = expand_and_dir_to_file(file1, current_buffer->directory);
2354 abspath2 = expand_and_dir_to_file(file2, current_buffer->directory);
2356 /* If the file name has special constructs in it,
2357 call the corresponding file handler. */
2358 handler = Ffind_file_name_handler(abspath1, Qfile_newer_than_file_p);
2361 Ffind_file_name_handler(abspath2, Qfile_newer_than_file_p);
2364 return call3(handler, Qfile_newer_than_file_p, abspath1,
2367 if (sxemacs_stat((char *)XSTRING_DATA(abspath1), &st) < 0)
2370 mtime1 = st.st_mtime;
2372 if (sxemacs_stat((char *)XSTRING_DATA(abspath2), &st) < 0)
2375 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2378 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2379 /* #define READ_BUF_SIZE (2 << 16) */
2380 #define READ_BUF_SIZE (1 << 15)
2382 DEFUN("insert-file-contents-internal", Finsert_file_contents_internal, 1, 7, 0, /*
2383 Insert contents of file FILENAME after point; no coding-system frobbing.
2384 This function is identical to `insert-file-contents' except for the
2385 handling of the CODESYS and USED-CODESYS arguments under
2386 SXEmacs/Mule. (When Mule support is not present, both functions are
2387 identical and ignore the CODESYS and USED-CODESYS arguments.)
2389 If support for Mule exists in this Emacs, the file is decoded according
2390 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2391 it should be a symbol, and the actual coding system that was used for the
2392 decoding is stored into it. It will in general be different from CODESYS
2393 if CODESYS specifies automatic encoding detection or end-of-line detection.
2395 Currently START and END refer to byte positions (as opposed to character
2396 positions), even in Mule. (Fixing this is very difficult.)
2398 (filename, visit, start, end, replace, codesys, used_codesys))
2400 /* This function can call lisp */
2404 Charcount inserted = 0;
2406 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2407 Lisp_Object handler = Qnil, val = Qnil;
2409 Bufbyte read_buf[READ_BUF_SIZE];
2411 struct buffer *buf = current_buffer;
2413 int not_regular = 0;
2415 if (UNLIKELY(buf->base_buffer && !NILP(visit))) {
2416 error("Cannot do file visiting in an indirect buffer");
2419 /* No need to call Fbarf_if_buffer_read_only() here.
2420 That's called in begin_multiple_change() or wherever. */
2421 /* #### dmoore - should probably check in various places to see if
2422 curbuf was killed and if so signal an error? */
2423 XSETBUFFER(curbuf, buf);
2425 GCPRO5(filename, val, visit, handler, curbuf);
2427 if (LIKELY(NILP(replace))) {
2428 mc_count = begin_multiple_change(buf, BUF_PT(buf), BUF_PT(buf));
2430 mc_count = begin_multiple_change(buf, BUF_BEG(buf), BUF_Z(buf));
2433 /* begin_multiple_change also adds an unwind_protect */
2434 speccount = specpdl_depth();
2436 filename = Fexpand_file_name(filename, Qnil);
2438 /* If the file name has special constructs in it,
2439 call the corresponding file handler. */
2440 handler = Ffind_file_name_handler(filename, Qinsert_file_contents);
2441 if (!NILP(handler)) {
2442 val = call6(handler, Qinsert_file_contents, filename,
2443 visit, start, end, replace);
2447 if (!NILP(used_codesys))
2448 CHECK_SYMBOL(used_codesys);
2451 if ((!NILP(start) || !NILP(end)) && !NILP(visit))
2452 error("Attempt to visit less than an entire file");
2456 if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) < 0) {
2461 report_file_error("Opening input file",
2467 /* Signal an error if we are accessing a non-regular file, with
2468 REPLACE, START or END being non-nil. */
2469 if (!S_ISREG(st.st_mode)) {
2475 if (!NILP(replace) || !NILP(start) || !NILP(end)) {
2476 end_multiple_change(buf, mc_count);
2479 (Fsignal(Qfile_error,
2480 list2(build_translated_string
2481 ("not a regular file"), filename)));
2484 #endif /* S_IFREG */
2495 if ((fd = interruptible_open((char *)XSTRING_DATA(filename),
2496 O_RDONLY | OPEN_BINARY, 0)) < 0)
2500 /* Replacement should preserve point as it preserves markers. */
2502 record_unwind_protect(restore_point_unwind,
2503 Fpoint_marker(Qnil, Qnil));
2505 record_unwind_protect(close_file_unwind, make_int(fd));
2507 /* Supposedly happens on VMS. */
2509 error("File size is negative");
2513 end = make_int(st.st_size);
2514 if (XINT(end) != st.st_size)
2515 error("Maximum buffer size exceeded");
2519 /* If requested, replace the accessible part of the buffer
2520 with the file contents. Avoid replacing text at the
2521 beginning or end of the buffer that matches the file contents;
2522 that preserves markers pointing to the unchanged parts. */
2523 #if !defined (FILE_CODING)
2524 /* The replace-mode code currently only works when the assumption
2525 'one byte == one char' holds true. This fails Mule because
2526 files may contain multibyte characters. It holds under Windows NT
2527 provided we convert CRLF into LF. */
2528 # define FSFMACS_SPEEDY_INSERT
2529 #endif /* !defined (FILE_CODING) */
2531 #ifndef FSFMACS_SPEEDY_INSERT
2532 if (!NILP(replace)) {
2533 buffer_delete_range(buf, BUF_BEG(buf), BUF_Z(buf),
2534 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2536 #else /* FSFMACS_SPEEDY_INSERT */
2537 if (!NILP(replace)) {
2538 char buffer[1 << 14];
2539 Bufpos same_at_start = BUF_BEGV(buf);
2540 Bufpos same_at_end = BUF_ZV(buf);
2543 /* Count how many chars at the start of the file
2544 match the text at the beginning of the buffer. */
2548 nread = read_allowing_quit(fd, buffer, sizeof buffer);
2550 error("IO error reading %s: %s",
2551 XSTRING_DATA(filename), strerror(errno));
2552 else if (nread == 0)
2555 while (bufpos < nread && same_at_start < BUF_ZV(buf)
2556 && BUF_FETCH_CHAR(buf,
2559 same_at_start++, bufpos++;
2560 /* If we found a discrepancy, stop the scan.
2561 Otherwise loop around and scan the next bufferful. */
2562 if (bufpos != nread)
2565 /* If the file matches the buffer completely,
2566 there's no need to replace anything. */
2567 if (same_at_start - BUF_BEGV(buf) == st.st_size) {
2569 unbind_to(speccount, Qnil);
2570 /* Truncate the buffer to the size of the file. */
2571 buffer_delete_range(buf, same_at_start, same_at_end,
2572 !NILP(visit) ? INSDEL_NO_LOCKING :
2576 /* Count how many chars at the end of the file
2577 match the text at the end of the buffer. */
2579 int total_read, nread;
2580 Bufpos bufpos, curpos, trial;
2582 /* At what file position are we now scanning? */
2583 curpos = st.st_size - (BUF_ZV(buf) - same_at_end);
2584 /* If the entire file matches the buffer tail, stop the scan. */
2587 /* How much can we scan in the next step? */
2588 trial = min(curpos, (Bufpos) sizeof(buffer));
2589 if (lseek(fd, curpos - trial, 0) < 0)
2590 report_file_error("Setting file position",
2594 while (total_read < trial) {
2596 read_allowing_quit(fd, buffer + total_read,
2597 trial - total_read);
2600 ("IO error reading file",
2602 total_read += nread;
2604 /* Scan this bufferful from the end, comparing with
2605 the Emacs buffer. */
2606 bufpos = total_read;
2607 /* Compare with same_at_start to avoid counting some buffer text
2608 as matching both at the file's beginning and at the end. */
2609 while (bufpos > 0 && same_at_end > same_at_start
2610 && BUF_FETCH_CHAR(buf, same_at_end - 1) ==
2612 same_at_end--, bufpos--;
2613 /* If we found a discrepancy, stop the scan.
2614 Otherwise loop around and scan the preceding bufferful. */
2617 /* If display current starts at beginning of line,
2618 keep it that way. */
2619 if (XBUFFER(XWINDOW(Fselected_window(Qnil))->buffer) ==
2621 XWINDOW(Fselected_window(Qnil))->
2623 !NILP(Fbolp(make_buffer(buf)));
2626 /* Don't try to reuse the same piece of text twice. */
2627 overlap = same_at_start - BUF_BEGV(buf) -
2628 (same_at_end + st.st_size - BUF_ZV(buf));
2630 same_at_end += overlap;
2632 /* Arrange to read only the nonmatching middle part of the file. */
2633 start = make_int(same_at_start - BUF_BEGV(buf));
2634 end = make_int(st.st_size - (BUF_ZV(buf) - same_at_end));
2636 buffer_delete_range(buf, same_at_start, same_at_end,
2637 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2638 /* Insert from the file at the proper position. */
2639 BUF_SET_PT(buf, same_at_start);
2641 #endif /* FSFMACS_SPEEDY_INSERT */
2644 total = XINT(end) - XINT(start);
2646 /* Make sure point-max won't overflow after this insertion. */
2647 if (total != XINT(make_int(total)))
2648 error("Maximum buffer size exceeded");
2650 /* For a special file, all we can do is guess. The value of -1
2651 will make the stream functions read as much as possible. */
2654 if (XINT(start) != 0
2655 #ifdef FSFMACS_SPEEDY_INSERT
2656 /* why was this here? asked jwz. The reason is that the replace-mode
2657 connivings above will normally put the file pointer other than
2658 where it should be. */
2660 #endif /* !FSFMACS_SPEEDY_INSERT */
2662 if (lseek(fd, XINT(start), 0) < 0)
2663 report_file_error("Setting file position",
2668 Bufpos cur_point = BUF_PT(buf);
2669 struct gcpro ngcpro1;
2670 Lisp_Object stream = make_filedesc_input_stream(fd, 0, total,
2674 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2677 stream = make_decoding_input_stream
2678 (XLSTREAM(stream), Fget_coding_system(codesys));
2679 Lstream_set_character_mode(XLSTREAM(stream));
2680 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2682 #endif /* FILE_CODING */
2684 record_unwind_protect(delete_stream_unwind, stream);
2686 /* No need to limit the amount of stuff we attempt to read. (It would
2687 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2688 occurs inside of the filedesc stream. */
2690 Lstream_data_count this_len;
2691 Charcount cc_inserted;
2694 this_len = Lstream_read(XLSTREAM(stream), read_buf,
2697 if (this_len <= 0) {
2704 buffer_insert_raw_string_1(buf, cur_point, read_buf,
2705 this_len, !NILP(visit)
2706 ? INSDEL_NO_LOCKING : 0);
2707 inserted += cc_inserted;
2708 cur_point += cc_inserted;
2711 if (!NILP(used_codesys)) {
2713 decoding_stream_coding_system(XLSTREAM(stream));
2714 Fset(used_codesys, XCODING_SYSTEM_NAME(tmp));
2716 #endif /* FILE_CODING */
2720 /* Close the file/stream */
2721 unbind_to(speccount, Qnil);
2723 if (saverrno != 0) {
2724 error("IO error reading %s: %s",
2725 XSTRING_DATA(filename), strerror(saverrno));
2731 end_multiple_change(buf, mc_count);
2734 if (!EQ(buf->undo_list, Qt))
2735 buf->undo_list = Qnil;
2736 if (NILP(handler)) {
2737 buf->modtime = st.st_mtime;
2738 buf->filename = filename;
2739 /* XEmacs addition: */
2740 /* This function used to be in C, ostensibly so that
2741 it could be called here. But that's just silly.
2742 There's no reason C code can't call out to Lisp
2743 code, and it's a lot cleaner this way. */
2744 /* Note: compute-buffer-file-truename is called for
2745 side-effect! Its return value is intentionally
2747 if (!NILP(Ffboundp(Qcompute_buffer_file_truename)))
2748 call1(Qcompute_buffer_file_truename,
2751 BUF_SAVE_MODIFF(buf) = BUF_MODIFF(buf);
2752 buf->auto_save_modified = BUF_MODIFF(buf);
2753 buf->saved_size = make_int(BUF_SIZE(buf));
2754 #ifdef CLASH_DETECTION
2755 if (NILP(handler)) {
2756 if (!NILP(buf->file_truename))
2757 unlock_file(buf->file_truename);
2758 unlock_file(filename);
2760 #endif /* CLASH_DETECTION */
2762 RETURN_UNGCPRO(Fsignal(Qfile_error,
2764 ("not a regular file"),
2767 /* If visiting nonexistent file, return nil. */
2768 if (buf->modtime == -1)
2769 report_file_error("Opening input file",
2773 /* Decode file format */
2775 Lisp_Object insval = call3(Qformat_decode,
2776 Qnil, make_int(inserted), visit);
2778 inserted = XINT(insval);
2783 struct gcpro ngcpro1;
2786 EXTERNAL_LIST_LOOP(p, Vafter_insert_file_functions) {
2787 Lisp_Object insval = call1(XCAR(p), make_int(inserted));
2788 if (!NILP(insval)) {
2789 CHECK_NATNUM(insval);
2790 inserted = XINT(insval);
2802 return (list2(filename, make_int(inserted)));
2805 static int a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
2806 Lisp_Object * annot);
2807 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end);
2809 /* If build_annotations switched buffers, switch back to BUF.
2810 Kill the temporary buffer that was selected in the meantime. */
2812 static Lisp_Object build_annotations_unwind(Lisp_Object buf)
2816 if (XBUFFER(buf) == current_buffer)
2818 tembuf = Fcurrent_buffer();
2820 Fkill_buffer(tembuf);
2824 DEFUN("write-region-internal", Fwrite_region_internal, 3, 7, "r\nFWrite region to file: ", /*
2825 Write current region into specified file; no coding-system frobbing.
2826 This function is identical to `write-region' except for the handling
2827 of the CODESYS argument under SXEmacs/Mule. (When Mule support is not
2828 present, both functions are identical and ignore the CODESYS argument.)
2829 If support for Mule exists in this Emacs, the file is encoded according
2830 to the value of CODESYS. If this is nil, no code conversion occurs.
2832 As a special kludge to support auto-saving, when START is nil START and
2833 END are set to the beginning and end, respectively, of the buffer,
2834 regardless of any restrictions. Don't use this feature. It is documented
2835 here because write-region handler writers need to be aware of it.
2837 (start, end, filename, append, visit, lockname, codesys))
2839 /* This function can call lisp. GC checked 2000-07-28 ben */
2841 int failure, stat_res;
2844 Lisp_Object fn = Qnil;
2845 int speccount = specpdl_depth();
2846 int visiting_other = STRINGP(visit);
2847 int visiting = (EQ(visit, Qt) || visiting_other);
2848 int quietly = (!visiting && !NILP(visit));
2849 Lisp_Object visit_file = Qnil;
2850 Lisp_Object annotations = Qnil;
2851 struct buffer *given_buffer;
2852 Bufpos start1, end1;
2853 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2854 struct gcpro ngcpro1, ngcpro2;
2857 XSETBUFFER(curbuf, current_buffer);
2859 /* start, end, visit, and append are never modified in this fun
2860 so we don't protect them. */
2861 GCPRO5(visit_file, filename, codesys, lockname, annotations);
2862 NGCPRO2(curbuf, fn);
2864 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
2865 we should signal an error rather than blissfully continuing
2866 along. ARGH, this function is going to lose lose lose. We need
2867 to protect the current_buffer from being destroyed, but the
2868 multiple return points make this a pain in the butt. ]] we do
2869 protect curbuf now. --ben */
2872 codesys = Fget_coding_system(codesys);
2873 #endif /* FILE_CODING */
2875 if (current_buffer->base_buffer && !NILP(visit))
2877 ("Cannot do file visiting in an indirect buffer", curbuf);
2879 if (!NILP(start) && !STRINGP(start))
2880 get_buffer_range_char(current_buffer, start, end, &start1,
2884 Lisp_Object handler;
2887 visit_file = Fexpand_file_name(visit, Qnil);
2889 visit_file = filename;
2890 filename = Fexpand_file_name(filename, Qnil);
2893 lockname = visit_file;
2895 /* We used to UNGCPRO here. BAD! visit_file is used below after
2896 more Lisp calling. */
2897 /* If the file name has special constructs in it,
2898 call the corresponding file handler. */
2899 handler = Ffind_file_name_handler(filename, Qwrite_region);
2900 /* If FILENAME has no handler, see if VISIT has one. */
2901 if (NILP(handler) && STRINGP(visit))
2902 handler = Ffind_file_name_handler(visit, Qwrite_region);
2904 if (!NILP(handler)) {
2906 call8(handler, Qwrite_region, start, end,
2907 filename, append, visit, lockname, codesys);
2909 BUF_SAVE_MODIFF(current_buffer) =
2910 BUF_MODIFF(current_buffer);
2911 current_buffer->saved_size =
2912 make_int(BUF_SIZE(current_buffer));
2913 current_buffer->filename = visit_file;
2914 MARK_MODELINE_CHANGED;
2922 #ifdef CLASH_DETECTION
2924 lock_file(lockname);
2925 #endif /* CLASH_DETECTION */
2927 /* Special kludge to simplify auto-saving. */
2929 start1 = BUF_BEG(current_buffer);
2930 end1 = BUF_Z(current_buffer);
2933 record_unwind_protect(build_annotations_unwind, Fcurrent_buffer());
2935 given_buffer = current_buffer;
2936 annotations = build_annotations(start, end);
2937 if (current_buffer != given_buffer) {
2938 start1 = BUF_BEGV(current_buffer);
2939 end1 = BUF_ZV(current_buffer);
2944 if (!NILP(append)) {
2946 open((char *)XSTRING_DATA(fn), O_WRONLY | OPEN_BINARY, 0);
2949 desc = open((char *)XSTRING_DATA(fn),
2950 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
2951 auto_saving ? auto_save_mode_bits : CREAT_MODE);
2955 #ifdef CLASH_DETECTION
2958 unlock_file(lockname);
2960 #endif /* CLASH_DETECTION */
2961 report_file_error("Opening output file", list1(filename));
2965 Lisp_Object desc_locative = Fcons(make_int(desc), Qnil);
2966 Lisp_Object instream = Qnil, outstream = Qnil;
2967 struct gcpro nngcpro1, nngcpro2;
2968 /* need to gcpro; QUIT could happen out of call to write() */
2969 NNGCPRO2(instream, outstream);
2971 record_unwind_protect(close_file_unwind, desc_locative);
2973 if (!NILP(append)) {
2974 if (lseek(desc, 0, 2) < 0) {
2975 #ifdef CLASH_DETECTION
2977 unlock_file(lockname);
2978 #endif /* CLASH_DETECTION */
2979 report_file_error("Lseek error",
2986 /* Note: I tried increasing the buffering size, along with
2987 various other tricks, but nothing seemed to make much of
2988 a difference in the time it took to save a large file.
2989 (Actually that's not true. With a local disk, changing
2990 the buffer size doesn't seem to make much difference.
2991 With an NFS-mounted disk, it could make a lot of difference
2992 because you're affecting the number of network requests
2993 that need to be made, and there could be a large latency
2994 for each request. So I've increased the buffer size
2996 outstream = make_filedesc_output_stream(desc, 0, -1, 0);
2997 Lstream_set_buffering(XLSTREAM(outstream),
2998 LSTREAM_BLOCKN_BUFFERED, 65536);
3001 make_encoding_output_stream(XLSTREAM(outstream), codesys);
3002 Lstream_set_buffering(XLSTREAM(outstream),
3003 LSTREAM_BLOCKN_BUFFERED, 65536);
3004 #endif /* FILE_CODING */
3005 if (STRINGP(start)) {
3006 instream = make_lisp_string_input_stream(start, 0, -1);
3010 make_lisp_buffer_input_stream(current_buffer,
3013 LSTR_IGNORE_ACCESSIBLE);
3015 (0 > (a_write(outstream, instream, start1, &annotations)));
3017 /* Note that this doesn't close the desc since we created the
3018 stream without the LSTR_CLOSING flag, but it does
3019 flush out any buffered data. */
3020 if (Lstream_close(XLSTREAM(outstream)) < 0) {
3024 Lstream_close(XLSTREAM(instream));
3027 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3028 Disk full in NFS may be reported here. */
3029 /* mib says that closing the file will try to write as fast as NFS can do
3030 it, and that means the fsync here is not crucial for autosave files. */
3031 if (!auto_saving && fsync(desc) < 0
3032 /* If fsync fails with EINTR, don't treat that as serious. */
3033 && errno != EINTR) {
3037 #endif /* HAVE_FSYNC */
3039 /* Spurious "file has changed on disk" warnings used to be seen on
3040 systems where close() can change the modtime. This is known to
3041 happen on various NFS file systems, on Windows, and on Linux.
3042 Rather than handling this on a per-system basis, we
3043 unconditionally do the sxemacs_stat() after the close(). */
3045 /* NFS can report a write failure now. */
3046 if (close(desc) < 0) {
3051 /* Discard the close unwind-protect. Execute the one for
3052 build_annotations (switches back to the original current buffer
3054 XCAR(desc_locative) = Qnil;
3055 unbind_to(speccount, Qnil);
3060 stat_res = sxemacs_stat((char *)XSTRING_DATA(fn), &st);
3062 #ifdef CLASH_DETECTION
3064 unlock_file(lockname);
3065 #endif /* CLASH_DETECTION */
3067 /* Do this before reporting IO error
3068 to avoid a "file has changed on disk" warning on
3069 next attempt to save. */
3072 current_buffer->modtime = st.st_mtime;
3074 If sxemacs_stat failed, we have bigger problems, and
3075 most likely the file is gone, so the error next time is
3081 report_file_error("Writing file", list1(fn));
3085 BUF_SAVE_MODIFF(current_buffer) = BUF_MODIFF(current_buffer);
3086 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3087 current_buffer->filename = visit_file;
3088 MARK_MODELINE_CHANGED;
3089 } else if (quietly) {
3097 message("Wrote %s", XSTRING_DATA(visit_file));
3099 Lisp_Object fsp = Qnil;
3100 struct gcpro nngcpro1;
3103 fsp = Ffile_symlink_p(fn);
3105 message("Wrote %s", XSTRING_DATA(fn));
3107 message("Wrote %s (symlink to %s)",
3108 XSTRING_DATA(fn), XSTRING_DATA(fsp));
3117 /* #### This is such a load of shit!!!! There is no way we should define
3118 something so stupid as a subr, just sort the fucking list more
3120 DEFUN("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3121 Return t if (car A) is numerically less than (car B).
3125 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcar(a), Fcar(b)))
3131 /* Heh heh heh, let's define this too, just to aggravate the person who
3132 wrote the above comment. */
3133 DEFUN("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3134 Return t if (cdr A) is numerically less than (cdr B).
3138 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcdr(a), Fcdr(b)))
3144 /* Build the complete list of annotations appropriate for writing out
3145 the text between START and END, by calling all the functions in
3146 write-region-annotate-functions and merging the lists they return.
3147 If one of these functions switches to a different buffer, we assume
3148 that buffer contains altered text. Therefore, the caller must
3149 make sure to restore the current buffer in all cases,
3150 as save-excursion would do. */
3152 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end)
3154 /* This function can GC */
3155 Lisp_Object annotations;
3157 struct gcpro gcpro1, gcpro2;
3158 Lisp_Object original_buffer;
3160 XSETBUFFER(original_buffer, current_buffer);
3163 p = Vwrite_region_annotate_functions;
3164 GCPRO2(annotations, p);
3166 struct buffer *given_buffer = current_buffer;
3167 Vwrite_region_annotations_so_far = annotations;
3168 res = call2(Fcar(p), start, end);
3169 /* If the function makes a different buffer current,
3170 assume that means this buffer contains altered text to be output.
3171 Reset START and END from the buffer bounds
3172 and discard all previous annotations because they should have
3173 been dealt with by this function. */
3174 if (current_buffer != given_buffer) {
3175 start = make_int(BUF_BEGV(current_buffer));
3176 end = make_int(BUF_ZV(current_buffer));
3179 Flength(res); /* Check basic validity of return value */
3180 annotations = merge(annotations, res, Qcar_less_than_car);
3184 /* Now do the same for annotation functions implied by the file-format */
3185 if (auto_saving && (!EQ(Vauto_save_file_format, Qt)))
3186 p = Vauto_save_file_format;
3188 p = current_buffer->file_format;
3190 struct buffer *given_buffer = current_buffer;
3191 Vwrite_region_annotations_so_far = annotations;
3192 res = call4(Qformat_annotate_function, Fcar(p), start, end,
3194 if (current_buffer != given_buffer) {
3195 start = make_int(BUF_BEGV(current_buffer));
3196 end = make_int(BUF_ZV(current_buffer));
3200 annotations = merge(annotations, res, Qcar_less_than_car);
3207 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3208 EOF is encountered), assuming they start at position POS in the buffer
3209 of string that STREAM refers to. Intersperse with them the annotations
3210 from *ANNOT that fall into the range of positions we are reading from,
3211 each at its appropriate position.
3213 Modify *ANNOT by discarding elements as we output them.
3214 The return value is negative in case of system call failure. */
3216 /* 4K should probably be fine. We just need to reduce the number of
3217 function calls to reasonable level. The Lstream stuff itself will
3218 batch to 64K to reduce the number of system calls. */
3220 #define A_WRITE_BATCH_SIZE 4096
3223 a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
3224 Lisp_Object * annot)
3228 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3229 Lstream *instr = XLSTREAM(instream);
3230 Lstream *outstr = XLSTREAM(outstream);
3232 while (LISTP(*annot)) {
3233 tem = Fcar_safe(Fcar(*annot));
3235 nextpos = XINT(tem);
3239 /* If there are annotations left and we have Mule, then we
3240 have to do the I/O one emchar at a time so we can
3241 determine when to insert the annotation. */
3242 if (!NILP(*annot)) {
3244 while (pos != nextpos
3245 && (ch = Lstream_get_emchar(instr)) != EOF) {
3246 if (Lstream_put_emchar(outstr, ch) < 0)
3253 while (pos != nextpos) {
3254 /* Otherwise there is no point to that. Just go in batches. */
3256 min(nextpos - pos, A_WRITE_BATCH_SIZE);
3258 chunk = Lstream_read(instr, largebuf, chunk);
3261 if (chunk == 0) /* EOF */
3263 if (Lstream_write(outstr, largebuf, chunk) <
3269 if (pos == nextpos) {
3270 tem = Fcdr(Fcar(*annot));
3272 if (Lstream_write(outstr, XSTRING_DATA(tem),
3273 XSTRING_LENGTH(tem)) < 0)
3276 *annot = Fcdr(*annot);
3283 DEFUN("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3284 Return t if last mod time of BUFFER's visited file matches what BUFFER records.
3285 This means that the file has not been changed since it was visited or saved.
3289 /* This function can call lisp; GC checked 2000-07-11 ben */
3292 Lisp_Object handler;
3294 CHECK_BUFFER(buffer);
3295 b = XBUFFER(buffer);
3297 if (!STRINGP(b->filename))
3299 if (b->modtime == 0)
3302 /* If the file name has special constructs in it,
3303 call the corresponding file handler. */
3304 handler = Ffind_file_name_handler(b->filename,
3305 Qverify_visited_file_modtime);
3307 return call2(handler, Qverify_visited_file_modtime, buffer);
3309 if (sxemacs_stat((char *)XSTRING_DATA(b->filename), &st) < 0) {
3310 /* If the file doesn't exist now and didn't exist before,
3311 we say that it isn't modified, provided the error is a tame one. */
3312 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3317 if (st.st_mtime == b->modtime
3318 /* If both are positive, accept them if they are off by one second. */
3319 || (st.st_mtime > 0 && b->modtime > 0
3320 && (st.st_mtime == b->modtime + 1
3321 || st.st_mtime == b->modtime - 1)))
3326 DEFUN("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3327 Clear out records of last mod time of visited file.
3328 Next attempt to save will certainly not complain of a discrepancy.
3332 current_buffer->modtime = 0;
3336 DEFUN("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3337 Return the current buffer's recorded visited file modification time.
3338 The value is a list of the form (HIGH . LOW), like the time values
3339 that `file-attributes' returns.
3343 return time_to_lisp((time_t) current_buffer->modtime);
3346 DEFUN("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3347 Update buffer's recorded modification time from the visited file's time.
3348 Useful if the buffer was not read from the file normally
3349 or if the file itself has been changed for some known benign reason.
3350 An argument specifies the modification time value to use
3351 \(instead of that of the visited file), in the form of a list
3352 \(HIGH . LOW) or (HIGH LOW).
3356 /* This function can call lisp */
3357 if (!NILP(time_list)) {
3359 lisp_to_time(time_list, &the_time);
3360 current_buffer->modtime = (int)the_time;
3362 Lisp_Object filename = Qnil;
3364 Lisp_Object handler;
3365 struct gcpro gcpro1, gcpro2, gcpro3;
3367 GCPRO3(filename, time_list, current_buffer->filename);
3368 filename = Fexpand_file_name(current_buffer->filename, Qnil);
3370 /* If the file name has special constructs in it,
3371 call the corresponding file handler. */
3373 Ffind_file_name_handler(filename,
3374 Qset_visited_file_modtime);
3377 /* The handler can find the file name the same way we did. */
3378 return call2(handler, Qset_visited_file_modtime, Qnil);
3379 else if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) >= 0)
3380 current_buffer->modtime = st.st_mtime;
3387 auto_save_error(Lisp_Object condition_object, Lisp_Object ignored)
3389 /* This function can call lisp */
3392 /* Don't try printing an error message after everything is gone! */
3393 if (preparing_for_armageddon)
3395 clear_echo_area(selected_frame(), Qauto_saving, 1);
3396 Fding(Qt, Qauto_save_error, Qnil);
3397 message("Auto-saving...error for %s",
3398 XSTRING_DATA(current_buffer->name));
3399 Fsleep_for(make_int(1));
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));
3409 static Lisp_Object auto_save_1(Lisp_Object ignored)
3411 /* This function can call lisp */
3412 /* #### I think caller is protecting current_buffer? */
3414 Lisp_Object fn = current_buffer->filename;
3415 Lisp_Object a = current_buffer->auto_save_file_name;
3420 /* Get visited file's mode to become the auto save file's mode. */
3421 if (STRINGP(fn) && sxemacs_stat((char *)XSTRING_DATA(fn), &st) >= 0)
3422 /* But make sure we can overwrite it later! */
3423 auto_save_mode_bits = st.st_mode | 0600;
3425 /* default mode for auto-save files of buffers with no file is
3426 readable by owner only. This may annoy some small number of
3427 people, but the alternative removes all privacy from email. */
3428 auto_save_mode_bits = 0600;
3431 /* !!#### need to deal with this 'escape-quoted everywhere */
3432 Fwrite_region_internal(Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3434 current_buffer->buffer_file_coding_system
3442 auto_save_expand_name_error(Lisp_Object condition_object, Lisp_Object ignored)
3444 /* #### this function should spew an error message about not being
3445 able to open the .saves file. */
3449 static Lisp_Object auto_save_expand_name(Lisp_Object name)
3451 struct gcpro gcpro1;
3453 /* note that caller did NOT gc protect name, so we do it. */
3454 /* #### dmoore - this might not be necessary, if condition_case_1
3455 protects it. but I don't think it does. */
3457 RETURN_UNGCPRO(Fexpand_file_name(name, Qnil));
3460 static Lisp_Object do_auto_save_unwind(Lisp_Object fd)
3466 static Lisp_Object do_auto_save_unwind_2(Lisp_Object old_auto_saving)
3468 auto_saving = XINT(old_auto_saving);
3472 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3473 and if so, tries to avoid touching lisp objects.
3475 The only time that Fdo_auto_save() is called while GC is in progress
3476 is if we're going down, as a result of an abort() or a kill signal.
3477 It's fairly important that we generate autosave files in that case!
3480 DEFUN("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3481 Auto-save all buffers that need it.
3482 This is all buffers that have auto-saving enabled
3483 and are changed since last auto-saved.
3484 Auto-saving writes the buffer into a file
3485 so that your editing is not lost if the system crashes.
3486 This file is not the file you visited; that changes only when you save.
3487 Normally we run the normal hook `auto-save-hook' before saving.
3489 Non-nil first argument means do not print any message if successful.
3490 Non-nil second argument means save only current buffer.
3492 (no_message, current_only))
3494 /* This function can call lisp */
3496 Lisp_Object tail, buf;
3498 int do_handled_files;
3499 Lisp_Object oquit = Qnil;
3500 Lisp_Object listfile = Qnil;
3503 int speccount = specpdl_depth();
3504 struct gcpro gcpro1, gcpro2, gcpro3;
3506 XSETBUFFER(old, current_buffer);
3507 GCPRO3(oquit, listfile, old);
3508 check_quit(); /* make Vquit_flag accurate */
3509 /* Ordinarily don't quit within this function,
3510 but don't make it impossible to quit (in case we get hung in I/O). */
3514 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3515 variables point to non-strings reached from Vbuffer_alist. */
3517 if (minibuf_level != 0 || preparing_for_armageddon)
3520 run_hook(Qauto_save_hook);
3522 if (STRINGP(Vauto_save_list_file_name))
3523 listfile = condition_case_1(Qt,
3524 auto_save_expand_name,
3525 Vauto_save_list_file_name,
3526 auto_save_expand_name_error, Qnil);
3528 /* Make sure auto_saving is reset. */
3529 record_unwind_protect(do_auto_save_unwind_2, make_int(auto_saving));
3533 /* First, save all files which don't have handlers. If Emacs is
3534 crashing, the handlers may tweak what is causing Emacs to crash
3535 in the first place, and it would be a shame if Emacs failed to
3536 autosave perfectly ordinary files because it couldn't handle some
3538 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) {
3539 for (tail = Vbuffer_alist; CONSP(tail); tail = XCDR(tail)) {
3540 buf = XCDR(XCAR(tail));
3543 if (!NILP(current_only)
3544 && b != current_buffer)
3547 /* Don't auto-save indirect buffers.
3548 The base buffer takes care of it. */
3552 /* Check for auto save enabled
3553 and file changed since last auto save
3554 and file changed since last real save. */
3555 if (STRINGP(b->auto_save_file_name)
3556 && BUF_SAVE_MODIFF(b) < BUF_MODIFF(b)
3557 && b->auto_save_modified < BUF_MODIFF(b)
3558 /* -1 means we've turned off autosaving for a while--see below. */
3559 && XINT(b->saved_size) >= 0
3560 && (do_handled_files
3562 NILP(Ffind_file_name_handler
3563 (b->auto_save_file_name,
3565 EMACS_TIME before_time, after_time;
3567 EMACS_GET_TIME(before_time);
3568 /* If we had a failure, don't try again for 20 minutes. */
3569 if (!preparing_for_armageddon
3570 && b->auto_save_failure_time >= 0
3571 && (EMACS_SECS(before_time) -
3572 b->auto_save_failure_time < 1200))
3575 if (!preparing_for_armageddon &&
3576 (XINT(b->saved_size) * 10
3577 > (BUF_Z(b) - BUF_BEG(b)) * 13)
3578 /* A short file is likely to change a large fraction;
3579 spare the user annoying messages. */
3580 && XINT(b->saved_size) > 5000
3581 /* These messages are frequent and annoying for `*mail*'. */
3582 && !NILP(b->filename)
3584 && disable_auto_save_when_buffer_shrinks) {
3585 /* It has shrunk too much; turn off auto-saving here.
3586 Unless we're about to crash, in which case auto-save it
3590 ("Buffer %s has shrunk a lot; auto save turned off there",
3591 XSTRING_DATA(b->name));
3592 /* Turn off auto-saving until there's a real save,
3593 and prevent any more warnings. */
3594 b->saved_size = make_int(-1);
3595 if (!gc_in_progress)
3596 Fsleep_for(make_int(1));
3599 set_buffer_internal(b);
3600 if (!auto_saved && NILP(no_message)) {
3601 static const unsigned char *msg
3603 (const unsigned char *)
3605 echo_area_message(selected_frame(), msg,
3607 strlen((const char *)
3612 /* Open the auto-save list file, if necessary.
3613 We only do this now so that the file only exists
3614 if we actually auto-saved any files. */
3615 if (!auto_saved && !inhibit_auto_save_session
3616 && !NILP(Vauto_save_list_file_prefix)
3617 && STRINGP(listfile) && listdesc < 0) {
3619 open((char *)XSTRING_DATA(listfile),
3620 O_WRONLY | O_TRUNC | O_CREAT |
3621 OPEN_BINARY, CREAT_MODE);
3623 /* Arrange to close that file whether or not we get
3626 record_unwind_protect
3627 (do_auto_save_unwind,
3628 make_int(listdesc));
3631 /* Record all the buffers that we are auto-saving in
3632 the special file that lists them. For each of
3633 these buffers, record visited name (if any) and
3635 if (listdesc >= 0) {
3636 const Extbyte *auto_save_file_name_ext;
3637 Extcount auto_save_file_name_ext_len;
3639 TO_EXTERNAL_FORMAT(LISP_STRING,
3641 auto_save_file_name,
3643 (auto_save_file_name_ext,
3644 auto_save_file_name_ext_len),
3646 if (!NILP(b->filename)) {
3647 const Extbyte *filename_ext;
3648 Extcount filename_ext_len;
3650 TO_EXTERNAL_FORMAT(LISP_STRING,
3656 write(listdesc, filename_ext,
3659 write(listdesc, "\n", 1);
3660 write(listdesc, auto_save_file_name_ext,
3661 auto_save_file_name_ext_len);
3662 write(listdesc, "\n", 1);
3665 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
3666 based on values in Vbuffer_alist. auto_save_1 may
3667 cause lisp handlers to run. Those handlers may kill
3668 the buffer and then GC. Since the buffer is killed,
3669 it's no longer in Vbuffer_alist so it might get reaped
3670 by the GC. We also need to protect tail. */
3671 /* #### There is probably a lot of other code which has
3672 pointers into buffers which may get blown away by
3675 struct gcpro ngcpro1, ngcpro2;
3677 condition_case_1(Qt,
3679 auto_save_error, Qnil);
3682 /* Handler killed our saved current-buffer! Pick any. */
3683 if (!BUFFER_LIVE_P(XBUFFER(old)))
3684 XSETBUFFER(old, current_buffer);
3686 set_buffer_internal(XBUFFER(old));
3689 /* Handler killed their own buffer! */
3690 if (!BUFFER_LIVE_P(b))
3693 b->auto_save_modified = BUF_MODIFF(b);
3694 b->saved_size = make_int(BUF_SIZE(b));
3695 EMACS_GET_TIME(after_time);
3696 /* If auto-save took more than 60 seconds,
3697 assume it was an NFS failure that got a timeout. */
3698 if (EMACS_SECS(after_time) -
3699 EMACS_SECS(before_time) > 60)
3700 b->auto_save_failure_time =
3701 EMACS_SECS(after_time);
3706 /* Prevent another auto save till enough input events come in. */
3710 /* If we didn't save anything into the listfile, remove the old
3711 one because nothing needed to be auto-saved. Do this afterwards
3712 rather than before in case we get a crash attempting to autosave
3713 (in that case we'd still want the old one around). */
3714 if (listdesc < 0 && !auto_saved && STRINGP(listfile))
3715 unlink((char *)XSTRING_DATA(listfile));
3717 /* Show "...done" only if the echo area would otherwise be empty. */
3718 if (auto_saved && NILP(no_message)
3719 && NILP(clear_echo_area(selected_frame(), Qauto_saving, 0))) {
3720 static const unsigned char *msg
3721 = (const unsigned char *)"Auto-saving...done";
3722 echo_area_message(selected_frame(), msg, Qnil, 0,
3723 strlen((const char *)msg), Qauto_saving);
3728 RETURN_UNGCPRO(unbind_to(speccount, Qnil));
3731 DEFUN("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
3732 Mark current buffer as auto-saved with its current text.
3733 No auto-save file will be written until the buffer changes again.
3737 current_buffer->auto_save_modified = BUF_MODIFF(current_buffer);
3738 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3739 current_buffer->auto_save_failure_time = -1;
3743 DEFUN("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
3744 Clear any record of a recent auto-save failure in the current buffer.
3748 current_buffer->auto_save_failure_time = -1;
3752 DEFUN("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
3753 Return t if buffer has been auto-saved since last read in or saved.
3757 return (BUF_SAVE_MODIFF(current_buffer) <
3758 current_buffer->auto_save_modified) ? Qt : Qnil;
3761 /************************************************************************/
3762 /* initialization */
3763 /************************************************************************/
3765 void syms_of_fileio(void)
3767 defsymbol(&Qexpand_file_name, "expand-file-name");
3768 defsymbol(&Qfile_truename, "file-truename");
3769 defsymbol(&Qsubstitute_in_file_name, "substitute-in-file-name");
3770 defsymbol(&Qdirectory_file_name, "directory-file-name");
3771 defsymbol(&Qfile_dirname, "file-dirname");
3772 defsymbol(&Qfile_basename, "file-basename");
3773 defsymbol(&Qfile_name_directory, "file-name-directory");
3774 defsymbol(&Qfile_name_nondirectory, "file-name-nondirectory");
3775 defsymbol(&Qunhandled_file_name_directory,
3776 "unhandled-file-name-directory");
3777 defsymbol(&Qfile_name_as_directory, "file-name-as-directory");
3778 defsymbol(&Qcopy_file, "copy-file");
3779 defsymbol(&Qmake_directory_internal, "make-directory-internal");
3780 defsymbol(&Qdelete_directory, "delete-directory");
3781 defsymbol(&Qdelete_file, "delete-file");
3782 defsymbol(&Qrename_file, "rename-file");
3783 defsymbol(&Qadd_name_to_file, "add-name-to-file");
3784 defsymbol(&Qmake_symbolic_link, "make-symbolic-link");
3785 defsymbol(&Qfile_exists_p, "file-exists-p");
3786 defsymbol(&Qfile_executable_p, "file-executable-p");
3787 defsymbol(&Qfile_readable_p, "file-readable-p");
3788 defsymbol(&Qfile_symlink_p, "file-symlink-p");
3789 defsymbol(&Qfile_writable_p, "file-writable-p");
3790 defsymbol(&Qfile_directory_p, "file-directory-p");
3791 defsymbol(&Qfile_regular_p, "file-regular-p");
3792 defsymbol(&Qfile_accessible_directory_p, "file-accessible-directory-p");
3793 defsymbol(&Qfile_modes, "file-modes");
3794 defsymbol(&Qset_file_modes, "set-file-modes");
3795 defsymbol(&Qfile_newer_than_file_p, "file-newer-than-file-p");
3796 defsymbol(&Qinsert_file_contents, "insert-file-contents");
3797 defsymbol(&Qwrite_region, "write-region");
3798 defsymbol(&Qverify_visited_file_modtime, "verify-visited-file-modtime");
3799 defsymbol(&Qset_visited_file_modtime, "set-visited-file-modtime");
3800 defsymbol(&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
3802 defsymbol(&Qauto_save_hook, "auto-save-hook");
3803 defsymbol(&Qauto_save_error, "auto-save-error");
3804 defsymbol(&Qauto_saving, "auto-saving");
3806 defsymbol(&Qformat_decode, "format-decode");
3807 defsymbol(&Qformat_annotate_function, "format-annotate-function");
3809 defsymbol(&Qcompute_buffer_file_truename,
3810 "compute-buffer-file-truename");
3811 DEFERROR_STANDARD(Qfile_error, Qio_error);
3812 DEFERROR_STANDARD(Qfile_already_exists, Qfile_error);
3814 DEFSUBR(Ffind_file_name_handler);
3816 DEFSUBR(Ffile_name_directory);
3817 DEFSUBR(Ffile_name_nondirectory);
3818 DEFSUBR(Ffile_basename);
3819 DEFSUBR(Ffile_dirname);
3820 DEFSUBR(Funhandled_file_name_directory);
3821 DEFSUBR(Ffile_name_as_directory);
3822 DEFSUBR(Fdirectory_file_name);
3823 DEFSUBR(Fmake_temp_name);
3824 DEFSUBR(Fexpand_file_name);
3825 DEFSUBR(Ffile_truename);
3826 DEFSUBR(Fsubstitute_in_file_name);
3827 DEFSUBR(Fcopy_file);
3828 DEFSUBR(Fmake_directory_internal);
3829 DEFSUBR(Fdelete_directory);
3830 DEFSUBR(Fdelete_file);
3831 DEFSUBR(Frename_file);
3832 DEFSUBR(Fadd_name_to_file);
3833 DEFSUBR(Fmake_symbolic_link);
3835 DEFSUBR(Fsysnetunam);
3836 #endif /* HPUX_NET */
3837 DEFSUBR(Ffile_name_absolute_p);
3838 DEFSUBR(Ffile_exists_p);
3839 DEFSUBR(Ffile_executable_p);
3840 DEFSUBR(Ffile_readable_p);
3841 DEFSUBR(Ffile_writable_p);
3842 DEFSUBR(Ffile_symlink_p);
3843 DEFSUBR(Ffile_directory_p);
3844 DEFSUBR(Ffile_accessible_directory_p);
3845 DEFSUBR(Ffile_regular_p);
3846 DEFSUBR(Ffile_modes);
3847 DEFSUBR(Fset_file_modes);
3848 DEFSUBR(Fset_default_file_modes);
3849 DEFSUBR(Fdefault_file_modes);
3850 DEFSUBR(Funix_sync);
3851 DEFSUBR(Ffile_newer_than_file_p);
3852 DEFSUBR(Finsert_file_contents_internal);
3853 DEFSUBR(Fwrite_region_internal);
3854 DEFSUBR(Fcar_less_than_car); /* Vomitous! */
3855 DEFSUBR(Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
3856 DEFSUBR(Fverify_visited_file_modtime);
3857 DEFSUBR(Fclear_visited_file_modtime);
3858 DEFSUBR(Fvisited_file_modtime);
3859 DEFSUBR(Fset_visited_file_modtime);
3861 DEFSUBR(Fdo_auto_save);
3862 DEFSUBR(Fset_buffer_auto_saved);
3863 DEFSUBR(Fclear_buffer_auto_save_failure);
3864 DEFSUBR(Frecent_auto_save_p);
3867 void vars_of_fileio(void)
3869 DEFVAR_LISP("auto-save-file-format", &Vauto_save_file_format /*
3870 *Format in which to write auto-save files.
3871 Should be a list of symbols naming formats that are defined in `format-alist'.
3872 If it is t, which is the default, auto-save files are written in the
3873 same format as a regular save would use.
3875 Vauto_save_file_format = Qt;
3877 DEFVAR_LISP("file-name-handler-alist", &Vfile_name_handler_alist /*
3878 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
3879 If a file name matches REGEXP, then all I/O on that file is done by calling
3882 The first argument given to HANDLER is the name of the I/O primitive
3883 to be handled; the remaining arguments are the arguments that were
3884 passed to that primitive. For example, if you do
3885 (file-exists-p FILENAME)
3886 and FILENAME is handled by HANDLER, then HANDLER is called like this:
3887 (funcall HANDLER 'file-exists-p FILENAME)
3888 The function `find-file-name-handler' checks this list for a handler
3891 Vfile_name_handler_alist = Qnil;
3893 DEFVAR_LISP("after-insert-file-functions", &Vafter_insert_file_functions /*
3894 A list of functions to be called at the end of `insert-file-contents'.
3895 Each is passed one argument, the number of bytes inserted. It should return
3896 the new byte count, and leave point the same. If `insert-file-contents' is
3897 intercepted by a handler from `file-name-handler-alist', that handler is
3898 responsible for calling the after-insert-file-functions if appropriate.
3900 Vafter_insert_file_functions = Qnil;
3902 DEFVAR_LISP("write-region-annotate-functions", &Vwrite_region_annotate_functions /*
3903 A list of functions to be called at the start of `write-region'.
3904 Each is passed two arguments, START and END, as for `write-region'.
3905 It should return a list of pairs (POSITION . STRING) of strings to be
3906 effectively inserted at the specified positions of the file being written
3907 \(1 means to insert before the first byte written). The POSITIONs must be
3908 sorted into increasing order. If there are several functions in the list,
3909 the several lists are merged destructively.
3911 Vwrite_region_annotate_functions = Qnil;
3913 DEFVAR_LISP("write-region-annotations-so-far", &Vwrite_region_annotations_so_far /*
3914 When an annotation function is called, this holds the previous annotations.
3915 These are the annotations made by other annotation functions
3916 that were already called. See also `write-region-annotate-functions'.
3918 Vwrite_region_annotations_so_far = Qnil;
3920 DEFVAR_LISP("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
3921 A list of file name handlers that temporarily should not be used.
3922 This applies only to the operation `inhibit-file-name-operation'.
3924 Vinhibit_file_name_handlers = Qnil;
3926 DEFVAR_LISP("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
3927 The operation for which `inhibit-file-name-handlers' is applicable.
3929 Vinhibit_file_name_operation = Qnil;
3931 DEFVAR_LISP("auto-save-list-file-name", &Vauto_save_list_file_name /*
3932 File name in which we write a list of all auto save file names.
3934 Vauto_save_list_file_name = Qnil;
3936 DEFVAR_LISP("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
3937 Prefix for generating auto-save-list-file-name.
3938 Emacs's pid and the system name will be appended to
3939 this prefix to create a unique file name.
3941 Vauto_save_list_file_prefix = build_string("~/.saves-");
3943 DEFVAR_BOOL("inhibit-auto-save-session", &inhibit_auto_save_session /*
3944 When non-nil, inhibit auto save list file creation.
3946 inhibit_auto_save_session = 0;
3948 DEFVAR_BOOL("disable-auto-save-when-buffer-shrinks", &disable_auto_save_when_buffer_shrinks /*
3949 If non-nil, auto-saving is disabled when a buffer shrinks too much.
3950 This is to prevent you from losing your edits if you accidentally
3951 delete a large chunk of the buffer and don't notice it until too late.
3952 Saving the buffer normally turns auto-save back on.
3954 disable_auto_save_when_buffer_shrinks = 1;
3956 DEFVAR_LISP("directory-sep-char", &Vdirectory_sep_char /*
3957 Directory separator character for built-in functions that return file names.
3958 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
3959 This variable affects the built-in functions only on Windows,
3960 on other platforms, it is initialized so that Lisp code can find out
3961 what the normal separator is.
3963 Vdirectory_sep_char = make_char('/');
3965 reinit_vars_of_fileio();
3968 void reinit_vars_of_fileio(void)
3970 /* We want temp_name_rand to be initialized to a value likely to be
3971 unique to the process, not to the executable. The danger is that
3972 two different SXEmacs processes using the same binary on different
3973 machines creating temp files in the same directory will be
3974 unlucky enough to have the same pid. If we randomize using
3975 process startup time, then in practice they will be unlikely to
3976 collide. We use the microseconds field so that scripts that start
3977 simultaneous SXEmacs processes on multiple machines will have less
3978 chance of collision. */
3982 EMACS_GET_TIME(thyme);
3984 (unsigned int)(EMACS_SECS(thyme) ^ EMACS_USECS(thyme));