Merge from origin/emacs-24
[emacs.git] / src / fileio.c
blobb8dec3a2041ac1b193d01106cf5de2b74263a47a
1 /* File IO for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-2014 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs 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 GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
21 #include <limits.h>
22 #include <fcntl.h>
23 #include "sysstdio.h"
24 #include <sys/types.h>
25 #include <sys/stat.h>
26 #include <unistd.h>
28 #ifdef HAVE_PWD_H
29 #include <pwd.h>
30 #endif
32 #include <errno.h>
34 #ifdef HAVE_LIBSELINUX
35 #include <selinux/selinux.h>
36 #include <selinux/context.h>
37 #endif
39 #ifdef HAVE_ACL_SET_FILE
40 #include <sys/acl.h>
41 #endif
43 #include <c-ctype.h>
45 #include "lisp.h"
46 #include "intervals.h"
47 #include "character.h"
48 #include "buffer.h"
49 #include "coding.h"
50 #include "window.h"
51 #include "blockinput.h"
52 #include "region-cache.h"
53 #include "frame.h"
54 #include "dispextern.h"
56 #ifdef WINDOWSNT
57 #define NOMINMAX 1
58 #include <windows.h>
59 #include <sys/file.h>
60 #include "w32.h"
61 #endif /* not WINDOWSNT */
63 #ifdef MSDOS
64 #include "msdos.h"
65 #include <sys/param.h>
66 #endif
68 #ifdef DOS_NT
69 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
70 redirector allows the six letters between 'Z' and 'a' as well. */
71 #ifdef MSDOS
72 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
73 #endif
74 #ifdef WINDOWSNT
75 #define IS_DRIVE(x) c_isalpha (x)
76 #endif
77 /* Need to lower-case the drive letter, or else expanded
78 filenames will sometimes compare unequal, because
79 `expand-file-name' doesn't always down-case the drive letter. */
80 #define DRIVE_LETTER(x) c_tolower (x)
81 #endif
83 #include "systime.h"
84 #include <acl.h>
85 #include <allocator.h>
86 #include <careadlinkat.h>
87 #include <stat-time.h>
89 #ifdef HPUX
90 #include <netio.h>
91 #endif
93 #include "commands.h"
95 /* True during writing of auto-save files. */
96 static bool auto_saving;
98 /* Emacs's real umask. */
99 static mode_t realmask;
101 /* Nonzero umask during creation of auto-save directories. */
102 static mode_t auto_saving_dir_umask;
104 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
105 a new file with the same mode as the original. */
106 static mode_t auto_save_mode_bits;
108 /* Set by auto_save_1 if an error occurred during the last auto-save. */
109 static bool auto_save_error_occurred;
111 /* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
112 number of a file system where time stamps were observed to to work. */
113 static bool valid_timestamp_file_system;
114 static dev_t timestamp_file_system;
116 /* The symbol bound to coding-system-for-read when
117 insert-file-contents is called for recovering a file. This is not
118 an actual coding system name, but just an indicator to tell
119 insert-file-contents to use `emacs-mule' with a special flag for
120 auto saving and recovering a file. */
121 static Lisp_Object Qauto_save_coding;
123 /* Property name of a file name handler,
124 which gives a list of operations it handles.. */
125 static Lisp_Object Qoperations;
127 /* Lisp functions for translating file formats. */
128 static Lisp_Object Qformat_decode, Qformat_annotate_function;
130 /* Lisp function for setting buffer-file-coding-system and the
131 multibyteness of the current buffer after inserting a file. */
132 static Lisp_Object Qafter_insert_file_set_coding;
134 static Lisp_Object Qwrite_region_annotate_functions;
135 /* Each time an annotation function changes the buffer, the new buffer
136 is added here. */
137 static Lisp_Object Vwrite_region_annotation_buffers;
139 static Lisp_Object Qdelete_by_moving_to_trash;
141 /* Lisp function for moving files to trash. */
142 static Lisp_Object Qmove_file_to_trash;
144 /* Lisp function for recursively copying directories. */
145 static Lisp_Object Qcopy_directory;
147 /* Lisp function for recursively deleting directories. */
148 static Lisp_Object Qdelete_directory;
150 static Lisp_Object Qsubstitute_env_in_file_name;
152 Lisp_Object Qfile_error, Qfile_notify_error;
153 static Lisp_Object Qfile_already_exists, Qfile_date_error;
154 static Lisp_Object Qexcl;
155 Lisp_Object Qfile_name_history;
157 static Lisp_Object Qcar_less_than_car;
159 static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
160 Lisp_Object *, struct coding_system *);
161 static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
162 struct coding_system *);
165 /* Return true if FILENAME exists. */
167 static bool
168 check_existing (const char *filename)
170 return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
173 /* Return true if file FILENAME exists and can be executed. */
175 static bool
176 check_executable (char *filename)
178 return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
181 /* Return true if file FILENAME exists and can be accessed
182 according to AMODE, which should include W_OK.
183 On failure, return false and set errno. */
185 static bool
186 check_writable (const char *filename, int amode)
188 #ifdef MSDOS
189 /* FIXME: an faccessat implementation should be added to the
190 DOS/Windows ports and this #ifdef branch should be removed. */
191 struct stat st;
192 if (stat (filename, &st) < 0)
193 return 0;
194 errno = EPERM;
195 return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
196 #else /* not MSDOS */
197 bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
198 #ifdef CYGWIN
199 /* faccessat may have returned failure because Cygwin couldn't
200 determine the file's UID or GID; if so, we return success. */
201 if (!res)
203 int faccessat_errno = errno;
204 struct stat st;
205 if (stat (filename, &st) < 0)
206 return 0;
207 res = (st.st_uid == -1 || st.st_gid == -1);
208 errno = faccessat_errno;
210 #endif /* CYGWIN */
211 return res;
212 #endif /* not MSDOS */
215 /* Signal a file-access failure. STRING describes the failure,
216 NAME the file involved, and ERRORNO the errno value.
218 If NAME is neither null nor a pair, package it up as a singleton
219 list before reporting it; this saves report_file_errno's caller the
220 trouble of preserving errno before calling list1. */
222 void
223 report_file_errno (char const *string, Lisp_Object name, int errorno)
225 Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
226 Lisp_Object errstring;
227 char *str;
229 synchronize_system_messages_locale ();
230 str = strerror (errorno);
231 errstring = code_convert_string_norecord (build_unibyte_string (str),
232 Vlocale_coding_system, 0);
234 while (1)
235 switch (errorno)
237 case EEXIST:
238 xsignal (Qfile_already_exists, Fcons (errstring, data));
239 break;
240 default:
241 /* System error messages are capitalized. Downcase the initial
242 unless it is followed by a slash. (The slash case caters to
243 error messages that begin with "I/O" or, in German, "E/A".) */
244 if (STRING_MULTIBYTE (errstring)
245 && ! EQ (Faref (errstring, make_number (1)), make_number ('/')))
247 int c;
249 str = SSDATA (errstring);
250 c = STRING_CHAR ((unsigned char *) str);
251 Faset (errstring, make_number (0), make_number (downcase (c)));
254 xsignal (Qfile_error,
255 Fcons (build_string (string), Fcons (errstring, data)));
259 /* Signal a file-access failure that set errno. STRING describes the
260 failure, NAME the file involved. When invoking this function, take
261 care to not use arguments such as build_string ("foo") that involve
262 side effects that may set errno. */
264 void
265 report_file_error (char const *string, Lisp_Object name)
267 report_file_errno (string, name, errno);
270 void
271 close_file_unwind (int fd)
273 emacs_close (fd);
276 void
277 fclose_unwind (void *arg)
279 FILE *stream = arg;
280 fclose (stream);
283 /* Restore point, having saved it as a marker. */
285 void
286 restore_point_unwind (Lisp_Object location)
288 Fgoto_char (location);
289 unchain_marker (XMARKER (location));
293 static Lisp_Object Qexpand_file_name;
294 static Lisp_Object Qsubstitute_in_file_name;
295 static Lisp_Object Qdirectory_file_name;
296 static Lisp_Object Qfile_name_directory;
297 static Lisp_Object Qfile_name_nondirectory;
298 static Lisp_Object Qunhandled_file_name_directory;
299 static Lisp_Object Qfile_name_as_directory;
300 static Lisp_Object Qcopy_file;
301 static Lisp_Object Qmake_directory_internal;
302 static Lisp_Object Qmake_directory;
303 static Lisp_Object Qdelete_directory_internal;
304 Lisp_Object Qdelete_file;
305 static Lisp_Object Qrename_file;
306 static Lisp_Object Qadd_name_to_file;
307 static Lisp_Object Qmake_symbolic_link;
308 Lisp_Object Qfile_exists_p;
309 static Lisp_Object Qfile_executable_p;
310 static Lisp_Object Qfile_readable_p;
311 static Lisp_Object Qfile_writable_p;
312 static Lisp_Object Qfile_symlink_p;
313 static Lisp_Object Qaccess_file;
314 Lisp_Object Qfile_directory_p;
315 static Lisp_Object Qfile_regular_p;
316 static Lisp_Object Qfile_accessible_directory_p;
317 static Lisp_Object Qfile_modes;
318 static Lisp_Object Qset_file_modes;
319 static Lisp_Object Qset_file_times;
320 static Lisp_Object Qfile_selinux_context;
321 static Lisp_Object Qset_file_selinux_context;
322 static Lisp_Object Qfile_acl;
323 static Lisp_Object Qset_file_acl;
324 static Lisp_Object Qfile_newer_than_file_p;
325 Lisp_Object Qinsert_file_contents;
326 Lisp_Object Qwrite_region;
327 static Lisp_Object Qverify_visited_file_modtime;
328 static Lisp_Object Qset_visited_file_modtime;
330 DEFUN ("find-file-name-handler", Ffind_file_name_handler,
331 Sfind_file_name_handler, 2, 2, 0,
332 doc: /* Return FILENAME's handler function for OPERATION, if it has one.
333 Otherwise, return nil.
334 A file name is handled if one of the regular expressions in
335 `file-name-handler-alist' matches it.
337 If OPERATION equals `inhibit-file-name-operation', then we ignore
338 any handlers that are members of `inhibit-file-name-handlers',
339 but we still do run any other handlers. This lets handlers
340 use the standard functions without calling themselves recursively. */)
341 (Lisp_Object filename, Lisp_Object operation)
343 /* This function must not munge the match data. */
344 Lisp_Object chain, inhibited_handlers, result;
345 ptrdiff_t pos = -1;
347 result = Qnil;
348 CHECK_STRING (filename);
350 if (EQ (operation, Vinhibit_file_name_operation))
351 inhibited_handlers = Vinhibit_file_name_handlers;
352 else
353 inhibited_handlers = Qnil;
355 for (chain = Vfile_name_handler_alist; CONSP (chain);
356 chain = XCDR (chain))
358 Lisp_Object elt;
359 elt = XCAR (chain);
360 if (CONSP (elt))
362 Lisp_Object string = XCAR (elt);
363 ptrdiff_t match_pos;
364 Lisp_Object handler = XCDR (elt);
365 Lisp_Object operations = Qnil;
367 if (SYMBOLP (handler))
368 operations = Fget (handler, Qoperations);
370 if (STRINGP (string)
371 && (match_pos = fast_string_match (string, filename)) > pos
372 && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
374 Lisp_Object tem;
376 handler = XCDR (elt);
377 tem = Fmemq (handler, inhibited_handlers);
378 if (NILP (tem))
380 result = handler;
381 pos = match_pos;
386 QUIT;
388 return result;
391 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
392 1, 1, 0,
393 doc: /* Return the directory component in file name FILENAME.
394 Return nil if FILENAME does not include a directory.
395 Otherwise return a directory name.
396 Given a Unix syntax file name, returns a string ending in slash. */)
397 (Lisp_Object filename)
399 Lisp_Object handler;
401 CHECK_STRING (filename);
403 /* If the file name has special constructs in it,
404 call the corresponding file handler. */
405 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
406 if (!NILP (handler))
408 Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
409 filename);
410 return STRINGP (handled_name) ? handled_name : Qnil;
413 char *beg = SSDATA (filename);
414 char const *p = beg + SBYTES (filename);
416 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
417 #ifdef DOS_NT
418 /* only recognize drive specifier at the beginning */
419 && !(p[-1] == ':'
420 /* handle the "/:d:foo" and "/:foo" cases correctly */
421 && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
422 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
423 #endif
424 ) p--;
426 if (p == beg)
427 return Qnil;
428 #ifdef DOS_NT
429 /* Expansion of "c:" to drive and default directory. */
430 Lisp_Object tem_fn;
431 USE_SAFE_ALLOCA;
432 SAFE_ALLOCA_STRING (beg, filename);
433 p = beg + (p - SSDATA (filename));
435 if (p[-1] == ':')
437 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
438 char *res = alloca (MAXPATHLEN + 1);
439 char *r = res;
441 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
443 memcpy (res, beg, 2);
444 beg += 2;
445 r += 2;
448 if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
450 size_t l = strlen (res);
452 if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
453 strcat (res, "/");
454 beg = res;
455 p = beg + strlen (beg);
456 dostounix_filename (beg);
457 tem_fn = make_specified_string (beg, -1, p - beg,
458 STRING_MULTIBYTE (filename));
460 else
461 tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
462 STRING_MULTIBYTE (filename));
464 else if (STRING_MULTIBYTE (filename))
466 tem_fn = make_specified_string (beg, -1, p - beg, 1);
467 dostounix_filename (SSDATA (tem_fn));
468 #ifdef WINDOWSNT
469 if (!NILP (Vw32_downcase_file_names))
470 tem_fn = Fdowncase (tem_fn);
471 #endif
473 else
475 dostounix_filename (beg);
476 tem_fn = make_specified_string (beg, -1, p - beg, 0);
478 SAFE_FREE ();
479 return tem_fn;
480 #else /* DOS_NT */
481 return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
482 #endif /* DOS_NT */
485 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
486 Sfile_name_nondirectory, 1, 1, 0,
487 doc: /* Return file name FILENAME sans its directory.
488 For example, in a Unix-syntax file name,
489 this is everything after the last slash,
490 or the entire name if it contains no slash. */)
491 (Lisp_Object filename)
493 register const char *beg, *p, *end;
494 Lisp_Object handler;
496 CHECK_STRING (filename);
498 /* If the file name has special constructs in it,
499 call the corresponding file handler. */
500 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
501 if (!NILP (handler))
503 Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory,
504 filename);
505 if (STRINGP (handled_name))
506 return handled_name;
507 error ("Invalid handler in `file-name-handler-alist'");
510 beg = SSDATA (filename);
511 end = p = beg + SBYTES (filename);
513 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
514 #ifdef DOS_NT
515 /* only recognize drive specifier at beginning */
516 && !(p[-1] == ':'
517 /* handle the "/:d:foo" case correctly */
518 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
519 #endif
521 p--;
523 return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
526 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
527 Sunhandled_file_name_directory, 1, 1, 0,
528 doc: /* Return a directly usable directory name somehow associated with FILENAME.
529 A `directly usable' directory name is one that may be used without the
530 intervention of any file handler.
531 If FILENAME is a directly usable file itself, return
532 \(file-name-directory FILENAME).
533 If FILENAME refers to a file which is not accessible from a local process,
534 then this should return nil.
535 The `call-process' and `start-process' functions use this function to
536 get a current directory to run processes in. */)
537 (Lisp_Object filename)
539 Lisp_Object handler;
541 /* If the file name has special constructs in it,
542 call the corresponding file handler. */
543 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
544 if (!NILP (handler))
546 Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
547 filename);
548 return STRINGP (handled_name) ? handled_name : Qnil;
551 return Ffile_name_directory (filename);
554 /* Maximum number of bytes that DST will be longer than SRC
555 in file_name_as_directory. This occurs when SRCLEN == 0. */
556 enum { file_name_as_directory_slop = 2 };
558 /* Convert from file name SRC of length SRCLEN to directory name in
559 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
560 string. On UNIX, just make sure there is a terminating /. Return
561 the length of DST in bytes. */
563 static ptrdiff_t
564 file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
565 bool multibyte)
567 if (srclen == 0)
569 dst[0] = '.';
570 dst[1] = '/';
571 dst[2] = '\0';
572 return 2;
575 memcpy (dst, src, srclen);
576 if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
577 dst[srclen++] = DIRECTORY_SEP;
578 dst[srclen] = 0;
579 #ifdef DOS_NT
580 dostounix_filename (dst);
581 #endif
582 return srclen;
585 DEFUN ("file-name-as-directory", Ffile_name_as_directory,
586 Sfile_name_as_directory, 1, 1, 0,
587 doc: /* Return a string representing the file name FILE interpreted as a directory.
588 This operation exists because a directory is also a file, but its name as
589 a directory is different from its name as a file.
590 The result can be used as the value of `default-directory'
591 or passed as second argument to `expand-file-name'.
592 For a Unix-syntax file name, just appends a slash. */)
593 (Lisp_Object file)
595 char *buf;
596 ptrdiff_t length;
597 Lisp_Object handler, val;
598 USE_SAFE_ALLOCA;
600 CHECK_STRING (file);
601 if (NILP (file))
602 return Qnil;
604 /* If the file name has special constructs in it,
605 call the corresponding file handler. */
606 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
607 if (!NILP (handler))
609 Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory,
610 file);
611 if (STRINGP (handled_name))
612 return handled_name;
613 error ("Invalid handler in `file-name-handler-alist'");
616 #ifdef WINDOWSNT
617 if (!NILP (Vw32_downcase_file_names))
618 file = Fdowncase (file);
619 #endif
620 buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
621 length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
622 STRING_MULTIBYTE (file));
623 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
624 SAFE_FREE ();
625 return val;
628 /* Convert from directory name SRC of length SRCLEN to file name in
629 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
630 string. On UNIX, just make sure there isn't a terminating /.
631 Return the length of DST in bytes. */
633 static ptrdiff_t
634 directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
636 /* Process as Unix format: just remove any final slash.
637 But leave "/" and "//" unchanged. */
638 while (srclen > 1
639 #ifdef DOS_NT
640 && !IS_ANY_SEP (src[srclen - 2])
641 #endif
642 && IS_DIRECTORY_SEP (src[srclen - 1])
643 && ! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
644 srclen--;
646 memcpy (dst, src, srclen);
647 dst[srclen] = 0;
648 #ifdef DOS_NT
649 dostounix_filename (dst);
650 #endif
651 return srclen;
654 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
655 1, 1, 0,
656 doc: /* Returns the file name of the directory named DIRECTORY.
657 This is the name of the file that holds the data for the directory DIRECTORY.
658 This operation exists because a directory is also a file, but its name as
659 a directory is different from its name as a file.
660 In Unix-syntax, this function just removes the final slash. */)
661 (Lisp_Object directory)
663 char *buf;
664 ptrdiff_t length;
665 Lisp_Object handler, val;
666 USE_SAFE_ALLOCA;
668 CHECK_STRING (directory);
670 if (NILP (directory))
671 return Qnil;
673 /* If the file name has special constructs in it,
674 call the corresponding file handler. */
675 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
676 if (!NILP (handler))
678 Lisp_Object handled_name = call2 (handler, Qdirectory_file_name,
679 directory);
680 if (STRINGP (handled_name))
681 return handled_name;
682 error ("Invalid handler in `file-name-handler-alist'");
685 #ifdef WINDOWSNT
686 if (!NILP (Vw32_downcase_file_names))
687 directory = Fdowncase (directory);
688 #endif
689 buf = SAFE_ALLOCA (SBYTES (directory) + 1);
690 length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
691 STRING_MULTIBYTE (directory));
692 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
693 SAFE_FREE ();
694 return val;
697 static const char make_temp_name_tbl[64] =
699 'A','B','C','D','E','F','G','H',
700 'I','J','K','L','M','N','O','P',
701 'Q','R','S','T','U','V','W','X',
702 'Y','Z','a','b','c','d','e','f',
703 'g','h','i','j','k','l','m','n',
704 'o','p','q','r','s','t','u','v',
705 'w','x','y','z','0','1','2','3',
706 '4','5','6','7','8','9','-','_'
709 static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
711 /* Value is a temporary file name starting with PREFIX, a string.
713 The Emacs process number forms part of the result, so there is
714 no danger of generating a name being used by another process.
715 In addition, this function makes an attempt to choose a name
716 which has no existing file. To make this work, PREFIX should be
717 an absolute file name.
719 BASE64_P means add the pid as 3 characters in base64
720 encoding. In this case, 6 characters will be added to PREFIX to
721 form the file name. Otherwise, if Emacs is running on a system
722 with long file names, add the pid as a decimal number.
724 This function signals an error if no unique file name could be
725 generated. */
727 Lisp_Object
728 make_temp_name (Lisp_Object prefix, bool base64_p)
730 Lisp_Object val, encoded_prefix;
731 ptrdiff_t len;
732 printmax_t pid;
733 char *p, *data;
734 char pidbuf[INT_BUFSIZE_BOUND (printmax_t)];
735 int pidlen;
737 CHECK_STRING (prefix);
739 /* VAL is created by adding 6 characters to PREFIX. The first
740 three are the PID of this process, in base 64, and the second
741 three are incremented if the file already exists. This ensures
742 262144 unique file names per PID per PREFIX. */
744 pid = getpid ();
746 if (base64_p)
748 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
749 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
750 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
751 pidlen = 3;
753 else
755 #ifdef HAVE_LONG_FILE_NAMES
756 pidlen = sprintf (pidbuf, "%"pMd, pid);
757 #else
758 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
759 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
760 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
761 pidlen = 3;
762 #endif
765 encoded_prefix = ENCODE_FILE (prefix);
766 len = SBYTES (encoded_prefix);
767 val = make_uninit_string (len + 3 + pidlen);
768 data = SSDATA (val);
769 memcpy (data, SSDATA (encoded_prefix), len);
770 p = data + len;
772 memcpy (p, pidbuf, pidlen);
773 p += pidlen;
775 /* Here we try to minimize useless stat'ing when this function is
776 invoked many times successively with the same PREFIX. We achieve
777 this by initializing count to a random value, and incrementing it
778 afterwards.
780 We don't want make-temp-name to be called while dumping,
781 because then make_temp_name_count_initialized_p would get set
782 and then make_temp_name_count would not be set when Emacs starts. */
784 if (!make_temp_name_count_initialized_p)
786 make_temp_name_count = time (NULL);
787 make_temp_name_count_initialized_p = 1;
790 while (1)
792 unsigned num = make_temp_name_count;
794 p[0] = make_temp_name_tbl[num & 63], num >>= 6;
795 p[1] = make_temp_name_tbl[num & 63], num >>= 6;
796 p[2] = make_temp_name_tbl[num & 63], num >>= 6;
798 /* Poor man's congruential RN generator. Replace with
799 ++make_temp_name_count for debugging. */
800 make_temp_name_count += 25229;
801 make_temp_name_count %= 225307;
803 if (!check_existing (data))
805 /* We want to return only if errno is ENOENT. */
806 if (errno == ENOENT)
807 return DECODE_FILE (val);
808 else
809 /* The error here is dubious, but there is little else we
810 can do. The alternatives are to return nil, which is
811 as bad as (and in many cases worse than) throwing the
812 error, or to ignore the error, which will likely result
813 in looping through 225307 stat's, which is not only
814 dog-slow, but also useless since eventually nil would
815 have to be returned anyway. */
816 report_file_error ("Cannot create temporary name for prefix",
817 prefix);
818 /* not reached */
824 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
825 doc: /* Generate temporary file name (string) starting with PREFIX (a string).
826 The Emacs process number forms part of the result,
827 so there is no danger of generating a name being used by another process.
829 In addition, this function makes an attempt to choose a name
830 which has no existing file. To make this work,
831 PREFIX should be an absolute file name.
833 There is a race condition between calling `make-temp-name' and creating the
834 file which opens all kinds of security holes. For that reason, you should
835 probably use `make-temp-file' instead, except in three circumstances:
837 * If you are creating the file in the user's home directory.
838 * If you are creating a directory rather than an ordinary file.
839 * If you are taking special precautions as `make-temp-file' does. */)
840 (Lisp_Object prefix)
842 return make_temp_name (prefix, 0);
845 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
846 doc: /* Convert filename NAME to absolute, and canonicalize it.
847 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
848 \(does not start with slash or tilde); both the directory name and
849 a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or
850 missing, the current buffer's value of `default-directory' is used.
851 NAME should be a string that is a valid file name for the underlying
852 filesystem.
853 File name components that are `.' are removed, and
854 so are file name components followed by `..', along with the `..' itself;
855 note that these simplifications are done without checking the resulting
856 file names in the file system.
857 Multiple consecutive slashes are collapsed into a single slash,
858 except at the beginning of the file name when they are significant (e.g.,
859 UNC file names on MS-Windows.)
860 An initial `~/' expands to your home directory.
861 An initial `~USER/' expands to USER's home directory.
862 See also the function `substitute-in-file-name'.
864 For technical reasons, this function can return correct but
865 non-intuitive results for the root directory; for instance,
866 \(expand-file-name ".." "/") returns "/..". For this reason, use
867 \(directory-file-name (file-name-directory dirname)) to traverse a
868 filesystem tree, not (expand-file-name ".." dirname). */)
869 (Lisp_Object name, Lisp_Object default_directory)
871 /* These point to SDATA and need to be careful with string-relocation
872 during GC (via DECODE_FILE). */
873 char *nm;
874 char *nmlim;
875 const char *newdir;
876 const char *newdirlim;
877 /* This should only point to alloca'd data. */
878 char *target;
880 ptrdiff_t tlen;
881 struct passwd *pw;
882 #ifdef DOS_NT
883 int drive = 0;
884 bool collapse_newdir = true;
885 bool is_escaped = 0;
886 #endif /* DOS_NT */
887 ptrdiff_t length, nbytes;
888 Lisp_Object handler, result, handled_name;
889 bool multibyte;
890 Lisp_Object hdir;
891 USE_SAFE_ALLOCA;
893 CHECK_STRING (name);
895 /* If the file name has special constructs in it,
896 call the corresponding file handler. */
897 handler = Ffind_file_name_handler (name, Qexpand_file_name);
898 if (!NILP (handler))
900 handled_name = call3 (handler, Qexpand_file_name,
901 name, default_directory);
902 if (STRINGP (handled_name))
903 return handled_name;
904 error ("Invalid handler in `file-name-handler-alist'");
908 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
909 if (NILP (default_directory))
910 default_directory = BVAR (current_buffer, directory);
911 if (! STRINGP (default_directory))
913 #ifdef DOS_NT
914 /* "/" is not considered a root directory on DOS_NT, so using "/"
915 here causes an infinite recursion in, e.g., the following:
917 (let (default-directory)
918 (expand-file-name "a"))
920 To avoid this, we set default_directory to the root of the
921 current drive. */
922 default_directory = build_string (emacs_root_dir ());
923 #else
924 default_directory = build_string ("/");
925 #endif
928 if (!NILP (default_directory))
930 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
931 if (!NILP (handler))
933 handled_name = call3 (handler, Qexpand_file_name,
934 name, default_directory);
935 if (STRINGP (handled_name))
936 return handled_name;
937 error ("Invalid handler in `file-name-handler-alist'");
942 char *o = SSDATA (default_directory);
944 /* Make sure DEFAULT_DIRECTORY is properly expanded.
945 It would be better to do this down below where we actually use
946 default_directory. Unfortunately, calling Fexpand_file_name recursively
947 could invoke GC, and the strings might be relocated. This would
948 be annoying because we have pointers into strings lying around
949 that would need adjusting, and people would add new pointers to
950 the code and forget to adjust them, resulting in intermittent bugs.
951 Putting this call here avoids all that crud.
953 The EQ test avoids infinite recursion. */
954 if (! NILP (default_directory) && !EQ (default_directory, name)
955 /* Save time in some common cases - as long as default_directory
956 is not relative, it can be canonicalized with name below (if it
957 is needed at all) without requiring it to be expanded now. */
958 #ifdef DOS_NT
959 /* Detect MSDOS file names with drive specifiers. */
960 && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1])
961 && IS_DIRECTORY_SEP (o[2]))
962 #ifdef WINDOWSNT
963 /* Detect Windows file names in UNC format. */
964 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
965 #endif
966 #else /* not DOS_NT */
967 /* Detect Unix absolute file names (/... alone is not absolute on
968 DOS or Windows). */
969 && ! (IS_DIRECTORY_SEP (o[0]))
970 #endif /* not DOS_NT */
973 struct gcpro gcpro1;
975 GCPRO1 (name);
976 default_directory = Fexpand_file_name (default_directory, Qnil);
977 UNGCPRO;
980 multibyte = STRING_MULTIBYTE (name);
981 if (multibyte != STRING_MULTIBYTE (default_directory))
983 if (multibyte)
985 unsigned char *p = SDATA (name);
987 while (*p && ASCII_CHAR_P (*p))
988 p++;
989 if (*p == '\0')
991 /* NAME is a pure ASCII string, and DEFAULT_DIRECTORY is
992 unibyte. Do not convert DEFAULT_DIRECTORY to
993 multibyte; instead, convert NAME to a unibyte string,
994 so that the result of this function is also a unibyte
995 string. This is needed during bootstrapping and
996 dumping, when Emacs cannot decode file names, because
997 the locale environment is not set up. */
998 name = make_unibyte_string (SSDATA (name), SBYTES (name));
999 multibyte = 0;
1001 else
1002 default_directory = string_to_multibyte (default_directory);
1004 else
1006 name = string_to_multibyte (name);
1007 multibyte = 1;
1011 #ifdef WINDOWSNT
1012 if (!NILP (Vw32_downcase_file_names))
1013 default_directory = Fdowncase (default_directory);
1014 #endif
1016 /* Make a local copy of NAME to protect it from GC in DECODE_FILE below. */
1017 SAFE_ALLOCA_STRING (nm, name);
1018 nmlim = nm + SBYTES (name);
1020 #ifdef DOS_NT
1021 /* Note if special escape prefix is present, but remove for now. */
1022 if (nm[0] == '/' && nm[1] == ':')
1024 is_escaped = 1;
1025 nm += 2;
1028 /* Find and remove drive specifier if present; this makes nm absolute
1029 even if the rest of the name appears to be relative. Only look for
1030 drive specifier at the beginning. */
1031 if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
1033 drive = (unsigned char) nm[0];
1034 nm += 2;
1037 #ifdef WINDOWSNT
1038 /* If we see "c://somedir", we want to strip the first slash after the
1039 colon when stripping the drive letter. Otherwise, this expands to
1040 "//somedir". */
1041 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1042 nm++;
1044 /* Discard any previous drive specifier if nm is now in UNC format. */
1045 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
1046 && !IS_DIRECTORY_SEP (nm[2]))
1047 drive = 0;
1048 #endif /* WINDOWSNT */
1049 #endif /* DOS_NT */
1051 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1052 none are found, we can probably return right away. We will avoid
1053 allocating a new string if name is already fully expanded. */
1054 if (
1055 IS_DIRECTORY_SEP (nm[0])
1056 #ifdef MSDOS
1057 && drive && !is_escaped
1058 #endif
1059 #ifdef WINDOWSNT
1060 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
1061 #endif
1064 /* If it turns out that the filename we want to return is just a
1065 suffix of FILENAME, we don't need to go through and edit
1066 things; we just need to construct a new string using data
1067 starting at the middle of FILENAME. If we set LOSE, that
1068 means we've discovered that we can't do that cool trick. */
1069 bool lose = 0;
1070 char *p = nm;
1072 while (*p)
1074 /* Since we know the name is absolute, we can assume that each
1075 element starts with a "/". */
1077 /* "." and ".." are hairy. */
1078 if (IS_DIRECTORY_SEP (p[0])
1079 && p[1] == '.'
1080 && (IS_DIRECTORY_SEP (p[2])
1081 || p[2] == 0
1082 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
1083 || p[3] == 0))))
1084 lose = 1;
1085 /* Replace multiple slashes with a single one, except
1086 leave leading "//" alone. */
1087 else if (IS_DIRECTORY_SEP (p[0])
1088 && IS_DIRECTORY_SEP (p[1])
1089 && (p != nm || IS_DIRECTORY_SEP (p[2])))
1090 lose = 1;
1091 p++;
1093 if (!lose)
1095 #ifdef DOS_NT
1096 /* Make sure directories are all separated with /, but
1097 avoid allocation of a new string when not required. */
1098 dostounix_filename (nm);
1099 #ifdef WINDOWSNT
1100 if (IS_DIRECTORY_SEP (nm[1]))
1102 if (strcmp (nm, SSDATA (name)) != 0)
1103 name = make_specified_string (nm, -1, nmlim - nm, multibyte);
1105 else
1106 #endif
1107 /* Drive must be set, so this is okay. */
1108 if (strcmp (nm - 2, SSDATA (name)) != 0)
1110 char temp[] = " :";
1112 name = make_specified_string (nm, -1, p - nm, multibyte);
1113 temp[0] = DRIVE_LETTER (drive);
1114 AUTO_STRING (drive_prefix, temp);
1115 name = concat2 (drive_prefix, name);
1117 #ifdef WINDOWSNT
1118 if (!NILP (Vw32_downcase_file_names))
1119 name = Fdowncase (name);
1120 #endif
1121 #else /* not DOS_NT */
1122 if (strcmp (nm, SSDATA (name)) != 0)
1123 name = make_specified_string (nm, -1, nmlim - nm, multibyte);
1124 #endif /* not DOS_NT */
1125 SAFE_FREE ();
1126 return name;
1130 /* At this point, nm might or might not be an absolute file name. We
1131 need to expand ~ or ~user if present, otherwise prefix nm with
1132 default_directory if nm is not absolute, and finally collapse /./
1133 and /foo/../ sequences.
1135 We set newdir to be the appropriate prefix if one is needed:
1136 - the relevant user directory if nm starts with ~ or ~user
1137 - the specified drive's working dir (DOS/NT only) if nm does not
1138 start with /
1139 - the value of default_directory.
1141 Note that these prefixes are not guaranteed to be absolute (except
1142 for the working dir of a drive). Therefore, to ensure we always
1143 return an absolute name, if the final prefix is not absolute we
1144 append it to the current working directory. */
1146 newdir = newdirlim = 0;
1148 if (nm[0] == '~') /* prefix ~ */
1150 if (IS_DIRECTORY_SEP (nm[1])
1151 || nm[1] == 0) /* ~ by itself */
1153 Lisp_Object tem;
1155 if (!(newdir = egetenv ("HOME")))
1156 newdir = newdirlim = "";
1157 nm++;
1158 /* `egetenv' may return a unibyte string, which will bite us since
1159 we expect the directory to be multibyte. */
1160 #ifdef WINDOWSNT
1161 if (newdir[0])
1163 char newdir_utf8[MAX_UTF8_PATH];
1165 filename_from_ansi (newdir, newdir_utf8);
1166 tem = make_unibyte_string (newdir_utf8, strlen (newdir_utf8));
1168 else
1169 #endif
1170 tem = build_string (newdir);
1171 newdirlim = newdir + SBYTES (tem);
1172 if (multibyte && !STRING_MULTIBYTE (tem))
1174 hdir = DECODE_FILE (tem);
1175 newdir = SSDATA (hdir);
1176 newdirlim = newdir + SBYTES (hdir);
1178 #ifdef DOS_NT
1179 collapse_newdir = false;
1180 #endif
1182 else /* ~user/filename */
1184 char *o, *p;
1185 for (p = nm; *p && !IS_DIRECTORY_SEP (*p); p++)
1186 continue;
1187 o = SAFE_ALLOCA (p - nm + 1);
1188 memcpy (o, nm, p - nm);
1189 o[p - nm] = 0;
1191 block_input ();
1192 pw = getpwnam (o + 1);
1193 unblock_input ();
1194 if (pw)
1196 Lisp_Object tem;
1198 newdir = pw->pw_dir;
1199 /* `getpwnam' may return a unibyte string, which will
1200 bite us since we expect the directory to be
1201 multibyte. */
1202 tem = make_unibyte_string (newdir, strlen (newdir));
1203 newdirlim = newdir + SBYTES (tem);
1204 if (multibyte && !STRING_MULTIBYTE (tem))
1206 hdir = DECODE_FILE (tem);
1207 newdir = SSDATA (hdir);
1208 newdirlim = newdir + SBYTES (hdir);
1210 nm = p;
1211 #ifdef DOS_NT
1212 collapse_newdir = false;
1213 #endif
1216 /* If we don't find a user of that name, leave the name
1217 unchanged; don't move nm forward to p. */
1221 #ifdef DOS_NT
1222 /* On DOS and Windows, nm is absolute if a drive name was specified;
1223 use the drive's current directory as the prefix if needed. */
1224 if (!newdir && drive)
1226 /* Get default directory if needed to make nm absolute. */
1227 char *adir = NULL;
1228 if (!IS_DIRECTORY_SEP (nm[0]))
1230 adir = alloca (MAXPATHLEN + 1);
1231 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1232 adir = NULL;
1233 else if (multibyte)
1235 Lisp_Object tem = build_string (adir);
1237 tem = DECODE_FILE (tem);
1238 newdirlim = adir + SBYTES (tem);
1239 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1241 else
1242 newdirlim = adir + strlen (adir);
1244 if (!adir)
1246 /* Either nm starts with /, or drive isn't mounted. */
1247 adir = alloca (4);
1248 adir[0] = DRIVE_LETTER (drive);
1249 adir[1] = ':';
1250 adir[2] = '/';
1251 adir[3] = 0;
1252 newdirlim = adir + 3;
1254 newdir = adir;
1256 #endif /* DOS_NT */
1258 /* Finally, if no prefix has been specified and nm is not absolute,
1259 then it must be expanded relative to default_directory. */
1261 if (1
1262 #ifndef DOS_NT
1263 /* /... alone is not absolute on DOS and Windows. */
1264 && !IS_DIRECTORY_SEP (nm[0])
1265 #endif
1266 #ifdef WINDOWSNT
1267 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
1268 && !IS_DIRECTORY_SEP (nm[2]))
1269 #endif
1270 && !newdir)
1272 newdir = SSDATA (default_directory);
1273 newdirlim = newdir + SBYTES (default_directory);
1274 #ifdef DOS_NT
1275 /* Note if special escape prefix is present, but remove for now. */
1276 if (newdir[0] == '/' && newdir[1] == ':')
1278 is_escaped = 1;
1279 newdir += 2;
1281 #endif
1284 #ifdef DOS_NT
1285 if (newdir)
1287 /* First ensure newdir is an absolute name. */
1288 if (
1289 /* Detect MSDOS file names with drive specifiers. */
1290 ! (IS_DRIVE (newdir[0])
1291 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1292 #ifdef WINDOWSNT
1293 /* Detect Windows file names in UNC format. */
1294 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
1295 && !IS_DIRECTORY_SEP (newdir[2]))
1296 #endif
1299 /* Effectively, let newdir be (expand-file-name newdir cwd).
1300 Because of the admonition against calling expand-file-name
1301 when we have pointers into lisp strings, we accomplish this
1302 indirectly by prepending newdir to nm if necessary, and using
1303 cwd (or the wd of newdir's drive) as the new newdir. */
1304 char *adir;
1305 #ifdef WINDOWSNT
1306 const int adir_size = MAX_UTF8_PATH;
1307 #else
1308 const int adir_size = MAXPATHLEN + 1;
1309 #endif
1311 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1313 drive = (unsigned char) newdir[0];
1314 newdir += 2;
1316 if (!IS_DIRECTORY_SEP (nm[0]))
1318 ptrdiff_t nmlen = nmlim - nm;
1319 ptrdiff_t newdirlen = newdirlim - newdir;
1320 char *tmp = alloca (newdirlen + file_name_as_directory_slop
1321 + nmlen + 1);
1322 ptrdiff_t dlen = file_name_as_directory (tmp, newdir, newdirlen,
1323 multibyte);
1324 memcpy (tmp + dlen, nm, nmlen + 1);
1325 nm = tmp;
1326 nmlim = nm + dlen + nmlen;
1328 adir = alloca (adir_size);
1329 if (drive)
1331 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1332 strcpy (adir, "/");
1334 else
1335 getcwd (adir, adir_size);
1336 if (multibyte)
1338 Lisp_Object tem = build_string (adir);
1340 tem = DECODE_FILE (tem);
1341 newdirlim = adir + SBYTES (tem);
1342 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1344 else
1345 newdirlim = adir + strlen (adir);
1346 newdir = adir;
1349 /* Strip off drive name from prefix, if present. */
1350 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1352 drive = newdir[0];
1353 newdir += 2;
1356 /* Keep only a prefix from newdir if nm starts with slash
1357 (//server/share for UNC, nothing otherwise). */
1358 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1360 #ifdef WINDOWSNT
1361 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
1362 && !IS_DIRECTORY_SEP (newdir[2]))
1364 char *adir = strcpy (alloca (newdirlim - newdir + 1), newdir);
1365 char *p = adir + 2;
1366 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1367 p++;
1368 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1369 *p = 0;
1370 newdir = adir;
1371 newdirlim = newdir + strlen (adir);
1373 else
1374 #endif
1375 newdir = newdirlim = "";
1378 #endif /* DOS_NT */
1380 /* Ignore any slash at the end of newdir, unless newdir is
1381 just "/" or "//". */
1382 length = newdirlim - newdir;
1383 while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1384 && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0])))
1385 length--;
1387 /* Now concatenate the directory and name to new space in the stack frame. */
1388 tlen = length + file_name_as_directory_slop + (nmlim - nm) + 1;
1389 eassert (tlen > file_name_as_directory_slop + 1);
1390 #ifdef DOS_NT
1391 /* Reserve space for drive specifier and escape prefix, since either
1392 or both may need to be inserted. (The Microsoft x86 compiler
1393 produces incorrect code if the following two lines are combined.) */
1394 target = alloca (tlen + 4);
1395 target += 4;
1396 #else /* not DOS_NT */
1397 target = SAFE_ALLOCA (tlen);
1398 #endif /* not DOS_NT */
1399 *target = 0;
1400 nbytes = 0;
1402 if (newdir)
1404 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1406 #ifdef DOS_NT
1407 /* If newdir is effectively "C:/", then the drive letter will have
1408 been stripped and newdir will be "/". Concatenating with an
1409 absolute directory in nm produces "//", which will then be
1410 incorrectly treated as a network share. Ignore newdir in
1411 this case (keeping the drive letter). */
1412 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
1413 && newdir[1] == '\0'))
1414 #endif
1416 memcpy (target, newdir, length);
1417 target[length] = 0;
1418 nbytes = length;
1421 else
1422 nbytes = file_name_as_directory (target, newdir, length, multibyte);
1425 memcpy (target + nbytes, nm, nmlim - nm + 1);
1427 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1428 appear. */
1430 char *p = target;
1431 char *o = target;
1433 while (*p)
1435 if (!IS_DIRECTORY_SEP (*p))
1437 *o++ = *p++;
1439 else if (p[1] == '.'
1440 && (IS_DIRECTORY_SEP (p[2])
1441 || p[2] == 0))
1443 /* If "/." is the entire filename, keep the "/". Otherwise,
1444 just delete the whole "/.". */
1445 if (o == target && p[2] == '\0')
1446 *o++ = *p;
1447 p += 2;
1449 else if (p[1] == '.' && p[2] == '.'
1450 /* `/../' is the "superroot" on certain file systems.
1451 Turned off on DOS_NT systems because they have no
1452 "superroot" and because this causes us to produce
1453 file names like "d:/../foo" which fail file-related
1454 functions of the underlying OS. (To reproduce, try a
1455 long series of "../../" in default_directory, longer
1456 than the number of levels from the root.) */
1457 #ifndef DOS_NT
1458 && o != target
1459 #endif
1460 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1462 #ifdef WINDOWSNT
1463 char *prev_o = o;
1464 #endif
1465 while (o != target && (--o, !IS_DIRECTORY_SEP (*o)))
1466 continue;
1467 #ifdef WINDOWSNT
1468 /* Don't go below server level in UNC filenames. */
1469 if (o == target + 1 && IS_DIRECTORY_SEP (*o)
1470 && IS_DIRECTORY_SEP (*target))
1471 o = prev_o;
1472 else
1473 #endif
1474 /* Keep initial / only if this is the whole name. */
1475 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1476 ++o;
1477 p += 3;
1479 else if (IS_DIRECTORY_SEP (p[1])
1480 && (p != target || IS_DIRECTORY_SEP (p[2])))
1481 /* Collapse multiple "/", except leave leading "//" alone. */
1482 p++;
1483 else
1485 *o++ = *p++;
1489 #ifdef DOS_NT
1490 /* At last, set drive name. */
1491 #ifdef WINDOWSNT
1492 /* Except for network file name. */
1493 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
1494 #endif /* WINDOWSNT */
1496 if (!drive) emacs_abort ();
1497 target -= 2;
1498 target[0] = DRIVE_LETTER (drive);
1499 target[1] = ':';
1501 /* Reinsert the escape prefix if required. */
1502 if (is_escaped)
1504 target -= 2;
1505 target[0] = '/';
1506 target[1] = ':';
1508 result = make_specified_string (target, -1, o - target, multibyte);
1509 dostounix_filename (SSDATA (result));
1510 #ifdef WINDOWSNT
1511 if (!NILP (Vw32_downcase_file_names))
1512 result = Fdowncase (result);
1513 #endif
1514 #else /* !DOS_NT */
1515 result = make_specified_string (target, -1, o - target, multibyte);
1516 #endif /* !DOS_NT */
1519 /* Again look to see if the file name has special constructs in it
1520 and perhaps call the corresponding file handler. This is needed
1521 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1522 the ".." component gives us "/user@host:/bar/../baz" which needs
1523 to be expanded again. */
1524 handler = Ffind_file_name_handler (result, Qexpand_file_name);
1525 if (!NILP (handler))
1527 handled_name = call3 (handler, Qexpand_file_name,
1528 result, default_directory);
1529 if (! STRINGP (handled_name))
1530 error ("Invalid handler in `file-name-handler-alist'");
1531 result = handled_name;
1534 SAFE_FREE ();
1535 return result;
1538 #if 0
1539 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1540 This is the old version of expand-file-name, before it was thoroughly
1541 rewritten for Emacs 10.31. We leave this version here commented-out,
1542 because the code is very complex and likely to have subtle bugs. If
1543 bugs _are_ found, it might be of interest to look at the old code and
1544 see what did it do in the relevant situation.
1546 Don't remove this code: it's true that it will be accessible
1547 from the repository, but a few years from deletion, people will
1548 forget it is there. */
1550 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1551 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1552 "Convert FILENAME to absolute, and canonicalize it.\n\
1553 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1554 \(does not start with slash); if DEFAULT is nil or missing,\n\
1555 the current buffer's value of default-directory is used.\n\
1556 Filenames containing `.' or `..' as components are simplified;\n\
1557 initial `~/' expands to your home directory.\n\
1558 See also the function `substitute-in-file-name'.")
1559 (name, defalt)
1560 Lisp_Object name, defalt;
1562 unsigned char *nm;
1564 register unsigned char *newdir, *p, *o;
1565 ptrdiff_t tlen;
1566 unsigned char *target;
1567 struct passwd *pw;
1569 CHECK_STRING (name);
1570 nm = SDATA (name);
1572 /* If nm is absolute, flush ...// and detect /./ and /../.
1573 If no /./ or /../ we can return right away. */
1574 if (nm[0] == '/')
1576 bool lose = 0;
1577 p = nm;
1578 while (*p)
1580 if (p[0] == '/' && p[1] == '/')
1581 nm = p + 1;
1582 if (p[0] == '/' && p[1] == '~')
1583 nm = p + 1, lose = 1;
1584 if (p[0] == '/' && p[1] == '.'
1585 && (p[2] == '/' || p[2] == 0
1586 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
1587 lose = 1;
1588 p++;
1590 if (!lose)
1592 if (nm == SDATA (name))
1593 return name;
1594 return build_string (nm);
1598 /* Now determine directory to start with and put it in NEWDIR. */
1600 newdir = 0;
1602 if (nm[0] == '~') /* prefix ~ */
1603 if (nm[1] == '/' || nm[1] == 0)/* ~/filename */
1605 if (!(newdir = (unsigned char *) egetenv ("HOME")))
1606 newdir = (unsigned char *) "";
1607 nm++;
1609 else /* ~user/filename */
1611 /* Get past ~ to user. */
1612 unsigned char *user = nm + 1;
1613 /* Find end of name. */
1614 unsigned char *ptr = (unsigned char *) strchr (user, '/');
1615 ptrdiff_t len = ptr ? ptr - user : strlen (user);
1616 /* Copy the user name into temp storage. */
1617 o = alloca (len + 1);
1618 memcpy (o, user, len);
1619 o[len] = 0;
1621 /* Look up the user name. */
1622 block_input ();
1623 pw = (struct passwd *) getpwnam (o + 1);
1624 unblock_input ();
1625 if (!pw)
1626 error ("\"%s\" isn't a registered user", o + 1);
1628 newdir = (unsigned char *) pw->pw_dir;
1630 /* Discard the user name from NM. */
1631 nm += len;
1634 if (nm[0] != '/' && !newdir)
1636 if (NILP (defalt))
1637 defalt = current_buffer->directory;
1638 CHECK_STRING (defalt);
1639 newdir = SDATA (defalt);
1642 /* Now concatenate the directory and name to new space in the stack frame. */
1644 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
1645 target = alloca (tlen);
1646 *target = 0;
1648 if (newdir)
1650 if (nm[0] == 0 || nm[0] == '/')
1651 strcpy (target, newdir);
1652 else
1653 file_name_as_directory (target, newdir);
1656 strcat (target, nm);
1658 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1660 p = target;
1661 o = target;
1663 while (*p)
1665 if (*p != '/')
1667 *o++ = *p++;
1669 else if (!strncmp (p, "//", 2)
1672 o = target;
1673 p++;
1675 else if (p[0] == '/' && p[1] == '.'
1676 && (p[2] == '/' || p[2] == 0))
1677 p += 2;
1678 else if (!strncmp (p, "/..", 3)
1679 /* `/../' is the "superroot" on certain file systems. */
1680 && o != target
1681 && (p[3] == '/' || p[3] == 0))
1683 while (o != target && *--o != '/')
1685 if (o == target && *o == '/')
1686 ++o;
1687 p += 3;
1689 else
1691 *o++ = *p++;
1695 return make_string (target, o - target);
1697 #endif
1699 /* If /~ or // appears, discard everything through first slash. */
1700 static bool
1701 file_name_absolute_p (const char *filename)
1703 return
1704 (IS_DIRECTORY_SEP (*filename) || *filename == '~'
1705 #ifdef DOS_NT
1706 || (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
1707 && IS_DIRECTORY_SEP (filename[2]))
1708 #endif
1712 static char *
1713 search_embedded_absfilename (char *nm, char *endp)
1715 char *p, *s;
1717 for (p = nm + 1; p < endp; p++)
1719 if (IS_DIRECTORY_SEP (p[-1])
1720 && file_name_absolute_p (p)
1721 #if defined (WINDOWSNT) || defined (CYGWIN)
1722 /* // at start of file name is meaningful in Apollo,
1723 WindowsNT and Cygwin systems. */
1724 && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
1725 #endif /* not (WINDOWSNT || CYGWIN) */
1728 for (s = p; *s && !IS_DIRECTORY_SEP (*s); s++);
1729 if (p[0] == '~' && s > p + 1) /* We've got "/~something/". */
1731 USE_SAFE_ALLOCA;
1732 char *o = SAFE_ALLOCA (s - p + 1);
1733 struct passwd *pw;
1734 memcpy (o, p, s - p);
1735 o [s - p] = 0;
1737 /* If we have ~user and `user' exists, discard
1738 everything up to ~. But if `user' does not exist, leave
1739 ~user alone, it might be a literal file name. */
1740 block_input ();
1741 pw = getpwnam (o + 1);
1742 unblock_input ();
1743 SAFE_FREE ();
1744 if (pw)
1745 return p;
1747 else
1748 return p;
1751 return NULL;
1754 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
1755 Ssubstitute_in_file_name, 1, 1, 0,
1756 doc: /* Substitute environment variables referred to in FILENAME.
1757 `$FOO' where FOO is an environment variable name means to substitute
1758 the value of that variable. The variable name should be terminated
1759 with a character not a letter, digit or underscore; otherwise, enclose
1760 the entire variable name in braces.
1762 If `/~' appears, all of FILENAME through that `/' is discarded.
1763 If `//' appears, everything up to and including the first of
1764 those `/' is discarded. */)
1765 (Lisp_Object filename)
1767 char *nm, *p, *x, *endp;
1768 bool substituted = false;
1769 bool multibyte;
1770 char *xnm;
1771 Lisp_Object handler;
1773 CHECK_STRING (filename);
1775 multibyte = STRING_MULTIBYTE (filename);
1777 /* If the file name has special constructs in it,
1778 call the corresponding file handler. */
1779 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
1780 if (!NILP (handler))
1782 Lisp_Object handled_name = call2 (handler, Qsubstitute_in_file_name,
1783 filename);
1784 if (STRINGP (handled_name))
1785 return handled_name;
1786 error ("Invalid handler in `file-name-handler-alist'");
1789 /* Always work on a copy of the string, in case GC happens during
1790 decode of environment variables, causing the original Lisp_String
1791 data to be relocated. */
1792 USE_SAFE_ALLOCA;
1793 SAFE_ALLOCA_STRING (nm, filename);
1795 #ifdef DOS_NT
1796 dostounix_filename (nm);
1797 substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
1798 #endif
1799 endp = nm + SBYTES (filename);
1801 /* If /~ or // appears, discard everything through first slash. */
1802 p = search_embedded_absfilename (nm, endp);
1803 if (p)
1804 /* Start over with the new string, so we check the file-name-handler
1805 again. Important with filenames like "/home/foo//:/hello///there"
1806 which would substitute to "/:/hello///there" rather than "/there". */
1808 Lisp_Object result
1809 = (Fsubstitute_in_file_name
1810 (make_specified_string (p, -1, endp - p, multibyte)));
1811 SAFE_FREE ();
1812 return result;
1815 /* See if any variables are substituted into the string. */
1817 if (!NILP (Ffboundp (Qsubstitute_env_in_file_name)))
1819 Lisp_Object name
1820 = (!substituted ? filename
1821 : make_specified_string (nm, -1, endp - nm, multibyte));
1822 Lisp_Object tmp = call1 (Qsubstitute_env_in_file_name, name);
1823 CHECK_STRING (tmp);
1824 if (!EQ (tmp, name))
1825 substituted = true;
1826 filename = tmp;
1829 if (!substituted)
1831 #ifdef WINDOWSNT
1832 if (!NILP (Vw32_downcase_file_names))
1833 filename = Fdowncase (filename);
1834 #endif
1835 SAFE_FREE ();
1836 return filename;
1839 xnm = SSDATA (filename);
1840 x = xnm + SBYTES (filename);
1842 /* If /~ or // appears, discard everything through first slash. */
1843 while ((p = search_embedded_absfilename (xnm, x)) != NULL)
1844 /* This time we do not start over because we've already expanded envvars
1845 and replaced $$ with $. Maybe we should start over as well, but we'd
1846 need to quote some $ to $$ first. */
1847 xnm = p;
1849 #ifdef WINDOWSNT
1850 if (!NILP (Vw32_downcase_file_names))
1852 Lisp_Object xname = make_specified_string (xnm, -1, x - xnm, multibyte);
1854 filename = Fdowncase (xname);
1856 else
1857 #endif
1858 if (xnm != SSDATA (filename))
1859 filename = make_specified_string (xnm, -1, x - xnm, multibyte);
1860 SAFE_FREE ();
1861 return filename;
1864 /* A slightly faster and more convenient way to get
1865 (directory-file-name (expand-file-name FOO)). */
1867 Lisp_Object
1868 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1870 register Lisp_Object absname;
1872 absname = Fexpand_file_name (filename, defdir);
1874 /* Remove final slash, if any (unless this is the root dir).
1875 stat behaves differently depending! */
1876 if (SCHARS (absname) > 1
1877 && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
1878 && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2)))
1879 /* We cannot take shortcuts; they might be wrong for magic file names. */
1880 absname = Fdirectory_file_name (absname);
1881 return absname;
1884 /* Signal an error if the file ABSNAME already exists.
1885 If KNOWN_TO_EXIST, the file is known to exist.
1886 QUERYSTRING is a name for the action that is being considered
1887 to alter the file.
1888 If INTERACTIVE, ask the user whether to proceed,
1889 and bypass the error if the user says to go ahead.
1890 If QUICK, ask for y or n, not yes or no. */
1892 static void
1893 barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist,
1894 const char *querystring, bool interactive,
1895 bool quick)
1897 Lisp_Object tem, encoded_filename;
1898 struct stat statbuf;
1899 struct gcpro gcpro1;
1901 encoded_filename = ENCODE_FILE (absname);
1903 if (! known_to_exist && lstat (SSDATA (encoded_filename), &statbuf) == 0)
1905 if (S_ISDIR (statbuf.st_mode))
1906 xsignal2 (Qfile_error,
1907 build_string ("File is a directory"), absname);
1908 known_to_exist = true;
1911 if (known_to_exist)
1913 if (! interactive)
1914 xsignal2 (Qfile_already_exists,
1915 build_string ("File already exists"), absname);
1916 GCPRO1 (absname);
1917 tem = format2 ("File %s already exists; %s anyway? ",
1918 absname, build_string (querystring));
1919 if (quick)
1920 tem = call1 (intern ("y-or-n-p"), tem);
1921 else
1922 tem = do_yes_or_no_p (tem);
1923 UNGCPRO;
1924 if (NILP (tem))
1925 xsignal2 (Qfile_already_exists,
1926 build_string ("File already exists"), absname);
1930 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
1931 "fCopy file: \nGCopy %s to file: \np\nP",
1932 doc: /* Copy FILE to NEWNAME. Both args must be strings.
1933 If NEWNAME names a directory, copy FILE there.
1935 This function always sets the file modes of the output file to match
1936 the input file.
1938 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1939 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1940 signal a `file-already-exists' error without overwriting. If
1941 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1942 about overwriting; this is what happens in interactive use with M-x.
1943 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1944 existing file.
1946 Fourth arg KEEP-TIME non-nil means give the output file the same
1947 last-modified time as the old one. (This works on only some systems.)
1949 A prefix arg makes KEEP-TIME non-nil.
1951 If PRESERVE-UID-GID is non-nil, we try to transfer the
1952 uid and gid of FILE to NEWNAME.
1954 If PRESERVE-PERMISSIONS is non-nil, copy permissions of FILE to NEWNAME;
1955 this includes the file modes, along with ACL entries and SELinux
1956 context if present. Otherwise, if NEWNAME is created its file
1957 permission bits are those of FILE, masked by the default file
1958 permissions. */)
1959 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists,
1960 Lisp_Object keep_time, Lisp_Object preserve_uid_gid,
1961 Lisp_Object preserve_permissions)
1963 Lisp_Object handler;
1964 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1965 ptrdiff_t count = SPECPDL_INDEX ();
1966 Lisp_Object encoded_file, encoded_newname;
1967 #if HAVE_LIBSELINUX
1968 security_context_t con;
1969 int conlength = 0;
1970 #endif
1971 #ifdef WINDOWSNT
1972 int result;
1973 #else
1974 bool already_exists = false;
1975 mode_t new_mask;
1976 int ifd, ofd;
1977 int n;
1978 char buf[16 * 1024];
1979 struct stat st;
1980 #endif
1982 encoded_file = encoded_newname = Qnil;
1983 GCPRO4 (file, newname, encoded_file, encoded_newname);
1984 CHECK_STRING (file);
1985 CHECK_STRING (newname);
1987 if (!NILP (Ffile_directory_p (newname)))
1988 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
1989 else
1990 newname = Fexpand_file_name (newname, Qnil);
1992 file = Fexpand_file_name (file, Qnil);
1994 /* If the input file name has special constructs in it,
1995 call the corresponding file handler. */
1996 handler = Ffind_file_name_handler (file, Qcopy_file);
1997 /* Likewise for output file name. */
1998 if (NILP (handler))
1999 handler = Ffind_file_name_handler (newname, Qcopy_file);
2000 if (!NILP (handler))
2001 RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname,
2002 ok_if_already_exists, keep_time, preserve_uid_gid,
2003 preserve_permissions));
2005 encoded_file = ENCODE_FILE (file);
2006 encoded_newname = ENCODE_FILE (newname);
2008 #ifdef WINDOWSNT
2009 if (NILP (ok_if_already_exists)
2010 || INTEGERP (ok_if_already_exists))
2011 barf_or_query_if_file_exists (newname, false, "copy to it",
2012 INTEGERP (ok_if_already_exists), false);
2014 result = w32_copy_file (SSDATA (encoded_file), SSDATA (encoded_newname),
2015 !NILP (keep_time), !NILP (preserve_uid_gid),
2016 !NILP (preserve_permissions));
2017 switch (result)
2019 case -1:
2020 report_file_error ("Copying file", list2 (file, newname));
2021 case -2:
2022 report_file_error ("Copying permissions from", file);
2023 case -3:
2024 xsignal2 (Qfile_date_error,
2025 build_string ("Resetting file times"), newname);
2026 case -4:
2027 report_file_error ("Copying permissions to", newname);
2029 #else /* not WINDOWSNT */
2030 immediate_quit = 1;
2031 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
2032 immediate_quit = 0;
2034 if (ifd < 0)
2035 report_file_error ("Opening input file", file);
2037 record_unwind_protect_int (close_file_unwind, ifd);
2039 if (fstat (ifd, &st) != 0)
2040 report_file_error ("Input file status", file);
2042 if (!NILP (preserve_permissions))
2044 #if HAVE_LIBSELINUX
2045 if (is_selinux_enabled ())
2047 conlength = fgetfilecon (ifd, &con);
2048 if (conlength == -1)
2049 report_file_error ("Doing fgetfilecon", file);
2051 #endif
2054 /* We can copy only regular files. */
2055 if (!S_ISREG (st.st_mode))
2056 report_file_errno ("Non-regular file", file,
2057 S_ISDIR (st.st_mode) ? EISDIR : EINVAL);
2059 #ifndef MSDOS
2060 new_mask = st.st_mode & (!NILP (preserve_uid_gid) ? 0700 : 0777);
2061 #else
2062 new_mask = S_IREAD | S_IWRITE;
2063 #endif
2065 ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY | O_CREAT | O_EXCL,
2066 new_mask);
2067 if (ofd < 0 && errno == EEXIST)
2069 if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists))
2070 barf_or_query_if_file_exists (newname, true, "copy to it",
2071 INTEGERP (ok_if_already_exists), false);
2072 already_exists = true;
2073 ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY, 0);
2075 if (ofd < 0)
2076 report_file_error ("Opening output file", newname);
2078 record_unwind_protect_int (close_file_unwind, ofd);
2080 if (already_exists)
2082 struct stat out_st;
2083 if (fstat (ofd, &out_st) != 0)
2084 report_file_error ("Output file status", newname);
2085 if (st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
2086 report_file_errno ("Input and output files are the same",
2087 list2 (file, newname), 0);
2088 if (ftruncate (ofd, 0) != 0)
2089 report_file_error ("Truncating output file", newname);
2092 immediate_quit = 1;
2093 QUIT;
2094 while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
2095 if (emacs_write_sig (ofd, buf, n) != n)
2096 report_file_error ("Write error", newname);
2097 immediate_quit = 0;
2099 #ifndef MSDOS
2100 /* Preserve the original file permissions, and if requested, also its
2101 owner and group. */
2103 mode_t preserved_permissions = st.st_mode & 07777;
2104 mode_t default_permissions = st.st_mode & 0777 & ~realmask;
2105 if (!NILP (preserve_uid_gid))
2107 /* Attempt to change owner and group. If that doesn't work
2108 attempt to change just the group, as that is sometimes allowed.
2109 Adjust the mode mask to eliminate setuid or setgid bits
2110 or group permissions bits that are inappropriate if the
2111 owner or group are wrong. */
2112 if (fchown (ofd, st.st_uid, st.st_gid) != 0)
2114 if (fchown (ofd, -1, st.st_gid) == 0)
2115 preserved_permissions &= ~04000;
2116 else
2118 preserved_permissions &= ~06000;
2120 /* Copy the other bits to the group bits, since the
2121 group is wrong. */
2122 preserved_permissions &= ~070;
2123 preserved_permissions |= (preserved_permissions & 7) << 3;
2124 default_permissions &= ~070;
2125 default_permissions |= (default_permissions & 7) << 3;
2130 switch (!NILP (preserve_permissions)
2131 ? qcopy_acl (SSDATA (encoded_file), ifd,
2132 SSDATA (encoded_newname), ofd,
2133 preserved_permissions)
2134 : (already_exists
2135 || (new_mask & ~realmask) == default_permissions)
2137 : fchmod (ofd, default_permissions))
2139 case -2: report_file_error ("Copying permissions from", file);
2140 case -1: report_file_error ("Copying permissions to", newname);
2143 #endif /* not MSDOS */
2145 #if HAVE_LIBSELINUX
2146 if (conlength > 0)
2148 /* Set the modified context back to the file. */
2149 bool fail = fsetfilecon (ofd, con) != 0;
2150 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2151 if (fail && errno != ENOTSUP)
2152 report_file_error ("Doing fsetfilecon", newname);
2154 freecon (con);
2156 #endif
2158 if (!NILP (keep_time))
2160 struct timespec atime = get_stat_atime (&st);
2161 struct timespec mtime = get_stat_mtime (&st);
2162 if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime) != 0)
2163 xsignal2 (Qfile_date_error,
2164 build_string ("Cannot set file date"), newname);
2167 if (emacs_close (ofd) < 0)
2168 report_file_error ("Write error", newname);
2170 emacs_close (ifd);
2172 #ifdef MSDOS
2173 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2174 and if it can't, it tells so. Otherwise, under MSDOS we usually
2175 get only the READ bit, which will make the copied file read-only,
2176 so it's better not to chmod at all. */
2177 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
2178 chmod (SDATA (encoded_newname), st.st_mode & 07777);
2179 #endif /* MSDOS */
2180 #endif /* not WINDOWSNT */
2182 /* Discard the unwind protects. */
2183 specpdl_ptr = specpdl + count;
2185 UNGCPRO;
2186 return Qnil;
2189 DEFUN ("make-directory-internal", Fmake_directory_internal,
2190 Smake_directory_internal, 1, 1, 0,
2191 doc: /* Create a new directory named DIRECTORY. */)
2192 (Lisp_Object directory)
2194 const char *dir;
2195 Lisp_Object handler;
2196 Lisp_Object encoded_dir;
2198 CHECK_STRING (directory);
2199 directory = Fexpand_file_name (directory, Qnil);
2201 handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
2202 if (!NILP (handler))
2203 return call2 (handler, Qmake_directory_internal, directory);
2205 encoded_dir = ENCODE_FILE (directory);
2207 dir = SSDATA (encoded_dir);
2209 #ifdef WINDOWSNT
2210 if (mkdir (dir) != 0)
2211 #else
2212 if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
2213 #endif
2214 report_file_error ("Creating directory", directory);
2216 return Qnil;
2219 DEFUN ("delete-directory-internal", Fdelete_directory_internal,
2220 Sdelete_directory_internal, 1, 1, 0,
2221 doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2222 (Lisp_Object directory)
2224 const char *dir;
2225 Lisp_Object encoded_dir;
2227 CHECK_STRING (directory);
2228 directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
2229 encoded_dir = ENCODE_FILE (directory);
2230 dir = SSDATA (encoded_dir);
2232 if (rmdir (dir) != 0)
2233 report_file_error ("Removing directory", directory);
2235 return Qnil;
2238 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 2,
2239 "(list (read-file-name \
2240 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2241 \"Move file to trash: \" \"Delete file: \") \
2242 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2243 (null current-prefix-arg))",
2244 doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2245 If file has multiple names, it continues to exist with the other names.
2246 TRASH non-nil means to trash the file instead of deleting, provided
2247 `delete-by-moving-to-trash' is non-nil.
2249 When called interactively, TRASH is t if no prefix argument is given.
2250 With a prefix argument, TRASH is nil. */)
2251 (Lisp_Object filename, Lisp_Object trash)
2253 Lisp_Object handler;
2254 Lisp_Object encoded_file;
2255 struct gcpro gcpro1;
2257 GCPRO1 (filename);
2258 if (!NILP (Ffile_directory_p (filename))
2259 && NILP (Ffile_symlink_p (filename)))
2260 xsignal2 (Qfile_error,
2261 build_string ("Removing old name: is a directory"),
2262 filename);
2263 UNGCPRO;
2264 filename = Fexpand_file_name (filename, Qnil);
2266 handler = Ffind_file_name_handler (filename, Qdelete_file);
2267 if (!NILP (handler))
2268 return call3 (handler, Qdelete_file, filename, trash);
2270 if (delete_by_moving_to_trash && !NILP (trash))
2271 return call1 (Qmove_file_to_trash, filename);
2273 encoded_file = ENCODE_FILE (filename);
2275 if (unlink (SSDATA (encoded_file)) < 0)
2276 report_file_error ("Removing old name", filename);
2277 return Qnil;
2280 static Lisp_Object
2281 internal_delete_file_1 (Lisp_Object ignore)
2283 return Qt;
2286 /* Delete file FILENAME, returning true if successful.
2287 This ignores `delete-by-moving-to-trash'. */
2289 bool
2290 internal_delete_file (Lisp_Object filename)
2292 Lisp_Object tem;
2294 tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
2295 Qt, internal_delete_file_1);
2296 return NILP (tem);
2299 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
2300 "fRename file: \nGRename %s to file: \np",
2301 doc: /* Rename FILE as NEWNAME. Both args must be strings.
2302 If file has names other than FILE, it continues to have those names.
2303 Signals a `file-already-exists' error if a file NEWNAME already exists
2304 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2305 A number as third arg means request confirmation if NEWNAME already exists.
2306 This is what happens in interactive use with M-x. */)
2307 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2309 Lisp_Object handler;
2310 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2311 Lisp_Object encoded_file, encoded_newname, symlink_target;
2313 symlink_target = encoded_file = encoded_newname = Qnil;
2314 GCPRO5 (file, newname, encoded_file, encoded_newname, symlink_target);
2315 CHECK_STRING (file);
2316 CHECK_STRING (newname);
2317 file = Fexpand_file_name (file, Qnil);
2319 if ((!NILP (Ffile_directory_p (newname)))
2320 #ifdef DOS_NT
2321 /* If the file names are identical but for the case,
2322 don't attempt to move directory to itself. */
2323 && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
2324 #endif
2327 Lisp_Object fname = (NILP (Ffile_directory_p (file))
2328 ? file : Fdirectory_file_name (file));
2329 newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname);
2331 else
2332 newname = Fexpand_file_name (newname, Qnil);
2334 /* If the file name has special constructs in it,
2335 call the corresponding file handler. */
2336 handler = Ffind_file_name_handler (file, Qrename_file);
2337 if (NILP (handler))
2338 handler = Ffind_file_name_handler (newname, Qrename_file);
2339 if (!NILP (handler))
2340 RETURN_UNGCPRO (call4 (handler, Qrename_file,
2341 file, newname, ok_if_already_exists));
2343 encoded_file = ENCODE_FILE (file);
2344 encoded_newname = ENCODE_FILE (newname);
2346 #ifdef DOS_NT
2347 /* If the file names are identical but for the case, don't ask for
2348 confirmation: they simply want to change the letter-case of the
2349 file name. */
2350 if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
2351 #endif
2352 if (NILP (ok_if_already_exists)
2353 || INTEGERP (ok_if_already_exists))
2354 barf_or_query_if_file_exists (newname, false, "rename to it",
2355 INTEGERP (ok_if_already_exists), false);
2356 if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
2358 int rename_errno = errno;
2359 if (rename_errno == EXDEV)
2361 ptrdiff_t count;
2362 symlink_target = Ffile_symlink_p (file);
2363 if (! NILP (symlink_target))
2364 Fmake_symbolic_link (symlink_target, newname,
2365 NILP (ok_if_already_exists) ? Qnil : Qt);
2366 else if (!NILP (Ffile_directory_p (file)))
2367 call4 (Qcopy_directory, file, newname, Qt, Qnil);
2368 else
2369 /* We have already prompted if it was an integer, so don't
2370 have copy-file prompt again. */
2371 Fcopy_file (file, newname,
2372 NILP (ok_if_already_exists) ? Qnil : Qt,
2373 Qt, Qt, Qt);
2375 count = SPECPDL_INDEX ();
2376 specbind (Qdelete_by_moving_to_trash, Qnil);
2378 if (!NILP (Ffile_directory_p (file)) && NILP (symlink_target))
2379 call2 (Qdelete_directory, file, Qt);
2380 else
2381 Fdelete_file (file, Qnil);
2382 unbind_to (count, Qnil);
2384 else
2385 report_file_errno ("Renaming", list2 (file, newname), rename_errno);
2387 UNGCPRO;
2388 return Qnil;
2391 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
2392 "fAdd name to file: \nGName to add to %s: \np",
2393 doc: /* Give FILE additional name NEWNAME. Both args must be strings.
2394 Signals a `file-already-exists' error if a file NEWNAME already exists
2395 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2396 A number as third arg means request confirmation if NEWNAME already exists.
2397 This is what happens in interactive use with M-x. */)
2398 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2400 Lisp_Object handler;
2401 Lisp_Object encoded_file, encoded_newname;
2402 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2404 GCPRO4 (file, newname, encoded_file, encoded_newname);
2405 encoded_file = encoded_newname = Qnil;
2406 CHECK_STRING (file);
2407 CHECK_STRING (newname);
2408 file = Fexpand_file_name (file, Qnil);
2410 if (!NILP (Ffile_directory_p (newname)))
2411 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
2412 else
2413 newname = Fexpand_file_name (newname, Qnil);
2415 /* If the file name has special constructs in it,
2416 call the corresponding file handler. */
2417 handler = Ffind_file_name_handler (file, Qadd_name_to_file);
2418 if (!NILP (handler))
2419 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
2420 newname, ok_if_already_exists));
2422 /* If the new name has special constructs in it,
2423 call the corresponding file handler. */
2424 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2425 if (!NILP (handler))
2426 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
2427 newname, ok_if_already_exists));
2429 encoded_file = ENCODE_FILE (file);
2430 encoded_newname = ENCODE_FILE (newname);
2432 if (NILP (ok_if_already_exists)
2433 || INTEGERP (ok_if_already_exists))
2434 barf_or_query_if_file_exists (newname, false, "make it a new name",
2435 INTEGERP (ok_if_already_exists), false);
2437 unlink (SSDATA (newname));
2438 if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
2440 int link_errno = errno;
2441 report_file_errno ("Adding new name", list2 (file, newname), link_errno);
2444 UNGCPRO;
2445 return Qnil;
2448 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
2449 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2450 doc: /* Make a symbolic link to FILENAME, named LINKNAME.
2451 Both args must be strings.
2452 Signals a `file-already-exists' error if a file LINKNAME already exists
2453 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2454 A number as third arg means request confirmation if LINKNAME already exists.
2455 This happens for interactive use with M-x. */)
2456 (Lisp_Object filename, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
2458 Lisp_Object handler;
2459 Lisp_Object encoded_filename, encoded_linkname;
2460 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2462 GCPRO4 (filename, linkname, encoded_filename, encoded_linkname);
2463 encoded_filename = encoded_linkname = Qnil;
2464 CHECK_STRING (filename);
2465 CHECK_STRING (linkname);
2466 /* If the link target has a ~, we must expand it to get
2467 a truly valid file name. Otherwise, do not expand;
2468 we want to permit links to relative file names. */
2469 if (SREF (filename, 0) == '~')
2470 filename = Fexpand_file_name (filename, Qnil);
2472 if (!NILP (Ffile_directory_p (linkname)))
2473 linkname = Fexpand_file_name (Ffile_name_nondirectory (filename), linkname);
2474 else
2475 linkname = Fexpand_file_name (linkname, Qnil);
2477 /* If the file name has special constructs in it,
2478 call the corresponding file handler. */
2479 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2480 if (!NILP (handler))
2481 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2482 linkname, ok_if_already_exists));
2484 /* If the new link name has special constructs in it,
2485 call the corresponding file handler. */
2486 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2487 if (!NILP (handler))
2488 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2489 linkname, ok_if_already_exists));
2491 encoded_filename = ENCODE_FILE (filename);
2492 encoded_linkname = ENCODE_FILE (linkname);
2494 if (NILP (ok_if_already_exists)
2495 || INTEGERP (ok_if_already_exists))
2496 barf_or_query_if_file_exists (linkname, false, "make it a link",
2497 INTEGERP (ok_if_already_exists), false);
2498 if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname)) < 0)
2500 /* If we didn't complain already, silently delete existing file. */
2501 int symlink_errno;
2502 if (errno == EEXIST)
2504 unlink (SSDATA (encoded_linkname));
2505 if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname))
2506 >= 0)
2508 UNGCPRO;
2509 return Qnil;
2512 if (errno == ENOSYS)
2514 UNGCPRO;
2515 xsignal1 (Qfile_error,
2516 build_string ("Symbolic links are not supported"));
2519 symlink_errno = errno;
2520 report_file_errno ("Making symbolic link", list2 (filename, linkname),
2521 symlink_errno);
2523 UNGCPRO;
2524 return Qnil;
2528 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
2529 1, 1, 0,
2530 doc: /* Return t if file FILENAME specifies an absolute file name.
2531 On Unix, this is a name starting with a `/' or a `~'. */)
2532 (Lisp_Object filename)
2534 CHECK_STRING (filename);
2535 return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
2538 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
2539 doc: /* Return t if file FILENAME exists (whether or not you can read it.)
2540 See also `file-readable-p' and `file-attributes'.
2541 This returns nil for a symlink to a nonexistent file.
2542 Use `file-symlink-p' to test for such links. */)
2543 (Lisp_Object filename)
2545 Lisp_Object absname;
2546 Lisp_Object handler;
2548 CHECK_STRING (filename);
2549 absname = Fexpand_file_name (filename, Qnil);
2551 /* If the file name has special constructs in it,
2552 call the corresponding file handler. */
2553 handler = Ffind_file_name_handler (absname, Qfile_exists_p);
2554 if (!NILP (handler))
2556 Lisp_Object result = call2 (handler, Qfile_exists_p, absname);
2557 errno = 0;
2558 return result;
2561 absname = ENCODE_FILE (absname);
2563 return check_existing (SSDATA (absname)) ? Qt : Qnil;
2566 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
2567 doc: /* Return t if FILENAME can be executed by you.
2568 For a directory, this means you can access files in that directory.
2569 \(It is generally better to use `file-accessible-directory-p' for that
2570 purpose, though.) */)
2571 (Lisp_Object filename)
2573 Lisp_Object absname;
2574 Lisp_Object handler;
2576 CHECK_STRING (filename);
2577 absname = Fexpand_file_name (filename, Qnil);
2579 /* If the file name has special constructs in it,
2580 call the corresponding file handler. */
2581 handler = Ffind_file_name_handler (absname, Qfile_executable_p);
2582 if (!NILP (handler))
2583 return call2 (handler, Qfile_executable_p, absname);
2585 absname = ENCODE_FILE (absname);
2587 return (check_executable (SSDATA (absname)) ? Qt : Qnil);
2590 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
2591 doc: /* Return t if file FILENAME exists and you can read it.
2592 See also `file-exists-p' and `file-attributes'. */)
2593 (Lisp_Object filename)
2595 Lisp_Object absname;
2596 Lisp_Object handler;
2598 CHECK_STRING (filename);
2599 absname = Fexpand_file_name (filename, Qnil);
2601 /* If the file name has special constructs in it,
2602 call the corresponding file handler. */
2603 handler = Ffind_file_name_handler (absname, Qfile_readable_p);
2604 if (!NILP (handler))
2605 return call2 (handler, Qfile_readable_p, absname);
2607 absname = ENCODE_FILE (absname);
2608 return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0
2609 ? Qt : Qnil);
2612 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2613 doc: /* Return t if file FILENAME can be written or created by you. */)
2614 (Lisp_Object filename)
2616 Lisp_Object absname, dir, encoded;
2617 Lisp_Object handler;
2619 CHECK_STRING (filename);
2620 absname = Fexpand_file_name (filename, Qnil);
2622 /* If the file name has special constructs in it,
2623 call the corresponding file handler. */
2624 handler = Ffind_file_name_handler (absname, Qfile_writable_p);
2625 if (!NILP (handler))
2626 return call2 (handler, Qfile_writable_p, absname);
2628 encoded = ENCODE_FILE (absname);
2629 if (check_writable (SSDATA (encoded), W_OK))
2630 return Qt;
2631 if (errno != ENOENT)
2632 return Qnil;
2634 dir = Ffile_name_directory (absname);
2635 eassert (!NILP (dir));
2636 #ifdef MSDOS
2637 dir = Fdirectory_file_name (dir);
2638 #endif /* MSDOS */
2640 dir = ENCODE_FILE (dir);
2641 #ifdef WINDOWSNT
2642 /* The read-only attribute of the parent directory doesn't affect
2643 whether a file or directory can be created within it. Some day we
2644 should check ACLs though, which do affect this. */
2645 return file_directory_p (SDATA (dir)) ? Qt : Qnil;
2646 #else
2647 return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil;
2648 #endif
2651 DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
2652 doc: /* Access file FILENAME, and get an error if that does not work.
2653 The second argument STRING is used in the error message.
2654 If there is no error, returns nil. */)
2655 (Lisp_Object filename, Lisp_Object string)
2657 Lisp_Object handler, encoded_filename, absname;
2659 CHECK_STRING (filename);
2660 absname = Fexpand_file_name (filename, Qnil);
2662 CHECK_STRING (string);
2664 /* If the file name has special constructs in it,
2665 call the corresponding file handler. */
2666 handler = Ffind_file_name_handler (absname, Qaccess_file);
2667 if (!NILP (handler))
2668 return call3 (handler, Qaccess_file, absname, string);
2670 encoded_filename = ENCODE_FILE (absname);
2672 if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0)
2673 report_file_error (SSDATA (string), filename);
2675 return Qnil;
2678 /* Relative to directory FD, return the symbolic link value of FILENAME.
2679 On failure, return nil. */
2680 Lisp_Object
2681 emacs_readlinkat (int fd, char const *filename)
2683 static struct allocator const emacs_norealloc_allocator =
2684 { xmalloc, NULL, xfree, memory_full };
2685 Lisp_Object val;
2686 char readlink_buf[1024];
2687 char *buf = careadlinkat (fd, filename, readlink_buf, sizeof readlink_buf,
2688 &emacs_norealloc_allocator, readlinkat);
2689 if (!buf)
2690 return Qnil;
2692 val = build_unibyte_string (buf);
2693 if (buf[0] == '/' && strchr (buf, ':'))
2695 AUTO_STRING (slash_colon, "/:");
2696 val = concat2 (slash_colon, val);
2698 if (buf != readlink_buf)
2699 xfree (buf);
2700 val = DECODE_FILE (val);
2701 return val;
2704 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
2705 doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
2706 The value is the link target, as a string.
2707 Otherwise it returns nil.
2709 This function does not check whether the link target exists. */)
2710 (Lisp_Object filename)
2712 Lisp_Object handler;
2714 CHECK_STRING (filename);
2715 filename = Fexpand_file_name (filename, Qnil);
2717 /* If the file name has special constructs in it,
2718 call the corresponding file handler. */
2719 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2720 if (!NILP (handler))
2721 return call2 (handler, Qfile_symlink_p, filename);
2723 filename = ENCODE_FILE (filename);
2725 return emacs_readlinkat (AT_FDCWD, SSDATA (filename));
2728 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
2729 doc: /* Return t if FILENAME names an existing directory.
2730 Symbolic links to directories count as directories.
2731 See `file-symlink-p' to distinguish symlinks. */)
2732 (Lisp_Object filename)
2734 Lisp_Object absname;
2735 Lisp_Object handler;
2737 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
2739 /* If the file name has special constructs in it,
2740 call the corresponding file handler. */
2741 handler = Ffind_file_name_handler (absname, Qfile_directory_p);
2742 if (!NILP (handler))
2743 return call2 (handler, Qfile_directory_p, absname);
2745 absname = ENCODE_FILE (absname);
2747 return file_directory_p (SSDATA (absname)) ? Qt : Qnil;
2750 /* Return true if FILE is a directory or a symlink to a directory. */
2751 bool
2752 file_directory_p (char const *file)
2754 #ifdef WINDOWSNT
2755 /* This is cheaper than 'stat'. */
2756 return faccessat (AT_FDCWD, file, D_OK, AT_EACCESS) == 0;
2757 #else
2758 struct stat st;
2759 return stat (file, &st) == 0 && S_ISDIR (st.st_mode);
2760 #endif
2763 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p,
2764 Sfile_accessible_directory_p, 1, 1, 0,
2765 doc: /* Return t if file FILENAME names a directory you can open.
2766 For the value to be t, FILENAME must specify the name of a directory as a file,
2767 and the directory must allow you to open files in it. In order to use a
2768 directory as a buffer's current directory, this predicate must return true.
2769 A directory name spec may be given instead; then the value is t
2770 if the directory so specified exists and really is a readable and
2771 searchable directory. */)
2772 (Lisp_Object filename)
2774 Lisp_Object absname;
2775 Lisp_Object handler;
2777 CHECK_STRING (filename);
2778 absname = Fexpand_file_name (filename, Qnil);
2780 /* If the file name has special constructs in it,
2781 call the corresponding file handler. */
2782 handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p);
2783 if (!NILP (handler))
2785 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
2786 errno = 0;
2787 return r;
2790 absname = ENCODE_FILE (absname);
2791 return file_accessible_directory_p (absname) ? Qt : Qnil;
2794 /* If FILE is a searchable directory or a symlink to a
2795 searchable directory, return true. Otherwise return
2796 false and set errno to an error number. */
2797 bool
2798 file_accessible_directory_p (Lisp_Object file)
2800 #ifdef DOS_NT
2801 /* There's no need to test whether FILE is searchable, as the
2802 searchable/executable bit is invented on DOS_NT platforms. */
2803 return file_directory_p (SSDATA (file));
2804 #else
2805 /* On POSIXish platforms, use just one system call; this avoids a
2806 race and is typically faster. */
2807 const char *data = SSDATA (file);
2808 ptrdiff_t len = SBYTES (file);
2809 char const *dir;
2810 bool ok;
2811 int saved_errno;
2812 USE_SAFE_ALLOCA;
2814 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2815 There are three exceptions: "", "/", and "//". Leave "" alone,
2816 as it's invalid. Append only "." to the other two exceptions as
2817 "/" and "//" are distinct on some platforms, whereas "/", "///",
2818 "////", etc. are all equivalent. */
2819 if (! len)
2820 dir = data;
2821 else
2823 /* Just check for trailing '/' when deciding whether to append '/'.
2824 That's simpler than testing the two special cases "/" and "//",
2825 and it's a safe optimization here. */
2826 char *buf = SAFE_ALLOCA (len + 3);
2827 memcpy (buf, data, len);
2828 strcpy (buf + len, &"/."[data[len - 1] == '/']);
2829 dir = buf;
2832 ok = check_existing (dir);
2833 saved_errno = errno;
2834 SAFE_FREE ();
2835 errno = saved_errno;
2836 return ok;
2837 #endif
2840 DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
2841 doc: /* Return t if FILENAME names a regular file.
2842 This is the sort of file that holds an ordinary stream of data bytes.
2843 Symbolic links to regular files count as regular files.
2844 See `file-symlink-p' to distinguish symlinks. */)
2845 (Lisp_Object filename)
2847 register Lisp_Object absname;
2848 struct stat st;
2849 Lisp_Object handler;
2851 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
2853 /* If the file name has special constructs in it,
2854 call the corresponding file handler. */
2855 handler = Ffind_file_name_handler (absname, Qfile_regular_p);
2856 if (!NILP (handler))
2857 return call2 (handler, Qfile_regular_p, absname);
2859 absname = ENCODE_FILE (absname);
2861 #ifdef WINDOWSNT
2863 int result;
2864 Lisp_Object tem = Vw32_get_true_file_attributes;
2866 /* Tell stat to use expensive method to get accurate info. */
2867 Vw32_get_true_file_attributes = Qt;
2868 result = stat (SDATA (absname), &st);
2869 Vw32_get_true_file_attributes = tem;
2871 if (result < 0)
2872 return Qnil;
2873 return S_ISREG (st.st_mode) ? Qt : Qnil;
2875 #else
2876 if (stat (SSDATA (absname), &st) < 0)
2877 return Qnil;
2878 return S_ISREG (st.st_mode) ? Qt : Qnil;
2879 #endif
2882 DEFUN ("file-selinux-context", Ffile_selinux_context,
2883 Sfile_selinux_context, 1, 1, 0,
2884 doc: /* Return SELinux context of file named FILENAME.
2885 The return value is a list (USER ROLE TYPE RANGE), where the list
2886 elements are strings naming the user, role, type, and range of the
2887 file's SELinux security context.
2889 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2890 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2891 (Lisp_Object filename)
2893 Lisp_Object absname;
2894 Lisp_Object values[4];
2895 Lisp_Object handler;
2896 #if HAVE_LIBSELINUX
2897 security_context_t con;
2898 int conlength;
2899 context_t context;
2900 #endif
2902 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
2904 /* If the file name has special constructs in it,
2905 call the corresponding file handler. */
2906 handler = Ffind_file_name_handler (absname, Qfile_selinux_context);
2907 if (!NILP (handler))
2908 return call2 (handler, Qfile_selinux_context, absname);
2910 absname = ENCODE_FILE (absname);
2912 values[0] = Qnil;
2913 values[1] = Qnil;
2914 values[2] = Qnil;
2915 values[3] = Qnil;
2916 #if HAVE_LIBSELINUX
2917 if (is_selinux_enabled ())
2919 conlength = lgetfilecon (SSDATA (absname), &con);
2920 if (conlength > 0)
2922 context = context_new (con);
2923 if (context_user_get (context))
2924 values[0] = build_string (context_user_get (context));
2925 if (context_role_get (context))
2926 values[1] = build_string (context_role_get (context));
2927 if (context_type_get (context))
2928 values[2] = build_string (context_type_get (context));
2929 if (context_range_get (context))
2930 values[3] = build_string (context_range_get (context));
2931 context_free (context);
2932 freecon (con);
2935 #endif
2937 return Flist (ARRAYELTS (values), values);
2940 DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
2941 Sset_file_selinux_context, 2, 2, 0,
2942 doc: /* Set SELinux context of file named FILENAME to CONTEXT.
2943 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2944 elements are strings naming the components of a SELinux context.
2946 Value is t if setting of SELinux context was successful, nil otherwise.
2948 This function does nothing and returns nil if SELinux is disabled,
2949 or if Emacs was not compiled with SELinux support. */)
2950 (Lisp_Object filename, Lisp_Object context)
2952 Lisp_Object absname;
2953 Lisp_Object handler;
2954 #if HAVE_LIBSELINUX
2955 Lisp_Object encoded_absname;
2956 Lisp_Object user = CAR_SAFE (context);
2957 Lisp_Object role = CAR_SAFE (CDR_SAFE (context));
2958 Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
2959 Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
2960 security_context_t con;
2961 bool fail;
2962 int conlength;
2963 context_t parsed_con;
2964 #endif
2966 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
2968 /* If the file name has special constructs in it,
2969 call the corresponding file handler. */
2970 handler = Ffind_file_name_handler (absname, Qset_file_selinux_context);
2971 if (!NILP (handler))
2972 return call3 (handler, Qset_file_selinux_context, absname, context);
2974 #if HAVE_LIBSELINUX
2975 if (is_selinux_enabled ())
2977 /* Get current file context. */
2978 encoded_absname = ENCODE_FILE (absname);
2979 conlength = lgetfilecon (SSDATA (encoded_absname), &con);
2980 if (conlength > 0)
2982 parsed_con = context_new (con);
2983 /* Change the parts defined in the parameter.*/
2984 if (STRINGP (user))
2986 if (context_user_set (parsed_con, SSDATA (user)))
2987 error ("Doing context_user_set");
2989 if (STRINGP (role))
2991 if (context_role_set (parsed_con, SSDATA (role)))
2992 error ("Doing context_role_set");
2994 if (STRINGP (type))
2996 if (context_type_set (parsed_con, SSDATA (type)))
2997 error ("Doing context_type_set");
2999 if (STRINGP (range))
3001 if (context_range_set (parsed_con, SSDATA (range)))
3002 error ("Doing context_range_set");
3005 /* Set the modified context back to the file. */
3006 fail = (lsetfilecon (SSDATA (encoded_absname),
3007 context_str (parsed_con))
3008 != 0);
3009 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
3010 if (fail && errno != ENOTSUP)
3011 report_file_error ("Doing lsetfilecon", absname);
3013 context_free (parsed_con);
3014 freecon (con);
3015 return fail ? Qnil : Qt;
3017 else
3018 report_file_error ("Doing lgetfilecon", absname);
3020 #endif
3022 return Qnil;
3025 DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0,
3026 doc: /* Return ACL entries of file named FILENAME.
3027 The entries are returned in a format suitable for use in `set-file-acl'
3028 but is otherwise undocumented and subject to change.
3029 Return nil if file does not exist or is not accessible, or if Emacs
3030 was unable to determine the ACL entries. */)
3031 (Lisp_Object filename)
3033 Lisp_Object absname;
3034 Lisp_Object handler;
3035 #ifdef HAVE_ACL_SET_FILE
3036 acl_t acl;
3037 Lisp_Object acl_string;
3038 char *str;
3039 # ifndef HAVE_ACL_TYPE_EXTENDED
3040 acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS;
3041 # endif
3042 #endif
3044 absname = expand_and_dir_to_file (filename,
3045 BVAR (current_buffer, directory));
3047 /* If the file name has special constructs in it,
3048 call the corresponding file handler. */
3049 handler = Ffind_file_name_handler (absname, Qfile_acl);
3050 if (!NILP (handler))
3051 return call2 (handler, Qfile_acl, absname);
3053 #ifdef HAVE_ACL_SET_FILE
3054 absname = ENCODE_FILE (absname);
3056 acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED);
3057 if (acl == NULL)
3058 return Qnil;
3060 str = acl_to_text (acl, NULL);
3061 if (str == NULL)
3063 acl_free (acl);
3064 return Qnil;
3067 acl_string = build_string (str);
3068 acl_free (str);
3069 acl_free (acl);
3071 return acl_string;
3072 #endif
3074 return Qnil;
3077 DEFUN ("set-file-acl", Fset_file_acl, Sset_file_acl,
3078 2, 2, 0,
3079 doc: /* Set ACL of file named FILENAME to ACL-STRING.
3080 ACL-STRING should contain the textual representation of the ACL
3081 entries in a format suitable for the platform.
3083 Value is t if setting of ACL was successful, nil otherwise.
3085 Setting ACL for local files requires Emacs to be built with ACL
3086 support. */)
3087 (Lisp_Object filename, Lisp_Object acl_string)
3089 Lisp_Object absname;
3090 Lisp_Object handler;
3091 #ifdef HAVE_ACL_SET_FILE
3092 Lisp_Object encoded_absname;
3093 acl_t acl;
3094 bool fail;
3095 #endif
3097 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3099 /* If the file name has special constructs in it,
3100 call the corresponding file handler. */
3101 handler = Ffind_file_name_handler (absname, Qset_file_acl);
3102 if (!NILP (handler))
3103 return call3 (handler, Qset_file_acl, absname, acl_string);
3105 #ifdef HAVE_ACL_SET_FILE
3106 if (STRINGP (acl_string))
3108 acl = acl_from_text (SSDATA (acl_string));
3109 if (acl == NULL)
3111 report_file_error ("Converting ACL", absname);
3112 return Qnil;
3115 encoded_absname = ENCODE_FILE (absname);
3117 fail = (acl_set_file (SSDATA (encoded_absname), ACL_TYPE_ACCESS,
3118 acl)
3119 != 0);
3120 if (fail && acl_errno_valid (errno))
3121 report_file_error ("Setting ACL", absname);
3123 acl_free (acl);
3124 return fail ? Qnil : Qt;
3126 #endif
3128 return Qnil;
3131 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
3132 doc: /* Return mode bits of file named FILENAME, as an integer.
3133 Return nil, if file does not exist or is not accessible. */)
3134 (Lisp_Object filename)
3136 Lisp_Object absname;
3137 struct stat st;
3138 Lisp_Object handler;
3140 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
3142 /* If the file name has special constructs in it,
3143 call the corresponding file handler. */
3144 handler = Ffind_file_name_handler (absname, Qfile_modes);
3145 if (!NILP (handler))
3146 return call2 (handler, Qfile_modes, absname);
3148 absname = ENCODE_FILE (absname);
3150 if (stat (SSDATA (absname), &st) < 0)
3151 return Qnil;
3153 return make_number (st.st_mode & 07777);
3156 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2,
3157 "(let ((file (read-file-name \"File: \"))) \
3158 (list file (read-file-modes nil file)))",
3159 doc: /* Set mode bits of file named FILENAME to MODE (an integer).
3160 Only the 12 low bits of MODE are used.
3162 Interactively, mode bits are read by `read-file-modes', which accepts
3163 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3164 (Lisp_Object filename, Lisp_Object mode)
3166 Lisp_Object absname, encoded_absname;
3167 Lisp_Object handler;
3169 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3170 CHECK_NUMBER (mode);
3172 /* If the file name has special constructs in it,
3173 call the corresponding file handler. */
3174 handler = Ffind_file_name_handler (absname, Qset_file_modes);
3175 if (!NILP (handler))
3176 return call3 (handler, Qset_file_modes, absname, mode);
3178 encoded_absname = ENCODE_FILE (absname);
3180 if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
3181 report_file_error ("Doing chmod", absname);
3183 return Qnil;
3186 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
3187 doc: /* Set the file permission bits for newly created files.
3188 The argument MODE should be an integer; only the low 9 bits are used.
3189 This setting is inherited by subprocesses. */)
3190 (Lisp_Object mode)
3192 mode_t oldrealmask, oldumask, newumask;
3193 CHECK_NUMBER (mode);
3194 oldrealmask = realmask;
3195 newumask = ~ XINT (mode) & 0777;
3197 block_input ();
3198 realmask = newumask;
3199 oldumask = umask (newumask);
3200 unblock_input ();
3202 eassert (oldumask == oldrealmask);
3203 return Qnil;
3206 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
3207 doc: /* Return the default file protection for created files.
3208 The value is an integer. */)
3209 (void)
3211 Lisp_Object value;
3212 XSETINT (value, (~ realmask) & 0777);
3213 return value;
3217 DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
3218 doc: /* Set times of file FILENAME to TIMESTAMP.
3219 Set both access and modification times.
3220 Return t on success, else nil.
3221 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3222 `current-time'. */)
3223 (Lisp_Object filename, Lisp_Object timestamp)
3225 Lisp_Object absname, encoded_absname;
3226 Lisp_Object handler;
3227 struct timespec t = lisp_time_argument (timestamp);
3229 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3231 /* If the file name has special constructs in it,
3232 call the corresponding file handler. */
3233 handler = Ffind_file_name_handler (absname, Qset_file_times);
3234 if (!NILP (handler))
3235 return call3 (handler, Qset_file_times, absname, timestamp);
3237 encoded_absname = ENCODE_FILE (absname);
3240 if (set_file_times (-1, SSDATA (encoded_absname), t, t) != 0)
3242 #ifdef MSDOS
3243 /* Setting times on a directory always fails. */
3244 if (file_directory_p (SSDATA (encoded_absname)))
3245 return Qnil;
3246 #endif
3247 report_file_error ("Setting file times", absname);
3251 return Qt;
3254 #ifdef HAVE_SYNC
3255 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
3256 doc: /* Tell Unix to finish all pending disk updates. */)
3257 (void)
3259 sync ();
3260 return Qnil;
3263 #endif /* HAVE_SYNC */
3265 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
3266 doc: /* Return t if file FILE1 is newer than file FILE2.
3267 If FILE1 does not exist, the answer is nil;
3268 otherwise, if FILE2 does not exist, the answer is t. */)
3269 (Lisp_Object file1, Lisp_Object file2)
3271 Lisp_Object absname1, absname2;
3272 struct stat st1, st2;
3273 Lisp_Object handler;
3274 struct gcpro gcpro1, gcpro2;
3276 CHECK_STRING (file1);
3277 CHECK_STRING (file2);
3279 absname1 = Qnil;
3280 GCPRO2 (absname1, file2);
3281 absname1 = expand_and_dir_to_file (file1, BVAR (current_buffer, directory));
3282 absname2 = expand_and_dir_to_file (file2, BVAR (current_buffer, directory));
3283 UNGCPRO;
3285 /* If the file name has special constructs in it,
3286 call the corresponding file handler. */
3287 handler = Ffind_file_name_handler (absname1, Qfile_newer_than_file_p);
3288 if (NILP (handler))
3289 handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p);
3290 if (!NILP (handler))
3291 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
3293 GCPRO2 (absname1, absname2);
3294 absname1 = ENCODE_FILE (absname1);
3295 absname2 = ENCODE_FILE (absname2);
3296 UNGCPRO;
3298 if (stat (SSDATA (absname1), &st1) < 0)
3299 return Qnil;
3301 if (stat (SSDATA (absname2), &st2) < 0)
3302 return Qt;
3304 return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0
3305 ? Qt : Qnil);
3308 #ifndef READ_BUF_SIZE
3309 #define READ_BUF_SIZE (64 << 10)
3310 #endif
3311 /* Some buffer offsets are stored in 'int' variables. */
3312 verify (READ_BUF_SIZE <= INT_MAX);
3314 /* This function is called after Lisp functions to decide a coding
3315 system are called, or when they cause an error. Before they are
3316 called, the current buffer is set unibyte and it contains only a
3317 newly inserted text (thus the buffer was empty before the
3318 insertion).
3320 The functions may set markers, overlays, text properties, or even
3321 alter the buffer contents, change the current buffer.
3323 Here, we reset all those changes by:
3324 o set back the current buffer.
3325 o move all markers and overlays to BEG.
3326 o remove all text properties.
3327 o set back the buffer multibyteness. */
3329 static void
3330 decide_coding_unwind (Lisp_Object unwind_data)
3332 Lisp_Object multibyte, undo_list, buffer;
3334 multibyte = XCAR (unwind_data);
3335 unwind_data = XCDR (unwind_data);
3336 undo_list = XCAR (unwind_data);
3337 buffer = XCDR (unwind_data);
3339 set_buffer_internal (XBUFFER (buffer));
3340 adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
3341 adjust_overlays_for_delete (BEG, Z - BEG);
3342 set_buffer_intervals (current_buffer, NULL);
3343 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3345 /* Now we are safe to change the buffer's multibyteness directly. */
3346 bset_enable_multibyte_characters (current_buffer, multibyte);
3347 bset_undo_list (current_buffer, undo_list);
3350 /* Read from a non-regular file. STATE is a Lisp_Save_Value
3351 object where slot 0 is the file descriptor, slot 1 specifies
3352 an offset to put the read bytes, and slot 2 is the maximum
3353 amount of bytes to read. Value is the number of bytes read. */
3355 static Lisp_Object
3356 read_non_regular (Lisp_Object state)
3358 int nbytes;
3360 immediate_quit = 1;
3361 QUIT;
3362 nbytes = emacs_read (XSAVE_INTEGER (state, 0),
3363 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3364 + XSAVE_INTEGER (state, 1)),
3365 XSAVE_INTEGER (state, 2));
3366 immediate_quit = 0;
3367 /* Fast recycle this object for the likely next call. */
3368 free_misc (state);
3369 return make_number (nbytes);
3373 /* Condition-case handler used when reading from non-regular files
3374 in insert-file-contents. */
3376 static Lisp_Object
3377 read_non_regular_quit (Lisp_Object ignore)
3379 return Qnil;
3382 /* Return the file offset that VAL represents, checking for type
3383 errors and overflow. */
3384 static off_t
3385 file_offset (Lisp_Object val)
3387 if (RANGED_INTEGERP (0, val, TYPE_MAXIMUM (off_t)))
3388 return XINT (val);
3390 if (FLOATP (val))
3392 double v = XFLOAT_DATA (val);
3393 if (0 <= v
3394 && (sizeof (off_t) < sizeof v
3395 ? v <= TYPE_MAXIMUM (off_t)
3396 : v < TYPE_MAXIMUM (off_t)))
3397 return v;
3400 wrong_type_argument (intern ("file-offset"), val);
3403 /* Return a special time value indicating the error number ERRNUM. */
3404 static struct timespec
3405 time_error_value (int errnum)
3407 int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR
3408 ? NONEXISTENT_MODTIME_NSECS
3409 : UNKNOWN_MODTIME_NSECS);
3410 return make_timespec (0, ns);
3413 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
3414 1, 5, 0,
3415 doc: /* Insert contents of file FILENAME after point.
3416 Returns list of absolute file name and number of characters inserted.
3417 If second argument VISIT is non-nil, the buffer's visited filename and
3418 last save file modtime are set, and it is marked unmodified. If
3419 visiting and the file does not exist, visiting is completed before the
3420 error is signaled.
3422 The optional third and fourth arguments BEG and END specify what portion
3423 of the file to insert. These arguments count bytes in the file, not
3424 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3426 If optional fifth argument REPLACE is non-nil, replace the current
3427 buffer contents (in the accessible portion) with the file contents.
3428 This is better than simply deleting and inserting the whole thing
3429 because (1) it preserves some marker positions and (2) it puts less data
3430 in the undo list. When REPLACE is non-nil, the second return value is
3431 the number of characters that replace previous buffer contents.
3433 This function does code conversion according to the value of
3434 `coding-system-for-read' or `file-coding-system-alist', and sets the
3435 variable `last-coding-system-used' to the coding system actually used.
3437 In addition, this function decodes the inserted text from known formats
3438 by calling `format-decode', which see. */)
3439 (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
3441 struct stat st;
3442 struct timespec mtime;
3443 int fd;
3444 ptrdiff_t inserted = 0;
3445 ptrdiff_t how_much;
3446 off_t beg_offset, end_offset;
3447 int unprocessed;
3448 ptrdiff_t count = SPECPDL_INDEX ();
3449 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3450 Lisp_Object handler, val, insval, orig_filename, old_undo;
3451 Lisp_Object p;
3452 ptrdiff_t total = 0;
3453 bool not_regular = 0;
3454 int save_errno = 0;
3455 char read_buf[READ_BUF_SIZE];
3456 struct coding_system coding;
3457 bool replace_handled = 0;
3458 bool set_coding_system = 0;
3459 Lisp_Object coding_system;
3460 bool read_quit = 0;
3461 /* If the undo log only contains the insertion, there's no point
3462 keeping it. It's typically when we first fill a file-buffer. */
3463 bool empty_undo_list_p
3464 = (!NILP (visit) && NILP (BVAR (current_buffer, undo_list))
3465 && BEG == Z);
3466 Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
3467 bool we_locked_file = 0;
3468 ptrdiff_t fd_index;
3470 if (current_buffer->base_buffer && ! NILP (visit))
3471 error ("Cannot do file visiting in an indirect buffer");
3473 if (!NILP (BVAR (current_buffer, read_only)))
3474 Fbarf_if_buffer_read_only (Qnil);
3476 val = Qnil;
3477 p = Qnil;
3478 orig_filename = Qnil;
3479 old_undo = Qnil;
3481 GCPRO5 (filename, val, p, orig_filename, old_undo);
3483 CHECK_STRING (filename);
3484 filename = Fexpand_file_name (filename, Qnil);
3486 /* The value Qnil means that the coding system is not yet
3487 decided. */
3488 coding_system = Qnil;
3490 /* If the file name has special constructs in it,
3491 call the corresponding file handler. */
3492 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
3493 if (!NILP (handler))
3495 val = call6 (handler, Qinsert_file_contents, filename,
3496 visit, beg, end, replace);
3497 if (CONSP (val) && CONSP (XCDR (val))
3498 && RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT))
3499 inserted = XINT (XCAR (XCDR (val)));
3500 goto handled;
3503 orig_filename = filename;
3504 filename = ENCODE_FILE (filename);
3506 fd = emacs_open (SSDATA (filename), O_RDONLY, 0);
3507 if (fd < 0)
3509 save_errno = errno;
3510 if (NILP (visit))
3511 report_file_error ("Opening input file", orig_filename);
3512 mtime = time_error_value (save_errno);
3513 st.st_size = -1;
3514 if (!NILP (Vcoding_system_for_read))
3515 Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
3516 goto notfound;
3519 fd_index = SPECPDL_INDEX ();
3520 record_unwind_protect_int (close_file_unwind, fd);
3522 /* Replacement should preserve point as it preserves markers. */
3523 if (!NILP (replace))
3524 record_unwind_protect (restore_point_unwind, Fpoint_marker ());
3526 if (fstat (fd, &st) != 0)
3527 report_file_error ("Input file status", orig_filename);
3528 mtime = get_stat_mtime (&st);
3530 /* This code will need to be changed in order to work on named
3531 pipes, and it's probably just not worth it. So we should at
3532 least signal an error. */
3533 if (!S_ISREG (st.st_mode))
3535 not_regular = 1;
3537 if (! NILP (visit))
3538 goto notfound;
3540 if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
3541 xsignal2 (Qfile_error,
3542 build_string ("not a regular file"), orig_filename);
3545 if (!NILP (visit))
3547 if (!NILP (beg) || !NILP (end))
3548 error ("Attempt to visit less than an entire file");
3549 if (BEG < Z && NILP (replace))
3550 error ("Cannot do file visiting in a non-empty buffer");
3553 if (!NILP (beg))
3554 beg_offset = file_offset (beg);
3555 else
3556 beg_offset = 0;
3558 if (!NILP (end))
3559 end_offset = file_offset (end);
3560 else
3562 if (not_regular)
3563 end_offset = TYPE_MAXIMUM (off_t);
3564 else
3566 end_offset = st.st_size;
3568 /* A negative size can happen on a platform that allows file
3569 sizes greater than the maximum off_t value. */
3570 if (end_offset < 0)
3571 buffer_overflow ();
3573 /* The file size returned from stat may be zero, but data
3574 may be readable nonetheless, for example when this is a
3575 file in the /proc filesystem. */
3576 if (end_offset == 0)
3577 end_offset = READ_BUF_SIZE;
3581 /* Check now whether the buffer will become too large,
3582 in the likely case where the file's length is not changing.
3583 This saves a lot of needless work before a buffer overflow. */
3584 if (! not_regular)
3586 /* The likely offset where we will stop reading. We could read
3587 more (or less), if the file grows (or shrinks) as we read it. */
3588 off_t likely_end = min (end_offset, st.st_size);
3590 if (beg_offset < likely_end)
3592 ptrdiff_t buf_bytes
3593 = Z_BYTE - (!NILP (replace) ? ZV_BYTE - BEGV_BYTE : 0);
3594 ptrdiff_t buf_growth_max = BUF_BYTES_MAX - buf_bytes;
3595 off_t likely_growth = likely_end - beg_offset;
3596 if (buf_growth_max < likely_growth)
3597 buffer_overflow ();
3601 /* Prevent redisplay optimizations. */
3602 current_buffer->clip_changed = 1;
3604 if (EQ (Vcoding_system_for_read, Qauto_save_coding))
3606 coding_system = coding_inherit_eol_type (Qutf_8_emacs, Qunix);
3607 setup_coding_system (coding_system, &coding);
3608 /* Ensure we set Vlast_coding_system_used. */
3609 set_coding_system = 1;
3611 else if (BEG < Z)
3613 /* Decide the coding system to use for reading the file now
3614 because we can't use an optimized method for handling
3615 `coding:' tag if the current buffer is not empty. */
3616 if (!NILP (Vcoding_system_for_read))
3617 coding_system = Vcoding_system_for_read;
3618 else
3620 /* Don't try looking inside a file for a coding system
3621 specification if it is not seekable. */
3622 if (! not_regular && ! NILP (Vset_auto_coding_function))
3624 /* Find a coding system specified in the heading two
3625 lines or in the tailing several lines of the file.
3626 We assume that the 1K-byte and 3K-byte for heading
3627 and tailing respectively are sufficient for this
3628 purpose. */
3629 int nread;
3631 if (st.st_size <= (1024 * 4))
3632 nread = emacs_read (fd, read_buf, 1024 * 4);
3633 else
3635 nread = emacs_read (fd, read_buf, 1024);
3636 if (nread == 1024)
3638 int ntail;
3639 if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
3640 report_file_error ("Setting file position",
3641 orig_filename);
3642 ntail = emacs_read (fd, read_buf + nread, 1024 * 3);
3643 nread = ntail < 0 ? ntail : nread + ntail;
3647 if (nread < 0)
3648 report_file_error ("Read error", orig_filename);
3649 else if (nread > 0)
3651 AUTO_STRING (name, " *code-converting-work*");
3652 struct buffer *prev = current_buffer;
3653 Lisp_Object workbuf;
3654 struct buffer *buf;
3656 record_unwind_current_buffer ();
3658 workbuf = Fget_buffer_create (name);
3659 buf = XBUFFER (workbuf);
3661 delete_all_overlays (buf);
3662 bset_directory (buf, BVAR (current_buffer, directory));
3663 bset_read_only (buf, Qnil);
3664 bset_filename (buf, Qnil);
3665 bset_undo_list (buf, Qt);
3666 eassert (buf->overlays_before == NULL);
3667 eassert (buf->overlays_after == NULL);
3669 set_buffer_internal (buf);
3670 Ferase_buffer ();
3671 bset_enable_multibyte_characters (buf, Qnil);
3673 insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
3674 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3675 coding_system = call2 (Vset_auto_coding_function,
3676 filename, make_number (nread));
3677 set_buffer_internal (prev);
3679 /* Discard the unwind protect for recovering the
3680 current buffer. */
3681 specpdl_ptr--;
3683 /* Rewind the file for the actual read done later. */
3684 if (lseek (fd, 0, SEEK_SET) < 0)
3685 report_file_error ("Setting file position", orig_filename);
3689 if (NILP (coding_system))
3691 /* If we have not yet decided a coding system, check
3692 file-coding-system-alist. */
3693 Lisp_Object args[6];
3695 args[0] = Qinsert_file_contents, args[1] = orig_filename;
3696 args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace;
3697 coding_system = Ffind_operation_coding_system (6, args);
3698 if (CONSP (coding_system))
3699 coding_system = XCAR (coding_system);
3703 if (NILP (coding_system))
3704 coding_system = Qundecided;
3705 else
3706 CHECK_CODING_SYSTEM (coding_system);
3708 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3709 /* We must suppress all character code conversion except for
3710 end-of-line conversion. */
3711 coding_system = raw_text_coding_system (coding_system);
3713 setup_coding_system (coding_system, &coding);
3714 /* Ensure we set Vlast_coding_system_used. */
3715 set_coding_system = 1;
3718 /* If requested, replace the accessible part of the buffer
3719 with the file contents. Avoid replacing text at the
3720 beginning or end of the buffer that matches the file contents;
3721 that preserves markers pointing to the unchanged parts.
3723 Here we implement this feature in an optimized way
3724 for the case where code conversion is NOT needed.
3725 The following if-statement handles the case of conversion
3726 in a less optimal way.
3728 If the code conversion is "automatic" then we try using this
3729 method and hope for the best.
3730 But if we discover the need for conversion, we give up on this method
3731 and let the following if-statement handle the replace job. */
3732 if (!NILP (replace)
3733 && BEGV < ZV
3734 && (NILP (coding_system)
3735 || ! CODING_REQUIRE_DECODING (&coding)))
3737 /* same_at_start and same_at_end count bytes,
3738 because file access counts bytes
3739 and BEG and END count bytes. */
3740 ptrdiff_t same_at_start = BEGV_BYTE;
3741 ptrdiff_t same_at_end = ZV_BYTE;
3742 ptrdiff_t overlap;
3743 /* There is still a possibility we will find the need to do code
3744 conversion. If that happens, set this variable to
3745 give up on handling REPLACE in the optimized way. */
3746 bool giveup_match_end = 0;
3748 if (beg_offset != 0)
3750 if (lseek (fd, beg_offset, SEEK_SET) < 0)
3751 report_file_error ("Setting file position", orig_filename);
3754 immediate_quit = 1;
3755 QUIT;
3756 /* Count how many chars at the start of the file
3757 match the text at the beginning of the buffer. */
3758 while (1)
3760 int nread, bufpos;
3762 nread = emacs_read (fd, read_buf, sizeof read_buf);
3763 if (nread < 0)
3764 report_file_error ("Read error", orig_filename);
3765 else if (nread == 0)
3766 break;
3768 if (CODING_REQUIRE_DETECTION (&coding))
3770 coding_system = detect_coding_system ((unsigned char *) read_buf,
3771 nread, nread, 1, 0,
3772 coding_system);
3773 setup_coding_system (coding_system, &coding);
3776 if (CODING_REQUIRE_DECODING (&coding))
3777 /* We found that the file should be decoded somehow.
3778 Let's give up here. */
3780 giveup_match_end = 1;
3781 break;
3784 bufpos = 0;
3785 while (bufpos < nread && same_at_start < ZV_BYTE
3786 && FETCH_BYTE (same_at_start) == read_buf[bufpos])
3787 same_at_start++, bufpos++;
3788 /* If we found a discrepancy, stop the scan.
3789 Otherwise loop around and scan the next bufferful. */
3790 if (bufpos != nread)
3791 break;
3793 immediate_quit = 0;
3794 /* If the file matches the buffer completely,
3795 there's no need to replace anything. */
3796 if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
3798 emacs_close (fd);
3799 clear_unwind_protect (fd_index);
3801 /* Truncate the buffer to the size of the file. */
3802 del_range_1 (same_at_start, same_at_end, 0, 0);
3803 goto handled;
3805 immediate_quit = 1;
3806 QUIT;
3807 /* Count how many chars at the end of the file
3808 match the text at the end of the buffer. But, if we have
3809 already found that decoding is necessary, don't waste time. */
3810 while (!giveup_match_end)
3812 int total_read, nread, bufpos, trial;
3813 off_t curpos;
3815 /* At what file position are we now scanning? */
3816 curpos = end_offset - (ZV_BYTE - same_at_end);
3817 /* If the entire file matches the buffer tail, stop the scan. */
3818 if (curpos == 0)
3819 break;
3820 /* How much can we scan in the next step? */
3821 trial = min (curpos, sizeof read_buf);
3822 if (lseek (fd, curpos - trial, SEEK_SET) < 0)
3823 report_file_error ("Setting file position", orig_filename);
3825 total_read = nread = 0;
3826 while (total_read < trial)
3828 nread = emacs_read (fd, read_buf + total_read, trial - total_read);
3829 if (nread < 0)
3830 report_file_error ("Read error", orig_filename);
3831 else if (nread == 0)
3832 break;
3833 total_read += nread;
3836 /* Scan this bufferful from the end, comparing with
3837 the Emacs buffer. */
3838 bufpos = total_read;
3840 /* Compare with same_at_start to avoid counting some buffer text
3841 as matching both at the file's beginning and at the end. */
3842 while (bufpos > 0 && same_at_end > same_at_start
3843 && FETCH_BYTE (same_at_end - 1) == read_buf[bufpos - 1])
3844 same_at_end--, bufpos--;
3846 /* If we found a discrepancy, stop the scan.
3847 Otherwise loop around and scan the preceding bufferful. */
3848 if (bufpos != 0)
3850 /* If this discrepancy is because of code conversion,
3851 we cannot use this method; giveup and try the other. */
3852 if (same_at_end > same_at_start
3853 && FETCH_BYTE (same_at_end - 1) >= 0200
3854 && ! NILP (BVAR (current_buffer, enable_multibyte_characters))
3855 && (CODING_MAY_REQUIRE_DECODING (&coding)))
3856 giveup_match_end = 1;
3857 break;
3860 if (nread == 0)
3861 break;
3863 immediate_quit = 0;
3865 if (! giveup_match_end)
3867 ptrdiff_t temp;
3869 /* We win! We can handle REPLACE the optimized way. */
3871 /* Extend the start of non-matching text area to multibyte
3872 character boundary. */
3873 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3874 while (same_at_start > BEGV_BYTE
3875 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
3876 same_at_start--;
3878 /* Extend the end of non-matching text area to multibyte
3879 character boundary. */
3880 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3881 while (same_at_end < ZV_BYTE
3882 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
3883 same_at_end++;
3885 /* Don't try to reuse the same piece of text twice. */
3886 overlap = (same_at_start - BEGV_BYTE
3887 - (same_at_end
3888 + (! NILP (end) ? end_offset : st.st_size) - ZV_BYTE));
3889 if (overlap > 0)
3890 same_at_end += overlap;
3892 /* Arrange to read only the nonmatching middle part of the file. */
3893 beg_offset += same_at_start - BEGV_BYTE;
3894 end_offset -= ZV_BYTE - same_at_end;
3896 invalidate_buffer_caches (current_buffer,
3897 BYTE_TO_CHAR (same_at_start),
3898 BYTE_TO_CHAR (same_at_end));
3899 del_range_byte (same_at_start, same_at_end, 0);
3900 /* Insert from the file at the proper position. */
3901 temp = BYTE_TO_CHAR (same_at_start);
3902 SET_PT_BOTH (temp, same_at_start);
3904 /* If display currently starts at beginning of line,
3905 keep it that way. */
3906 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
3907 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
3909 replace_handled = 1;
3913 /* If requested, replace the accessible part of the buffer
3914 with the file contents. Avoid replacing text at the
3915 beginning or end of the buffer that matches the file contents;
3916 that preserves markers pointing to the unchanged parts.
3918 Here we implement this feature for the case where code conversion
3919 is needed, in a simple way that needs a lot of memory.
3920 The preceding if-statement handles the case of no conversion
3921 in a more optimized way. */
3922 if (!NILP (replace) && ! replace_handled && BEGV < ZV)
3924 ptrdiff_t same_at_start = BEGV_BYTE;
3925 ptrdiff_t same_at_end = ZV_BYTE;
3926 ptrdiff_t same_at_start_charpos;
3927 ptrdiff_t inserted_chars;
3928 ptrdiff_t overlap;
3929 ptrdiff_t bufpos;
3930 unsigned char *decoded;
3931 ptrdiff_t temp;
3932 ptrdiff_t this = 0;
3933 ptrdiff_t this_count = SPECPDL_INDEX ();
3934 bool multibyte
3935 = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
3936 Lisp_Object conversion_buffer;
3937 struct gcpro gcpro1;
3939 conversion_buffer = code_conversion_save (1, multibyte);
3941 /* First read the whole file, performing code conversion into
3942 CONVERSION_BUFFER. */
3944 if (lseek (fd, beg_offset, SEEK_SET) < 0)
3945 report_file_error ("Setting file position", orig_filename);
3947 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
3948 unprocessed = 0; /* Bytes not processed in previous loop. */
3950 GCPRO1 (conversion_buffer);
3951 while (1)
3953 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3954 quitting while reading a huge file. */
3956 /* Allow quitting out of the actual I/O. */
3957 immediate_quit = 1;
3958 QUIT;
3959 this = emacs_read (fd, read_buf + unprocessed,
3960 READ_BUF_SIZE - unprocessed);
3961 immediate_quit = 0;
3963 if (this <= 0)
3964 break;
3966 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
3967 BUF_Z (XBUFFER (conversion_buffer)));
3968 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3969 unprocessed + this, conversion_buffer);
3970 unprocessed = coding.carryover_bytes;
3971 if (coding.carryover_bytes > 0)
3972 memcpy (read_buf, coding.carryover, unprocessed);
3974 UNGCPRO;
3975 if (this < 0)
3976 report_file_error ("Read error", orig_filename);
3977 emacs_close (fd);
3978 clear_unwind_protect (fd_index);
3980 if (unprocessed > 0)
3982 coding.mode |= CODING_MODE_LAST_BLOCK;
3983 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3984 unprocessed, conversion_buffer);
3985 coding.mode &= ~CODING_MODE_LAST_BLOCK;
3988 coding_system = CODING_ID_NAME (coding.id);
3989 set_coding_system = 1;
3990 decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer));
3991 inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer))
3992 - BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
3994 /* Compare the beginning of the converted string with the buffer
3995 text. */
3997 bufpos = 0;
3998 while (bufpos < inserted && same_at_start < same_at_end
3999 && FETCH_BYTE (same_at_start) == decoded[bufpos])
4000 same_at_start++, bufpos++;
4002 /* If the file matches the head of buffer completely,
4003 there's no need to replace anything. */
4005 if (bufpos == inserted)
4007 /* Truncate the buffer to the size of the file. */
4008 if (same_at_start != same_at_end)
4010 invalidate_buffer_caches (current_buffer,
4011 BYTE_TO_CHAR (same_at_start),
4012 BYTE_TO_CHAR (same_at_end));
4013 del_range_byte (same_at_start, same_at_end, 0);
4015 inserted = 0;
4017 unbind_to (this_count, Qnil);
4018 goto handled;
4021 /* Extend the start of non-matching text area to the previous
4022 multibyte character boundary. */
4023 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
4024 while (same_at_start > BEGV_BYTE
4025 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
4026 same_at_start--;
4028 /* Scan this bufferful from the end, comparing with
4029 the Emacs buffer. */
4030 bufpos = inserted;
4032 /* Compare with same_at_start to avoid counting some buffer text
4033 as matching both at the file's beginning and at the end. */
4034 while (bufpos > 0 && same_at_end > same_at_start
4035 && FETCH_BYTE (same_at_end - 1) == decoded[bufpos - 1])
4036 same_at_end--, bufpos--;
4038 /* Extend the end of non-matching text area to the next
4039 multibyte character boundary. */
4040 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
4041 while (same_at_end < ZV_BYTE
4042 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
4043 same_at_end++;
4045 /* Don't try to reuse the same piece of text twice. */
4046 overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
4047 if (overlap > 0)
4048 same_at_end += overlap;
4050 /* If display currently starts at beginning of line,
4051 keep it that way. */
4052 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
4053 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
4055 /* Replace the chars that we need to replace,
4056 and update INSERTED to equal the number of bytes
4057 we are taking from the decoded string. */
4058 inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
4060 if (same_at_end != same_at_start)
4062 invalidate_buffer_caches (current_buffer,
4063 BYTE_TO_CHAR (same_at_start),
4064 BYTE_TO_CHAR (same_at_end));
4065 del_range_byte (same_at_start, same_at_end, 0);
4066 temp = GPT;
4067 eassert (same_at_start == GPT_BYTE);
4068 same_at_start = GPT_BYTE;
4070 else
4072 temp = BYTE_TO_CHAR (same_at_start);
4074 /* Insert from the file at the proper position. */
4075 SET_PT_BOTH (temp, same_at_start);
4076 same_at_start_charpos
4077 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
4078 same_at_start - BEGV_BYTE
4079 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
4080 eassert (same_at_start_charpos == temp - (BEGV - BEG));
4081 inserted_chars
4082 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
4083 same_at_start + inserted - BEGV_BYTE
4084 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)))
4085 - same_at_start_charpos);
4086 /* This binding is to avoid ask-user-about-supersession-threat
4087 being called in insert_from_buffer (via in
4088 prepare_to_modify_buffer). */
4089 specbind (intern ("buffer-file-name"), Qnil);
4090 insert_from_buffer (XBUFFER (conversion_buffer),
4091 same_at_start_charpos, inserted_chars, 0);
4092 /* Set `inserted' to the number of inserted characters. */
4093 inserted = PT - temp;
4094 /* Set point before the inserted characters. */
4095 SET_PT_BOTH (temp, same_at_start);
4097 unbind_to (this_count, Qnil);
4099 goto handled;
4102 if (! not_regular)
4103 total = end_offset - beg_offset;
4104 else
4105 /* For a special file, all we can do is guess. */
4106 total = READ_BUF_SIZE;
4108 if (NILP (visit) && total > 0)
4110 if (!NILP (BVAR (current_buffer, file_truename))
4111 /* Make binding buffer-file-name to nil effective. */
4112 && !NILP (BVAR (current_buffer, filename))
4113 && SAVE_MODIFF >= MODIFF)
4114 we_locked_file = 1;
4115 prepare_to_modify_buffer (PT, PT, NULL);
4118 move_gap_both (PT, PT_BYTE);
4119 if (GAP_SIZE < total)
4120 make_gap (total - GAP_SIZE);
4122 if (beg_offset != 0 || !NILP (replace))
4124 if (lseek (fd, beg_offset, SEEK_SET) < 0)
4125 report_file_error ("Setting file position", orig_filename);
4128 /* In the following loop, HOW_MUCH contains the total bytes read so
4129 far for a regular file, and not changed for a special file. But,
4130 before exiting the loop, it is set to a negative value if I/O
4131 error occurs. */
4132 how_much = 0;
4134 /* Total bytes inserted. */
4135 inserted = 0;
4137 /* Here, we don't do code conversion in the loop. It is done by
4138 decode_coding_gap after all data are read into the buffer. */
4140 ptrdiff_t gap_size = GAP_SIZE;
4142 while (how_much < total)
4144 /* try is reserved in some compilers (Microsoft C) */
4145 ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE);
4146 ptrdiff_t this;
4148 if (not_regular)
4150 Lisp_Object nbytes;
4152 /* Maybe make more room. */
4153 if (gap_size < trytry)
4155 make_gap (trytry - gap_size);
4156 gap_size = GAP_SIZE - inserted;
4159 /* Read from the file, capturing `quit'. When an
4160 error occurs, end the loop, and arrange for a quit
4161 to be signaled after decoding the text we read. */
4162 nbytes = internal_condition_case_1
4163 (read_non_regular,
4164 make_save_int_int_int (fd, inserted, trytry),
4165 Qerror, read_non_regular_quit);
4167 if (NILP (nbytes))
4169 read_quit = 1;
4170 break;
4173 this = XINT (nbytes);
4175 else
4177 /* Allow quitting out of the actual I/O. We don't make text
4178 part of the buffer until all the reading is done, so a C-g
4179 here doesn't do any harm. */
4180 immediate_quit = 1;
4181 QUIT;
4182 this = emacs_read (fd,
4183 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
4184 + inserted),
4185 trytry);
4186 immediate_quit = 0;
4189 if (this <= 0)
4191 how_much = this;
4192 break;
4195 gap_size -= this;
4197 /* For a regular file, where TOTAL is the real size,
4198 count HOW_MUCH to compare with it.
4199 For a special file, where TOTAL is just a buffer size,
4200 so don't bother counting in HOW_MUCH.
4201 (INSERTED is where we count the number of characters inserted.) */
4202 if (! not_regular)
4203 how_much += this;
4204 inserted += this;
4208 /* Now we have either read all the file data into the gap,
4209 or stop reading on I/O error or quit. If nothing was
4210 read, undo marking the buffer modified. */
4212 if (inserted == 0)
4214 if (we_locked_file)
4215 unlock_file (BVAR (current_buffer, file_truename));
4216 Vdeactivate_mark = old_Vdeactivate_mark;
4218 else
4219 Vdeactivate_mark = Qt;
4221 emacs_close (fd);
4222 clear_unwind_protect (fd_index);
4224 if (how_much < 0)
4225 report_file_error ("Read error", orig_filename);
4227 /* Make the text read part of the buffer. */
4228 GAP_SIZE -= inserted;
4229 GPT += inserted;
4230 GPT_BYTE += inserted;
4231 ZV += inserted;
4232 ZV_BYTE += inserted;
4233 Z += inserted;
4234 Z_BYTE += inserted;
4236 if (GAP_SIZE > 0)
4237 /* Put an anchor to ensure multi-byte form ends at gap. */
4238 *GPT_ADDR = 0;
4240 notfound:
4242 if (NILP (coding_system))
4244 /* The coding system is not yet decided. Decide it by an
4245 optimized method for handling `coding:' tag.
4247 Note that we can get here only if the buffer was empty
4248 before the insertion. */
4250 if (!NILP (Vcoding_system_for_read))
4251 coding_system = Vcoding_system_for_read;
4252 else
4254 /* Since we are sure that the current buffer was empty
4255 before the insertion, we can toggle
4256 enable-multibyte-characters directly here without taking
4257 care of marker adjustment. By this way, we can run Lisp
4258 program safely before decoding the inserted text. */
4259 Lisp_Object unwind_data;
4260 ptrdiff_t count1 = SPECPDL_INDEX ();
4262 unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters),
4263 Fcons (BVAR (current_buffer, undo_list),
4264 Fcurrent_buffer ()));
4265 bset_enable_multibyte_characters (current_buffer, Qnil);
4266 bset_undo_list (current_buffer, Qt);
4267 record_unwind_protect (decide_coding_unwind, unwind_data);
4269 if (inserted > 0 && ! NILP (Vset_auto_coding_function))
4271 coding_system = call2 (Vset_auto_coding_function,
4272 filename, make_number (inserted));
4275 if (NILP (coding_system))
4277 /* If the coding system is not yet decided, check
4278 file-coding-system-alist. */
4279 Lisp_Object args[6];
4281 args[0] = Qinsert_file_contents, args[1] = orig_filename;
4282 args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
4283 coding_system = Ffind_operation_coding_system (6, args);
4284 if (CONSP (coding_system))
4285 coding_system = XCAR (coding_system);
4287 unbind_to (count1, Qnil);
4288 inserted = Z_BYTE - BEG_BYTE;
4291 if (NILP (coding_system))
4292 coding_system = Qundecided;
4293 else
4294 CHECK_CODING_SYSTEM (coding_system);
4296 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
4297 /* We must suppress all character code conversion except for
4298 end-of-line conversion. */
4299 coding_system = raw_text_coding_system (coding_system);
4300 setup_coding_system (coding_system, &coding);
4301 /* Ensure we set Vlast_coding_system_used. */
4302 set_coding_system = 1;
4305 if (!NILP (visit))
4307 /* When we visit a file by raw-text, we change the buffer to
4308 unibyte. */
4309 if (CODING_FOR_UNIBYTE (&coding)
4310 /* Can't do this if part of the buffer might be preserved. */
4311 && NILP (replace))
4312 /* Visiting a file with these coding system makes the buffer
4313 unibyte. */
4314 bset_enable_multibyte_characters (current_buffer, Qnil);
4317 coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
4318 if (CODING_MAY_REQUIRE_DECODING (&coding)
4319 && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding)))
4321 move_gap_both (PT, PT_BYTE);
4322 GAP_SIZE += inserted;
4323 ZV_BYTE -= inserted;
4324 Z_BYTE -= inserted;
4325 ZV -= inserted;
4326 Z -= inserted;
4327 decode_coding_gap (&coding, inserted, inserted);
4328 inserted = coding.produced_char;
4329 coding_system = CODING_ID_NAME (coding.id);
4331 else if (inserted > 0)
4333 invalidate_buffer_caches (current_buffer, PT, PT + inserted);
4334 adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
4335 inserted);
4338 /* Call after-change hooks for the inserted text, aside from the case
4339 of normal visiting (not with REPLACE), which is done in a new buffer
4340 "before" the buffer is changed. */
4341 if (inserted > 0 && total > 0
4342 && (NILP (visit) || !NILP (replace)))
4344 signal_after_change (PT, 0, inserted);
4345 update_compositions (PT, PT, CHECK_BORDER);
4348 /* Now INSERTED is measured in characters. */
4350 handled:
4352 if (!NILP (visit))
4354 if (empty_undo_list_p)
4355 bset_undo_list (current_buffer, Qnil);
4357 if (NILP (handler))
4359 current_buffer->modtime = mtime;
4360 current_buffer->modtime_size = st.st_size;
4361 bset_filename (current_buffer, orig_filename);
4364 SAVE_MODIFF = MODIFF;
4365 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
4366 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
4367 if (NILP (handler))
4369 if (!NILP (BVAR (current_buffer, file_truename)))
4370 unlock_file (BVAR (current_buffer, file_truename));
4371 unlock_file (filename);
4373 if (not_regular)
4374 xsignal2 (Qfile_error,
4375 build_string ("not a regular file"), orig_filename);
4378 if (set_coding_system)
4379 Vlast_coding_system_used = coding_system;
4381 if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
4383 insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
4384 visit);
4385 if (! NILP (insval))
4387 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4388 wrong_type_argument (intern ("inserted-chars"), insval);
4389 inserted = XFASTINT (insval);
4393 /* Decode file format. */
4394 if (inserted > 0)
4396 /* Don't run point motion or modification hooks when decoding. */
4397 ptrdiff_t count1 = SPECPDL_INDEX ();
4398 ptrdiff_t old_inserted = inserted;
4399 specbind (Qinhibit_point_motion_hooks, Qt);
4400 specbind (Qinhibit_modification_hooks, Qt);
4402 /* Save old undo list and don't record undo for decoding. */
4403 old_undo = BVAR (current_buffer, undo_list);
4404 bset_undo_list (current_buffer, Qt);
4406 if (NILP (replace))
4408 insval = call3 (Qformat_decode,
4409 Qnil, make_number (inserted), visit);
4410 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4411 wrong_type_argument (intern ("inserted-chars"), insval);
4412 inserted = XFASTINT (insval);
4414 else
4416 /* If REPLACE is non-nil and we succeeded in not replacing the
4417 beginning or end of the buffer text with the file's contents,
4418 call format-decode with `point' positioned at the beginning
4419 of the buffer and `inserted' equaling the number of
4420 characters in the buffer. Otherwise, format-decode might
4421 fail to correctly analyze the beginning or end of the buffer.
4422 Hence we temporarily save `point' and `inserted' here and
4423 restore `point' iff format-decode did not insert or delete
4424 any text. Otherwise we leave `point' at point-min. */
4425 ptrdiff_t opoint = PT;
4426 ptrdiff_t opoint_byte = PT_BYTE;
4427 ptrdiff_t oinserted = ZV - BEGV;
4428 EMACS_INT ochars_modiff = CHARS_MODIFF;
4430 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4431 insval = call3 (Qformat_decode,
4432 Qnil, make_number (oinserted), visit);
4433 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4434 wrong_type_argument (intern ("inserted-chars"), insval);
4435 if (ochars_modiff == CHARS_MODIFF)
4436 /* format_decode didn't modify buffer's characters => move
4437 point back to position before inserted text and leave
4438 value of inserted alone. */
4439 SET_PT_BOTH (opoint, opoint_byte);
4440 else
4441 /* format_decode modified buffer's characters => consider
4442 entire buffer changed and leave point at point-min. */
4443 inserted = XFASTINT (insval);
4446 /* For consistency with format-decode call these now iff inserted > 0
4447 (martin 2007-06-28). */
4448 p = Vafter_insert_file_functions;
4449 while (CONSP (p))
4451 if (NILP (replace))
4453 insval = call1 (XCAR (p), make_number (inserted));
4454 if (!NILP (insval))
4456 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4457 wrong_type_argument (intern ("inserted-chars"), insval);
4458 inserted = XFASTINT (insval);
4461 else
4463 /* For the rationale of this see the comment on
4464 format-decode above. */
4465 ptrdiff_t opoint = PT;
4466 ptrdiff_t opoint_byte = PT_BYTE;
4467 ptrdiff_t oinserted = ZV - BEGV;
4468 EMACS_INT ochars_modiff = CHARS_MODIFF;
4470 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4471 insval = call1 (XCAR (p), make_number (oinserted));
4472 if (!NILP (insval))
4474 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4475 wrong_type_argument (intern ("inserted-chars"), insval);
4476 if (ochars_modiff == CHARS_MODIFF)
4477 /* after_insert_file_functions didn't modify
4478 buffer's characters => move point back to
4479 position before inserted text and leave value of
4480 inserted alone. */
4481 SET_PT_BOTH (opoint, opoint_byte);
4482 else
4483 /* after_insert_file_functions did modify buffer's
4484 characters => consider entire buffer changed and
4485 leave point at point-min. */
4486 inserted = XFASTINT (insval);
4490 QUIT;
4491 p = XCDR (p);
4494 if (!empty_undo_list_p)
4496 bset_undo_list (current_buffer, old_undo);
4497 if (CONSP (old_undo) && inserted != old_inserted)
4499 /* Adjust the last undo record for the size change during
4500 the format conversion. */
4501 Lisp_Object tem = XCAR (old_undo);
4502 if (CONSP (tem) && INTEGERP (XCAR (tem))
4503 && INTEGERP (XCDR (tem))
4504 && XFASTINT (XCDR (tem)) == PT + old_inserted)
4505 XSETCDR (tem, make_number (PT + inserted));
4508 else
4509 /* If undo_list was Qt before, keep it that way.
4510 Otherwise start with an empty undo_list. */
4511 bset_undo_list (current_buffer, EQ (old_undo, Qt) ? Qt : Qnil);
4513 unbind_to (count1, Qnil);
4516 if (!NILP (visit)
4517 && current_buffer->modtime.tv_nsec == NONEXISTENT_MODTIME_NSECS)
4519 /* If visiting nonexistent file, return nil. */
4520 report_file_errno ("Opening input file", orig_filename, save_errno);
4523 /* We made a lot of deletions and insertions above, so invalidate
4524 the newline cache for the entire region of the inserted
4525 characters. */
4526 if (current_buffer->base_buffer && current_buffer->base_buffer->newline_cache)
4527 invalidate_region_cache (current_buffer->base_buffer,
4528 current_buffer->base_buffer->newline_cache,
4529 PT - BEG, Z - PT - inserted);
4530 else if (current_buffer->newline_cache)
4531 invalidate_region_cache (current_buffer,
4532 current_buffer->newline_cache,
4533 PT - BEG, Z - PT - inserted);
4535 if (read_quit)
4536 Fsignal (Qquit, Qnil);
4538 /* Retval needs to be dealt with in all cases consistently. */
4539 if (NILP (val))
4540 val = list2 (orig_filename, make_number (inserted));
4542 RETURN_UNGCPRO (unbind_to (count, val));
4545 static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
4547 static void
4548 build_annotations_unwind (Lisp_Object arg)
4550 Vwrite_region_annotation_buffers = arg;
4553 /* Decide the coding-system to encode the data with. */
4555 static Lisp_Object
4556 choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4557 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4558 struct coding_system *coding)
4560 Lisp_Object val;
4561 Lisp_Object eol_parent = Qnil;
4563 if (auto_saving
4564 && NILP (Fstring_equal (BVAR (current_buffer, filename),
4565 BVAR (current_buffer, auto_save_file_name))))
4567 val = Qutf_8_emacs;
4568 eol_parent = Qunix;
4570 else if (!NILP (Vcoding_system_for_write))
4572 val = Vcoding_system_for_write;
4573 if (coding_system_require_warning
4574 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4575 /* Confirm that VAL can surely encode the current region. */
4576 val = call5 (Vselect_safe_coding_system_function,
4577 start, end, list2 (Qt, val),
4578 Qnil, filename);
4580 else
4582 /* If the variable `buffer-file-coding-system' is set locally,
4583 it means that the file was read with some kind of code
4584 conversion or the variable is explicitly set by users. We
4585 had better write it out with the same coding system even if
4586 `enable-multibyte-characters' is nil.
4588 If it is not set locally, we anyway have to convert EOL
4589 format if the default value of `buffer-file-coding-system'
4590 tells that it is not Unix-like (LF only) format. */
4591 bool using_default_coding = 0;
4592 bool force_raw_text = 0;
4594 val = BVAR (current_buffer, buffer_file_coding_system);
4595 if (NILP (val)
4596 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
4598 val = Qnil;
4599 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
4600 force_raw_text = 1;
4603 if (NILP (val))
4605 /* Check file-coding-system-alist. */
4606 Lisp_Object args[7], coding_systems;
4608 args[0] = Qwrite_region; args[1] = start; args[2] = end;
4609 args[3] = filename; args[4] = append; args[5] = visit;
4610 args[6] = lockname;
4611 coding_systems = Ffind_operation_coding_system (7, args);
4612 if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
4613 val = XCDR (coding_systems);
4616 if (NILP (val))
4618 /* If we still have not decided a coding system, use the
4619 default value of buffer-file-coding-system. */
4620 val = BVAR (current_buffer, buffer_file_coding_system);
4621 using_default_coding = 1;
4624 if (! NILP (val) && ! force_raw_text)
4626 Lisp_Object spec, attrs;
4628 CHECK_CODING_SYSTEM_GET_SPEC (val, spec);
4629 attrs = AREF (spec, 0);
4630 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
4631 force_raw_text = 1;
4634 if (!force_raw_text
4635 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4636 /* Confirm that VAL can surely encode the current region. */
4637 val = call5 (Vselect_safe_coding_system_function,
4638 start, end, val, Qnil, filename);
4640 /* If the decided coding-system doesn't specify end-of-line
4641 format, we use that of
4642 `default-buffer-file-coding-system'. */
4643 if (! using_default_coding
4644 && ! NILP (BVAR (&buffer_defaults, buffer_file_coding_system)))
4645 val = (coding_inherit_eol_type
4646 (val, BVAR (&buffer_defaults, buffer_file_coding_system)));
4648 /* If we decide not to encode text, use `raw-text' or one of its
4649 subsidiaries. */
4650 if (force_raw_text)
4651 val = raw_text_coding_system (val);
4654 val = coding_inherit_eol_type (val, eol_parent);
4655 setup_coding_system (val, coding);
4657 if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display)))
4658 coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
4659 return val;
4662 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
4663 "r\nFWrite region to file: \ni\ni\ni\np",
4664 doc: /* Write current region into specified file.
4665 When called from a program, requires three arguments:
4666 START, END and FILENAME. START and END are normally buffer positions
4667 specifying the part of the buffer to write.
4668 If START is nil, that means to use the entire buffer contents.
4669 If START is a string, then output that string to the file
4670 instead of any buffer contents; END is ignored.
4672 Optional fourth argument APPEND if non-nil means
4673 append to existing file contents (if any). If it is a number,
4674 seek to that offset in the file before writing.
4675 Optional fifth argument VISIT, if t or a string, means
4676 set the last-save-file-modtime of buffer to this file's modtime
4677 and mark buffer not modified.
4678 If VISIT is a string, it is a second file name;
4679 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4680 VISIT is also the file name to lock and unlock for clash detection.
4681 If VISIT is neither t nor nil nor a string,
4682 that means do not display the \"Wrote file\" message.
4683 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4684 use for locking and unlocking, overriding FILENAME and VISIT.
4685 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4686 for an existing file with the same name. If MUSTBENEW is `excl',
4687 that means to get an error if the file already exists; never overwrite.
4688 If MUSTBENEW is neither nil nor `excl', that means ask for
4689 confirmation before overwriting, but do go ahead and overwrite the file
4690 if the user confirms.
4692 This does code conversion according to the value of
4693 `coding-system-for-write', `buffer-file-coding-system', or
4694 `file-coding-system-alist', and sets the variable
4695 `last-coding-system-used' to the coding system actually used.
4697 This calls `write-region-annotate-functions' at the start, and
4698 `write-region-post-annotation-function' at the end. */)
4699 (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append,
4700 Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
4702 return write_region (start, end, filename, append, visit, lockname, mustbenew,
4703 -1);
4706 /* Like Fwrite_region, except that if DESC is nonnegative, it is a file
4707 descriptor for FILENAME, so do not open or close FILENAME. */
4709 Lisp_Object
4710 write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4711 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4712 Lisp_Object mustbenew, int desc)
4714 int open_flags;
4715 int mode;
4716 off_t offset IF_LINT (= 0);
4717 bool open_and_close_file = desc < 0;
4718 bool ok;
4719 int save_errno = 0;
4720 const char *fn;
4721 struct stat st;
4722 struct timespec modtime;
4723 ptrdiff_t count = SPECPDL_INDEX ();
4724 ptrdiff_t count1 IF_LINT (= 0);
4725 Lisp_Object handler;
4726 Lisp_Object visit_file;
4727 Lisp_Object annotations;
4728 Lisp_Object encoded_filename;
4729 bool visiting = (EQ (visit, Qt) || STRINGP (visit));
4730 bool quietly = !NILP (visit);
4731 bool file_locked = 0;
4732 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4733 struct buffer *given_buffer;
4734 struct coding_system coding;
4736 if (current_buffer->base_buffer && visiting)
4737 error ("Cannot do file visiting in an indirect buffer");
4739 if (!NILP (start) && !STRINGP (start))
4740 validate_region (&start, &end);
4742 visit_file = Qnil;
4743 GCPRO5 (start, filename, visit, visit_file, lockname);
4745 filename = Fexpand_file_name (filename, Qnil);
4747 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
4748 barf_or_query_if_file_exists (filename, false, "overwrite", true, true);
4750 if (STRINGP (visit))
4751 visit_file = Fexpand_file_name (visit, Qnil);
4752 else
4753 visit_file = filename;
4755 if (NILP (lockname))
4756 lockname = visit_file;
4758 annotations = Qnil;
4760 /* If the file name has special constructs in it,
4761 call the corresponding file handler. */
4762 handler = Ffind_file_name_handler (filename, Qwrite_region);
4763 /* If FILENAME has no handler, see if VISIT has one. */
4764 if (NILP (handler) && STRINGP (visit))
4765 handler = Ffind_file_name_handler (visit, Qwrite_region);
4767 if (!NILP (handler))
4769 Lisp_Object val;
4770 val = call6 (handler, Qwrite_region, start, end,
4771 filename, append, visit);
4773 if (visiting)
4775 SAVE_MODIFF = MODIFF;
4776 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
4777 bset_filename (current_buffer, visit_file);
4779 UNGCPRO;
4780 return val;
4783 record_unwind_protect (save_restriction_restore, save_restriction_save ());
4785 /* Special kludge to simplify auto-saving. */
4786 if (NILP (start))
4788 /* Do it later, so write-region-annotate-function can work differently
4789 if we save "the buffer" vs "a region".
4790 This is useful in tar-mode. --Stef
4791 XSETFASTINT (start, BEG);
4792 XSETFASTINT (end, Z); */
4793 Fwiden ();
4796 record_unwind_protect (build_annotations_unwind,
4797 Vwrite_region_annotation_buffers);
4798 Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ());
4800 given_buffer = current_buffer;
4802 if (!STRINGP (start))
4804 annotations = build_annotations (start, end);
4806 if (current_buffer != given_buffer)
4808 XSETFASTINT (start, BEGV);
4809 XSETFASTINT (end, ZV);
4813 if (NILP (start))
4815 XSETFASTINT (start, BEGV);
4816 XSETFASTINT (end, ZV);
4819 UNGCPRO;
4821 GCPRO5 (start, filename, annotations, visit_file, lockname);
4823 /* Decide the coding-system to encode the data with.
4824 We used to make this choice before calling build_annotations, but that
4825 leads to problems when a write-annotate-function takes care of
4826 unsavable chars (as was the case with X-Symbol). */
4827 Vlast_coding_system_used
4828 = choose_write_coding_system (start, end, filename,
4829 append, visit, lockname, &coding);
4831 if (open_and_close_file && !auto_saving)
4833 lock_file (lockname);
4834 file_locked = 1;
4837 encoded_filename = ENCODE_FILE (filename);
4838 fn = SSDATA (encoded_filename);
4839 open_flags = O_WRONLY | O_BINARY | O_CREAT;
4840 open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
4841 if (NUMBERP (append))
4842 offset = file_offset (append);
4843 else if (!NILP (append))
4844 open_flags |= O_APPEND;
4845 #ifdef DOS_NT
4846 mode = S_IREAD | S_IWRITE;
4847 #else
4848 mode = auto_saving ? auto_save_mode_bits : 0666;
4849 #endif
4851 if (open_and_close_file)
4853 desc = emacs_open (fn, open_flags, mode);
4854 if (desc < 0)
4856 int open_errno = errno;
4857 if (file_locked)
4858 unlock_file (lockname);
4859 UNGCPRO;
4860 report_file_errno ("Opening output file", filename, open_errno);
4863 count1 = SPECPDL_INDEX ();
4864 record_unwind_protect_int (close_file_unwind, desc);
4867 if (NUMBERP (append))
4869 off_t ret = lseek (desc, offset, SEEK_SET);
4870 if (ret < 0)
4872 int lseek_errno = errno;
4873 if (file_locked)
4874 unlock_file (lockname);
4875 UNGCPRO;
4876 report_file_errno ("Lseek error", filename, lseek_errno);
4880 UNGCPRO;
4882 immediate_quit = 1;
4884 if (STRINGP (start))
4885 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
4886 else if (XINT (start) != XINT (end))
4887 ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start),
4888 &annotations, &coding);
4889 else
4891 /* If file was empty, still need to write the annotations. */
4892 coding.mode |= CODING_MODE_LAST_BLOCK;
4893 ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
4895 save_errno = errno;
4897 if (ok && CODING_REQUIRE_FLUSHING (&coding)
4898 && !(coding.mode & CODING_MODE_LAST_BLOCK))
4900 /* We have to flush out a data. */
4901 coding.mode |= CODING_MODE_LAST_BLOCK;
4902 ok = e_write (desc, Qnil, 1, 1, &coding);
4903 save_errno = errno;
4906 immediate_quit = 0;
4908 /* fsync is not crucial for temporary files. Nor for auto-save
4909 files, since they might lose some work anyway. */
4910 if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
4912 /* Transfer data and metadata to disk, retrying if interrupted.
4913 fsync can report a write failure here, e.g., due to disk full
4914 under NFS. But ignore EINVAL, which means fsync is not
4915 supported on this file. */
4916 while (fsync (desc) != 0)
4917 if (errno != EINTR)
4919 if (errno != EINVAL)
4920 ok = 0, save_errno = errno;
4921 break;
4925 modtime = invalid_timespec ();
4926 if (visiting)
4928 if (fstat (desc, &st) == 0)
4929 modtime = get_stat_mtime (&st);
4930 else
4931 ok = 0, save_errno = errno;
4934 if (open_and_close_file)
4936 /* NFS can report a write failure now. */
4937 if (emacs_close (desc) < 0)
4938 ok = 0, save_errno = errno;
4940 /* Discard the unwind protect for close_file_unwind. */
4941 specpdl_ptr = specpdl + count1;
4944 /* Some file systems have a bug where st_mtime is not updated
4945 properly after a write. For example, CIFS might not see the
4946 st_mtime change until after the file is opened again.
4948 Attempt to detect this file system bug, and update MODTIME to the
4949 newer st_mtime if the bug appears to be present. This introduces
4950 a race condition, so to avoid most instances of the race condition
4951 on non-buggy file systems, skip this check if the most recently
4952 encountered non-buggy file system was the current file system.
4954 A race condition can occur if some other process modifies the
4955 file between the fstat above and the fstat below, but the race is
4956 unlikely and a similar race between the last write and the fstat
4957 above cannot possibly be closed anyway. */
4959 if (timespec_valid_p (modtime)
4960 && ! (valid_timestamp_file_system && st.st_dev == timestamp_file_system))
4962 int desc1 = emacs_open (fn, O_WRONLY | O_BINARY, 0);
4963 if (desc1 >= 0)
4965 struct stat st1;
4966 if (fstat (desc1, &st1) == 0
4967 && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino)
4969 /* Use the heuristic if it appears to be valid. With neither
4970 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
4971 file, the time stamp won't change. Also, some non-POSIX
4972 systems don't update an empty file's time stamp when
4973 truncating it. Finally, file systems with 100 ns or worse
4974 resolution sometimes seem to have bugs: on a system with ns
4975 resolution, checking ns % 100 incorrectly avoids the heuristic
4976 1% of the time, but the problem should be temporary as we will
4977 try again on the next time stamp. */
4978 bool use_heuristic
4979 = ((open_flags & (O_EXCL | O_TRUNC)) != 0
4980 && st.st_size != 0
4981 && modtime.tv_nsec % 100 != 0);
4983 struct timespec modtime1 = get_stat_mtime (&st1);
4984 if (use_heuristic
4985 && timespec_cmp (modtime, modtime1) == 0
4986 && st.st_size == st1.st_size)
4988 timestamp_file_system = st.st_dev;
4989 valid_timestamp_file_system = 1;
4991 else
4993 st.st_size = st1.st_size;
4994 modtime = modtime1;
4997 emacs_close (desc1);
5001 /* Call write-region-post-annotation-function. */
5002 while (CONSP (Vwrite_region_annotation_buffers))
5004 Lisp_Object buf = XCAR (Vwrite_region_annotation_buffers);
5005 if (!NILP (Fbuffer_live_p (buf)))
5007 Fset_buffer (buf);
5008 if (FUNCTIONP (Vwrite_region_post_annotation_function))
5009 call0 (Vwrite_region_post_annotation_function);
5011 Vwrite_region_annotation_buffers
5012 = XCDR (Vwrite_region_annotation_buffers);
5015 unbind_to (count, Qnil);
5017 if (file_locked)
5018 unlock_file (lockname);
5020 /* Do this before reporting IO error
5021 to avoid a "file has changed on disk" warning on
5022 next attempt to save. */
5023 if (timespec_valid_p (modtime))
5025 current_buffer->modtime = modtime;
5026 current_buffer->modtime_size = st.st_size;
5029 if (! ok)
5030 report_file_errno ("Write error", filename, save_errno);
5032 if (visiting)
5034 SAVE_MODIFF = MODIFF;
5035 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5036 bset_filename (current_buffer, visit_file);
5037 update_mode_lines = 14;
5039 else if (quietly)
5041 if (auto_saving
5042 && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
5043 BVAR (current_buffer, auto_save_file_name))))
5044 SAVE_MODIFF = MODIFF;
5046 return Qnil;
5049 if (!auto_saving)
5050 message_with_string ((NUMBERP (append)
5051 ? "Updated %s"
5052 : ! NILP (append)
5053 ? "Added to %s"
5054 : "Wrote %s"),
5055 visit_file, 1);
5057 return Qnil;
5060 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
5061 doc: /* Return t if (car A) is numerically less than (car B). */)
5062 (Lisp_Object a, Lisp_Object b)
5064 Lisp_Object args[2];
5065 args[0] = Fcar (a);
5066 args[1] = Fcar (b);
5067 return Flss (2, args);
5070 /* Build the complete list of annotations appropriate for writing out
5071 the text between START and END, by calling all the functions in
5072 write-region-annotate-functions and merging the lists they return.
5073 If one of these functions switches to a different buffer, we assume
5074 that buffer contains altered text. Therefore, the caller must
5075 make sure to restore the current buffer in all cases,
5076 as save-excursion would do. */
5078 static Lisp_Object
5079 build_annotations (Lisp_Object start, Lisp_Object end)
5081 Lisp_Object annotations;
5082 Lisp_Object p, res;
5083 struct gcpro gcpro1, gcpro2;
5084 Lisp_Object original_buffer;
5085 int i;
5086 bool used_global = 0;
5088 XSETBUFFER (original_buffer, current_buffer);
5090 annotations = Qnil;
5091 p = Vwrite_region_annotate_functions;
5092 GCPRO2 (annotations, p);
5093 while (CONSP (p))
5095 struct buffer *given_buffer = current_buffer;
5096 if (EQ (Qt, XCAR (p)) && !used_global)
5097 { /* Use the global value of the hook. */
5098 Lisp_Object arg[2];
5099 used_global = 1;
5100 arg[0] = Fdefault_value (Qwrite_region_annotate_functions);
5101 arg[1] = XCDR (p);
5102 p = Fappend (2, arg);
5103 continue;
5105 Vwrite_region_annotations_so_far = annotations;
5106 res = call2 (XCAR (p), start, end);
5107 /* If the function makes a different buffer current,
5108 assume that means this buffer contains altered text to be output.
5109 Reset START and END from the buffer bounds
5110 and discard all previous annotations because they should have
5111 been dealt with by this function. */
5112 if (current_buffer != given_buffer)
5114 Vwrite_region_annotation_buffers
5115 = Fcons (Fcurrent_buffer (),
5116 Vwrite_region_annotation_buffers);
5117 XSETFASTINT (start, BEGV);
5118 XSETFASTINT (end, ZV);
5119 annotations = Qnil;
5121 Flength (res); /* Check basic validity of return value */
5122 annotations = merge (annotations, res, Qcar_less_than_car);
5123 p = XCDR (p);
5126 /* Now do the same for annotation functions implied by the file-format */
5127 if (auto_saving && (!EQ (BVAR (current_buffer, auto_save_file_format), Qt)))
5128 p = BVAR (current_buffer, auto_save_file_format);
5129 else
5130 p = BVAR (current_buffer, file_format);
5131 for (i = 0; CONSP (p); p = XCDR (p), ++i)
5133 struct buffer *given_buffer = current_buffer;
5135 Vwrite_region_annotations_so_far = annotations;
5137 /* Value is either a list of annotations or nil if the function
5138 has written annotations to a temporary buffer, which is now
5139 current. */
5140 res = call5 (Qformat_annotate_function, XCAR (p), start, end,
5141 original_buffer, make_number (i));
5142 if (current_buffer != given_buffer)
5144 XSETFASTINT (start, BEGV);
5145 XSETFASTINT (end, ZV);
5146 annotations = Qnil;
5149 if (CONSP (res))
5150 annotations = merge (annotations, res, Qcar_less_than_car);
5153 UNGCPRO;
5154 return annotations;
5158 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5159 If STRING is nil, POS is the character position in the current buffer.
5160 Intersperse with them the annotations from *ANNOT
5161 which fall within the range of POS to POS + NCHARS,
5162 each at its appropriate position.
5164 We modify *ANNOT by discarding elements as we use them up.
5166 Return true if successful. */
5168 static bool
5169 a_write (int desc, Lisp_Object string, ptrdiff_t pos,
5170 ptrdiff_t nchars, Lisp_Object *annot,
5171 struct coding_system *coding)
5173 Lisp_Object tem;
5174 ptrdiff_t nextpos;
5175 ptrdiff_t lastpos = pos + nchars;
5177 while (NILP (*annot) || CONSP (*annot))
5179 tem = Fcar_safe (Fcar (*annot));
5180 nextpos = pos - 1;
5181 if (INTEGERP (tem))
5182 nextpos = XFASTINT (tem);
5184 /* If there are no more annotations in this range,
5185 output the rest of the range all at once. */
5186 if (! (nextpos >= pos && nextpos <= lastpos))
5187 return e_write (desc, string, pos, lastpos, coding);
5189 /* Output buffer text up to the next annotation's position. */
5190 if (nextpos > pos)
5192 if (!e_write (desc, string, pos, nextpos, coding))
5193 return 0;
5194 pos = nextpos;
5196 /* Output the annotation. */
5197 tem = Fcdr (Fcar (*annot));
5198 if (STRINGP (tem))
5200 if (!e_write (desc, tem, 0, SCHARS (tem), coding))
5201 return 0;
5203 *annot = Fcdr (*annot);
5205 return 1;
5208 /* Maximum number of characters that the next
5209 function encodes per one loop iteration. */
5211 enum { E_WRITE_MAX = 8 * 1024 * 1024 };
5213 /* Write text in the range START and END into descriptor DESC,
5214 encoding them with coding system CODING. If STRING is nil, START
5215 and END are character positions of the current buffer, else they
5216 are indexes to the string STRING. Return true if successful. */
5218 static bool
5219 e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
5220 struct coding_system *coding)
5222 if (STRINGP (string))
5224 start = 0;
5225 end = SCHARS (string);
5228 /* We used to have a code for handling selective display here. But,
5229 now it is handled within encode_coding. */
5231 while (start < end)
5233 if (STRINGP (string))
5235 coding->src_multibyte = SCHARS (string) < SBYTES (string);
5236 if (CODING_REQUIRE_ENCODING (coding))
5238 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5240 /* Avoid creating huge Lisp string in encode_coding_object. */
5241 if (nchars == E_WRITE_MAX)
5242 coding->raw_destination = 1;
5244 encode_coding_object
5245 (coding, string, start, string_char_to_byte (string, start),
5246 start + nchars, string_char_to_byte (string, start + nchars),
5247 Qt);
5249 else
5251 coding->dst_object = string;
5252 coding->consumed_char = SCHARS (string);
5253 coding->produced = SBYTES (string);
5256 else
5258 ptrdiff_t start_byte = CHAR_TO_BYTE (start);
5259 ptrdiff_t end_byte = CHAR_TO_BYTE (end);
5261 coding->src_multibyte = (end - start) < (end_byte - start_byte);
5262 if (CODING_REQUIRE_ENCODING (coding))
5264 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5266 /* Likewise. */
5267 if (nchars == E_WRITE_MAX)
5268 coding->raw_destination = 1;
5270 encode_coding_object
5271 (coding, Fcurrent_buffer (), start, start_byte,
5272 start + nchars, CHAR_TO_BYTE (start + nchars), Qt);
5274 else
5276 coding->dst_object = Qnil;
5277 coding->dst_pos_byte = start_byte;
5278 if (start >= GPT || end <= GPT)
5280 coding->consumed_char = end - start;
5281 coding->produced = end_byte - start_byte;
5283 else
5285 coding->consumed_char = GPT - start;
5286 coding->produced = GPT_BYTE - start_byte;
5291 if (coding->produced > 0)
5293 char *buf = (coding->raw_destination ? (char *) coding->destination
5294 : (STRINGP (coding->dst_object)
5295 ? SSDATA (coding->dst_object)
5296 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
5297 coding->produced -= emacs_write_sig (desc, buf, coding->produced);
5299 if (coding->raw_destination)
5301 /* We're responsible for freeing this, see
5302 encode_coding_object to check why. */
5303 xfree (coding->destination);
5304 coding->raw_destination = 0;
5306 if (coding->produced)
5307 return 0;
5309 start += coding->consumed_char;
5312 return 1;
5315 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
5316 Sverify_visited_file_modtime, 0, 1, 0,
5317 doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
5318 This means that the file has not been changed since it was visited or saved.
5319 If BUF is omitted or nil, it defaults to the current buffer.
5320 See Info node `(elisp)Modification Time' for more details. */)
5321 (Lisp_Object buf)
5323 struct buffer *b = decode_buffer (buf);
5324 struct stat st;
5325 Lisp_Object handler;
5326 Lisp_Object filename;
5327 struct timespec mtime;
5329 if (!STRINGP (BVAR (b, filename))) return Qt;
5330 if (b->modtime.tv_nsec == UNKNOWN_MODTIME_NSECS) return Qt;
5332 /* If the file name has special constructs in it,
5333 call the corresponding file handler. */
5334 handler = Ffind_file_name_handler (BVAR (b, filename),
5335 Qverify_visited_file_modtime);
5336 if (!NILP (handler))
5337 return call2 (handler, Qverify_visited_file_modtime, buf);
5339 filename = ENCODE_FILE (BVAR (b, filename));
5341 mtime = (stat (SSDATA (filename), &st) == 0
5342 ? get_stat_mtime (&st)
5343 : time_error_value (errno));
5344 if (timespec_cmp (mtime, b->modtime) == 0
5345 && (b->modtime_size < 0
5346 || st.st_size == b->modtime_size))
5347 return Qt;
5348 return Qnil;
5351 DEFUN ("visited-file-modtime", Fvisited_file_modtime,
5352 Svisited_file_modtime, 0, 0, 0,
5353 doc: /* Return the current buffer's recorded visited file modification time.
5354 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5355 `file-attributes' returns. If the current buffer has no recorded file
5356 modification time, this function returns 0. If the visited file
5357 doesn't exist, return -1.
5358 See Info node `(elisp)Modification Time' for more details. */)
5359 (void)
5361 int ns = current_buffer->modtime.tv_nsec;
5362 if (ns < 0)
5363 return make_number (UNKNOWN_MODTIME_NSECS - ns);
5364 return make_lisp_time (current_buffer->modtime);
5367 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
5368 Sset_visited_file_modtime, 0, 1, 0,
5369 doc: /* Update buffer's recorded modification time from the visited file's time.
5370 Useful if the buffer was not read from the file normally
5371 or if the file itself has been changed for some known benign reason.
5372 An argument specifies the modification time value to use
5373 \(instead of that of the visited file), in the form of a list
5374 \(HIGH LOW USEC PSEC) or an integer flag as returned by
5375 `visited-file-modtime'. */)
5376 (Lisp_Object time_flag)
5378 if (!NILP (time_flag))
5380 struct timespec mtime;
5381 if (INTEGERP (time_flag))
5383 CHECK_RANGED_INTEGER (time_flag, -1, 0);
5384 mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag));
5386 else
5387 mtime = lisp_time_argument (time_flag);
5389 current_buffer->modtime = mtime;
5390 current_buffer->modtime_size = -1;
5392 else
5394 register Lisp_Object filename;
5395 struct stat st;
5396 Lisp_Object handler;
5398 filename = Fexpand_file_name (BVAR (current_buffer, filename), Qnil);
5400 /* If the file name has special constructs in it,
5401 call the corresponding file handler. */
5402 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
5403 if (!NILP (handler))
5404 /* The handler can find the file name the same way we did. */
5405 return call2 (handler, Qset_visited_file_modtime, Qnil);
5407 filename = ENCODE_FILE (filename);
5409 if (stat (SSDATA (filename), &st) >= 0)
5411 current_buffer->modtime = get_stat_mtime (&st);
5412 current_buffer->modtime_size = st.st_size;
5416 return Qnil;
5419 static Lisp_Object
5420 auto_save_error (Lisp_Object error_val)
5422 Lisp_Object msg;
5423 int i;
5424 struct gcpro gcpro1;
5426 auto_save_error_occurred = 1;
5428 ring_bell (XFRAME (selected_frame));
5430 AUTO_STRING (format, "Auto-saving %s: %s");
5431 msg = Fformat (3, ((Lisp_Object [])
5432 {format, BVAR (current_buffer, name),
5433 Ferror_message_string (error_val)}));
5434 GCPRO1 (msg);
5436 for (i = 0; i < 3; ++i)
5438 if (i == 0)
5439 message3 (msg);
5440 else
5441 message3_nolog (msg);
5442 Fsleep_for (make_number (1), Qnil);
5445 UNGCPRO;
5446 return Qnil;
5449 static Lisp_Object
5450 auto_save_1 (void)
5452 struct stat st;
5453 Lisp_Object modes;
5455 auto_save_mode_bits = 0666;
5457 /* Get visited file's mode to become the auto save file's mode. */
5458 if (! NILP (BVAR (current_buffer, filename)))
5460 if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0)
5461 /* But make sure we can overwrite it later! */
5462 auto_save_mode_bits = (st.st_mode | 0600) & 0777;
5463 else if (modes = Ffile_modes (BVAR (current_buffer, filename)),
5464 INTEGERP (modes))
5465 /* Remote files don't cooperate with stat. */
5466 auto_save_mode_bits = (XINT (modes) | 0600) & 0777;
5469 return
5470 Fwrite_region (Qnil, Qnil, BVAR (current_buffer, auto_save_file_name), Qnil,
5471 NILP (Vauto_save_visited_file_name) ? Qlambda : Qt,
5472 Qnil, Qnil);
5475 struct auto_save_unwind
5477 FILE *stream;
5478 bool auto_raise;
5481 static void
5482 do_auto_save_unwind (void *arg)
5484 struct auto_save_unwind *p = arg;
5485 FILE *stream = p->stream;
5486 minibuffer_auto_raise = p->auto_raise;
5487 auto_saving = 0;
5488 if (stream != NULL)
5490 block_input ();
5491 fclose (stream);
5492 unblock_input ();
5496 static Lisp_Object
5497 do_auto_save_make_dir (Lisp_Object dir)
5499 Lisp_Object result;
5501 auto_saving_dir_umask = 077;
5502 result = call2 (Qmake_directory, dir, Qt);
5503 auto_saving_dir_umask = 0;
5504 return result;
5507 static Lisp_Object
5508 do_auto_save_eh (Lisp_Object ignore)
5510 auto_saving_dir_umask = 0;
5511 return Qnil;
5514 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
5515 doc: /* Auto-save all buffers that need it.
5516 This is all buffers that have auto-saving enabled
5517 and are changed since last auto-saved.
5518 Auto-saving writes the buffer into a file
5519 so that your editing is not lost if the system crashes.
5520 This file is not the file you visited; that changes only when you save.
5521 Normally we run the normal hook `auto-save-hook' before saving.
5523 A non-nil NO-MESSAGE argument means do not print any message if successful.
5524 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5525 (Lisp_Object no_message, Lisp_Object current_only)
5527 struct buffer *old = current_buffer, *b;
5528 Lisp_Object tail, buf, hook;
5529 bool auto_saved = 0;
5530 int do_handled_files;
5531 Lisp_Object oquit;
5532 FILE *stream = NULL;
5533 ptrdiff_t count = SPECPDL_INDEX ();
5534 bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
5535 bool old_message_p = 0;
5536 struct auto_save_unwind auto_save_unwind;
5537 struct gcpro gcpro1, gcpro2;
5539 if (max_specpdl_size < specpdl_size + 40)
5540 max_specpdl_size = specpdl_size + 40;
5542 if (minibuf_level)
5543 no_message = Qt;
5545 if (NILP (no_message))
5547 old_message_p = push_message ();
5548 record_unwind_protect_void (pop_message_unwind);
5551 /* Ordinarily don't quit within this function,
5552 but don't make it impossible to quit (in case we get hung in I/O). */
5553 oquit = Vquit_flag;
5554 Vquit_flag = Qnil;
5556 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5557 point to non-strings reached from Vbuffer_alist. */
5559 hook = intern ("auto-save-hook");
5560 safe_run_hooks (hook);
5562 if (STRINGP (Vauto_save_list_file_name))
5564 Lisp_Object listfile;
5566 listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
5568 /* Don't try to create the directory when shutting down Emacs,
5569 because creating the directory might signal an error, and
5570 that would leave Emacs in a strange state. */
5571 if (!NILP (Vrun_hooks))
5573 Lisp_Object dir;
5574 dir = Qnil;
5575 GCPRO2 (dir, listfile);
5576 dir = Ffile_name_directory (listfile);
5577 if (NILP (Ffile_directory_p (dir)))
5578 internal_condition_case_1 (do_auto_save_make_dir,
5579 dir, Qt,
5580 do_auto_save_eh);
5581 UNGCPRO;
5584 stream = emacs_fopen (SSDATA (listfile), "w");
5587 auto_save_unwind.stream = stream;
5588 auto_save_unwind.auto_raise = minibuffer_auto_raise;
5589 record_unwind_protect_ptr (do_auto_save_unwind, &auto_save_unwind);
5590 minibuffer_auto_raise = 0;
5591 auto_saving = 1;
5592 auto_save_error_occurred = 0;
5594 /* On first pass, save all files that don't have handlers.
5595 On second pass, save all files that do have handlers.
5597 If Emacs is crashing, the handlers may tweak what is causing
5598 Emacs to crash in the first place, and it would be a shame if
5599 Emacs failed to autosave perfectly ordinary files because it
5600 couldn't handle some ange-ftp'd file. */
5602 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
5603 FOR_EACH_LIVE_BUFFER (tail, buf)
5605 b = XBUFFER (buf);
5607 /* Record all the buffers that have auto save mode
5608 in the special file that lists them. For each of these buffers,
5609 Record visited name (if any) and auto save name. */
5610 if (STRINGP (BVAR (b, auto_save_file_name))
5611 && stream != NULL && do_handled_files == 0)
5613 block_input ();
5614 if (!NILP (BVAR (b, filename)))
5616 fwrite (SDATA (BVAR (b, filename)), 1,
5617 SBYTES (BVAR (b, filename)), stream);
5619 putc ('\n', stream);
5620 fwrite (SDATA (BVAR (b, auto_save_file_name)), 1,
5621 SBYTES (BVAR (b, auto_save_file_name)), stream);
5622 putc ('\n', stream);
5623 unblock_input ();
5626 if (!NILP (current_only)
5627 && b != current_buffer)
5628 continue;
5630 /* Don't auto-save indirect buffers.
5631 The base buffer takes care of it. */
5632 if (b->base_buffer)
5633 continue;
5635 /* Check for auto save enabled
5636 and file changed since last auto save
5637 and file changed since last real save. */
5638 if (STRINGP (BVAR (b, auto_save_file_name))
5639 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
5640 && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b)
5641 /* -1 means we've turned off autosaving for a while--see below. */
5642 && XINT (BVAR (b, save_length)) >= 0
5643 && (do_handled_files
5644 || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
5645 Qwrite_region))))
5647 struct timespec before_time = current_timespec ();
5648 struct timespec after_time;
5650 /* If we had a failure, don't try again for 20 minutes. */
5651 if (b->auto_save_failure_time > 0
5652 && before_time.tv_sec - b->auto_save_failure_time < 1200)
5653 continue;
5655 set_buffer_internal (b);
5656 if (NILP (Vauto_save_include_big_deletions)
5657 && (XFASTINT (BVAR (b, save_length)) * 10
5658 > (BUF_Z (b) - BUF_BEG (b)) * 13)
5659 /* A short file is likely to change a large fraction;
5660 spare the user annoying messages. */
5661 && XFASTINT (BVAR (b, save_length)) > 5000
5662 /* These messages are frequent and annoying for `*mail*'. */
5663 && !EQ (BVAR (b, filename), Qnil)
5664 && NILP (no_message))
5666 /* It has shrunk too much; turn off auto-saving here. */
5667 minibuffer_auto_raise = orig_minibuffer_auto_raise;
5668 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5669 BVAR (b, name), 1);
5670 minibuffer_auto_raise = 0;
5671 /* Turn off auto-saving until there's a real save,
5672 and prevent any more warnings. */
5673 XSETINT (BVAR (b, save_length), -1);
5674 Fsleep_for (make_number (1), Qnil);
5675 continue;
5677 if (!auto_saved && NILP (no_message))
5678 message1 ("Auto-saving...");
5679 internal_condition_case (auto_save_1, Qt, auto_save_error);
5680 auto_saved = 1;
5681 BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
5682 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5683 set_buffer_internal (old);
5685 after_time = current_timespec ();
5687 /* If auto-save took more than 60 seconds,
5688 assume it was an NFS failure that got a timeout. */
5689 if (after_time.tv_sec - before_time.tv_sec > 60)
5690 b->auto_save_failure_time = after_time.tv_sec;
5694 /* Prevent another auto save till enough input events come in. */
5695 record_auto_save ();
5697 if (auto_saved && NILP (no_message))
5699 if (old_message_p)
5701 /* If we are going to restore an old message,
5702 give time to read ours. */
5703 sit_for (make_number (1), 0, 0);
5704 restore_message ();
5706 else if (!auto_save_error_occurred)
5707 /* Don't overwrite the error message if an error occurred.
5708 If we displayed a message and then restored a state
5709 with no message, leave a "done" message on the screen. */
5710 message1 ("Auto-saving...done");
5713 Vquit_flag = oquit;
5715 /* This restores the message-stack status. */
5716 unbind_to (count, Qnil);
5717 return Qnil;
5720 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
5721 Sset_buffer_auto_saved, 0, 0, 0,
5722 doc: /* Mark current buffer as auto-saved with its current text.
5723 No auto-save file will be written until the buffer changes again. */)
5724 (void)
5726 /* FIXME: This should not be called in indirect buffers, since
5727 they're not autosaved. */
5728 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
5729 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5730 current_buffer->auto_save_failure_time = 0;
5731 return Qnil;
5734 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
5735 Sclear_buffer_auto_save_failure, 0, 0, 0,
5736 doc: /* Clear any record of a recent auto-save failure in the current buffer. */)
5737 (void)
5739 current_buffer->auto_save_failure_time = 0;
5740 return Qnil;
5743 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
5744 0, 0, 0,
5745 doc: /* Return t if current buffer has been auto-saved recently.
5746 More precisely, if it has been auto-saved since last read from or saved
5747 in the visited file. If the buffer has no visited file,
5748 then any auto-save counts as "recent". */)
5749 (void)
5751 /* FIXME: maybe we should return nil for indirect buffers since
5752 they're never autosaved. */
5753 return (SAVE_MODIFF < BUF_AUTOSAVE_MODIFF (current_buffer) ? Qt : Qnil);
5756 /* Reading and completing file names */
5758 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
5759 Snext_read_file_uses_dialog_p, 0, 0, 0,
5760 doc: /* Return t if a call to `read-file-name' will use a dialog.
5761 The return value is only relevant for a call to `read-file-name' that happens
5762 before any other event (mouse or keypress) is handled. */)
5763 (void)
5765 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) \
5766 || defined (HAVE_NS)
5767 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
5768 && use_dialog_box
5769 && use_file_dialog
5770 && window_system_available (SELECTED_FRAME ()))
5771 return Qt;
5772 #endif
5773 return Qnil;
5776 void
5777 init_fileio (void)
5779 realmask = umask (0);
5780 umask (realmask);
5782 valid_timestamp_file_system = 0;
5784 /* fsync can be a significant performance hit. Often it doesn't
5785 suffice to make the file-save operation survive a crash. For
5786 batch scripts, which are typically part of larger shell commands
5787 that don't fsync other files, its effect on performance can be
5788 significant so its utility is particularly questionable.
5789 Hence, for now by default fsync is used only when interactive.
5791 For more on why fsync often fails to work on today's hardware, see:
5792 Zheng M et al. Understanding the robustness of SSDs under power fault.
5793 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
5794 http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
5796 For more on why fsync does not suffice even if it works properly, see:
5797 Roche X. Necessary step(s) to synchronize filename operations on disk.
5798 Austin Group Defect 672, 2013-03-19
5799 http://austingroupbugs.net/view.php?id=672 */
5800 write_region_inhibit_fsync = noninteractive;
5803 void
5804 syms_of_fileio (void)
5806 DEFSYM (Qoperations, "operations");
5807 DEFSYM (Qexpand_file_name, "expand-file-name");
5808 DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name");
5809 DEFSYM (Qdirectory_file_name, "directory-file-name");
5810 DEFSYM (Qfile_name_directory, "file-name-directory");
5811 DEFSYM (Qfile_name_nondirectory, "file-name-nondirectory");
5812 DEFSYM (Qunhandled_file_name_directory, "unhandled-file-name-directory");
5813 DEFSYM (Qfile_name_as_directory, "file-name-as-directory");
5814 DEFSYM (Qcopy_file, "copy-file");
5815 DEFSYM (Qmake_directory_internal, "make-directory-internal");
5816 DEFSYM (Qmake_directory, "make-directory");
5817 DEFSYM (Qdelete_directory_internal, "delete-directory-internal");
5818 DEFSYM (Qdelete_file, "delete-file");
5819 DEFSYM (Qrename_file, "rename-file");
5820 DEFSYM (Qadd_name_to_file, "add-name-to-file");
5821 DEFSYM (Qmake_symbolic_link, "make-symbolic-link");
5822 DEFSYM (Qfile_exists_p, "file-exists-p");
5823 DEFSYM (Qfile_executable_p, "file-executable-p");
5824 DEFSYM (Qfile_readable_p, "file-readable-p");
5825 DEFSYM (Qfile_writable_p, "file-writable-p");
5826 DEFSYM (Qfile_symlink_p, "file-symlink-p");
5827 DEFSYM (Qaccess_file, "access-file");
5828 DEFSYM (Qfile_directory_p, "file-directory-p");
5829 DEFSYM (Qfile_regular_p, "file-regular-p");
5830 DEFSYM (Qfile_accessible_directory_p, "file-accessible-directory-p");
5831 DEFSYM (Qfile_modes, "file-modes");
5832 DEFSYM (Qset_file_modes, "set-file-modes");
5833 DEFSYM (Qset_file_times, "set-file-times");
5834 DEFSYM (Qfile_selinux_context, "file-selinux-context");
5835 DEFSYM (Qset_file_selinux_context, "set-file-selinux-context");
5836 DEFSYM (Qfile_acl, "file-acl");
5837 DEFSYM (Qset_file_acl, "set-file-acl");
5838 DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
5839 DEFSYM (Qinsert_file_contents, "insert-file-contents");
5840 DEFSYM (Qwrite_region, "write-region");
5841 DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
5842 DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
5843 DEFSYM (Qauto_save_coding, "auto-save-coding");
5845 DEFSYM (Qfile_name_history, "file-name-history");
5846 Fset (Qfile_name_history, Qnil);
5848 DEFSYM (Qfile_error, "file-error");
5849 DEFSYM (Qfile_already_exists, "file-already-exists");
5850 DEFSYM (Qfile_date_error, "file-date-error");
5851 DEFSYM (Qfile_notify_error, "file-notify-error");
5852 DEFSYM (Qexcl, "excl");
5854 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
5855 doc: /* Coding system for encoding file names.
5856 If it is nil, `default-file-name-coding-system' (which see) is used.
5858 On MS-Windows, the value of this variable is largely ignored if
5859 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5860 behaves as if file names were encoded in `utf-8'. */);
5861 Vfile_name_coding_system = Qnil;
5863 DEFVAR_LISP ("default-file-name-coding-system",
5864 Vdefault_file_name_coding_system,
5865 doc: /* Default coding system for encoding file names.
5866 This variable is used only when `file-name-coding-system' is nil.
5868 This variable is set/changed by the command `set-language-environment'.
5869 User should not set this variable manually,
5870 instead use `file-name-coding-system' to get a constant encoding
5871 of file names regardless of the current language environment.
5873 On MS-Windows, the value of this variable is largely ignored if
5874 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5875 behaves as if file names were encoded in `utf-8'. */);
5876 Vdefault_file_name_coding_system = Qnil;
5878 DEFSYM (Qformat_decode, "format-decode");
5879 DEFSYM (Qformat_annotate_function, "format-annotate-function");
5880 DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding");
5881 DEFSYM (Qcar_less_than_car, "car-less-than-car");
5883 Fput (Qfile_error, Qerror_conditions,
5884 Fpurecopy (list2 (Qfile_error, Qerror)));
5885 Fput (Qfile_error, Qerror_message,
5886 build_pure_c_string ("File error"));
5888 Fput (Qfile_already_exists, Qerror_conditions,
5889 Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
5890 Fput (Qfile_already_exists, Qerror_message,
5891 build_pure_c_string ("File already exists"));
5893 Fput (Qfile_date_error, Qerror_conditions,
5894 Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
5895 Fput (Qfile_date_error, Qerror_message,
5896 build_pure_c_string ("Cannot set file date"));
5898 Fput (Qfile_notify_error, Qerror_conditions,
5899 Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
5900 Fput (Qfile_notify_error, Qerror_message,
5901 build_pure_c_string ("File notification error"));
5903 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
5904 doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5905 If a file name matches REGEXP, all I/O on that file is done by calling
5906 HANDLER. If a file name matches more than one handler, the handler
5907 whose match starts last in the file name gets precedence. The
5908 function `find-file-name-handler' checks this list for a handler for
5909 its argument.
5911 HANDLER should be a function. The first argument given to it is the
5912 name of the I/O primitive to be handled; the remaining arguments are
5913 the arguments that were passed to that primitive. For example, if you
5914 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5915 HANDLER is called like this:
5917 (funcall HANDLER 'file-exists-p FILENAME)
5919 Note that HANDLER must be able to handle all I/O primitives; if it has
5920 nothing special to do for a primitive, it should reinvoke the
5921 primitive to handle the operation \"the usual way\".
5922 See Info node `(elisp)Magic File Names' for more details. */);
5923 Vfile_name_handler_alist = Qnil;
5925 DEFVAR_LISP ("set-auto-coding-function",
5926 Vset_auto_coding_function,
5927 doc: /* If non-nil, a function to call to decide a coding system of file.
5928 Two arguments are passed to this function: the file name
5929 and the length of a file contents following the point.
5930 This function should return a coding system to decode the file contents.
5931 It should check the file name against `auto-coding-alist'.
5932 If no coding system is decided, it should check a coding system
5933 specified in the heading lines with the format:
5934 -*- ... coding: CODING-SYSTEM; ... -*-
5935 or local variable spec of the tailing lines with `coding:' tag. */);
5936 Vset_auto_coding_function = Qnil;
5938 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions,
5939 doc: /* A list of functions to be called at the end of `insert-file-contents'.
5940 Each is passed one argument, the number of characters inserted,
5941 with point at the start of the inserted text. Each function
5942 should leave point the same, and return the new character count.
5943 If `insert-file-contents' is intercepted by a handler from
5944 `file-name-handler-alist', that handler is responsible for calling the
5945 functions in `after-insert-file-functions' if appropriate. */);
5946 Vafter_insert_file_functions = Qnil;
5948 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions,
5949 doc: /* A list of functions to be called at the start of `write-region'.
5950 Each is passed two arguments, START and END as for `write-region'.
5951 These are usually two numbers but not always; see the documentation
5952 for `write-region'. The function should return a list of pairs
5953 of the form (POSITION . STRING), consisting of strings to be effectively
5954 inserted at the specified positions of the file being written (1 means to
5955 insert before the first byte written). The POSITIONs must be sorted into
5956 increasing order.
5958 If there are several annotation functions, the lists returned by these
5959 functions are merged destructively. As each annotation function runs,
5960 the variable `write-region-annotations-so-far' contains a list of all
5961 annotations returned by previous annotation functions.
5963 An annotation function can return with a different buffer current.
5964 Doing so removes the annotations returned by previous functions, and
5965 resets START and END to `point-min' and `point-max' of the new buffer.
5967 After `write-region' completes, Emacs calls the function stored in
5968 `write-region-post-annotation-function', once for each buffer that was
5969 current when building the annotations (i.e., at least once), with that
5970 buffer current. */);
5971 Vwrite_region_annotate_functions = Qnil;
5972 DEFSYM (Qwrite_region_annotate_functions, "write-region-annotate-functions");
5974 DEFVAR_LISP ("write-region-post-annotation-function",
5975 Vwrite_region_post_annotation_function,
5976 doc: /* Function to call after `write-region' completes.
5977 The function is called with no arguments. If one or more of the
5978 annotation functions in `write-region-annotate-functions' changed the
5979 current buffer, the function stored in this variable is called for
5980 each of those additional buffers as well, in addition to the original
5981 buffer. The relevant buffer is current during each function call. */);
5982 Vwrite_region_post_annotation_function = Qnil;
5983 staticpro (&Vwrite_region_annotation_buffers);
5985 DEFVAR_LISP ("write-region-annotations-so-far",
5986 Vwrite_region_annotations_so_far,
5987 doc: /* When an annotation function is called, this holds the previous annotations.
5988 These are the annotations made by other annotation functions
5989 that were already called. See also `write-region-annotate-functions'. */);
5990 Vwrite_region_annotations_so_far = Qnil;
5992 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers,
5993 doc: /* A list of file name handlers that temporarily should not be used.
5994 This applies only to the operation `inhibit-file-name-operation'. */);
5995 Vinhibit_file_name_handlers = Qnil;
5997 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation,
5998 doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5999 Vinhibit_file_name_operation = Qnil;
6001 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name,
6002 doc: /* File name in which we write a list of all auto save file names.
6003 This variable is initialized automatically from `auto-save-list-file-prefix'
6004 shortly after Emacs reads your init file, if you have not yet given it
6005 a non-nil value. */);
6006 Vauto_save_list_file_name = Qnil;
6008 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name,
6009 doc: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
6010 Normally auto-save files are written under other names. */);
6011 Vauto_save_visited_file_name = Qnil;
6013 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions,
6014 doc: /* If non-nil, auto-save even if a large part of the text is deleted.
6015 If nil, deleting a substantial portion of the text disables auto-save
6016 in the buffer; this is the default behavior, because the auto-save
6017 file is usually more useful if it contains the deleted text. */);
6018 Vauto_save_include_big_deletions = Qnil;
6020 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync,
6021 doc: /* Non-nil means don't call fsync in `write-region'.
6022 This variable affects calls to `write-region' as well as save commands.
6023 Setting this to nil may avoid data loss if the system loses power or
6024 the operating system crashes. By default, it is non-nil in batch mode. */);
6025 write_region_inhibit_fsync = 0; /* See also `init_fileio' above. */
6027 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash,
6028 doc: /* Specifies whether to use the system's trash can.
6029 When non-nil, certain file deletion commands use the function
6030 `move-file-to-trash' instead of deleting files outright.
6031 This includes interactive calls to `delete-file' and
6032 `delete-directory' and the Dired deletion commands. */);
6033 delete_by_moving_to_trash = 0;
6034 Qdelete_by_moving_to_trash = intern_c_string ("delete-by-moving-to-trash");
6036 DEFSYM (Qmove_file_to_trash, "move-file-to-trash");
6037 DEFSYM (Qcopy_directory, "copy-directory");
6038 DEFSYM (Qdelete_directory, "delete-directory");
6039 DEFSYM (Qsubstitute_env_in_file_name, "substitute-env-in-file-name");
6041 defsubr (&Sfind_file_name_handler);
6042 defsubr (&Sfile_name_directory);
6043 defsubr (&Sfile_name_nondirectory);
6044 defsubr (&Sunhandled_file_name_directory);
6045 defsubr (&Sfile_name_as_directory);
6046 defsubr (&Sdirectory_file_name);
6047 defsubr (&Smake_temp_name);
6048 defsubr (&Sexpand_file_name);
6049 defsubr (&Ssubstitute_in_file_name);
6050 defsubr (&Scopy_file);
6051 defsubr (&Smake_directory_internal);
6052 defsubr (&Sdelete_directory_internal);
6053 defsubr (&Sdelete_file);
6054 defsubr (&Srename_file);
6055 defsubr (&Sadd_name_to_file);
6056 defsubr (&Smake_symbolic_link);
6057 defsubr (&Sfile_name_absolute_p);
6058 defsubr (&Sfile_exists_p);
6059 defsubr (&Sfile_executable_p);
6060 defsubr (&Sfile_readable_p);
6061 defsubr (&Sfile_writable_p);
6062 defsubr (&Saccess_file);
6063 defsubr (&Sfile_symlink_p);
6064 defsubr (&Sfile_directory_p);
6065 defsubr (&Sfile_accessible_directory_p);
6066 defsubr (&Sfile_regular_p);
6067 defsubr (&Sfile_modes);
6068 defsubr (&Sset_file_modes);
6069 defsubr (&Sset_file_times);
6070 defsubr (&Sfile_selinux_context);
6071 defsubr (&Sfile_acl);
6072 defsubr (&Sset_file_acl);
6073 defsubr (&Sset_file_selinux_context);
6074 defsubr (&Sset_default_file_modes);
6075 defsubr (&Sdefault_file_modes);
6076 defsubr (&Sfile_newer_than_file_p);
6077 defsubr (&Sinsert_file_contents);
6078 defsubr (&Swrite_region);
6079 defsubr (&Scar_less_than_car);
6080 defsubr (&Sverify_visited_file_modtime);
6081 defsubr (&Svisited_file_modtime);
6082 defsubr (&Sset_visited_file_modtime);
6083 defsubr (&Sdo_auto_save);
6084 defsubr (&Sset_buffer_auto_saved);
6085 defsubr (&Sclear_buffer_auto_save_failure);
6086 defsubr (&Srecent_auto_save_p);
6088 defsubr (&Snext_read_file_uses_dialog_p);
6090 #ifdef HAVE_SYNC
6091 defsubr (&Sunix_sync);
6092 #endif