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];
1109 TO_EXTERNAL_FORMAT(LISP_STRING, expanded_name,
1110 ALLOCA, (path, elen), Qfile_name);
1114 if (elen > MAXPATHLEN)
1117 /* Try doing it all at once. */
1118 /* !! Does realpath() Mule-encapsulate?
1119 Answer: Nope! So we do it above */
1120 if (!xrealpath((char *)path, resolved_path)) {
1121 /* Didn't resolve it -- have to do it one component at a time. */
1122 /* "realpath" is a typically useless, stupid un*x piece of crap.
1123 It claims to return a useful value in the "error" case, but since
1124 there is no indication provided of how far along the pathname
1125 the function went before erring, there is no way to use the
1126 partial result returned. What a piece of junk.
1128 The above comment refers to historical versions of
1129 realpath(). The Unix98 specs state:
1131 "On successful completion, realpath() returns a
1132 pointer to the resolved name. Otherwise, realpath()
1133 returns a null pointer and sets errno to indicate the
1134 error, and the contents of the buffer pointed to by
1135 resolved_name are undefined."
1137 Since we depend on undocumented semantics of various system realpath()s,
1138 we just use our own version in realpath.c. */
1142 for (pos = p + 1; pos < path + elen; pos++)
1143 if (IS_DIRECTORY_SEP(*pos)) {
1150 if (xrealpath((char *)path, resolved_path)) {
1156 } else if (errno == ENOENT || errno == EACCES) {
1157 /* Failed on this component. Just tack on the rest of
1158 the string and we are done. */
1159 int rlen = strlen(resolved_path);
1161 /* "On failure, it returns NULL, sets errno to indicate
1162 the error, and places in resolved_path the absolute pathname
1163 of the path component which could not be resolved." */
1166 int plen = elen - (p - path);
1171 (resolved_path[rlen - 1]))
1174 if (plen + rlen + 1 >
1175 countof(resolved_path))
1178 resolved_path[rlen] =
1180 memcpy(resolved_path + rlen + 1,
1181 p + 1, plen + 1 - 1);
1190 Lisp_Object resolved_name;
1191 int rlen = strlen(resolved_path);
1194 IS_DIRECTORY_SEP(XSTRING_BYTE
1195 (expanded_name, elen - 1))
1197 && IS_DIRECTORY_SEP(resolved_path[rlen - 1])))
1199 if (rlen + 1 > countof(resolved_path))
1201 resolved_path[rlen++] = DIRECTORY_SEP;
1202 resolved_path[rlen] = '\0';
1204 TO_INTERNAL_FORMAT(DATA, (resolved_path, rlen),
1205 LISP_STRING, resolved_name,
1207 RETURN_UNGCPRO(resolved_name);
1211 errno = ENAMETOOLONG;
1214 report_file_error("Finding truename", list1(expanded_name));
1216 RETURN_UNGCPRO(Qnil);
1219 DEFUN("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /*
1220 Substitute environment variables referred to in FILENAME.
1221 `$FOO' where FOO is an environment variable name means to substitute
1222 the value of that variable. The variable name should be terminated
1223 with a character, not a letter, digit or underscore; otherwise, enclose
1224 the entire variable name in braces.
1225 If `/~' appears, all of FILENAME through that `/' is discarded.
1229 /* This function can GC. GC checked 2000-07-28 ben. */
1232 Bufbyte *s, *p, *o, *x, *endp;
1233 Bufbyte *target = 0;
1235 int substituted = 0;
1237 Lisp_Object handler;
1239 CHECK_STRING(filename);
1241 /* If the file name has special constructs in it,
1242 call the corresponding file handler. */
1243 handler = Ffind_file_name_handler(filename, Qsubstitute_in_file_name);
1245 return call2_check_string_or_nil(handler,
1246 Qsubstitute_in_file_name,
1249 nm = XSTRING_DATA(filename);
1250 endp = nm + XSTRING_LENGTH(filename);
1252 /* If /~ or // appears, discard everything through first slash. */
1254 for (p = nm; p != endp; p++) {
1256 || IS_DIRECTORY_SEP(p[0])
1258 && p != nm && (IS_DIRECTORY_SEP(p[-1]))) {
1264 /* See if any variables are substituted into the string
1265 and find the total length of their values in `total' */
1267 for (p = nm; p != endp;)
1274 else if (*p == '$') {
1275 /* "$$" means a single "$" */
1280 } else if (*p == '{') {
1282 while (p != endp && *p != '}')
1289 while (p != endp && (isalnum(*p) || *p == '_'))
1294 /* Copy out the variable name */
1295 target = (Bufbyte *) alloca(s - o + 1);
1296 strncpy((char *)target, (char *)o, s - o);
1297 target[s - o] = '\0';
1299 /* Get variable value */
1300 o = (Bufbyte *) egetenv((char *)target);
1303 total += strlen((char *)o);
1310 /* If substitution required, recopy the filename and do it */
1311 /* Make space in stack frame for the new copy */
1312 xnm = (Bufbyte *) alloca(XSTRING_LENGTH(filename) + total + 1);
1315 /* Copy the rest of the name through, replacing $ constructs with values */
1323 else if (*p == '$') {
1326 } else if (*p == '{') {
1328 while (p != endp && *p != '}')
1335 while (p != endp && (isalnum(*p) || *p == '_'))
1340 /* Copy out the variable name */
1341 target = (Bufbyte *) alloca(s - o + 1);
1342 strncpy((char *)target, (char *)o, s - o);
1343 target[s - o] = '\0';
1345 /* Get variable value */
1346 o = (Bufbyte *) egetenv((char *)target);
1350 strcpy((char *)x, (char *)o);
1351 x += strlen((char *)o);
1356 /* If /~ or // appears, discard everything through first slash. */
1358 for (p = xnm; p != x; p++)
1360 || IS_DIRECTORY_SEP(p[0])
1362 /* don't do p[-1] if that would go off the beginning --jwz */
1363 && p != nm && p > xnm && IS_DIRECTORY_SEP(p[-1]))
1366 return make_string(xnm, x - xnm);
1369 syntax_error("Bad format environment-variable substitution", filename);
1371 syntax_error("Missing \"}\" in environment-variable substitution",
1374 syntax_error_2("Substituting nonexistent environment variable",
1375 filename, build_string((char *)target));
1378 return Qnil; /* suppress compiler warning */
1381 /* A slightly faster and more convenient way to get
1382 (directory-file-name (expand-file-name FOO)). */
1384 Lisp_Object expand_and_dir_to_file(Lisp_Object filename, Lisp_Object defdir)
1386 /* This function can call Lisp. GC checked 2000-07-28 ben */
1387 Lisp_Object abspath;
1388 struct gcpro gcpro1;
1390 abspath = Fexpand_file_name(filename, defdir);
1392 /* Remove final slash, if any (unless path is root).
1393 stat behaves differently depending! */
1394 if (XSTRING_LENGTH(abspath) > 1
1396 IS_DIRECTORY_SEP(XSTRING_BYTE(abspath, XSTRING_LENGTH(abspath) - 1))
1398 !IS_DEVICE_SEP(XSTRING_BYTE(abspath, XSTRING_LENGTH(abspath) - 2)))
1399 /* We cannot take shortcuts; they might be wrong for magic file names. */
1400 abspath = Fdirectory_file_name(abspath);
1405 /* Signal an error if the file ABSNAME already exists.
1406 If INTERACTIVE is nonzero, ask the user whether to proceed,
1407 and bypass the error if the user says to go ahead.
1408 QUERYSTRING is a name for the action that is being considered
1410 *STATPTR is used to store the stat information if the file exists.
1411 If the file does not exist, STATPTR->st_mode is set to 0. */
1414 barf_or_query_if_file_exists(Lisp_Object absname, const char *querystring,
1415 int interactive, struct stat *statptr)
1417 /* This function can call Lisp. GC checked 2000-07-28 ben */
1418 struct stat statbuf;
1420 /* stat is a good way to tell whether the file exists,
1421 regardless of what access permissions it has. */
1422 if (sxemacs_stat((char *)XSTRING_DATA(absname), &statbuf) >= 0) {
1427 struct gcpro gcpro1;
1429 prompt = emacs_doprnt_string_c
1431 GETTEXT("File %s already exists; %s anyway? "),
1432 Qnil, -1, XSTRING_DATA(absname),
1433 GETTEXT(querystring));
1436 tem = call1(Qyes_or_no_p, prompt);
1442 Fsignal(Qfile_already_exists,
1443 list2(build_translated_string
1444 ("File already exists"), absname));
1449 statptr->st_mode = 0;
1454 DEFUN("copy-file", Fcopy_file, 2, 4, "fCopy file: \nFCopy %s to file: \np\nP", /*
1455 Copy FILENAME to NEWNAME. Both args must be strings.
1456 Signals a `file-already-exists' error if file NEWNAME already exists,
1457 unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
1458 A number as third arg means request confirmation if NEWNAME already exists.
1459 This is what happens in interactive use with M-x.
1460 Fourth arg KEEP-TIME non-nil means give the new file the same
1461 last-modified time as the old one. (This works on only some systems.)
1462 A prefix arg makes KEEP-TIME non-nil.
1464 (filename, newname, ok_if_already_exists, keep_time))
1466 /* This function can call Lisp. GC checked 2000-07-28 ben */
1468 char buf[16 * 1024];
1469 struct stat st, out_st;
1470 Lisp_Object handler;
1471 int speccount = specpdl_depth();
1472 struct gcpro gcpro1, gcpro2;
1473 /* Lisp_Object args[6]; */
1474 int input_file_statable_p;
1476 GCPRO2(filename, newname);
1477 CHECK_STRING(filename);
1478 CHECK_STRING(newname);
1479 filename = Fexpand_file_name(filename, Qnil);
1480 newname = Fexpand_file_name(newname, Qnil);
1482 /* If the input file name has special constructs in it,
1483 call the corresponding file handler. */
1484 handler = Ffind_file_name_handler(filename, Qcopy_file);
1485 /* Likewise for output file name. */
1487 handler = Ffind_file_name_handler(newname, Qcopy_file);
1488 if (!NILP(handler)) {
1490 return call5(handler, Qcopy_file, filename, newname,
1491 ok_if_already_exists, keep_time);
1494 /* When second argument is a directory, copy the file into it.
1495 (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo")
1497 if (!NILP(Ffile_directory_p(newname))) {
1498 Lisp_Object args[3] = {newname, Qnil, Qnil};
1499 struct gcpro ngcpro1;
1502 NGCPROn(args, countof(args));
1503 if (!IS_DIRECTORY_SEP(
1504 XSTRING_BYTE(newname,
1505 XSTRING_LENGTH(newname) - 1))) {
1506 args[i++] = Fchar_to_string(Vdirectory_sep_char);
1508 args[i++] = Ffile_name_nondirectory(filename);
1509 newname = Fconcat(i, args);
1513 if (NILP(ok_if_already_exists)
1514 || INTP(ok_if_already_exists))
1515 barf_or_query_if_file_exists(newname, "copy to it",
1516 INTP(ok_if_already_exists),
1518 else if (sxemacs_stat((const char *)XSTRING_DATA(newname), &out_st) < 0)
1521 ifd = interruptible_open((char *)XSTRING_DATA(filename),
1522 O_RDONLY | OPEN_BINARY, 0);
1524 report_file_error("Opening input file", list1(filename));
1526 record_unwind_protect(close_file_unwind, make_int(ifd));
1528 /* We can only copy regular files and symbolic links. Other files are not
1530 input_file_statable_p = (fstat(ifd, &st) >= 0);
1532 if (out_st.st_mode != 0
1533 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) {
1535 report_file_error("Input and output files are the same",
1536 list2(filename, newname));
1539 #if defined (S_ISREG) && defined (S_ISLNK)
1540 if (input_file_statable_p) {
1541 if (!(S_ISREG(st.st_mode))
1542 /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */
1544 && !(S_ISCHR(st.st_mode))
1546 && !(S_ISLNK(st.st_mode))) {
1547 #if defined (EISDIR)
1548 /* Get a better looking error message. */
1551 report_file_error("Non-regular file", list1(filename));
1554 #endif /* S_ISREG && S_ISLNK */
1556 ofd = open((char *)XSTRING_DATA(newname),
1557 O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE);
1559 report_file_error("Opening output file", list1(newname));
1562 Lisp_Object ofd_locative = noseeum_cons(make_int(ofd), Qnil);
1564 record_unwind_protect(close_file_unwind, ofd_locative);
1566 while ((n = read_allowing_quit(ifd, buf, sizeof(buf))) > 0) {
1567 if (write_allowing_quit(ofd, buf, n) != n)
1568 report_file_error("I/O error", list1(newname));
1571 /* Closing the output clobbers the file times on some systems. */
1573 report_file_error("I/O error", list1(newname));
1575 if (input_file_statable_p) {
1576 if (!NILP(keep_time)) {
1577 EMACS_TIME atime, mtime;
1578 EMACS_SET_SECS_USECS(atime, st.st_atime, 0);
1579 EMACS_SET_SECS_USECS(mtime, st.st_mtime, 0);
1580 if (set_file_times(newname, atime, mtime))
1581 report_file_error("I/O error",
1584 chmod((const char *)XSTRING_DATA(newname),
1585 st.st_mode & 07777);
1588 /* We'll close it by hand */
1589 XCAR(ofd_locative) = Qnil;
1592 unbind_to(speccount, Qnil);
1599 DEFUN("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /*
1600 Create a directory. One argument, a file name string.
1604 /* This function can GC. GC checked 1997.04.06. */
1605 char dir[MAXPATHLEN];
1606 Lisp_Object handler;
1607 struct gcpro gcpro1;
1609 CHECK_STRING(dirname_);
1610 dirname_ = Fexpand_file_name(dirname_, Qnil);
1613 handler = Ffind_file_name_handler(dirname_, Qmake_directory_internal);
1616 return (call2(handler, Qmake_directory_internal, dirname_));
1618 if (XSTRING_LENGTH(dirname_) > (Bytecount) (sizeof(dir) - 1)) {
1619 return Fsignal(Qfile_error,
1620 list3(build_translated_string
1621 ("Creating directory"),
1622 build_translated_string
1623 ("pathname too long"), dirname_));
1625 strncpy(dir, (char *)XSTRING_DATA(dirname_),
1626 XSTRING_LENGTH(dirname_) + 1);
1627 dir[XSTRING_LENGTH(dirname_)]='\0';
1628 if (dir[XSTRING_LENGTH(dirname_) - 1] == '/')
1629 dir[XSTRING_LENGTH(dirname_) - 1] = '\0';
1631 if (mkdir(dir, 0777) != 0)
1632 report_file_error("Creating directory", list1(dirname_));
1637 DEFUN("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /*
1638 Delete a directory. One argument, a file name or directory name string.
1642 /* This function can GC. GC checked 1997.04.06. */
1643 Lisp_Object handler;
1644 struct gcpro gcpro1;
1646 CHECK_STRING(dirname_);
1649 dirname_ = Fexpand_file_name(dirname_, Qnil);
1650 dirname_ = Fdirectory_file_name(dirname_);
1652 handler = Ffind_file_name_handler(dirname_, Qdelete_directory);
1655 return (call2(handler, Qdelete_directory, dirname_));
1657 if (rmdir((char *)XSTRING_DATA(dirname_)) != 0)
1658 report_file_error("Removing directory", list1(dirname_));
1663 DEFUN("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /*
1664 Delete the file named FILENAME (a string).
1665 If FILENAME has multiple names, it continues to exist with the other names.
1669 /* This function can GC. GC checked 1997.04.06. */
1670 Lisp_Object handler;
1671 struct gcpro gcpro1;
1673 CHECK_STRING(filename);
1674 filename = Fexpand_file_name(filename, Qnil);
1677 handler = Ffind_file_name_handler(filename, Qdelete_file);
1680 return call2(handler, Qdelete_file, filename);
1682 if (0 > unlink((char *)XSTRING_DATA(filename)))
1683 report_file_error("Removing old name", list1(filename));
1688 internal_delete_file_1(Lisp_Object ignore, Lisp_Object ignore2)
1693 /* Delete file FILENAME, returning 1 if successful and 0 if failed. */
1695 int internal_delete_file(Lisp_Object filename)
1697 /* This function can GC. GC checked 1997.04.06. */
1698 return NILP(condition_case_1(Qt, Fdelete_file, filename,
1699 internal_delete_file_1, Qnil));
1702 DEFUN("rename-file", Frename_file, 2, 3, "fRename file: \nFRename %s to file: \np", /*
1703 Rename FILENAME as NEWNAME. Both args must be strings.
1704 If file has names other than FILENAME, it continues to have those names.
1705 Signals a `file-already-exists' error if a file NEWNAME already exists
1706 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1707 A number as third arg means request confirmation if NEWNAME already exists.
1708 This is what happens in interactive use with M-x.
1710 (filename, newname, ok_if_already_exists))
1712 /* This function can GC. GC checked 1997.04.06. */
1713 Lisp_Object handler;
1714 struct gcpro gcpro1, gcpro2;
1716 GCPRO2(filename, newname);
1717 CHECK_STRING(filename);
1718 CHECK_STRING(newname);
1719 filename = Fexpand_file_name(filename, Qnil);
1720 newname = Fexpand_file_name(newname, Qnil);
1722 /* If the file name has special constructs in it,
1723 call the corresponding file handler. */
1724 handler = Ffind_file_name_handler(filename, Qrename_file);
1726 handler = Ffind_file_name_handler(newname, Qrename_file);
1727 if (!NILP(handler)) {
1729 return call4(handler, Qrename_file,
1730 filename, newname, ok_if_already_exists);
1733 /* When second argument is a directory, rename the file into it.
1734 (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo")
1736 if (!NILP(Ffile_directory_p(newname))) {
1737 Lisp_Object args[3] = {newname, Qnil, Qnil};
1738 struct gcpro ngcpro1;
1741 NGCPROn(args, countof(args));
1742 if (XSTRING_BYTE(newname, XSTRING_LENGTH(newname) - 1) != '/') {
1743 args[i++] = build_string("/");
1745 args[i++] = Ffile_name_nondirectory(filename);
1746 newname = Fconcat(i, args);
1750 if (NILP(ok_if_already_exists)
1751 || INTP(ok_if_already_exists))
1752 barf_or_query_if_file_exists(newname, "rename to it",
1753 INTP(ok_if_already_exists), 0);
1755 /* Syncing with FSF 19.34.6 note: FSF does not have conditional code for
1756 WIN32_NATIVE here; I've removed it. --marcpa */
1758 /* We have configure check for rename() and emulate using
1759 link()/unlink() if necessary. */
1760 if (0 > rename((char *)XSTRING_DATA(filename),
1761 (char *)XSTRING_DATA(newname))) {
1762 if (errno == EXDEV) {
1763 Fcopy_file(filename, newname,
1764 /* We have already prompted if it was an integer,
1765 so don't have copy-file prompt again. */
1766 (NILP(ok_if_already_exists) ? Qnil : Qt),
1768 Fdelete_file(filename);
1770 report_file_error("Renaming", list2(filename, newname));
1777 DEFUN("add-name-to-file", Fadd_name_to_file, 2, 3, "fAdd name to file: \nFName to add to %s: \np", /*
1778 Give FILENAME additional name NEWNAME. Both args must be strings.
1779 Signals a `file-already-exists' error if a file NEWNAME already exists
1780 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1781 A number as third arg means request confirmation if NEWNAME already exists.
1782 This is what happens in interactive use with M-x.
1784 (filename, newname, ok_if_already_exists))
1786 /* This function can GC. GC checked 1997.04.06. */
1787 Lisp_Object handler;
1788 struct gcpro gcpro1, gcpro2;
1790 GCPRO2(filename, newname);
1791 CHECK_STRING(filename);
1792 CHECK_STRING(newname);
1793 filename = Fexpand_file_name(filename, Qnil);
1794 newname = Fexpand_file_name(newname, Qnil);
1796 /* If the file name has special constructs in it,
1797 call the corresponding file handler. */
1798 handler = Ffind_file_name_handler(filename, Qadd_name_to_file);
1800 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1801 newname, ok_if_already_exists));
1803 /* If the new name has special constructs in it,
1804 call the corresponding file handler. */
1805 handler = Ffind_file_name_handler(newname, Qadd_name_to_file);
1807 RETURN_UNGCPRO(call4(handler, Qadd_name_to_file, filename,
1808 newname, ok_if_already_exists));
1810 if (NILP(ok_if_already_exists)
1811 || INTP(ok_if_already_exists))
1812 barf_or_query_if_file_exists(newname, "make it a new name",
1813 INTP(ok_if_already_exists), 0);
1814 /* Syncing with FSF 19.34.6 note: FSF does not report a file error
1815 on NT here. --marcpa */
1816 /* But FSF #defines link as sys_link which is supplied in nt.c. We can't do
1817 that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK.
1818 Reverted to previous behavior pending a working fix. (jhar) */
1820 unlink((char *)XSTRING_DATA(newname));
1821 if (0 > link((char *)XSTRING_DATA(filename),
1822 (char *)XSTRING_DATA(newname))) {
1823 report_file_error("Adding new name", list2(filename, newname));
1830 DEFUN("make-symbolic-link", Fmake_symbolic_link, 2, 3, "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /*
1831 Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
1832 Signals a `file-already-exists' error if a file LINKNAME already exists
1833 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
1834 A number as third arg means request confirmation if LINKNAME already exists.
1835 This happens for interactive use with M-x.
1837 (filename, linkname, ok_if_already_exists))
1839 /* This function can GC. GC checked 1997.06.04. */
1840 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
1841 Lisp_Object handler;
1842 struct gcpro gcpro1, gcpro2;
1844 GCPRO2(filename, linkname);
1845 CHECK_STRING(filename);
1846 CHECK_STRING(linkname);
1847 /* If the link target has a ~, we must expand it to get
1848 a truly valid file name. Otherwise, do not expand;
1849 we want to permit links to relative file names. */
1850 if (XSTRING_BYTE(filename, 0) == '~')
1851 filename = Fexpand_file_name(filename, Qnil);
1852 linkname = Fexpand_file_name(linkname, Qnil);
1854 /* If the file name has special constructs in it,
1855 call the corresponding file handler. */
1856 handler = Ffind_file_name_handler(filename, Qmake_symbolic_link);
1858 RETURN_UNGCPRO(call4
1859 (handler, Qmake_symbolic_link, filename,
1860 linkname, ok_if_already_exists));
1862 /* If the new link name has special constructs in it,
1863 call the corresponding file handler. */
1864 handler = Ffind_file_name_handler(linkname, Qmake_symbolic_link);
1866 RETURN_UNGCPRO(call4(handler, Qmake_symbolic_link, filename,
1867 linkname, ok_if_already_exists));
1870 if (NILP(ok_if_already_exists)
1871 || INTP(ok_if_already_exists))
1872 barf_or_query_if_file_exists(linkname, "make it a link",
1873 INTP(ok_if_already_exists), 0);
1875 unlink((char *)XSTRING_DATA(linkname));
1876 if (0 > symlink((char *)XSTRING_DATA(filename),
1877 (char *)XSTRING_DATA(linkname))) {
1878 report_file_error("Making symbolic link",
1879 list2(filename, linkname));
1881 #endif /* S_IFLNK */
1889 DEFUN("sysnetunam", Fsysnetunam, 2, 2, 0, /*
1890 Open a network connection to PATH using LOGIN as the login string.
1895 const char *path_ext;
1896 const char *login_ext;
1899 CHECK_STRING(login);
1901 /* netunam, being a strange-o system call only used once, is not
1904 LISP_STRING_TO_EXTERNAL(path, path_ext, Qfile_name);
1905 LISP_STRING_TO_EXTERNAL(login, login_ext, Qnative);
1907 netresult = netunam(path_ext, login_ext);
1909 return netresult == -1 ? Qnil : Qt;
1911 #endif /* HPUX_NET */
1913 DEFUN("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /*
1914 Return t if file FILENAME specifies an absolute path name.
1915 On Unix, this is a name starting with a `/' or a `~'.
1919 /* This function does not GC */
1922 CHECK_STRING(filename);
1923 ptr = XSTRING_DATA(filename);
1924 return (IS_DIRECTORY_SEP(*ptr) || *ptr == '~'
1928 /* Return nonzero if file FILENAME exists and can be executed. */
1930 static int check_executable(char *filename)
1933 return eaccess(filename, X_OK) >= 0;
1935 /* Access isn't quite right because it uses the real uid
1936 and we really want to test with the effective uid.
1937 But Unix doesn't give us a right way to do it. */
1938 return access(filename, X_OK) >= 0;
1939 #endif /* HAVE_EACCESS */
1942 /* Return nonzero if file FILENAME exists and can be written. */
1944 static int check_writable(const char *filename)
1947 return (eaccess(filename, W_OK) >= 0);
1949 /* Access isn't quite right because it uses the real uid
1950 and we really want to test with the effective uid.
1951 But Unix doesn't give us a right way to do it.
1952 Opening with O_WRONLY could work for an ordinary file,
1953 but would lose for directories. */
1954 return (access(filename, W_OK) >= 0);
1958 DEFUN("file-exists-p", Ffile_exists_p, 1, 1, 0, /*
1959 Return t if file FILENAME exists. (This does not mean you can read it.)
1960 See also `file-readable-p' and `file-attributes'.
1964 /* This function can call lisp; GC checked 2000-07-11 ben */
1965 Lisp_Object abspath;
1966 Lisp_Object handler;
1967 struct stat statbuf;
1968 struct gcpro gcpro1;
1970 CHECK_STRING(filename);
1971 abspath = Fexpand_file_name(filename, Qnil);
1973 /* If the file name has special constructs in it,
1974 call the corresponding file handler. */
1976 handler = Ffind_file_name_handler(abspath, Qfile_exists_p);
1979 return call2(handler, Qfile_exists_p, abspath);
1981 return sxemacs_stat((char *)XSTRING_DATA(abspath),
1982 &statbuf) >= 0 ? Qt : Qnil;
1985 DEFUN("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
1986 Return t if FILENAME can be executed by you.
1987 For a directory, this means you can access files in that directory.
1991 /* This function can GC. GC checked 07-11-2000 ben. */
1992 Lisp_Object abspath;
1993 Lisp_Object handler;
1994 struct gcpro gcpro1;
1996 CHECK_STRING(filename);
1997 abspath = Fexpand_file_name(filename, Qnil);
1999 /* If the file name has special constructs in it,
2000 call the corresponding file handler. */
2002 handler = Ffind_file_name_handler(abspath, Qfile_executable_p);
2005 return call2(handler, Qfile_executable_p, abspath);
2007 return check_executable((char *)XSTRING_DATA(abspath)) ? Qt : Qnil;
2010 DEFUN("file-readable-p", Ffile_readable_p, 1, 1, 0, /*
2011 Return t if file FILENAME exists and you can read it.
2012 See also `file-exists-p' and `file-attributes'.
2016 /* This function can GC */
2017 Lisp_Object abspath = Qnil;
2018 Lisp_Object handler;
2019 struct gcpro gcpro1;
2022 CHECK_STRING(filename);
2023 abspath = Fexpand_file_name(filename, Qnil);
2025 /* If the file name has special constructs in it,
2026 call the corresponding file handler. */
2027 handler = Ffind_file_name_handler(abspath, Qfile_readable_p);
2029 RETURN_UNGCPRO(call2(handler, Qfile_readable_p, abspath));
2033 interruptible_open((char *)XSTRING_DATA(abspath),
2034 O_RDONLY | OPEN_BINARY, 0);
2043 /* Having this before file-symlink-p mysteriously caused it to be forgotten
2045 DEFUN("file-writable-p", Ffile_writable_p, 1, 1, 0, /*
2046 Return t if file FILENAME can be written or created by you.
2050 /* This function can GC. GC checked 1997.04.10. */
2051 Lisp_Object abspath, dir;
2052 Lisp_Object handler;
2053 struct stat statbuf;
2054 struct gcpro gcpro1;
2056 CHECK_STRING(filename);
2057 abspath = Fexpand_file_name(filename, Qnil);
2059 /* If the file name has special constructs in it,
2060 call the corresponding file handler. */
2062 handler = Ffind_file_name_handler(abspath, Qfile_writable_p);
2065 return call2(handler, Qfile_writable_p, abspath);
2067 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &statbuf) >= 0)
2068 return (check_writable((char *)XSTRING_DATA(abspath))
2072 dir = Ffile_name_directory(abspath);
2074 return (check_writable(!NILP(dir) ? (char *)XSTRING_DATA(dir)
2079 DEFUN("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /*
2080 Return non-nil if file FILENAME is the name of a symbolic link.
2081 The value is the name of the file to which it is linked.
2082 Otherwise returns nil.
2086 /* This function can GC. GC checked 1997.04.10. */
2087 /* XEmacs change: run handlers even if local machine doesn't have symlinks */
2094 Lisp_Object handler;
2095 struct gcpro gcpro1;
2097 CHECK_STRING(filename);
2098 filename = Fexpand_file_name(filename, Qnil);
2100 /* If the file name has special constructs in it,
2101 call the corresponding file handler. */
2103 handler = Ffind_file_name_handler(filename, Qfile_symlink_p);
2105 if (!NILP(handler)) {
2106 return call2(handler, Qfile_symlink_p, filename);
2111 buf = ynew_array_and_zero(char, bufsize);
2112 valsize = readlink((char *)XSTRING_DATA(filename),
2114 if (valsize < bufsize) {
2117 /* Buffer was not long enough */
2121 if (valsize == -1) {
2125 val = make_string((Bufbyte*)buf, valsize);
2128 #else /* not S_IFLNK */
2130 #endif /* not S_IFLNK */
2133 DEFUN("file-directory-p", Ffile_directory_p, 1, 1, 0, /*
2134 Return t if file FILENAME is the name of a directory as a file.
2135 A directory name spec may be given instead; then the value is t
2136 if the directory so specified exists and really is a directory.
2140 /* This function can GC. GC checked 1997.04.10. */
2141 Lisp_Object abspath;
2143 Lisp_Object handler;
2144 struct gcpro gcpro1;
2146 GCPRO1(current_buffer->directory);
2147 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2150 /* If the file name has special constructs in it,
2151 call the corresponding file handler. */
2153 handler = Ffind_file_name_handler(abspath, Qfile_directory_p);
2156 return call2(handler, Qfile_directory_p, abspath);
2158 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2160 return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
2163 DEFUN("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /*
2164 Return t if file FILENAME is the name of a directory as a file,
2165 and files in that directory can be opened by you. In order to use a
2166 directory as a buffer's current directory, this predicate must return true.
2167 A directory name spec may be given instead; then the value is t
2168 if the directory so specified exists and really is a readable and
2169 searchable directory.
2173 /* This function can GC. GC checked 1997.04.10. */
2174 Lisp_Object handler;
2176 /* If the file name has special constructs in it,
2177 call the corresponding file handler. */
2179 Ffind_file_name_handler(filename, Qfile_accessible_directory_p);
2181 return call2(handler, Qfile_accessible_directory_p, filename);
2183 if (NILP(Ffile_directory_p(filename)))
2186 return Ffile_executable_p(filename);
2189 DEFUN("file-regular-p", Ffile_regular_p, 1, 1, 0, /*
2190 Return t if file FILENAME is the name of a regular file.
2191 This is the sort of file that holds an ordinary stream of data bytes.
2195 /* This function can GC. GC checked 1997.04.10. */
2196 Lisp_Object abspath;
2198 Lisp_Object handler;
2199 struct gcpro gcpro1;
2201 GCPRO1(current_buffer->directory);
2202 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2205 /* If the file name has special constructs in it,
2206 call the corresponding file handler. */
2208 handler = Ffind_file_name_handler(abspath, Qfile_regular_p);
2211 return call2(handler, Qfile_regular_p, abspath);
2213 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2215 return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
2218 DEFUN("file-modes", Ffile_modes, 1, 1, 0, /*
2219 Return mode bits of file named FILENAME, as an integer.
2223 /* This function can GC. GC checked 1997.04.10. */
2224 Lisp_Object abspath;
2226 Lisp_Object handler;
2227 struct gcpro gcpro1;
2229 GCPRO1(current_buffer->directory);
2230 abspath = expand_and_dir_to_file(filename, current_buffer->directory);
2233 /* If the file name has special constructs in it,
2234 call the corresponding file handler. */
2236 handler = Ffind_file_name_handler(abspath, Qfile_modes);
2239 return call2(handler, Qfile_modes, abspath);
2241 if (sxemacs_stat((char *)XSTRING_DATA(abspath), &st) < 0)
2243 /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
2245 return make_int(st.st_mode & 07777);
2248 DEFUN("set-file-modes", Fset_file_modes, 2, 2, 0, /*
2249 Set mode bits of file named FILENAME to MODE (an integer).
2250 Only the 12 low bits of MODE are used.
2254 /* This function can GC. GC checked 1997.04.10. */
2255 Lisp_Object abspath;
2256 Lisp_Object handler;
2257 struct gcpro gcpro1;
2259 GCPRO1(current_buffer->directory);
2260 abspath = Fexpand_file_name(filename, current_buffer->directory);
2265 /* If the file name has special constructs in it,
2266 call the corresponding file handler. */
2268 handler = Ffind_file_name_handler(abspath, Qset_file_modes);
2271 return call3(handler, Qset_file_modes, abspath, mode);
2273 if (chmod((char *)XSTRING_DATA(abspath), XINT(mode)) < 0)
2274 report_file_error("Doing chmod", list1(abspath));
2279 DEFUN("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
2280 Set the file permission bits for newly created files.
2281 The argument MODE should be an integer; if a bit in MODE is 1,
2282 subsequently created files will not have the permission corresponding
2283 to that bit enabled. Only the low 9 bits are used.
2284 This setting is inherited by subprocesses.
2290 umask((~XINT(mode)) & 0777);
2295 DEFUN("default-file-modes", Fdefault_file_modes, 0, 0, 0, /*
2296 Return the default file protection for created files.
2297 The umask value determines which permissions are enabled in newly
2298 created files. If a permission's bit in the umask is 1, subsequently
2299 created files will not have that permission enabled.
2308 return make_int((~mode) & 0777);
2311 DEFUN("unix-sync", Funix_sync, 0, 0, "", /*
2312 Tell Unix to finish all pending disk updates.
2320 DEFUN("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /*
2321 Return t if file FILE1 is newer than file FILE2.
2322 If FILE1 does not exist, the answer is nil;
2323 otherwise, if FILE2 does not exist, the answer is t.
2327 /* This function can GC. GC checked 1997.04.10. */
2328 Lisp_Object abspath1, abspath2;
2331 Lisp_Object handler;
2332 struct gcpro gcpro1, gcpro2, gcpro3;
2334 CHECK_STRING(file1);
2335 CHECK_STRING(file2);
2340 GCPRO3(abspath1, abspath2, current_buffer->directory);
2341 abspath1 = expand_and_dir_to_file(file1, current_buffer->directory);
2342 abspath2 = expand_and_dir_to_file(file2, current_buffer->directory);
2344 /* If the file name has special constructs in it,
2345 call the corresponding file handler. */
2346 handler = Ffind_file_name_handler(abspath1, Qfile_newer_than_file_p);
2349 Ffind_file_name_handler(abspath2, Qfile_newer_than_file_p);
2352 return call3(handler, Qfile_newer_than_file_p, abspath1,
2355 if (sxemacs_stat((char *)XSTRING_DATA(abspath1), &st) < 0)
2358 mtime1 = st.st_mtime;
2360 if (sxemacs_stat((char *)XSTRING_DATA(abspath2), &st) < 0)
2363 return (mtime1 > st.st_mtime) ? Qt : Qnil;
2366 /* Stack sizes > 2**16 is a good way to elicit compiler bugs */
2367 /* #define READ_BUF_SIZE (2 << 16) */
2368 #define READ_BUF_SIZE (1 << 15)
2370 DEFUN("insert-file-contents-internal", Finsert_file_contents_internal, 1, 7, 0, /*
2371 Insert contents of file FILENAME after point; no coding-system frobbing.
2372 This function is identical to `insert-file-contents' except for the
2373 handling of the CODESYS and USED-CODESYS arguments under
2374 SXEmacs/Mule. (When Mule support is not present, both functions are
2375 identical and ignore the CODESYS and USED-CODESYS arguments.)
2377 If support for Mule exists in this Emacs, the file is decoded according
2378 to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil,
2379 it should be a symbol, and the actual coding system that was used for the
2380 decoding is stored into it. It will in general be different from CODESYS
2381 if CODESYS specifies automatic encoding detection or end-of-line detection.
2383 Currently START and END refer to byte positions (as opposed to character
2384 positions), even in Mule. (Fixing this is very difficult.)
2386 (filename, visit, start, end, replace, codesys, used_codesys))
2388 /* This function can call lisp */
2392 Charcount inserted = 0;
2394 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2395 Lisp_Object handler = Qnil, val = Qnil;
2397 Bufbyte read_buf[READ_BUF_SIZE];
2399 struct buffer *buf = current_buffer;
2401 int not_regular = 0;
2403 if (UNLIKELY(buf->base_buffer && !NILP(visit))) {
2404 error("Cannot do file visiting in an indirect buffer");
2407 /* No need to call Fbarf_if_buffer_read_only() here.
2408 That's called in begin_multiple_change() or wherever. */
2409 /* #### dmoore - should probably check in various places to see if
2410 curbuf was killed and if so signal an error? */
2411 XSETBUFFER(curbuf, buf);
2413 GCPRO5(filename, val, visit, handler, curbuf);
2415 if (LIKELY(NILP(replace))) {
2416 mc_count = begin_multiple_change(buf, BUF_PT(buf), BUF_PT(buf));
2418 mc_count = begin_multiple_change(buf, BUF_BEG(buf), BUF_Z(buf));
2421 /* begin_multiple_change also adds an unwind_protect */
2422 speccount = specpdl_depth();
2424 filename = Fexpand_file_name(filename, Qnil);
2426 /* If the file name has special constructs in it,
2427 call the corresponding file handler. */
2428 handler = Ffind_file_name_handler(filename, Qinsert_file_contents);
2429 if (!NILP(handler)) {
2430 val = call6(handler, Qinsert_file_contents, filename,
2431 visit, start, end, replace);
2435 if (!NILP(used_codesys))
2436 CHECK_SYMBOL(used_codesys);
2439 if ((!NILP(start) || !NILP(end)) && !NILP(visit))
2440 error("Attempt to visit less than an entire file");
2444 if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) < 0) {
2449 report_file_error("Opening input file",
2455 /* Signal an error if we are accessing a non-regular file, with
2456 REPLACE, START or END being non-nil. */
2457 if (!S_ISREG(st.st_mode)) {
2463 if (!NILP(replace) || !NILP(start) || !NILP(end)) {
2464 end_multiple_change(buf, mc_count);
2467 (Fsignal(Qfile_error,
2468 list2(build_translated_string
2469 ("not a regular file"), filename)));
2472 #endif /* S_IFREG */
2483 if ((fd = interruptible_open((char *)XSTRING_DATA(filename),
2484 O_RDONLY | OPEN_BINARY, 0)) < 0)
2488 /* Replacement should preserve point as it preserves markers. */
2490 record_unwind_protect(restore_point_unwind,
2491 Fpoint_marker(Qnil, Qnil));
2493 record_unwind_protect(close_file_unwind, make_int(fd));
2495 /* Supposedly happens on VMS. */
2497 error("File size is negative");
2501 end = make_int(st.st_size);
2502 if (XINT(end) != st.st_size)
2503 error("Maximum buffer size exceeded");
2507 /* If requested, replace the accessible part of the buffer
2508 with the file contents. Avoid replacing text at the
2509 beginning or end of the buffer that matches the file contents;
2510 that preserves markers pointing to the unchanged parts. */
2511 #if !defined (FILE_CODING)
2512 /* The replace-mode code currently only works when the assumption
2513 'one byte == one char' holds true. This fails Mule because
2514 files may contain multibyte characters. It holds under Windows NT
2515 provided we convert CRLF into LF. */
2516 # define FSFMACS_SPEEDY_INSERT
2517 #endif /* !defined (FILE_CODING) */
2519 #ifndef FSFMACS_SPEEDY_INSERT
2520 if (!NILP(replace)) {
2521 buffer_delete_range(buf, BUF_BEG(buf), BUF_Z(buf),
2522 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2524 #else /* FSFMACS_SPEEDY_INSERT */
2525 if (!NILP(replace)) {
2526 char buffer[1 << 14];
2527 Bufpos same_at_start = BUF_BEGV(buf);
2528 Bufpos same_at_end = BUF_ZV(buf);
2531 /* Count how many chars at the start of the file
2532 match the text at the beginning of the buffer. */
2536 nread = read_allowing_quit(fd, buffer, sizeof buffer);
2538 error("IO error reading %s: %s",
2539 XSTRING_DATA(filename), strerror(errno));
2540 else if (nread == 0)
2543 while (bufpos < nread && same_at_start < BUF_ZV(buf)
2544 && BUF_FETCH_CHAR(buf,
2547 same_at_start++, bufpos++;
2548 /* If we found a discrepancy, stop the scan.
2549 Otherwise loop around and scan the next bufferful. */
2550 if (bufpos != nread)
2553 /* If the file matches the buffer completely,
2554 there's no need to replace anything. */
2555 if (same_at_start - BUF_BEGV(buf) == st.st_size) {
2557 unbind_to(speccount, Qnil);
2558 /* Truncate the buffer to the size of the file. */
2559 buffer_delete_range(buf, same_at_start, same_at_end,
2560 !NILP(visit) ? INSDEL_NO_LOCKING :
2564 /* Count how many chars at the end of the file
2565 match the text at the end of the buffer. */
2567 int total_read, nread;
2568 Bufpos bufpos, curpos, trial;
2570 /* At what file position are we now scanning? */
2571 curpos = st.st_size - (BUF_ZV(buf) - same_at_end);
2572 /* If the entire file matches the buffer tail, stop the scan. */
2575 /* How much can we scan in the next step? */
2576 trial = min(curpos, (Bufpos) sizeof(buffer));
2577 if (lseek(fd, curpos - trial, 0) < 0)
2578 report_file_error("Setting file position",
2582 while (total_read < trial) {
2584 read_allowing_quit(fd, buffer + total_read,
2585 trial - total_read);
2588 ("IO error reading file",
2590 total_read += nread;
2592 /* Scan this bufferful from the end, comparing with
2593 the Emacs buffer. */
2594 bufpos = total_read;
2595 /* Compare with same_at_start to avoid counting some buffer text
2596 as matching both at the file's beginning and at the end. */
2597 while (bufpos > 0 && same_at_end > same_at_start
2598 && BUF_FETCH_CHAR(buf, same_at_end - 1) ==
2600 same_at_end--, bufpos--;
2601 /* If we found a discrepancy, stop the scan.
2602 Otherwise loop around and scan the preceding bufferful. */
2605 /* If display current starts at beginning of line,
2606 keep it that way. */
2607 if (XBUFFER(XWINDOW(Fselected_window(Qnil))->buffer) ==
2609 XWINDOW(Fselected_window(Qnil))->
2611 !NILP(Fbolp(make_buffer(buf)));
2614 /* Don't try to reuse the same piece of text twice. */
2615 overlap = same_at_start - BUF_BEGV(buf) -
2616 (same_at_end + st.st_size - BUF_ZV(buf));
2618 same_at_end += overlap;
2620 /* Arrange to read only the nonmatching middle part of the file. */
2621 start = make_int(same_at_start - BUF_BEGV(buf));
2622 end = make_int(st.st_size - (BUF_ZV(buf) - same_at_end));
2624 buffer_delete_range(buf, same_at_start, same_at_end,
2625 !NILP(visit) ? INSDEL_NO_LOCKING : 0);
2626 /* Insert from the file at the proper position. */
2627 BUF_SET_PT(buf, same_at_start);
2629 #endif /* FSFMACS_SPEEDY_INSERT */
2632 total = XINT(end) - XINT(start);
2634 /* Make sure point-max won't overflow after this insertion. */
2635 if (total != XINT(make_int(total)))
2636 error("Maximum buffer size exceeded");
2638 /* For a special file, all we can do is guess. The value of -1
2639 will make the stream functions read as much as possible. */
2642 if (XINT(start) != 0
2643 #ifdef FSFMACS_SPEEDY_INSERT
2644 /* why was this here? asked jwz. The reason is that the replace-mode
2645 connivings above will normally put the file pointer other than
2646 where it should be. */
2648 #endif /* !FSFMACS_SPEEDY_INSERT */
2650 if (lseek(fd, XINT(start), 0) < 0)
2651 report_file_error("Setting file position",
2656 Bufpos cur_point = BUF_PT(buf);
2657 struct gcpro ngcpro1;
2658 Lisp_Object stream = make_filedesc_input_stream(fd, 0, total,
2662 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2665 stream = make_decoding_input_stream
2666 (XLSTREAM(stream), Fget_coding_system(codesys));
2667 Lstream_set_character_mode(XLSTREAM(stream));
2668 Lstream_set_buffering(XLSTREAM(stream), LSTREAM_BLOCKN_BUFFERED,
2670 #endif /* FILE_CODING */
2672 record_unwind_protect(delete_stream_unwind, stream);
2674 /* No need to limit the amount of stuff we attempt to read. (It would
2675 be incorrect, anyway, when Mule is enabled.) Instead, the limiting
2676 occurs inside of the filedesc stream. */
2678 Lstream_data_count this_len;
2679 Charcount cc_inserted;
2682 this_len = Lstream_read(XLSTREAM(stream), read_buf,
2685 if (this_len <= 0) {
2692 buffer_insert_raw_string_1(buf, cur_point, read_buf,
2693 this_len, !NILP(visit)
2694 ? INSDEL_NO_LOCKING : 0);
2695 inserted += cc_inserted;
2696 cur_point += cc_inserted;
2699 if (!NILP(used_codesys)) {
2701 decoding_stream_coding_system(XLSTREAM(stream));
2702 Fset(used_codesys, XCODING_SYSTEM_NAME(tmp));
2704 #endif /* FILE_CODING */
2708 /* Close the file/stream */
2709 unbind_to(speccount, Qnil);
2711 if (saverrno != 0) {
2712 error("IO error reading %s: %s",
2713 XSTRING_DATA(filename), strerror(saverrno));
2719 end_multiple_change(buf, mc_count);
2722 if (!EQ(buf->undo_list, Qt))
2723 buf->undo_list = Qnil;
2724 if (NILP(handler)) {
2725 buf->modtime = st.st_mtime;
2726 buf->filename = filename;
2727 /* XEmacs addition: */
2728 /* This function used to be in C, ostensibly so that
2729 it could be called here. But that's just silly.
2730 There's no reason C code can't call out to Lisp
2731 code, and it's a lot cleaner this way. */
2732 /* Note: compute-buffer-file-truename is called for
2733 side-effect! Its return value is intentionally
2735 if (!NILP(Ffboundp(Qcompute_buffer_file_truename)))
2736 call1(Qcompute_buffer_file_truename,
2739 BUF_SAVE_MODIFF(buf) = BUF_MODIFF(buf);
2740 buf->auto_save_modified = BUF_MODIFF(buf);
2741 buf->saved_size = make_int(BUF_SIZE(buf));
2742 #ifdef CLASH_DETECTION
2743 if (NILP(handler)) {
2744 if (!NILP(buf->file_truename))
2745 unlock_file(buf->file_truename);
2746 unlock_file(filename);
2748 #endif /* CLASH_DETECTION */
2750 RETURN_UNGCPRO(Fsignal(Qfile_error,
2752 ("not a regular file"),
2755 /* If visiting nonexistent file, return nil. */
2756 if (buf->modtime == -1)
2757 report_file_error("Opening input file",
2761 /* Decode file format */
2763 Lisp_Object insval = call3(Qformat_decode,
2764 Qnil, make_int(inserted), visit);
2766 inserted = XINT(insval);
2771 struct gcpro ngcpro1;
2774 EXTERNAL_LIST_LOOP(p, Vafter_insert_file_functions) {
2775 Lisp_Object insval = call1(XCAR(p), make_int(inserted));
2776 if (!NILP(insval)) {
2777 CHECK_NATNUM(insval);
2778 inserted = XINT(insval);
2790 return (list2(filename, make_int(inserted)));
2793 static int a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
2794 Lisp_Object * annot);
2795 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end);
2797 /* If build_annotations switched buffers, switch back to BUF.
2798 Kill the temporary buffer that was selected in the meantime. */
2800 static Lisp_Object build_annotations_unwind(Lisp_Object buf)
2804 if (XBUFFER(buf) == current_buffer)
2806 tembuf = Fcurrent_buffer();
2808 Fkill_buffer(tembuf);
2812 DEFUN("write-region-internal", Fwrite_region_internal, 3, 7, "r\nFWrite region to file: ", /*
2813 Write current region into specified file; no coding-system frobbing.
2814 This function is identical to `write-region' except for the handling
2815 of the CODESYS argument under SXEmacs/Mule. (When Mule support is not
2816 present, both functions are identical and ignore the CODESYS argument.)
2817 If support for Mule exists in this Emacs, the file is encoded according
2818 to the value of CODESYS. If this is nil, no code conversion occurs.
2820 As a special kludge to support auto-saving, when START is nil START and
2821 END are set to the beginning and end, respectively, of the buffer,
2822 regardless of any restrictions. Don't use this feature. It is documented
2823 here because write-region handler writers need to be aware of it.
2825 (start, end, filename, append, visit, lockname, codesys))
2827 /* This function can call lisp. GC checked 2000-07-28 ben */
2829 int failure, stat_res;
2832 Lisp_Object fn = Qnil;
2833 int speccount = specpdl_depth();
2834 int visiting_other = STRINGP(visit);
2835 int visiting = (EQ(visit, Qt) || visiting_other);
2836 int quietly = (!visiting && !NILP(visit));
2837 Lisp_Object visit_file = Qnil;
2838 Lisp_Object annotations = Qnil;
2839 struct buffer *given_buffer;
2840 Bufpos start1, end1;
2841 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2842 struct gcpro ngcpro1, ngcpro2;
2845 XSETBUFFER(curbuf, current_buffer);
2847 /* start, end, visit, and append are never modified in this fun
2848 so we don't protect them. */
2849 GCPRO5(visit_file, filename, codesys, lockname, annotations);
2850 NGCPRO2(curbuf, fn);
2852 /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
2853 we should signal an error rather than blissfully continuing
2854 along. ARGH, this function is going to lose lose lose. We need
2855 to protect the current_buffer from being destroyed, but the
2856 multiple return points make this a pain in the butt. ]] we do
2857 protect curbuf now. --ben */
2860 codesys = Fget_coding_system(codesys);
2861 #endif /* FILE_CODING */
2863 if (current_buffer->base_buffer && !NILP(visit))
2865 ("Cannot do file visiting in an indirect buffer", curbuf);
2867 if (!NILP(start) && !STRINGP(start))
2868 get_buffer_range_char(current_buffer, start, end, &start1,
2872 Lisp_Object handler;
2875 visit_file = Fexpand_file_name(visit, Qnil);
2877 visit_file = filename;
2878 filename = Fexpand_file_name(filename, Qnil);
2881 lockname = visit_file;
2883 /* We used to UNGCPRO here. BAD! visit_file is used below after
2884 more Lisp calling. */
2885 /* If the file name has special constructs in it,
2886 call the corresponding file handler. */
2887 handler = Ffind_file_name_handler(filename, Qwrite_region);
2888 /* If FILENAME has no handler, see if VISIT has one. */
2889 if (NILP(handler) && STRINGP(visit))
2890 handler = Ffind_file_name_handler(visit, Qwrite_region);
2892 if (!NILP(handler)) {
2894 call8(handler, Qwrite_region, start, end,
2895 filename, append, visit, lockname, codesys);
2897 BUF_SAVE_MODIFF(current_buffer) =
2898 BUF_MODIFF(current_buffer);
2899 current_buffer->saved_size =
2900 make_int(BUF_SIZE(current_buffer));
2901 current_buffer->filename = visit_file;
2902 MARK_MODELINE_CHANGED;
2910 #ifdef CLASH_DETECTION
2912 lock_file(lockname);
2913 #endif /* CLASH_DETECTION */
2915 /* Special kludge to simplify auto-saving. */
2917 start1 = BUF_BEG(current_buffer);
2918 end1 = BUF_Z(current_buffer);
2921 record_unwind_protect(build_annotations_unwind, Fcurrent_buffer());
2923 given_buffer = current_buffer;
2924 annotations = build_annotations(start, end);
2925 if (current_buffer != given_buffer) {
2926 start1 = BUF_BEGV(current_buffer);
2927 end1 = BUF_ZV(current_buffer);
2932 if (!NILP(append)) {
2934 open((char *)XSTRING_DATA(fn), O_WRONLY | OPEN_BINARY, 0);
2937 desc = open((char *)XSTRING_DATA(fn),
2938 O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
2939 auto_saving ? auto_save_mode_bits : CREAT_MODE);
2943 #ifdef CLASH_DETECTION
2946 unlock_file(lockname);
2948 #endif /* CLASH_DETECTION */
2949 report_file_error("Opening output file", list1(filename));
2953 Lisp_Object desc_locative = Fcons(make_int(desc), Qnil);
2954 Lisp_Object instream = Qnil, outstream = Qnil;
2955 struct gcpro nngcpro1, nngcpro2;
2956 /* need to gcpro; QUIT could happen out of call to write() */
2957 NNGCPRO2(instream, outstream);
2959 record_unwind_protect(close_file_unwind, desc_locative);
2961 if (!NILP(append)) {
2962 if (lseek(desc, 0, 2) < 0) {
2963 #ifdef CLASH_DETECTION
2965 unlock_file(lockname);
2966 #endif /* CLASH_DETECTION */
2967 report_file_error("Lseek error",
2974 /* Note: I tried increasing the buffering size, along with
2975 various other tricks, but nothing seemed to make much of
2976 a difference in the time it took to save a large file.
2977 (Actually that's not true. With a local disk, changing
2978 the buffer size doesn't seem to make much difference.
2979 With an NFS-mounted disk, it could make a lot of difference
2980 because you're affecting the number of network requests
2981 that need to be made, and there could be a large latency
2982 for each request. So I've increased the buffer size
2984 outstream = make_filedesc_output_stream(desc, 0, -1, 0);
2985 Lstream_set_buffering(XLSTREAM(outstream),
2986 LSTREAM_BLOCKN_BUFFERED, 65536);
2989 make_encoding_output_stream(XLSTREAM(outstream), codesys);
2990 Lstream_set_buffering(XLSTREAM(outstream),
2991 LSTREAM_BLOCKN_BUFFERED, 65536);
2992 #endif /* FILE_CODING */
2993 if (STRINGP(start)) {
2994 instream = make_lisp_string_input_stream(start, 0, -1);
2998 make_lisp_buffer_input_stream(current_buffer,
3001 LSTR_IGNORE_ACCESSIBLE);
3003 (0 > (a_write(outstream, instream, start1, &annotations)));
3005 /* Note that this doesn't close the desc since we created the
3006 stream without the LSTR_CLOSING flag, but it does
3007 flush out any buffered data. */
3008 if (Lstream_close(XLSTREAM(outstream)) < 0) {
3012 Lstream_close(XLSTREAM(instream));
3015 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
3016 Disk full in NFS may be reported here. */
3017 /* mib says that closing the file will try to write as fast as NFS can do
3018 it, and that means the fsync here is not crucial for autosave files. */
3019 if (!auto_saving && fsync(desc) < 0
3020 /* If fsync fails with EINTR, don't treat that as serious. */
3021 && errno != EINTR) {
3025 #endif /* HAVE_FSYNC */
3027 /* Spurious "file has changed on disk" warnings used to be seen on
3028 systems where close() can change the modtime. This is known to
3029 happen on various NFS file systems, on Windows, and on Linux.
3030 Rather than handling this on a per-system basis, we
3031 unconditionally do the sxemacs_stat() after the close(). */
3033 /* NFS can report a write failure now. */
3034 if (close(desc) < 0) {
3039 /* Discard the close unwind-protect. Execute the one for
3040 build_annotations (switches back to the original current buffer
3042 XCAR(desc_locative) = Qnil;
3043 unbind_to(speccount, Qnil);
3048 stat_res = sxemacs_stat((char *)XSTRING_DATA(fn), &st);
3050 #ifdef CLASH_DETECTION
3052 unlock_file(lockname);
3053 #endif /* CLASH_DETECTION */
3055 /* Do this before reporting IO error
3056 to avoid a "file has changed on disk" warning on
3057 next attempt to save. */
3060 current_buffer->modtime = st.st_mtime;
3062 If sxemacs_stat failed, we have bigger problems, and
3063 most likely the file is gone, so the error next time is
3069 report_file_error("Writing file", list1(fn));
3073 BUF_SAVE_MODIFF(current_buffer) = BUF_MODIFF(current_buffer);
3074 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3075 current_buffer->filename = visit_file;
3076 MARK_MODELINE_CHANGED;
3077 } else if (quietly) {
3085 message("Wrote %s", XSTRING_DATA(visit_file));
3087 Lisp_Object fsp = Qnil;
3088 struct gcpro nngcpro1;
3091 fsp = Ffile_symlink_p(fn);
3093 message("Wrote %s", XSTRING_DATA(fn));
3095 message("Wrote %s (symlink to %s)",
3096 XSTRING_DATA(fn), XSTRING_DATA(fsp));
3105 /* #### This is such a load of shit!!!! There is no way we should define
3106 something so stupid as a subr, just sort the fucking list more
3108 DEFUN("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
3109 Return t if (car A) is numerically less than (car B).
3113 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcar(a), Fcar(b)))
3119 /* Heh heh heh, let's define this too, just to aggravate the person who
3120 wrote the above comment. */
3121 DEFUN("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
3122 Return t if (cdr A) is numerically less than (cdr B).
3126 if (ent_binrel(ASE_BINARY_REL_LESSP, Fcdr(a), Fcdr(b)))
3132 /* Build the complete list of annotations appropriate for writing out
3133 the text between START and END, by calling all the functions in
3134 write-region-annotate-functions and merging the lists they return.
3135 If one of these functions switches to a different buffer, we assume
3136 that buffer contains altered text. Therefore, the caller must
3137 make sure to restore the current buffer in all cases,
3138 as save-excursion would do. */
3140 static Lisp_Object build_annotations(Lisp_Object start, Lisp_Object end)
3142 /* This function can GC */
3143 Lisp_Object annotations;
3145 struct gcpro gcpro1, gcpro2;
3146 Lisp_Object original_buffer;
3148 XSETBUFFER(original_buffer, current_buffer);
3151 p = Vwrite_region_annotate_functions;
3152 GCPRO2(annotations, p);
3154 struct buffer *given_buffer = current_buffer;
3155 Vwrite_region_annotations_so_far = annotations;
3156 res = call2(Fcar(p), start, end);
3157 /* If the function makes a different buffer current,
3158 assume that means this buffer contains altered text to be output.
3159 Reset START and END from the buffer bounds
3160 and discard all previous annotations because they should have
3161 been dealt with by this function. */
3162 if (current_buffer != given_buffer) {
3163 start = make_int(BUF_BEGV(current_buffer));
3164 end = make_int(BUF_ZV(current_buffer));
3167 Flength(res); /* Check basic validity of return value */
3168 annotations = merge(annotations, res, Qcar_less_than_car);
3172 /* Now do the same for annotation functions implied by the file-format */
3173 if (auto_saving && (!EQ(Vauto_save_file_format, Qt)))
3174 p = Vauto_save_file_format;
3176 p = current_buffer->file_format;
3178 struct buffer *given_buffer = current_buffer;
3179 Vwrite_region_annotations_so_far = annotations;
3180 res = call4(Qformat_annotate_function, Fcar(p), start, end,
3182 if (current_buffer != given_buffer) {
3183 start = make_int(BUF_BEGV(current_buffer));
3184 end = make_int(BUF_ZV(current_buffer));
3188 annotations = merge(annotations, res, Qcar_less_than_car);
3195 /* Write to stream OUTSTREAM the characters from INSTREAM (it is read until
3196 EOF is encountered), assuming they start at position POS in the buffer
3197 of string that STREAM refers to. Intersperse with them the annotations
3198 from *ANNOT that fall into the range of positions we are reading from,
3199 each at its appropriate position.
3201 Modify *ANNOT by discarding elements as we output them.
3202 The return value is negative in case of system call failure. */
3204 /* 4K should probably be fine. We just need to reduce the number of
3205 function calls to reasonable level. The Lstream stuff itself will
3206 batch to 64K to reduce the number of system calls. */
3208 #define A_WRITE_BATCH_SIZE 4096
3211 a_write(Lisp_Object outstream, Lisp_Object instream, int pos,
3212 Lisp_Object * annot)
3216 unsigned char largebuf[A_WRITE_BATCH_SIZE];
3217 Lstream *instr = XLSTREAM(instream);
3218 Lstream *outstr = XLSTREAM(outstream);
3220 while (LISTP(*annot)) {
3221 tem = Fcar_safe(Fcar(*annot));
3223 nextpos = XINT(tem);
3227 /* If there are annotations left and we have Mule, then we
3228 have to do the I/O one emchar at a time so we can
3229 determine when to insert the annotation. */
3230 if (!NILP(*annot)) {
3232 while (pos != nextpos
3233 && (ch = Lstream_get_emchar(instr)) != EOF) {
3234 if (Lstream_put_emchar(outstr, ch) < 0)
3241 while (pos != nextpos) {
3242 /* Otherwise there is no point to that. Just go in batches. */
3244 min(nextpos - pos, A_WRITE_BATCH_SIZE);
3246 chunk = Lstream_read(instr, largebuf, chunk);
3249 if (chunk == 0) /* EOF */
3251 if (Lstream_write(outstr, largebuf, chunk) <
3257 if (pos == nextpos) {
3258 tem = Fcdr(Fcar(*annot));
3260 if (Lstream_write(outstr, XSTRING_DATA(tem),
3261 XSTRING_LENGTH(tem)) < 0)
3264 *annot = Fcdr(*annot);
3271 DEFUN("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
3272 Return t if last mod time of BUFFER's visited file matches what BUFFER records.
3273 This means that the file has not been changed since it was visited or saved.
3277 /* This function can call lisp; GC checked 2000-07-11 ben */
3280 Lisp_Object handler;
3282 CHECK_BUFFER(buffer);
3283 b = XBUFFER(buffer);
3285 if (!STRINGP(b->filename))
3287 if (b->modtime == 0)
3290 /* If the file name has special constructs in it,
3291 call the corresponding file handler. */
3292 handler = Ffind_file_name_handler(b->filename,
3293 Qverify_visited_file_modtime);
3295 return call2(handler, Qverify_visited_file_modtime, buffer);
3297 if (sxemacs_stat((char *)XSTRING_DATA(b->filename), &st) < 0) {
3298 /* If the file doesn't exist now and didn't exist before,
3299 we say that it isn't modified, provided the error is a tame one. */
3300 if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
3305 if (st.st_mtime == b->modtime
3306 /* If both are positive, accept them if they are off by one second. */
3307 || (st.st_mtime > 0 && b->modtime > 0
3308 && (st.st_mtime == b->modtime + 1
3309 || st.st_mtime == b->modtime - 1)))
3314 DEFUN("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /*
3315 Clear out records of last mod time of visited file.
3316 Next attempt to save will certainly not complain of a discrepancy.
3320 current_buffer->modtime = 0;
3324 DEFUN("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /*
3325 Return the current buffer's recorded visited file modification time.
3326 The value is a list of the form (HIGH . LOW), like the time values
3327 that `file-attributes' returns.
3331 return time_to_lisp((time_t) current_buffer->modtime);
3334 DEFUN("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /*
3335 Update buffer's recorded modification time from the visited file's time.
3336 Useful if the buffer was not read from the file normally
3337 or if the file itself has been changed for some known benign reason.
3338 An argument specifies the modification time value to use
3339 \(instead of that of the visited file), in the form of a list
3340 \(HIGH . LOW) or (HIGH LOW).
3344 /* This function can call lisp */
3345 if (!NILP(time_list)) {
3347 lisp_to_time(time_list, &the_time);
3348 current_buffer->modtime = (int)the_time;
3350 Lisp_Object filename = Qnil;
3352 Lisp_Object handler;
3353 struct gcpro gcpro1, gcpro2, gcpro3;
3355 GCPRO3(filename, time_list, current_buffer->filename);
3356 filename = Fexpand_file_name(current_buffer->filename, Qnil);
3358 /* If the file name has special constructs in it,
3359 call the corresponding file handler. */
3361 Ffind_file_name_handler(filename,
3362 Qset_visited_file_modtime);
3365 /* The handler can find the file name the same way we did. */
3366 return call2(handler, Qset_visited_file_modtime, Qnil);
3367 else if (sxemacs_stat((char *)XSTRING_DATA(filename), &st) >= 0)
3368 current_buffer->modtime = st.st_mtime;
3375 auto_save_error(Lisp_Object condition_object, Lisp_Object ignored)
3377 /* This function can call lisp */
3380 /* Don't try printing an error message after everything is gone! */
3381 if (preparing_for_armageddon)
3383 clear_echo_area(selected_frame(), Qauto_saving, 1);
3384 Fding(Qt, Qauto_save_error, Qnil);
3385 message("Auto-saving...error for %s",
3386 XSTRING_DATA(current_buffer->name));
3387 Fsleep_for(make_int(1));
3388 message("Auto-saving...error!for %s",
3389 XSTRING_DATA(current_buffer->name));
3390 Fsleep_for(make_int(1));
3391 message("Auto-saving...error for %s",
3392 XSTRING_DATA(current_buffer->name));
3393 Fsleep_for(make_int(1));
3397 static Lisp_Object auto_save_1(Lisp_Object ignored)
3399 /* This function can call lisp */
3400 /* #### I think caller is protecting current_buffer? */
3402 Lisp_Object fn = current_buffer->filename;
3403 Lisp_Object a = current_buffer->auto_save_file_name;
3408 /* Get visited file's mode to become the auto save file's mode. */
3409 if (STRINGP(fn) && sxemacs_stat((char *)XSTRING_DATA(fn), &st) >= 0)
3410 /* But make sure we can overwrite it later! */
3411 auto_save_mode_bits = st.st_mode | 0600;
3413 /* default mode for auto-save files of buffers with no file is
3414 readable by owner only. This may annoy some small number of
3415 people, but the alternative removes all privacy from email. */
3416 auto_save_mode_bits = 0600;
3419 /* !!#### need to deal with this 'escape-quoted everywhere */
3420 Fwrite_region_internal(Qnil, Qnil, a, Qnil, Qlambda, Qnil,
3422 current_buffer->buffer_file_coding_system
3430 auto_save_expand_name_error(Lisp_Object condition_object, Lisp_Object ignored)
3432 /* #### this function should spew an error message about not being
3433 able to open the .saves file. */
3437 static Lisp_Object auto_save_expand_name(Lisp_Object name)
3439 struct gcpro gcpro1;
3441 /* note that caller did NOT gc protect name, so we do it. */
3442 /* #### dmoore - this might not be necessary, if condition_case_1
3443 protects it. but I don't think it does. */
3445 RETURN_UNGCPRO(Fexpand_file_name(name, Qnil));
3448 static Lisp_Object do_auto_save_unwind(Lisp_Object fd)
3454 static Lisp_Object do_auto_save_unwind_2(Lisp_Object old_auto_saving)
3456 auto_saving = XINT(old_auto_saving);
3460 /* Fdo_auto_save() checks whether a GC is in progress when it is called,
3461 and if so, tries to avoid touching lisp objects.
3463 The only time that Fdo_auto_save() is called while GC is in progress
3464 is if we're going down, as a result of an abort() or a kill signal.
3465 It's fairly important that we generate autosave files in that case!
3468 DEFUN("do-auto-save", Fdo_auto_save, 0, 2, "", /*
3469 Auto-save all buffers that need it.
3470 This is all buffers that have auto-saving enabled
3471 and are changed since last auto-saved.
3472 Auto-saving writes the buffer into a file
3473 so that your editing is not lost if the system crashes.
3474 This file is not the file you visited; that changes only when you save.
3475 Normally we run the normal hook `auto-save-hook' before saving.
3477 Non-nil first argument means do not print any message if successful.
3478 Non-nil second argument means save only current buffer.
3480 (no_message, current_only))
3482 /* This function can call lisp */
3484 Lisp_Object tail, buf;
3486 int do_handled_files;
3487 Lisp_Object oquit = Qnil;
3488 Lisp_Object listfile = Qnil;
3491 int speccount = specpdl_depth();
3492 struct gcpro gcpro1, gcpro2, gcpro3;
3494 XSETBUFFER(old, current_buffer);
3495 GCPRO3(oquit, listfile, old);
3496 check_quit(); /* make Vquit_flag accurate */
3497 /* Ordinarily don't quit within this function,
3498 but don't make it impossible to quit (in case we get hung in I/O). */
3502 /* No further GCPRO needed, because (when it matters) all Lisp_Object
3503 variables point to non-strings reached from Vbuffer_alist. */
3505 if (minibuf_level != 0 || preparing_for_armageddon)
3508 run_hook(Qauto_save_hook);
3510 if (STRINGP(Vauto_save_list_file_name))
3511 listfile = condition_case_1(Qt,
3512 auto_save_expand_name,
3513 Vauto_save_list_file_name,
3514 auto_save_expand_name_error, Qnil);
3516 /* Make sure auto_saving is reset. */
3517 record_unwind_protect(do_auto_save_unwind_2, make_int(auto_saving));
3521 /* First, save all files which don't have handlers. If Emacs is
3522 crashing, the handlers may tweak what is causing Emacs to crash
3523 in the first place, and it would be a shame if Emacs failed to
3524 autosave perfectly ordinary files because it couldn't handle some
3526 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) {
3527 for (tail = Vbuffer_alist; CONSP(tail); tail = XCDR(tail)) {
3528 buf = XCDR(XCAR(tail));
3531 if (!NILP(current_only)
3532 && b != current_buffer)
3535 /* Don't auto-save indirect buffers.
3536 The base buffer takes care of it. */
3540 /* Check for auto save enabled
3541 and file changed since last auto save
3542 and file changed since last real save. */
3543 if (STRINGP(b->auto_save_file_name)
3544 && BUF_SAVE_MODIFF(b) < BUF_MODIFF(b)
3545 && b->auto_save_modified < BUF_MODIFF(b)
3546 /* -1 means we've turned off autosaving for a while--see below. */
3547 && XINT(b->saved_size) >= 0
3548 && (do_handled_files
3550 NILP(Ffind_file_name_handler
3551 (b->auto_save_file_name,
3553 EMACS_TIME before_time, after_time;
3555 EMACS_GET_TIME(before_time);
3556 /* If we had a failure, don't try again for 20 minutes. */
3557 if (!preparing_for_armageddon
3558 && b->auto_save_failure_time >= 0
3559 && (EMACS_SECS(before_time) -
3560 b->auto_save_failure_time < 1200))
3563 if (!preparing_for_armageddon &&
3564 (XINT(b->saved_size) * 10
3565 > (BUF_Z(b) - BUF_BEG(b)) * 13)
3566 /* A short file is likely to change a large fraction;
3567 spare the user annoying messages. */
3568 && XINT(b->saved_size) > 5000
3569 /* These messages are frequent and annoying for `*mail*'. */
3570 && !NILP(b->filename)
3572 && disable_auto_save_when_buffer_shrinks) {
3573 /* It has shrunk too much; turn off auto-saving here.
3574 Unless we're about to crash, in which case auto-save it
3578 ("Buffer %s has shrunk a lot; auto save turned off there",
3579 XSTRING_DATA(b->name));
3580 /* Turn off auto-saving until there's a real save,
3581 and prevent any more warnings. */
3582 b->saved_size = make_int(-1);
3583 if (!gc_in_progress)
3584 Fsleep_for(make_int(1));
3587 set_buffer_internal(b);
3588 if (!auto_saved && NILP(no_message)) {
3589 static const unsigned char *msg
3591 (const unsigned char *)
3593 echo_area_message(selected_frame(), msg,
3595 strlen((const char *)
3600 /* Open the auto-save list file, if necessary.
3601 We only do this now so that the file only exists
3602 if we actually auto-saved any files. */
3603 if (!auto_saved && !inhibit_auto_save_session
3604 && !NILP(Vauto_save_list_file_prefix)
3605 && STRINGP(listfile) && listdesc < 0) {
3607 open((char *)XSTRING_DATA(listfile),
3608 O_WRONLY | O_TRUNC | O_CREAT |
3609 OPEN_BINARY, CREAT_MODE);
3611 /* Arrange to close that file whether or not we get
3614 record_unwind_protect
3615 (do_auto_save_unwind,
3616 make_int(listdesc));
3619 /* Record all the buffers that we are auto-saving in
3620 the special file that lists them. For each of
3621 these buffers, record visited name (if any) and
3623 if (listdesc >= 0) {
3624 const Extbyte *auto_save_file_name_ext;
3625 Extcount auto_save_file_name_ext_len;
3627 TO_EXTERNAL_FORMAT(LISP_STRING,
3629 auto_save_file_name,
3631 (auto_save_file_name_ext,
3632 auto_save_file_name_ext_len),
3634 if (!NILP(b->filename)) {
3635 const Extbyte *filename_ext;
3636 Extcount filename_ext_len;
3638 TO_EXTERNAL_FORMAT(LISP_STRING,
3644 write(listdesc, filename_ext,
3647 write(listdesc, "\n", 1);
3648 write(listdesc, auto_save_file_name_ext,
3649 auto_save_file_name_ext_len);
3650 write(listdesc, "\n", 1);
3653 /* dmoore - In a bad scenario we've set b=XBUFFER(buf)
3654 based on values in Vbuffer_alist. auto_save_1 may
3655 cause lisp handlers to run. Those handlers may kill
3656 the buffer and then GC. Since the buffer is killed,
3657 it's no longer in Vbuffer_alist so it might get reaped
3658 by the GC. We also need to protect tail. */
3659 /* #### There is probably a lot of other code which has
3660 pointers into buffers which may get blown away by
3663 struct gcpro ngcpro1, ngcpro2;
3665 condition_case_1(Qt,
3667 auto_save_error, Qnil);
3670 /* Handler killed our saved current-buffer! Pick any. */
3671 if (!BUFFER_LIVE_P(XBUFFER(old)))
3672 XSETBUFFER(old, current_buffer);
3674 set_buffer_internal(XBUFFER(old));
3677 /* Handler killed their own buffer! */
3678 if (!BUFFER_LIVE_P(b))
3681 b->auto_save_modified = BUF_MODIFF(b);
3682 b->saved_size = make_int(BUF_SIZE(b));
3683 EMACS_GET_TIME(after_time);
3684 /* If auto-save took more than 60 seconds,
3685 assume it was an NFS failure that got a timeout. */
3686 if (EMACS_SECS(after_time) -
3687 EMACS_SECS(before_time) > 60)
3688 b->auto_save_failure_time =
3689 EMACS_SECS(after_time);
3694 /* Prevent another auto save till enough input events come in. */
3698 /* If we didn't save anything into the listfile, remove the old
3699 one because nothing needed to be auto-saved. Do this afterwards
3700 rather than before in case we get a crash attempting to autosave
3701 (in that case we'd still want the old one around). */
3702 if (listdesc < 0 && !auto_saved && STRINGP(listfile))
3703 unlink((char *)XSTRING_DATA(listfile));
3705 /* Show "...done" only if the echo area would otherwise be empty. */
3706 if (auto_saved && NILP(no_message)
3707 && NILP(clear_echo_area(selected_frame(), Qauto_saving, 0))) {
3708 static const unsigned char *msg
3709 = (const unsigned char *)"Auto-saving...done";
3710 echo_area_message(selected_frame(), msg, Qnil, 0,
3711 strlen((const char *)msg), Qauto_saving);
3716 RETURN_UNGCPRO(unbind_to(speccount, Qnil));
3719 DEFUN("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /*
3720 Mark current buffer as auto-saved with its current text.
3721 No auto-save file will be written until the buffer changes again.
3725 current_buffer->auto_save_modified = BUF_MODIFF(current_buffer);
3726 current_buffer->saved_size = make_int(BUF_SIZE(current_buffer));
3727 current_buffer->auto_save_failure_time = -1;
3731 DEFUN("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /*
3732 Clear any record of a recent auto-save failure in the current buffer.
3736 current_buffer->auto_save_failure_time = -1;
3740 DEFUN("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /*
3741 Return t if buffer has been auto-saved since last read in or saved.
3745 return (BUF_SAVE_MODIFF(current_buffer) <
3746 current_buffer->auto_save_modified) ? Qt : Qnil;
3749 /************************************************************************/
3750 /* initialization */
3751 /************************************************************************/
3753 void syms_of_fileio(void)
3755 defsymbol(&Qexpand_file_name, "expand-file-name");
3756 defsymbol(&Qfile_truename, "file-truename");
3757 defsymbol(&Qsubstitute_in_file_name, "substitute-in-file-name");
3758 defsymbol(&Qdirectory_file_name, "directory-file-name");
3759 defsymbol(&Qfile_dirname, "file-dirname");
3760 defsymbol(&Qfile_basename, "file-basename");
3761 defsymbol(&Qfile_name_directory, "file-name-directory");
3762 defsymbol(&Qfile_name_nondirectory, "file-name-nondirectory");
3763 defsymbol(&Qunhandled_file_name_directory,
3764 "unhandled-file-name-directory");
3765 defsymbol(&Qfile_name_as_directory, "file-name-as-directory");
3766 defsymbol(&Qcopy_file, "copy-file");
3767 defsymbol(&Qmake_directory_internal, "make-directory-internal");
3768 defsymbol(&Qdelete_directory, "delete-directory");
3769 defsymbol(&Qdelete_file, "delete-file");
3770 defsymbol(&Qrename_file, "rename-file");
3771 defsymbol(&Qadd_name_to_file, "add-name-to-file");
3772 defsymbol(&Qmake_symbolic_link, "make-symbolic-link");
3773 defsymbol(&Qfile_exists_p, "file-exists-p");
3774 defsymbol(&Qfile_executable_p, "file-executable-p");
3775 defsymbol(&Qfile_readable_p, "file-readable-p");
3776 defsymbol(&Qfile_symlink_p, "file-symlink-p");
3777 defsymbol(&Qfile_writable_p, "file-writable-p");
3778 defsymbol(&Qfile_directory_p, "file-directory-p");
3779 defsymbol(&Qfile_regular_p, "file-regular-p");
3780 defsymbol(&Qfile_accessible_directory_p, "file-accessible-directory-p");
3781 defsymbol(&Qfile_modes, "file-modes");
3782 defsymbol(&Qset_file_modes, "set-file-modes");
3783 defsymbol(&Qfile_newer_than_file_p, "file-newer-than-file-p");
3784 defsymbol(&Qinsert_file_contents, "insert-file-contents");
3785 defsymbol(&Qwrite_region, "write-region");
3786 defsymbol(&Qverify_visited_file_modtime, "verify-visited-file-modtime");
3787 defsymbol(&Qset_visited_file_modtime, "set-visited-file-modtime");
3788 defsymbol(&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */
3790 defsymbol(&Qauto_save_hook, "auto-save-hook");
3791 defsymbol(&Qauto_save_error, "auto-save-error");
3792 defsymbol(&Qauto_saving, "auto-saving");
3794 defsymbol(&Qformat_decode, "format-decode");
3795 defsymbol(&Qformat_annotate_function, "format-annotate-function");
3797 defsymbol(&Qcompute_buffer_file_truename,
3798 "compute-buffer-file-truename");
3799 DEFERROR_STANDARD(Qfile_error, Qio_error);
3800 DEFERROR_STANDARD(Qfile_already_exists, Qfile_error);
3802 DEFSUBR(Ffind_file_name_handler);
3804 DEFSUBR(Ffile_name_directory);
3805 DEFSUBR(Ffile_name_nondirectory);
3806 DEFSUBR(Ffile_basename);
3807 DEFSUBR(Ffile_dirname);
3808 DEFSUBR(Funhandled_file_name_directory);
3809 DEFSUBR(Ffile_name_as_directory);
3810 DEFSUBR(Fdirectory_file_name);
3811 DEFSUBR(Fmake_temp_name);
3812 DEFSUBR(Fexpand_file_name);
3813 DEFSUBR(Ffile_truename);
3814 DEFSUBR(Fsubstitute_in_file_name);
3815 DEFSUBR(Fcopy_file);
3816 DEFSUBR(Fmake_directory_internal);
3817 DEFSUBR(Fdelete_directory);
3818 DEFSUBR(Fdelete_file);
3819 DEFSUBR(Frename_file);
3820 DEFSUBR(Fadd_name_to_file);
3821 DEFSUBR(Fmake_symbolic_link);
3823 DEFSUBR(Fsysnetunam);
3824 #endif /* HPUX_NET */
3825 DEFSUBR(Ffile_name_absolute_p);
3826 DEFSUBR(Ffile_exists_p);
3827 DEFSUBR(Ffile_executable_p);
3828 DEFSUBR(Ffile_readable_p);
3829 DEFSUBR(Ffile_writable_p);
3830 DEFSUBR(Ffile_symlink_p);
3831 DEFSUBR(Ffile_directory_p);
3832 DEFSUBR(Ffile_accessible_directory_p);
3833 DEFSUBR(Ffile_regular_p);
3834 DEFSUBR(Ffile_modes);
3835 DEFSUBR(Fset_file_modes);
3836 DEFSUBR(Fset_default_file_modes);
3837 DEFSUBR(Fdefault_file_modes);
3838 DEFSUBR(Funix_sync);
3839 DEFSUBR(Ffile_newer_than_file_p);
3840 DEFSUBR(Finsert_file_contents_internal);
3841 DEFSUBR(Fwrite_region_internal);
3842 DEFSUBR(Fcar_less_than_car); /* Vomitous! */
3843 DEFSUBR(Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
3844 DEFSUBR(Fverify_visited_file_modtime);
3845 DEFSUBR(Fclear_visited_file_modtime);
3846 DEFSUBR(Fvisited_file_modtime);
3847 DEFSUBR(Fset_visited_file_modtime);
3849 DEFSUBR(Fdo_auto_save);
3850 DEFSUBR(Fset_buffer_auto_saved);
3851 DEFSUBR(Fclear_buffer_auto_save_failure);
3852 DEFSUBR(Frecent_auto_save_p);
3855 void vars_of_fileio(void)
3857 DEFVAR_LISP("auto-save-file-format", &Vauto_save_file_format /*
3858 *Format in which to write auto-save files.
3859 Should be a list of symbols naming formats that are defined in `format-alist'.
3860 If it is t, which is the default, auto-save files are written in the
3861 same format as a regular save would use.
3863 Vauto_save_file_format = Qt;
3865 DEFVAR_LISP("file-name-handler-alist", &Vfile_name_handler_alist /*
3866 *Alist of elements (REGEXP . HANDLER) for file names handled specially.
3867 If a file name matches REGEXP, then all I/O on that file is done by calling
3870 The first argument given to HANDLER is the name of the I/O primitive
3871 to be handled; the remaining arguments are the arguments that were
3872 passed to that primitive. For example, if you do
3873 (file-exists-p FILENAME)
3874 and FILENAME is handled by HANDLER, then HANDLER is called like this:
3875 (funcall HANDLER 'file-exists-p FILENAME)
3876 The function `find-file-name-handler' checks this list for a handler
3879 Vfile_name_handler_alist = Qnil;
3881 DEFVAR_LISP("after-insert-file-functions", &Vafter_insert_file_functions /*
3882 A list of functions to be called at the end of `insert-file-contents'.
3883 Each is passed one argument, the number of bytes inserted. It should return
3884 the new byte count, and leave point the same. If `insert-file-contents' is
3885 intercepted by a handler from `file-name-handler-alist', that handler is
3886 responsible for calling the after-insert-file-functions if appropriate.
3888 Vafter_insert_file_functions = Qnil;
3890 DEFVAR_LISP("write-region-annotate-functions", &Vwrite_region_annotate_functions /*
3891 A list of functions to be called at the start of `write-region'.
3892 Each is passed two arguments, START and END, as for `write-region'.
3893 It should return a list of pairs (POSITION . STRING) of strings to be
3894 effectively inserted at the specified positions of the file being written
3895 \(1 means to insert before the first byte written). The POSITIONs must be
3896 sorted into increasing order. If there are several functions in the list,
3897 the several lists are merged destructively.
3899 Vwrite_region_annotate_functions = Qnil;
3901 DEFVAR_LISP("write-region-annotations-so-far", &Vwrite_region_annotations_so_far /*
3902 When an annotation function is called, this holds the previous annotations.
3903 These are the annotations made by other annotation functions
3904 that were already called. See also `write-region-annotate-functions'.
3906 Vwrite_region_annotations_so_far = Qnil;
3908 DEFVAR_LISP("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /*
3909 A list of file name handlers that temporarily should not be used.
3910 This applies only to the operation `inhibit-file-name-operation'.
3912 Vinhibit_file_name_handlers = Qnil;
3914 DEFVAR_LISP("inhibit-file-name-operation", &Vinhibit_file_name_operation /*
3915 The operation for which `inhibit-file-name-handlers' is applicable.
3917 Vinhibit_file_name_operation = Qnil;
3919 DEFVAR_LISP("auto-save-list-file-name", &Vauto_save_list_file_name /*
3920 File name in which we write a list of all auto save file names.
3922 Vauto_save_list_file_name = Qnil;
3924 DEFVAR_LISP("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
3925 Prefix for generating auto-save-list-file-name.
3926 Emacs's pid and the system name will be appended to
3927 this prefix to create a unique file name.
3929 Vauto_save_list_file_prefix = build_string("~/.saves-");
3931 DEFVAR_BOOL("inhibit-auto-save-session", &inhibit_auto_save_session /*
3932 When non-nil, inhibit auto save list file creation.
3934 inhibit_auto_save_session = 0;
3936 DEFVAR_BOOL("disable-auto-save-when-buffer-shrinks", &disable_auto_save_when_buffer_shrinks /*
3937 If non-nil, auto-saving is disabled when a buffer shrinks too much.
3938 This is to prevent you from losing your edits if you accidentally
3939 delete a large chunk of the buffer and don't notice it until too late.
3940 Saving the buffer normally turns auto-save back on.
3942 disable_auto_save_when_buffer_shrinks = 1;
3944 DEFVAR_LISP("directory-sep-char", &Vdirectory_sep_char /*
3945 Directory separator character for built-in functions that return file names.
3946 The value should be either ?/ or ?\\ (any other value is treated as ?\\).
3947 This variable affects the built-in functions only on Windows,
3948 on other platforms, it is initialized so that Lisp code can find out
3949 what the normal separator is.
3951 Vdirectory_sep_char = make_char('/');
3953 reinit_vars_of_fileio();
3956 void reinit_vars_of_fileio(void)
3958 /* We want temp_name_rand to be initialized to a value likely to be
3959 unique to the process, not to the executable. The danger is that
3960 two different SXEmacs processes using the same binary on different
3961 machines creating temp files in the same directory will be
3962 unlucky enough to have the same pid. If we randomize using
3963 process startup time, then in practice they will be unlikely to
3964 collide. We use the microseconds field so that scripts that start
3965 simultaneous SXEmacs processes on multiple machines will have less
3966 chance of collision. */
3970 EMACS_GET_TIME(thyme);
3972 (unsigned int)(EMACS_SECS(thyme) ^ EMACS_USECS(thyme));