package.el (package--get-deps): Fix for indirect dependencies.
[emacs.git] / src / fileio.c
blob43ab456d813676923cf99a05ca5d996ccbe6f123
1 /* File IO for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-2015 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 #include <binary-io.h>
91 #ifdef HPUX
92 #include <netio.h>
93 #endif
95 #include "commands.h"
97 /* True during writing of auto-save files. */
98 static bool auto_saving;
100 /* Emacs's real umask. */
101 static mode_t realmask;
103 /* Nonzero umask during creation of auto-save directories. */
104 static mode_t auto_saving_dir_umask;
106 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
107 a new file with the same mode as the original. */
108 static mode_t auto_save_mode_bits;
110 /* Set by auto_save_1 if an error occurred during the last auto-save. */
111 static bool auto_save_error_occurred;
113 /* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
114 number of a file system where time stamps were observed to to work. */
115 static bool valid_timestamp_file_system;
116 static dev_t timestamp_file_system;
118 /* Each time an annotation function changes the buffer, the new buffer
119 is added here. */
120 static Lisp_Object Vwrite_region_annotation_buffers;
122 static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
123 Lisp_Object *, struct coding_system *);
124 static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
125 struct coding_system *);
128 /* Return true if FILENAME exists. */
130 static bool
131 check_existing (const char *filename)
133 return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
136 /* Return true if file FILENAME exists and can be executed. */
138 static bool
139 check_executable (char *filename)
141 return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
144 /* Return true if file FILENAME exists and can be accessed
145 according to AMODE, which should include W_OK.
146 On failure, return false and set errno. */
148 static bool
149 check_writable (const char *filename, int amode)
151 #ifdef MSDOS
152 /* FIXME: an faccessat implementation should be added to the
153 DOS/Windows ports and this #ifdef branch should be removed. */
154 struct stat st;
155 if (stat (filename, &st) < 0)
156 return 0;
157 errno = EPERM;
158 return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
159 #else /* not MSDOS */
160 bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
161 #ifdef CYGWIN
162 /* faccessat may have returned failure because Cygwin couldn't
163 determine the file's UID or GID; if so, we return success. */
164 if (!res)
166 int faccessat_errno = errno;
167 struct stat st;
168 if (stat (filename, &st) < 0)
169 return 0;
170 res = (st.st_uid == -1 || st.st_gid == -1);
171 errno = faccessat_errno;
173 #endif /* CYGWIN */
174 return res;
175 #endif /* not MSDOS */
178 /* Signal a file-access failure. STRING describes the failure,
179 NAME the file involved, and ERRORNO the errno value.
181 If NAME is neither null nor a pair, package it up as a singleton
182 list before reporting it; this saves report_file_errno's caller the
183 trouble of preserving errno before calling list1. */
185 void
186 report_file_errno (char const *string, Lisp_Object name, int errorno)
188 Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
189 synchronize_system_messages_locale ();
190 char *str = strerror (errorno);
191 Lisp_Object errstring
192 = code_convert_string_norecord (build_unibyte_string (str),
193 Vlocale_coding_system, 0);
194 Lisp_Object errdata = Fcons (errstring, data);
196 if (errorno == EEXIST)
197 xsignal (Qfile_already_exists, errdata);
198 else
199 xsignal (Qfile_error, Fcons (build_string (string), errdata));
202 /* Signal a file-access failure that set errno. STRING describes the
203 failure, NAME the file involved. When invoking this function, take
204 care to not use arguments such as build_string ("foo") that involve
205 side effects that may set errno. */
207 void
208 report_file_error (char const *string, Lisp_Object name)
210 report_file_errno (string, name, errno);
213 void
214 close_file_unwind (int fd)
216 emacs_close (fd);
219 void
220 fclose_unwind (void *arg)
222 FILE *stream = arg;
223 fclose (stream);
226 /* Restore point, having saved it as a marker. */
228 void
229 restore_point_unwind (Lisp_Object location)
231 Fgoto_char (location);
232 unchain_marker (XMARKER (location));
236 DEFUN ("find-file-name-handler", Ffind_file_name_handler,
237 Sfind_file_name_handler, 2, 2, 0,
238 doc: /* Return FILENAME's handler function for OPERATION, if it has one.
239 Otherwise, return nil.
240 A file name is handled if one of the regular expressions in
241 `file-name-handler-alist' matches it.
243 If OPERATION equals `inhibit-file-name-operation', then we ignore
244 any handlers that are members of `inhibit-file-name-handlers',
245 but we still do run any other handlers. This lets handlers
246 use the standard functions without calling themselves recursively. */)
247 (Lisp_Object filename, Lisp_Object operation)
249 /* This function must not munge the match data. */
250 Lisp_Object chain, inhibited_handlers, result;
251 ptrdiff_t pos = -1;
253 result = Qnil;
254 CHECK_STRING (filename);
256 if (EQ (operation, Vinhibit_file_name_operation))
257 inhibited_handlers = Vinhibit_file_name_handlers;
258 else
259 inhibited_handlers = Qnil;
261 for (chain = Vfile_name_handler_alist; CONSP (chain);
262 chain = XCDR (chain))
264 Lisp_Object elt;
265 elt = XCAR (chain);
266 if (CONSP (elt))
268 Lisp_Object string = XCAR (elt);
269 ptrdiff_t match_pos;
270 Lisp_Object handler = XCDR (elt);
271 Lisp_Object operations = Qnil;
273 if (SYMBOLP (handler))
274 operations = Fget (handler, Qoperations);
276 if (STRINGP (string)
277 && (match_pos = fast_string_match (string, filename)) > pos
278 && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
280 Lisp_Object tem;
282 handler = XCDR (elt);
283 tem = Fmemq (handler, inhibited_handlers);
284 if (NILP (tem))
286 result = handler;
287 pos = match_pos;
292 QUIT;
294 return result;
297 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
298 1, 1, 0,
299 doc: /* Return the directory component in file name FILENAME.
300 Return nil if FILENAME does not include a directory.
301 Otherwise return a directory name.
302 Given a Unix syntax file name, returns a string ending in slash. */)
303 (Lisp_Object filename)
305 Lisp_Object handler;
307 CHECK_STRING (filename);
309 /* If the file name has special constructs in it,
310 call the corresponding file handler. */
311 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
312 if (!NILP (handler))
314 Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
315 filename);
316 return STRINGP (handled_name) ? handled_name : Qnil;
319 char *beg = SSDATA (filename);
320 char const *p = beg + SBYTES (filename);
322 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
323 #ifdef DOS_NT
324 /* only recognize drive specifier at the beginning */
325 && !(p[-1] == ':'
326 /* handle the "/:d:foo" and "/:foo" cases correctly */
327 && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
328 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
329 #endif
330 ) p--;
332 if (p == beg)
333 return Qnil;
334 #ifdef DOS_NT
335 /* Expansion of "c:" to drive and default directory. */
336 Lisp_Object tem_fn;
337 USE_SAFE_ALLOCA;
338 SAFE_ALLOCA_STRING (beg, filename);
339 p = beg + (p - SSDATA (filename));
341 if (p[-1] == ':')
343 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
344 char *res = alloca (MAXPATHLEN + 1);
345 char *r = res;
347 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
349 memcpy (res, beg, 2);
350 beg += 2;
351 r += 2;
354 if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
356 size_t l = strlen (res);
358 if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
359 strcat (res, "/");
360 beg = res;
361 p = beg + strlen (beg);
362 dostounix_filename (beg);
363 tem_fn = make_specified_string (beg, -1, p - beg,
364 STRING_MULTIBYTE (filename));
366 else
367 tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
368 STRING_MULTIBYTE (filename));
370 else if (STRING_MULTIBYTE (filename))
372 tem_fn = make_specified_string (beg, -1, p - beg, 1);
373 dostounix_filename (SSDATA (tem_fn));
374 #ifdef WINDOWSNT
375 if (!NILP (Vw32_downcase_file_names))
376 tem_fn = Fdowncase (tem_fn);
377 #endif
379 else
381 dostounix_filename (beg);
382 tem_fn = make_specified_string (beg, -1, p - beg, 0);
384 SAFE_FREE ();
385 return tem_fn;
386 #else /* DOS_NT */
387 return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
388 #endif /* DOS_NT */
391 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
392 Sfile_name_nondirectory, 1, 1, 0,
393 doc: /* Return file name FILENAME sans its directory.
394 For example, in a Unix-syntax file name,
395 this is everything after the last slash,
396 or the entire name if it contains no slash. */)
397 (Lisp_Object filename)
399 register const char *beg, *p, *end;
400 Lisp_Object handler;
402 CHECK_STRING (filename);
404 /* If the file name has special constructs in it,
405 call the corresponding file handler. */
406 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
407 if (!NILP (handler))
409 Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory,
410 filename);
411 if (STRINGP (handled_name))
412 return handled_name;
413 error ("Invalid handler in `file-name-handler-alist'");
416 beg = SSDATA (filename);
417 end = p = beg + SBYTES (filename);
419 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
420 #ifdef DOS_NT
421 /* only recognize drive specifier at beginning */
422 && !(p[-1] == ':'
423 /* handle the "/:d:foo" case correctly */
424 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
425 #endif
427 p--;
429 return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
432 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
433 Sunhandled_file_name_directory, 1, 1, 0,
434 doc: /* Return a directly usable directory name somehow associated with FILENAME.
435 A `directly usable' directory name is one that may be used without the
436 intervention of any file handler.
437 If FILENAME is a directly usable file itself, return
438 \(file-name-directory FILENAME).
439 If FILENAME refers to a file which is not accessible from a local process,
440 then this should return nil.
441 The `call-process' and `start-process' functions use this function to
442 get a current directory to run processes in. */)
443 (Lisp_Object filename)
445 Lisp_Object handler;
447 /* If the file name has special constructs in it,
448 call the corresponding file handler. */
449 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
450 if (!NILP (handler))
452 Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
453 filename);
454 return STRINGP (handled_name) ? handled_name : Qnil;
457 return Ffile_name_directory (filename);
460 /* Maximum number of bytes that DST will be longer than SRC
461 in file_name_as_directory. This occurs when SRCLEN == 0. */
462 enum { file_name_as_directory_slop = 2 };
464 /* Convert from file name SRC of length SRCLEN to directory name in
465 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
466 string. On UNIX, just make sure there is a terminating /. Return
467 the length of DST in bytes. */
469 static ptrdiff_t
470 file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
471 bool multibyte)
473 if (srclen == 0)
475 dst[0] = '.';
476 dst[1] = '/';
477 dst[2] = '\0';
478 return 2;
481 memcpy (dst, src, srclen);
482 if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
483 dst[srclen++] = DIRECTORY_SEP;
484 dst[srclen] = 0;
485 #ifdef DOS_NT
486 dostounix_filename (dst);
487 #endif
488 return srclen;
491 DEFUN ("file-name-as-directory", Ffile_name_as_directory,
492 Sfile_name_as_directory, 1, 1, 0,
493 doc: /* Return a string representing the file name FILE interpreted as a directory.
494 This operation exists because a directory is also a file, but its name as
495 a directory is different from its name as a file.
496 The result can be used as the value of `default-directory'
497 or passed as second argument to `expand-file-name'.
498 For a Unix-syntax file name, just appends a slash. */)
499 (Lisp_Object file)
501 char *buf;
502 ptrdiff_t length;
503 Lisp_Object handler, val;
504 USE_SAFE_ALLOCA;
506 CHECK_STRING (file);
508 /* If the file name has special constructs in it,
509 call the corresponding file handler. */
510 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
511 if (!NILP (handler))
513 Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory,
514 file);
515 if (STRINGP (handled_name))
516 return handled_name;
517 error ("Invalid handler in `file-name-handler-alist'");
520 #ifdef WINDOWSNT
521 if (!NILP (Vw32_downcase_file_names))
522 file = Fdowncase (file);
523 #endif
524 buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
525 length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
526 STRING_MULTIBYTE (file));
527 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
528 SAFE_FREE ();
529 return val;
532 /* Convert from directory name SRC of length SRCLEN to file name in
533 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
534 string. On UNIX, just make sure there isn't a terminating /.
535 Return the length of DST in bytes. */
537 static ptrdiff_t
538 directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
540 /* Process as Unix format: just remove any final slash.
541 But leave "/" and "//" unchanged. */
542 while (srclen > 1
543 #ifdef DOS_NT
544 && !IS_ANY_SEP (src[srclen - 2])
545 #endif
546 && IS_DIRECTORY_SEP (src[srclen - 1])
547 && ! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
548 srclen--;
550 memcpy (dst, src, srclen);
551 dst[srclen] = 0;
552 #ifdef DOS_NT
553 dostounix_filename (dst);
554 #endif
555 return srclen;
558 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
559 1, 1, 0,
560 doc: /* Returns the file name of the directory named DIRECTORY.
561 This is the name of the file that holds the data for the directory DIRECTORY.
562 This operation exists because a directory is also a file, but its name as
563 a directory is different from its name as a file.
564 In Unix-syntax, this function just removes the final slash. */)
565 (Lisp_Object directory)
567 char *buf;
568 ptrdiff_t length;
569 Lisp_Object handler, val;
570 USE_SAFE_ALLOCA;
572 CHECK_STRING (directory);
574 /* If the file name has special constructs in it,
575 call the corresponding file handler. */
576 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
577 if (!NILP (handler))
579 Lisp_Object handled_name = call2 (handler, Qdirectory_file_name,
580 directory);
581 if (STRINGP (handled_name))
582 return handled_name;
583 error ("Invalid handler in `file-name-handler-alist'");
586 #ifdef WINDOWSNT
587 if (!NILP (Vw32_downcase_file_names))
588 directory = Fdowncase (directory);
589 #endif
590 buf = SAFE_ALLOCA (SBYTES (directory) + 1);
591 length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
592 STRING_MULTIBYTE (directory));
593 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
594 SAFE_FREE ();
595 return val;
598 static const char make_temp_name_tbl[64] =
600 'A','B','C','D','E','F','G','H',
601 'I','J','K','L','M','N','O','P',
602 'Q','R','S','T','U','V','W','X',
603 'Y','Z','a','b','c','d','e','f',
604 'g','h','i','j','k','l','m','n',
605 'o','p','q','r','s','t','u','v',
606 'w','x','y','z','0','1','2','3',
607 '4','5','6','7','8','9','-','_'
610 static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
612 /* Value is a temporary file name starting with PREFIX, a string.
614 The Emacs process number forms part of the result, so there is
615 no danger of generating a name being used by another process.
616 In addition, this function makes an attempt to choose a name
617 which has no existing file. To make this work, PREFIX should be
618 an absolute file name.
620 BASE64_P means add the pid as 3 characters in base64
621 encoding. In this case, 6 characters will be added to PREFIX to
622 form the file name. Otherwise, if Emacs is running on a system
623 with long file names, add the pid as a decimal number.
625 This function signals an error if no unique file name could be
626 generated. */
628 Lisp_Object
629 make_temp_name (Lisp_Object prefix, bool base64_p)
631 Lisp_Object val, encoded_prefix;
632 ptrdiff_t len;
633 printmax_t pid;
634 char *p, *data;
635 char pidbuf[INT_BUFSIZE_BOUND (printmax_t)];
636 int pidlen;
638 CHECK_STRING (prefix);
640 /* VAL is created by adding 6 characters to PREFIX. The first
641 three are the PID of this process, in base 64, and the second
642 three are incremented if the file already exists. This ensures
643 262144 unique file names per PID per PREFIX. */
645 pid = getpid ();
647 if (base64_p)
649 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
650 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
651 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
652 pidlen = 3;
654 else
656 #ifdef HAVE_LONG_FILE_NAMES
657 pidlen = sprintf (pidbuf, "%"pMd, pid);
658 #else
659 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
660 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
661 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
662 pidlen = 3;
663 #endif
666 encoded_prefix = ENCODE_FILE (prefix);
667 len = SBYTES (encoded_prefix);
668 val = make_uninit_string (len + 3 + pidlen);
669 data = SSDATA (val);
670 memcpy (data, SSDATA (encoded_prefix), len);
671 p = data + len;
673 memcpy (p, pidbuf, pidlen);
674 p += pidlen;
676 /* Here we try to minimize useless stat'ing when this function is
677 invoked many times successively with the same PREFIX. We achieve
678 this by initializing count to a random value, and incrementing it
679 afterwards.
681 We don't want make-temp-name to be called while dumping,
682 because then make_temp_name_count_initialized_p would get set
683 and then make_temp_name_count would not be set when Emacs starts. */
685 if (!make_temp_name_count_initialized_p)
687 make_temp_name_count = time (NULL);
688 make_temp_name_count_initialized_p = 1;
691 while (1)
693 unsigned num = make_temp_name_count;
695 p[0] = make_temp_name_tbl[num & 63], num >>= 6;
696 p[1] = make_temp_name_tbl[num & 63], num >>= 6;
697 p[2] = make_temp_name_tbl[num & 63], num >>= 6;
699 /* Poor man's congruential RN generator. Replace with
700 ++make_temp_name_count for debugging. */
701 make_temp_name_count += 25229;
702 make_temp_name_count %= 225307;
704 if (!check_existing (data))
706 /* We want to return only if errno is ENOENT. */
707 if (errno == ENOENT)
708 return DECODE_FILE (val);
709 else
710 /* The error here is dubious, but there is little else we
711 can do. The alternatives are to return nil, which is
712 as bad as (and in many cases worse than) throwing the
713 error, or to ignore the error, which will likely result
714 in looping through 225307 stat's, which is not only
715 dog-slow, but also useless since eventually nil would
716 have to be returned anyway. */
717 report_file_error ("Cannot create temporary name for prefix",
718 prefix);
719 /* not reached */
725 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
726 doc: /* Generate temporary file name (string) starting with PREFIX (a string).
727 The Emacs process number forms part of the result,
728 so there is no danger of generating a name being used by another process.
730 In addition, this function makes an attempt to choose a name
731 which has no existing file. To make this work,
732 PREFIX should be an absolute file name.
734 There is a race condition between calling `make-temp-name' and creating the
735 file which opens all kinds of security holes. For that reason, you should
736 probably use `make-temp-file' instead, except in three circumstances:
738 * If you are creating the file in the user's home directory.
739 * If you are creating a directory rather than an ordinary file.
740 * If you are taking special precautions as `make-temp-file' does. */)
741 (Lisp_Object prefix)
743 return make_temp_name (prefix, 0);
746 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
747 doc: /* Convert filename NAME to absolute, and canonicalize it.
748 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
749 \(does not start with slash or tilde); both the directory name and
750 a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or
751 missing, the current buffer's value of `default-directory' is used.
752 NAME should be a string that is a valid file name for the underlying
753 filesystem.
754 File name components that are `.' are removed, and
755 so are file name components followed by `..', along with the `..' itself;
756 note that these simplifications are done without checking the resulting
757 file names in the file system.
758 Multiple consecutive slashes are collapsed into a single slash,
759 except at the beginning of the file name when they are significant (e.g.,
760 UNC file names on MS-Windows.)
761 An initial `~/' expands to your home directory.
762 An initial `~USER/' expands to USER's home directory.
763 See also the function `substitute-in-file-name'.
765 For technical reasons, this function can return correct but
766 non-intuitive results for the root directory; for instance,
767 \(expand-file-name ".." "/") returns "/..". For this reason, use
768 \(directory-file-name (file-name-directory dirname)) to traverse a
769 filesystem tree, not (expand-file-name ".." dirname). */)
770 (Lisp_Object name, Lisp_Object default_directory)
772 /* These point to SDATA and need to be careful with string-relocation
773 during GC (via DECODE_FILE). */
774 char *nm;
775 char *nmlim;
776 const char *newdir;
777 const char *newdirlim;
778 /* This should only point to alloca'd data. */
779 char *target;
781 ptrdiff_t tlen;
782 struct passwd *pw;
783 #ifdef DOS_NT
784 int drive = 0;
785 bool collapse_newdir = true;
786 bool is_escaped = 0;
787 #endif /* DOS_NT */
788 ptrdiff_t length, nbytes;
789 Lisp_Object handler, result, handled_name;
790 bool multibyte;
791 Lisp_Object hdir;
792 USE_SAFE_ALLOCA;
794 CHECK_STRING (name);
796 /* If the file name has special constructs in it,
797 call the corresponding file handler. */
798 handler = Ffind_file_name_handler (name, Qexpand_file_name);
799 if (!NILP (handler))
801 handled_name = call3 (handler, Qexpand_file_name,
802 name, default_directory);
803 if (STRINGP (handled_name))
804 return handled_name;
805 error ("Invalid handler in `file-name-handler-alist'");
809 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
810 if (NILP (default_directory))
811 default_directory = BVAR (current_buffer, directory);
812 if (! STRINGP (default_directory))
814 #ifdef DOS_NT
815 /* "/" is not considered a root directory on DOS_NT, so using "/"
816 here causes an infinite recursion in, e.g., the following:
818 (let (default-directory)
819 (expand-file-name "a"))
821 To avoid this, we set default_directory to the root of the
822 current drive. */
823 default_directory = build_string (emacs_root_dir ());
824 #else
825 default_directory = build_string ("/");
826 #endif
829 if (!NILP (default_directory))
831 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
832 if (!NILP (handler))
834 handled_name = call3 (handler, Qexpand_file_name,
835 name, default_directory);
836 if (STRINGP (handled_name))
837 return handled_name;
838 error ("Invalid handler in `file-name-handler-alist'");
843 char *o = SSDATA (default_directory);
845 /* Make sure DEFAULT_DIRECTORY is properly expanded.
846 It would be better to do this down below where we actually use
847 default_directory. Unfortunately, calling Fexpand_file_name recursively
848 could invoke GC, and the strings might be relocated. This would
849 be annoying because we have pointers into strings lying around
850 that would need adjusting, and people would add new pointers to
851 the code and forget to adjust them, resulting in intermittent bugs.
852 Putting this call here avoids all that crud.
854 The EQ test avoids infinite recursion. */
855 if (! NILP (default_directory) && !EQ (default_directory, name)
856 /* Save time in some common cases - as long as default_directory
857 is not relative, it can be canonicalized with name below (if it
858 is needed at all) without requiring it to be expanded now. */
859 #ifdef DOS_NT
860 /* Detect MSDOS file names with drive specifiers. */
861 && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1])
862 && IS_DIRECTORY_SEP (o[2]))
863 #ifdef WINDOWSNT
864 /* Detect Windows file names in UNC format. */
865 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
866 #endif
867 #else /* not DOS_NT */
868 /* Detect Unix absolute file names (/... alone is not absolute on
869 DOS or Windows). */
870 && ! (IS_DIRECTORY_SEP (o[0]))
871 #endif /* not DOS_NT */
874 struct gcpro gcpro1;
876 GCPRO1 (name);
877 default_directory = Fexpand_file_name (default_directory, Qnil);
878 UNGCPRO;
881 multibyte = STRING_MULTIBYTE (name);
882 if (multibyte != STRING_MULTIBYTE (default_directory))
884 if (multibyte)
886 unsigned char *p = SDATA (name);
888 while (*p && ASCII_CHAR_P (*p))
889 p++;
890 if (*p == '\0')
892 /* NAME is a pure ASCII string, and DEFAULT_DIRECTORY is
893 unibyte. Do not convert DEFAULT_DIRECTORY to
894 multibyte; instead, convert NAME to a unibyte string,
895 so that the result of this function is also a unibyte
896 string. This is needed during bootstrapping and
897 dumping, when Emacs cannot decode file names, because
898 the locale environment is not set up. */
899 name = make_unibyte_string (SSDATA (name), SBYTES (name));
900 multibyte = 0;
902 else
903 default_directory = string_to_multibyte (default_directory);
905 else
907 name = string_to_multibyte (name);
908 multibyte = 1;
912 #ifdef WINDOWSNT
913 if (!NILP (Vw32_downcase_file_names))
914 default_directory = Fdowncase (default_directory);
915 #endif
917 /* Make a local copy of NAME to protect it from GC in DECODE_FILE below. */
918 SAFE_ALLOCA_STRING (nm, name);
919 nmlim = nm + SBYTES (name);
921 #ifdef DOS_NT
922 /* Note if special escape prefix is present, but remove for now. */
923 if (nm[0] == '/' && nm[1] == ':')
925 is_escaped = 1;
926 nm += 2;
929 /* Find and remove drive specifier if present; this makes nm absolute
930 even if the rest of the name appears to be relative. Only look for
931 drive specifier at the beginning. */
932 if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
934 drive = (unsigned char) nm[0];
935 nm += 2;
938 #ifdef WINDOWSNT
939 /* If we see "c://somedir", we want to strip the first slash after the
940 colon when stripping the drive letter. Otherwise, this expands to
941 "//somedir". */
942 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
943 nm++;
945 /* Discard any previous drive specifier if nm is now in UNC format. */
946 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
947 && !IS_DIRECTORY_SEP (nm[2]))
948 drive = 0;
949 #endif /* WINDOWSNT */
950 #endif /* DOS_NT */
952 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
953 none are found, we can probably return right away. We will avoid
954 allocating a new string if name is already fully expanded. */
955 if (
956 IS_DIRECTORY_SEP (nm[0])
957 #ifdef MSDOS
958 && drive && !is_escaped
959 #endif
960 #ifdef WINDOWSNT
961 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
962 #endif
965 /* If it turns out that the filename we want to return is just a
966 suffix of FILENAME, we don't need to go through and edit
967 things; we just need to construct a new string using data
968 starting at the middle of FILENAME. If we set LOSE, that
969 means we've discovered that we can't do that cool trick. */
970 bool lose = 0;
971 char *p = nm;
973 while (*p)
975 /* Since we know the name is absolute, we can assume that each
976 element starts with a "/". */
978 /* "." and ".." are hairy. */
979 if (IS_DIRECTORY_SEP (p[0])
980 && p[1] == '.'
981 && (IS_DIRECTORY_SEP (p[2])
982 || p[2] == 0
983 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
984 || p[3] == 0))))
985 lose = 1;
986 /* Replace multiple slashes with a single one, except
987 leave leading "//" alone. */
988 else if (IS_DIRECTORY_SEP (p[0])
989 && IS_DIRECTORY_SEP (p[1])
990 && (p != nm || IS_DIRECTORY_SEP (p[2])))
991 lose = 1;
992 p++;
994 if (!lose)
996 #ifdef DOS_NT
997 /* Make sure directories are all separated with /, but
998 avoid allocation of a new string when not required. */
999 dostounix_filename (nm);
1000 #ifdef WINDOWSNT
1001 if (IS_DIRECTORY_SEP (nm[1]))
1003 if (strcmp (nm, SSDATA (name)) != 0)
1004 name = make_specified_string (nm, -1, nmlim - nm, multibyte);
1006 else
1007 #endif
1008 /* Drive must be set, so this is okay. */
1009 if (strcmp (nm - 2, SSDATA (name)) != 0)
1011 char temp[] = " :";
1013 name = make_specified_string (nm, -1, p - nm, multibyte);
1014 temp[0] = DRIVE_LETTER (drive);
1015 AUTO_STRING (drive_prefix, temp);
1016 name = concat2 (drive_prefix, name);
1018 #ifdef WINDOWSNT
1019 if (!NILP (Vw32_downcase_file_names))
1020 name = Fdowncase (name);
1021 #endif
1022 #else /* not DOS_NT */
1023 if (strcmp (nm, SSDATA (name)) != 0)
1024 name = make_specified_string (nm, -1, nmlim - nm, multibyte);
1025 #endif /* not DOS_NT */
1026 SAFE_FREE ();
1027 return name;
1031 /* At this point, nm might or might not be an absolute file name. We
1032 need to expand ~ or ~user if present, otherwise prefix nm with
1033 default_directory if nm is not absolute, and finally collapse /./
1034 and /foo/../ sequences.
1036 We set newdir to be the appropriate prefix if one is needed:
1037 - the relevant user directory if nm starts with ~ or ~user
1038 - the specified drive's working dir (DOS/NT only) if nm does not
1039 start with /
1040 - the value of default_directory.
1042 Note that these prefixes are not guaranteed to be absolute (except
1043 for the working dir of a drive). Therefore, to ensure we always
1044 return an absolute name, if the final prefix is not absolute we
1045 append it to the current working directory. */
1047 newdir = newdirlim = 0;
1049 if (nm[0] == '~') /* prefix ~ */
1051 if (IS_DIRECTORY_SEP (nm[1])
1052 || nm[1] == 0) /* ~ by itself */
1054 Lisp_Object tem;
1056 if (!(newdir = egetenv ("HOME")))
1057 newdir = newdirlim = "";
1058 nm++;
1059 /* `egetenv' may return a unibyte string, which will bite us since
1060 we expect the directory to be multibyte. */
1061 #ifdef WINDOWSNT
1062 if (newdir[0])
1064 char newdir_utf8[MAX_UTF8_PATH];
1066 filename_from_ansi (newdir, newdir_utf8);
1067 tem = make_unibyte_string (newdir_utf8, strlen (newdir_utf8));
1069 else
1070 #endif
1071 tem = build_string (newdir);
1072 newdirlim = newdir + SBYTES (tem);
1073 if (multibyte && !STRING_MULTIBYTE (tem))
1075 hdir = DECODE_FILE (tem);
1076 newdir = SSDATA (hdir);
1077 newdirlim = newdir + SBYTES (hdir);
1079 #ifdef DOS_NT
1080 collapse_newdir = false;
1081 #endif
1083 else /* ~user/filename */
1085 char *o, *p;
1086 for (p = nm; *p && !IS_DIRECTORY_SEP (*p); p++)
1087 continue;
1088 o = SAFE_ALLOCA (p - nm + 1);
1089 memcpy (o, nm, p - nm);
1090 o[p - nm] = 0;
1092 block_input ();
1093 pw = getpwnam (o + 1);
1094 unblock_input ();
1095 if (pw)
1097 Lisp_Object tem;
1099 newdir = pw->pw_dir;
1100 /* `getpwnam' may return a unibyte string, which will
1101 bite us since we expect the directory to be
1102 multibyte. */
1103 tem = make_unibyte_string (newdir, strlen (newdir));
1104 newdirlim = newdir + SBYTES (tem);
1105 if (multibyte && !STRING_MULTIBYTE (tem))
1107 hdir = DECODE_FILE (tem);
1108 newdir = SSDATA (hdir);
1109 newdirlim = newdir + SBYTES (hdir);
1111 nm = p;
1112 #ifdef DOS_NT
1113 collapse_newdir = false;
1114 #endif
1117 /* If we don't find a user of that name, leave the name
1118 unchanged; don't move nm forward to p. */
1122 #ifdef DOS_NT
1123 /* On DOS and Windows, nm is absolute if a drive name was specified;
1124 use the drive's current directory as the prefix if needed. */
1125 if (!newdir && drive)
1127 /* Get default directory if needed to make nm absolute. */
1128 char *adir = NULL;
1129 if (!IS_DIRECTORY_SEP (nm[0]))
1131 adir = alloca (MAXPATHLEN + 1);
1132 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1133 adir = NULL;
1134 else if (multibyte)
1136 Lisp_Object tem = build_string (adir);
1138 tem = DECODE_FILE (tem);
1139 newdirlim = adir + SBYTES (tem);
1140 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1142 else
1143 newdirlim = adir + strlen (adir);
1145 if (!adir)
1147 /* Either nm starts with /, or drive isn't mounted. */
1148 adir = alloca (4);
1149 adir[0] = DRIVE_LETTER (drive);
1150 adir[1] = ':';
1151 adir[2] = '/';
1152 adir[3] = 0;
1153 newdirlim = adir + 3;
1155 newdir = adir;
1157 #endif /* DOS_NT */
1159 /* Finally, if no prefix has been specified and nm is not absolute,
1160 then it must be expanded relative to default_directory. */
1162 if (1
1163 #ifndef DOS_NT
1164 /* /... alone is not absolute on DOS and Windows. */
1165 && !IS_DIRECTORY_SEP (nm[0])
1166 #endif
1167 #ifdef WINDOWSNT
1168 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
1169 && !IS_DIRECTORY_SEP (nm[2]))
1170 #endif
1171 && !newdir)
1173 newdir = SSDATA (default_directory);
1174 newdirlim = newdir + SBYTES (default_directory);
1175 #ifdef DOS_NT
1176 /* Note if special escape prefix is present, but remove for now. */
1177 if (newdir[0] == '/' && newdir[1] == ':')
1179 is_escaped = 1;
1180 newdir += 2;
1182 #endif
1185 #ifdef DOS_NT
1186 if (newdir)
1188 /* First ensure newdir is an absolute name. */
1189 if (
1190 /* Detect MSDOS file names with drive specifiers. */
1191 ! (IS_DRIVE (newdir[0])
1192 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1193 #ifdef WINDOWSNT
1194 /* Detect Windows file names in UNC format. */
1195 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
1196 && !IS_DIRECTORY_SEP (newdir[2]))
1197 #endif
1200 /* Effectively, let newdir be (expand-file-name newdir cwd).
1201 Because of the admonition against calling expand-file-name
1202 when we have pointers into lisp strings, we accomplish this
1203 indirectly by prepending newdir to nm if necessary, and using
1204 cwd (or the wd of newdir's drive) as the new newdir. */
1205 char *adir;
1206 #ifdef WINDOWSNT
1207 const int adir_size = MAX_UTF8_PATH;
1208 #else
1209 const int adir_size = MAXPATHLEN + 1;
1210 #endif
1212 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1214 drive = (unsigned char) newdir[0];
1215 newdir += 2;
1217 if (!IS_DIRECTORY_SEP (nm[0]))
1219 ptrdiff_t nmlen = nmlim - nm;
1220 ptrdiff_t newdirlen = newdirlim - newdir;
1221 char *tmp = alloca (newdirlen + file_name_as_directory_slop
1222 + nmlen + 1);
1223 ptrdiff_t dlen = file_name_as_directory (tmp, newdir, newdirlen,
1224 multibyte);
1225 memcpy (tmp + dlen, nm, nmlen + 1);
1226 nm = tmp;
1227 nmlim = nm + dlen + nmlen;
1229 adir = alloca (adir_size);
1230 if (drive)
1232 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1233 strcpy (adir, "/");
1235 else
1236 getcwd (adir, adir_size);
1237 if (multibyte)
1239 Lisp_Object tem = build_string (adir);
1241 tem = DECODE_FILE (tem);
1242 newdirlim = adir + SBYTES (tem);
1243 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1245 else
1246 newdirlim = adir + strlen (adir);
1247 newdir = adir;
1250 /* Strip off drive name from prefix, if present. */
1251 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1253 drive = newdir[0];
1254 newdir += 2;
1257 /* Keep only a prefix from newdir if nm starts with slash
1258 (//server/share for UNC, nothing otherwise). */
1259 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1261 #ifdef WINDOWSNT
1262 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
1263 && !IS_DIRECTORY_SEP (newdir[2]))
1265 char *adir = strcpy (alloca (newdirlim - newdir + 1), newdir);
1266 char *p = adir + 2;
1267 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1268 p++;
1269 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1270 *p = 0;
1271 newdir = adir;
1272 newdirlim = newdir + strlen (adir);
1274 else
1275 #endif
1276 newdir = newdirlim = "";
1279 #endif /* DOS_NT */
1281 /* Ignore any slash at the end of newdir, unless newdir is
1282 just "/" or "//". */
1283 length = newdirlim - newdir;
1284 while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1285 && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0])))
1286 length--;
1288 /* Now concatenate the directory and name to new space in the stack frame. */
1289 tlen = length + file_name_as_directory_slop + (nmlim - nm) + 1;
1290 eassert (tlen > file_name_as_directory_slop + 1);
1291 #ifdef DOS_NT
1292 /* Reserve space for drive specifier and escape prefix, since either
1293 or both may need to be inserted. (The Microsoft x86 compiler
1294 produces incorrect code if the following two lines are combined.) */
1295 target = alloca (tlen + 4);
1296 target += 4;
1297 #else /* not DOS_NT */
1298 target = SAFE_ALLOCA (tlen);
1299 #endif /* not DOS_NT */
1300 *target = 0;
1301 nbytes = 0;
1303 if (newdir)
1305 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1307 #ifdef DOS_NT
1308 /* If newdir is effectively "C:/", then the drive letter will have
1309 been stripped and newdir will be "/". Concatenating with an
1310 absolute directory in nm produces "//", which will then be
1311 incorrectly treated as a network share. Ignore newdir in
1312 this case (keeping the drive letter). */
1313 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
1314 && newdir[1] == '\0'))
1315 #endif
1317 memcpy (target, newdir, length);
1318 target[length] = 0;
1319 nbytes = length;
1322 else
1323 nbytes = file_name_as_directory (target, newdir, length, multibyte);
1326 memcpy (target + nbytes, nm, nmlim - nm + 1);
1328 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1329 appear. */
1331 char *p = target;
1332 char *o = target;
1334 while (*p)
1336 if (!IS_DIRECTORY_SEP (*p))
1338 *o++ = *p++;
1340 else if (p[1] == '.'
1341 && (IS_DIRECTORY_SEP (p[2])
1342 || p[2] == 0))
1344 /* If "/." is the entire filename, keep the "/". Otherwise,
1345 just delete the whole "/.". */
1346 if (o == target && p[2] == '\0')
1347 *o++ = *p;
1348 p += 2;
1350 else if (p[1] == '.' && p[2] == '.'
1351 /* `/../' is the "superroot" on certain file systems.
1352 Turned off on DOS_NT systems because they have no
1353 "superroot" and because this causes us to produce
1354 file names like "d:/../foo" which fail file-related
1355 functions of the underlying OS. (To reproduce, try a
1356 long series of "../../" in default_directory, longer
1357 than the number of levels from the root.) */
1358 #ifndef DOS_NT
1359 && o != target
1360 #endif
1361 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1363 #ifdef WINDOWSNT
1364 char *prev_o = o;
1365 #endif
1366 while (o != target && (--o, !IS_DIRECTORY_SEP (*o)))
1367 continue;
1368 #ifdef WINDOWSNT
1369 /* Don't go below server level in UNC filenames. */
1370 if (o == target + 1 && IS_DIRECTORY_SEP (*o)
1371 && IS_DIRECTORY_SEP (*target))
1372 o = prev_o;
1373 else
1374 #endif
1375 /* Keep initial / only if this is the whole name. */
1376 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1377 ++o;
1378 p += 3;
1380 else if (IS_DIRECTORY_SEP (p[1])
1381 && (p != target || IS_DIRECTORY_SEP (p[2])))
1382 /* Collapse multiple "/", except leave leading "//" alone. */
1383 p++;
1384 else
1386 *o++ = *p++;
1390 #ifdef DOS_NT
1391 /* At last, set drive name. */
1392 #ifdef WINDOWSNT
1393 /* Except for network file name. */
1394 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
1395 #endif /* WINDOWSNT */
1397 if (!drive) emacs_abort ();
1398 target -= 2;
1399 target[0] = DRIVE_LETTER (drive);
1400 target[1] = ':';
1402 /* Reinsert the escape prefix if required. */
1403 if (is_escaped)
1405 target -= 2;
1406 target[0] = '/';
1407 target[1] = ':';
1409 result = make_specified_string (target, -1, o - target, multibyte);
1410 dostounix_filename (SSDATA (result));
1411 #ifdef WINDOWSNT
1412 if (!NILP (Vw32_downcase_file_names))
1413 result = Fdowncase (result);
1414 #endif
1415 #else /* !DOS_NT */
1416 result = make_specified_string (target, -1, o - target, multibyte);
1417 #endif /* !DOS_NT */
1420 /* Again look to see if the file name has special constructs in it
1421 and perhaps call the corresponding file handler. This is needed
1422 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1423 the ".." component gives us "/user@host:/bar/../baz" which needs
1424 to be expanded again. */
1425 handler = Ffind_file_name_handler (result, Qexpand_file_name);
1426 if (!NILP (handler))
1428 handled_name = call3 (handler, Qexpand_file_name,
1429 result, default_directory);
1430 if (! STRINGP (handled_name))
1431 error ("Invalid handler in `file-name-handler-alist'");
1432 result = handled_name;
1435 SAFE_FREE ();
1436 return result;
1439 #if 0
1440 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1441 This is the old version of expand-file-name, before it was thoroughly
1442 rewritten for Emacs 10.31. We leave this version here commented-out,
1443 because the code is very complex and likely to have subtle bugs. If
1444 bugs _are_ found, it might be of interest to look at the old code and
1445 see what did it do in the relevant situation.
1447 Don't remove this code: it's true that it will be accessible
1448 from the repository, but a few years from deletion, people will
1449 forget it is there. */
1451 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1452 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1453 "Convert FILENAME to absolute, and canonicalize it.\n\
1454 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1455 \(does not start with slash); if DEFAULT is nil or missing,\n\
1456 the current buffer's value of default-directory is used.\n\
1457 Filenames containing `.' or `..' as components are simplified;\n\
1458 initial `~/' expands to your home directory.\n\
1459 See also the function `substitute-in-file-name'.")
1460 (name, defalt)
1461 Lisp_Object name, defalt;
1463 unsigned char *nm;
1465 register unsigned char *newdir, *p, *o;
1466 ptrdiff_t tlen;
1467 unsigned char *target;
1468 struct passwd *pw;
1470 CHECK_STRING (name);
1471 nm = SDATA (name);
1473 /* If nm is absolute, flush ...// and detect /./ and /../.
1474 If no /./ or /../ we can return right away. */
1475 if (nm[0] == '/')
1477 bool lose = 0;
1478 p = nm;
1479 while (*p)
1481 if (p[0] == '/' && p[1] == '/')
1482 nm = p + 1;
1483 if (p[0] == '/' && p[1] == '~')
1484 nm = p + 1, lose = 1;
1485 if (p[0] == '/' && p[1] == '.'
1486 && (p[2] == '/' || p[2] == 0
1487 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
1488 lose = 1;
1489 p++;
1491 if (!lose)
1493 if (nm == SDATA (name))
1494 return name;
1495 return build_string (nm);
1499 /* Now determine directory to start with and put it in NEWDIR. */
1501 newdir = 0;
1503 if (nm[0] == '~') /* prefix ~ */
1504 if (nm[1] == '/' || nm[1] == 0)/* ~/filename */
1506 if (!(newdir = (unsigned char *) egetenv ("HOME")))
1507 newdir = (unsigned char *) "";
1508 nm++;
1510 else /* ~user/filename */
1512 /* Get past ~ to user. */
1513 unsigned char *user = nm + 1;
1514 /* Find end of name. */
1515 unsigned char *ptr = (unsigned char *) strchr (user, '/');
1516 ptrdiff_t len = ptr ? ptr - user : strlen (user);
1517 /* Copy the user name into temp storage. */
1518 o = alloca (len + 1);
1519 memcpy (o, user, len);
1520 o[len] = 0;
1522 /* Look up the user name. */
1523 block_input ();
1524 pw = (struct passwd *) getpwnam (o + 1);
1525 unblock_input ();
1526 if (!pw)
1527 error ("\"%s\" isn't a registered user", o + 1);
1529 newdir = (unsigned char *) pw->pw_dir;
1531 /* Discard the user name from NM. */
1532 nm += len;
1535 if (nm[0] != '/' && !newdir)
1537 if (NILP (defalt))
1538 defalt = current_buffer->directory;
1539 CHECK_STRING (defalt);
1540 newdir = SDATA (defalt);
1543 /* Now concatenate the directory and name to new space in the stack frame. */
1545 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
1546 target = alloca (tlen);
1547 *target = 0;
1549 if (newdir)
1551 if (nm[0] == 0 || nm[0] == '/')
1552 strcpy (target, newdir);
1553 else
1554 file_name_as_directory (target, newdir);
1557 strcat (target, nm);
1559 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1561 p = target;
1562 o = target;
1564 while (*p)
1566 if (*p != '/')
1568 *o++ = *p++;
1570 else if (!strncmp (p, "//", 2)
1573 o = target;
1574 p++;
1576 else if (p[0] == '/' && p[1] == '.'
1577 && (p[2] == '/' || p[2] == 0))
1578 p += 2;
1579 else if (!strncmp (p, "/..", 3)
1580 /* `/../' is the "superroot" on certain file systems. */
1581 && o != target
1582 && (p[3] == '/' || p[3] == 0))
1584 while (o != target && *--o != '/')
1586 if (o == target && *o == '/')
1587 ++o;
1588 p += 3;
1590 else
1592 *o++ = *p++;
1596 return make_string (target, o - target);
1598 #endif
1600 /* If /~ or // appears, discard everything through first slash. */
1601 static bool
1602 file_name_absolute_p (const char *filename)
1604 return
1605 (IS_DIRECTORY_SEP (*filename) || *filename == '~'
1606 #ifdef DOS_NT
1607 || (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
1608 && IS_DIRECTORY_SEP (filename[2]))
1609 #endif
1613 static char *
1614 search_embedded_absfilename (char *nm, char *endp)
1616 char *p, *s;
1618 for (p = nm + 1; p < endp; p++)
1620 if (IS_DIRECTORY_SEP (p[-1])
1621 && file_name_absolute_p (p)
1622 #if defined (WINDOWSNT) || defined (CYGWIN)
1623 /* // at start of file name is meaningful in Apollo,
1624 WindowsNT and Cygwin systems. */
1625 && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
1626 #endif /* not (WINDOWSNT || CYGWIN) */
1629 for (s = p; *s && !IS_DIRECTORY_SEP (*s); s++);
1630 if (p[0] == '~' && s > p + 1) /* We've got "/~something/". */
1632 USE_SAFE_ALLOCA;
1633 char *o = SAFE_ALLOCA (s - p + 1);
1634 struct passwd *pw;
1635 memcpy (o, p, s - p);
1636 o [s - p] = 0;
1638 /* If we have ~user and `user' exists, discard
1639 everything up to ~. But if `user' does not exist, leave
1640 ~user alone, it might be a literal file name. */
1641 block_input ();
1642 pw = getpwnam (o + 1);
1643 unblock_input ();
1644 SAFE_FREE ();
1645 if (pw)
1646 return p;
1648 else
1649 return p;
1652 return NULL;
1655 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
1656 Ssubstitute_in_file_name, 1, 1, 0,
1657 doc: /* Substitute environment variables referred to in FILENAME.
1658 `$FOO' where FOO is an environment variable name means to substitute
1659 the value of that variable. The variable name should be terminated
1660 with a character not a letter, digit or underscore; otherwise, enclose
1661 the entire variable name in braces.
1663 If `/~' appears, all of FILENAME through that `/' is discarded.
1664 If `//' appears, everything up to and including the first of
1665 those `/' is discarded. */)
1666 (Lisp_Object filename)
1668 char *nm, *p, *x, *endp;
1669 bool substituted = false;
1670 bool multibyte;
1671 char *xnm;
1672 Lisp_Object handler;
1674 CHECK_STRING (filename);
1676 multibyte = STRING_MULTIBYTE (filename);
1678 /* If the file name has special constructs in it,
1679 call the corresponding file handler. */
1680 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
1681 if (!NILP (handler))
1683 Lisp_Object handled_name = call2 (handler, Qsubstitute_in_file_name,
1684 filename);
1685 if (STRINGP (handled_name))
1686 return handled_name;
1687 error ("Invalid handler in `file-name-handler-alist'");
1690 /* Always work on a copy of the string, in case GC happens during
1691 decode of environment variables, causing the original Lisp_String
1692 data to be relocated. */
1693 USE_SAFE_ALLOCA;
1694 SAFE_ALLOCA_STRING (nm, filename);
1696 #ifdef DOS_NT
1697 dostounix_filename (nm);
1698 substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
1699 #endif
1700 endp = nm + SBYTES (filename);
1702 /* If /~ or // appears, discard everything through first slash. */
1703 p = search_embedded_absfilename (nm, endp);
1704 if (p)
1705 /* Start over with the new string, so we check the file-name-handler
1706 again. Important with filenames like "/home/foo//:/hello///there"
1707 which would substitute to "/:/hello///there" rather than "/there". */
1709 Lisp_Object result
1710 = (Fsubstitute_in_file_name
1711 (make_specified_string (p, -1, endp - p, multibyte)));
1712 SAFE_FREE ();
1713 return result;
1716 /* See if any variables are substituted into the string. */
1718 if (!NILP (Ffboundp (Qsubstitute_env_in_file_name)))
1720 Lisp_Object name
1721 = (!substituted ? filename
1722 : make_specified_string (nm, -1, endp - nm, multibyte));
1723 Lisp_Object tmp = call1 (Qsubstitute_env_in_file_name, name);
1724 CHECK_STRING (tmp);
1725 if (!EQ (tmp, name))
1726 substituted = true;
1727 filename = tmp;
1730 if (!substituted)
1732 #ifdef WINDOWSNT
1733 if (!NILP (Vw32_downcase_file_names))
1734 filename = Fdowncase (filename);
1735 #endif
1736 SAFE_FREE ();
1737 return filename;
1740 xnm = SSDATA (filename);
1741 x = xnm + SBYTES (filename);
1743 /* If /~ or // appears, discard everything through first slash. */
1744 while ((p = search_embedded_absfilename (xnm, x)) != NULL)
1745 /* This time we do not start over because we've already expanded envvars
1746 and replaced $$ with $. Maybe we should start over as well, but we'd
1747 need to quote some $ to $$ first. */
1748 xnm = p;
1750 #ifdef WINDOWSNT
1751 if (!NILP (Vw32_downcase_file_names))
1753 Lisp_Object xname = make_specified_string (xnm, -1, x - xnm, multibyte);
1755 filename = Fdowncase (xname);
1757 else
1758 #endif
1759 if (xnm != SSDATA (filename))
1760 filename = make_specified_string (xnm, -1, x - xnm, multibyte);
1761 SAFE_FREE ();
1762 return filename;
1765 /* A slightly faster and more convenient way to get
1766 (directory-file-name (expand-file-name FOO)). */
1768 Lisp_Object
1769 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1771 register Lisp_Object absname;
1773 absname = Fexpand_file_name (filename, defdir);
1775 /* Remove final slash, if any (unless this is the root dir).
1776 stat behaves differently depending! */
1777 if (SCHARS (absname) > 1
1778 && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
1779 && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2)))
1780 /* We cannot take shortcuts; they might be wrong for magic file names. */
1781 absname = Fdirectory_file_name (absname);
1782 return absname;
1785 /* Signal an error if the file ABSNAME already exists.
1786 If KNOWN_TO_EXIST, the file is known to exist.
1787 QUERYSTRING is a name for the action that is being considered
1788 to alter the file.
1789 If INTERACTIVE, ask the user whether to proceed,
1790 and bypass the error if the user says to go ahead.
1791 If QUICK, ask for y or n, not yes or no. */
1793 static void
1794 barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist,
1795 const char *querystring, bool interactive,
1796 bool quick)
1798 Lisp_Object tem, encoded_filename;
1799 struct stat statbuf;
1800 struct gcpro gcpro1;
1802 encoded_filename = ENCODE_FILE (absname);
1804 if (! known_to_exist && lstat (SSDATA (encoded_filename), &statbuf) == 0)
1806 if (S_ISDIR (statbuf.st_mode))
1807 xsignal2 (Qfile_error,
1808 build_string ("File is a directory"), absname);
1809 known_to_exist = true;
1812 if (known_to_exist)
1814 if (! interactive)
1815 xsignal2 (Qfile_already_exists,
1816 build_string ("File already exists"), absname);
1817 GCPRO1 (absname);
1818 tem = format2 ("File %s already exists; %s anyway? ",
1819 absname, build_string (querystring));
1820 if (quick)
1821 tem = call1 (intern ("y-or-n-p"), tem);
1822 else
1823 tem = do_yes_or_no_p (tem);
1824 UNGCPRO;
1825 if (NILP (tem))
1826 xsignal2 (Qfile_already_exists,
1827 build_string ("File already exists"), absname);
1831 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
1832 "fCopy file: \nGCopy %s to file: \np\nP",
1833 doc: /* Copy FILE to NEWNAME. Both args must be strings.
1834 If NEWNAME names a directory, copy FILE there.
1836 This function always sets the file modes of the output file to match
1837 the input file.
1839 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1840 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1841 signal a `file-already-exists' error without overwriting. If
1842 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1843 about overwriting; this is what happens in interactive use with M-x.
1844 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1845 existing file.
1847 Fourth arg KEEP-TIME non-nil means give the output file the same
1848 last-modified time as the old one. (This works on only some systems.)
1850 A prefix arg makes KEEP-TIME non-nil.
1852 If PRESERVE-UID-GID is non-nil, we try to transfer the
1853 uid and gid of FILE to NEWNAME.
1855 If PRESERVE-PERMISSIONS is non-nil, copy permissions of FILE to NEWNAME;
1856 this includes the file modes, along with ACL entries and SELinux
1857 context if present. Otherwise, if NEWNAME is created its file
1858 permission bits are those of FILE, masked by the default file
1859 permissions. */)
1860 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists,
1861 Lisp_Object keep_time, Lisp_Object preserve_uid_gid,
1862 Lisp_Object preserve_permissions)
1864 Lisp_Object handler;
1865 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1866 ptrdiff_t count = SPECPDL_INDEX ();
1867 Lisp_Object encoded_file, encoded_newname;
1868 #if HAVE_LIBSELINUX
1869 security_context_t con;
1870 int conlength = 0;
1871 #endif
1872 #ifdef WINDOWSNT
1873 int result;
1874 #else
1875 bool already_exists = false;
1876 mode_t new_mask;
1877 int ifd, ofd;
1878 int n;
1879 char buf[16 * 1024];
1880 struct stat st;
1881 #endif
1883 encoded_file = encoded_newname = Qnil;
1884 GCPRO4 (file, newname, encoded_file, encoded_newname);
1885 CHECK_STRING (file);
1886 CHECK_STRING (newname);
1888 if (!NILP (Ffile_directory_p (newname)))
1889 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
1890 else
1891 newname = Fexpand_file_name (newname, Qnil);
1893 file = Fexpand_file_name (file, Qnil);
1895 /* If the input file name has special constructs in it,
1896 call the corresponding file handler. */
1897 handler = Ffind_file_name_handler (file, Qcopy_file);
1898 /* Likewise for output file name. */
1899 if (NILP (handler))
1900 handler = Ffind_file_name_handler (newname, Qcopy_file);
1901 if (!NILP (handler))
1902 RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname,
1903 ok_if_already_exists, keep_time, preserve_uid_gid,
1904 preserve_permissions));
1906 encoded_file = ENCODE_FILE (file);
1907 encoded_newname = ENCODE_FILE (newname);
1909 #ifdef WINDOWSNT
1910 if (NILP (ok_if_already_exists)
1911 || INTEGERP (ok_if_already_exists))
1912 barf_or_query_if_file_exists (newname, false, "copy to it",
1913 INTEGERP (ok_if_already_exists), false);
1915 result = w32_copy_file (SSDATA (encoded_file), SSDATA (encoded_newname),
1916 !NILP (keep_time), !NILP (preserve_uid_gid),
1917 !NILP (preserve_permissions));
1918 switch (result)
1920 case -1:
1921 report_file_error ("Copying file", list2 (file, newname));
1922 case -2:
1923 report_file_error ("Copying permissions from", file);
1924 case -3:
1925 xsignal2 (Qfile_date_error,
1926 build_string ("Resetting file times"), newname);
1927 case -4:
1928 report_file_error ("Copying permissions to", newname);
1930 #else /* not WINDOWSNT */
1931 immediate_quit = 1;
1932 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
1933 immediate_quit = 0;
1935 if (ifd < 0)
1936 report_file_error ("Opening input file", file);
1938 record_unwind_protect_int (close_file_unwind, ifd);
1940 if (fstat (ifd, &st) != 0)
1941 report_file_error ("Input file status", file);
1943 if (!NILP (preserve_permissions))
1945 #if HAVE_LIBSELINUX
1946 if (is_selinux_enabled ())
1948 conlength = fgetfilecon (ifd, &con);
1949 if (conlength == -1)
1950 report_file_error ("Doing fgetfilecon", file);
1952 #endif
1955 /* We can copy only regular files. */
1956 if (!S_ISREG (st.st_mode))
1957 report_file_errno ("Non-regular file", file,
1958 S_ISDIR (st.st_mode) ? EISDIR : EINVAL);
1960 #ifndef MSDOS
1961 new_mask = st.st_mode & (!NILP (preserve_uid_gid) ? 0700 : 0777);
1962 #else
1963 new_mask = S_IREAD | S_IWRITE;
1964 #endif
1966 ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY | O_CREAT | O_EXCL,
1967 new_mask);
1968 if (ofd < 0 && errno == EEXIST)
1970 if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists))
1971 barf_or_query_if_file_exists (newname, true, "copy to it",
1972 INTEGERP (ok_if_already_exists), false);
1973 already_exists = true;
1974 ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY, 0);
1976 if (ofd < 0)
1977 report_file_error ("Opening output file", newname);
1979 record_unwind_protect_int (close_file_unwind, ofd);
1981 if (already_exists)
1983 struct stat out_st;
1984 if (fstat (ofd, &out_st) != 0)
1985 report_file_error ("Output file status", newname);
1986 if (st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1987 report_file_errno ("Input and output files are the same",
1988 list2 (file, newname), 0);
1989 if (ftruncate (ofd, 0) != 0)
1990 report_file_error ("Truncating output file", newname);
1993 immediate_quit = 1;
1994 QUIT;
1995 while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
1996 if (emacs_write_sig (ofd, buf, n) != n)
1997 report_file_error ("Write error", newname);
1998 immediate_quit = 0;
2000 #ifndef MSDOS
2001 /* Preserve the original file permissions, and if requested, also its
2002 owner and group. */
2004 mode_t preserved_permissions = st.st_mode & 07777;
2005 mode_t default_permissions = st.st_mode & 0777 & ~realmask;
2006 if (!NILP (preserve_uid_gid))
2008 /* Attempt to change owner and group. If that doesn't work
2009 attempt to change just the group, as that is sometimes allowed.
2010 Adjust the mode mask to eliminate setuid or setgid bits
2011 or group permissions bits that are inappropriate if the
2012 owner or group are wrong. */
2013 if (fchown (ofd, st.st_uid, st.st_gid) != 0)
2015 if (fchown (ofd, -1, st.st_gid) == 0)
2016 preserved_permissions &= ~04000;
2017 else
2019 preserved_permissions &= ~06000;
2021 /* Copy the other bits to the group bits, since the
2022 group is wrong. */
2023 preserved_permissions &= ~070;
2024 preserved_permissions |= (preserved_permissions & 7) << 3;
2025 default_permissions &= ~070;
2026 default_permissions |= (default_permissions & 7) << 3;
2031 switch (!NILP (preserve_permissions)
2032 ? qcopy_acl (SSDATA (encoded_file), ifd,
2033 SSDATA (encoded_newname), ofd,
2034 preserved_permissions)
2035 : (already_exists
2036 || (new_mask & ~realmask) == default_permissions)
2038 : fchmod (ofd, default_permissions))
2040 case -2: report_file_error ("Copying permissions from", file);
2041 case -1: report_file_error ("Copying permissions to", newname);
2044 #endif /* not MSDOS */
2046 #if HAVE_LIBSELINUX
2047 if (conlength > 0)
2049 /* Set the modified context back to the file. */
2050 bool fail = fsetfilecon (ofd, con) != 0;
2051 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2052 if (fail && errno != ENOTSUP)
2053 report_file_error ("Doing fsetfilecon", newname);
2055 freecon (con);
2057 #endif
2059 if (!NILP (keep_time))
2061 struct timespec atime = get_stat_atime (&st);
2062 struct timespec mtime = get_stat_mtime (&st);
2063 if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime) != 0)
2064 xsignal2 (Qfile_date_error,
2065 build_string ("Cannot set file date"), newname);
2068 if (emacs_close (ofd) < 0)
2069 report_file_error ("Write error", newname);
2071 emacs_close (ifd);
2073 #ifdef MSDOS
2074 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2075 and if it can't, it tells so. Otherwise, under MSDOS we usually
2076 get only the READ bit, which will make the copied file read-only,
2077 so it's better not to chmod at all. */
2078 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
2079 chmod (SDATA (encoded_newname), st.st_mode & 07777);
2080 #endif /* MSDOS */
2081 #endif /* not WINDOWSNT */
2083 /* Discard the unwind protects. */
2084 specpdl_ptr = specpdl + count;
2086 UNGCPRO;
2087 return Qnil;
2090 DEFUN ("make-directory-internal", Fmake_directory_internal,
2091 Smake_directory_internal, 1, 1, 0,
2092 doc: /* Create a new directory named DIRECTORY. */)
2093 (Lisp_Object directory)
2095 const char *dir;
2096 Lisp_Object handler;
2097 Lisp_Object encoded_dir;
2099 CHECK_STRING (directory);
2100 directory = Fexpand_file_name (directory, Qnil);
2102 handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
2103 if (!NILP (handler))
2104 return call2 (handler, Qmake_directory_internal, directory);
2106 encoded_dir = ENCODE_FILE (directory);
2108 dir = SSDATA (encoded_dir);
2110 #ifdef WINDOWSNT
2111 if (mkdir (dir) != 0)
2112 #else
2113 if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
2114 #endif
2115 report_file_error ("Creating directory", directory);
2117 return Qnil;
2120 DEFUN ("delete-directory-internal", Fdelete_directory_internal,
2121 Sdelete_directory_internal, 1, 1, 0,
2122 doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2123 (Lisp_Object directory)
2125 const char *dir;
2126 Lisp_Object encoded_dir;
2128 CHECK_STRING (directory);
2129 directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
2130 encoded_dir = ENCODE_FILE (directory);
2131 dir = SSDATA (encoded_dir);
2133 if (rmdir (dir) != 0)
2134 report_file_error ("Removing directory", directory);
2136 return Qnil;
2139 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 2,
2140 "(list (read-file-name \
2141 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2142 \"Move file to trash: \" \"Delete file: \") \
2143 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2144 (null current-prefix-arg))",
2145 doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2146 If file has multiple names, it continues to exist with the other names.
2147 TRASH non-nil means to trash the file instead of deleting, provided
2148 `delete-by-moving-to-trash' is non-nil.
2150 When called interactively, TRASH is t if no prefix argument is given.
2151 With a prefix argument, TRASH is nil. */)
2152 (Lisp_Object filename, Lisp_Object trash)
2154 Lisp_Object handler;
2155 Lisp_Object encoded_file;
2156 struct gcpro gcpro1;
2158 GCPRO1 (filename);
2159 if (!NILP (Ffile_directory_p (filename))
2160 && NILP (Ffile_symlink_p (filename)))
2161 xsignal2 (Qfile_error,
2162 build_string ("Removing old name: is a directory"),
2163 filename);
2164 UNGCPRO;
2165 filename = Fexpand_file_name (filename, Qnil);
2167 handler = Ffind_file_name_handler (filename, Qdelete_file);
2168 if (!NILP (handler))
2169 return call3 (handler, Qdelete_file, filename, trash);
2171 if (delete_by_moving_to_trash && !NILP (trash))
2172 return call1 (Qmove_file_to_trash, filename);
2174 encoded_file = ENCODE_FILE (filename);
2176 if (unlink (SSDATA (encoded_file)) < 0)
2177 report_file_error ("Removing old name", filename);
2178 return Qnil;
2181 static Lisp_Object
2182 internal_delete_file_1 (Lisp_Object ignore)
2184 return Qt;
2187 /* Delete file FILENAME, returning true if successful.
2188 This ignores `delete-by-moving-to-trash'. */
2190 bool
2191 internal_delete_file (Lisp_Object filename)
2193 Lisp_Object tem;
2195 tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
2196 Qt, internal_delete_file_1);
2197 return NILP (tem);
2200 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
2201 "fRename file: \nGRename %s to file: \np",
2202 doc: /* Rename FILE as NEWNAME. Both args must be strings.
2203 If file has names other than FILE, it continues to have those names.
2204 Signals a `file-already-exists' error if a file NEWNAME already exists
2205 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2206 A number as third arg means request confirmation if NEWNAME already exists.
2207 This is what happens in interactive use with M-x. */)
2208 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2210 Lisp_Object handler;
2211 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2212 Lisp_Object encoded_file, encoded_newname, symlink_target;
2214 symlink_target = encoded_file = encoded_newname = Qnil;
2215 GCPRO5 (file, newname, encoded_file, encoded_newname, symlink_target);
2216 CHECK_STRING (file);
2217 CHECK_STRING (newname);
2218 file = Fexpand_file_name (file, Qnil);
2220 if ((!NILP (Ffile_directory_p (newname)))
2221 #ifdef DOS_NT
2222 /* If the file names are identical but for the case,
2223 don't attempt to move directory to itself. */
2224 && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
2225 #endif
2228 Lisp_Object fname = (NILP (Ffile_directory_p (file))
2229 ? file : Fdirectory_file_name (file));
2230 newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname);
2232 else
2233 newname = Fexpand_file_name (newname, Qnil);
2235 /* If the file name has special constructs in it,
2236 call the corresponding file handler. */
2237 handler = Ffind_file_name_handler (file, Qrename_file);
2238 if (NILP (handler))
2239 handler = Ffind_file_name_handler (newname, Qrename_file);
2240 if (!NILP (handler))
2241 RETURN_UNGCPRO (call4 (handler, Qrename_file,
2242 file, newname, ok_if_already_exists));
2244 encoded_file = ENCODE_FILE (file);
2245 encoded_newname = ENCODE_FILE (newname);
2247 #ifdef DOS_NT
2248 /* If the file names are identical but for the case, don't ask for
2249 confirmation: they simply want to change the letter-case of the
2250 file name. */
2251 if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
2252 #endif
2253 if (NILP (ok_if_already_exists)
2254 || INTEGERP (ok_if_already_exists))
2255 barf_or_query_if_file_exists (newname, false, "rename to it",
2256 INTEGERP (ok_if_already_exists), false);
2257 if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
2259 int rename_errno = errno;
2260 if (rename_errno == EXDEV)
2262 ptrdiff_t count;
2263 symlink_target = Ffile_symlink_p (file);
2264 if (! NILP (symlink_target))
2265 Fmake_symbolic_link (symlink_target, newname,
2266 NILP (ok_if_already_exists) ? Qnil : Qt);
2267 else if (!NILP (Ffile_directory_p (file)))
2268 call4 (Qcopy_directory, file, newname, Qt, Qnil);
2269 else
2270 /* We have already prompted if it was an integer, so don't
2271 have copy-file prompt again. */
2272 Fcopy_file (file, newname,
2273 NILP (ok_if_already_exists) ? Qnil : Qt,
2274 Qt, Qt, Qt);
2276 count = SPECPDL_INDEX ();
2277 specbind (Qdelete_by_moving_to_trash, Qnil);
2279 if (!NILP (Ffile_directory_p (file)) && NILP (symlink_target))
2280 call2 (Qdelete_directory, file, Qt);
2281 else
2282 Fdelete_file (file, Qnil);
2283 unbind_to (count, Qnil);
2285 else
2286 report_file_errno ("Renaming", list2 (file, newname), rename_errno);
2288 UNGCPRO;
2289 return Qnil;
2292 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
2293 "fAdd name to file: \nGName to add to %s: \np",
2294 doc: /* Give FILE additional name NEWNAME. Both args must be strings.
2295 Signals a `file-already-exists' error if a file NEWNAME already exists
2296 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2297 A number as third arg means request confirmation if NEWNAME already exists.
2298 This is what happens in interactive use with M-x. */)
2299 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2301 Lisp_Object handler;
2302 Lisp_Object encoded_file, encoded_newname;
2303 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2305 GCPRO4 (file, newname, encoded_file, encoded_newname);
2306 encoded_file = encoded_newname = Qnil;
2307 CHECK_STRING (file);
2308 CHECK_STRING (newname);
2309 file = Fexpand_file_name (file, Qnil);
2311 if (!NILP (Ffile_directory_p (newname)))
2312 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
2313 else
2314 newname = Fexpand_file_name (newname, Qnil);
2316 /* If the file name has special constructs in it,
2317 call the corresponding file handler. */
2318 handler = Ffind_file_name_handler (file, Qadd_name_to_file);
2319 if (!NILP (handler))
2320 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
2321 newname, ok_if_already_exists));
2323 /* If the new name has special constructs in it,
2324 call the corresponding file handler. */
2325 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2326 if (!NILP (handler))
2327 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
2328 newname, ok_if_already_exists));
2330 encoded_file = ENCODE_FILE (file);
2331 encoded_newname = ENCODE_FILE (newname);
2333 if (NILP (ok_if_already_exists)
2334 || INTEGERP (ok_if_already_exists))
2335 barf_or_query_if_file_exists (newname, false, "make it a new name",
2336 INTEGERP (ok_if_already_exists), false);
2338 unlink (SSDATA (newname));
2339 if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
2341 int link_errno = errno;
2342 report_file_errno ("Adding new name", list2 (file, newname), link_errno);
2345 UNGCPRO;
2346 return Qnil;
2349 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
2350 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2351 doc: /* Make a symbolic link to FILENAME, named LINKNAME.
2352 Both args must be strings.
2353 Signals a `file-already-exists' error if a file LINKNAME already exists
2354 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2355 A number as third arg means request confirmation if LINKNAME already exists.
2356 This happens for interactive use with M-x. */)
2357 (Lisp_Object filename, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
2359 Lisp_Object handler;
2360 Lisp_Object encoded_filename, encoded_linkname;
2361 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2363 GCPRO4 (filename, linkname, encoded_filename, encoded_linkname);
2364 encoded_filename = encoded_linkname = Qnil;
2365 CHECK_STRING (filename);
2366 CHECK_STRING (linkname);
2367 /* If the link target has a ~, we must expand it to get
2368 a truly valid file name. Otherwise, do not expand;
2369 we want to permit links to relative file names. */
2370 if (SREF (filename, 0) == '~')
2371 filename = Fexpand_file_name (filename, Qnil);
2373 if (!NILP (Ffile_directory_p (linkname)))
2374 linkname = Fexpand_file_name (Ffile_name_nondirectory (filename), linkname);
2375 else
2376 linkname = Fexpand_file_name (linkname, Qnil);
2378 /* If the file name has special constructs in it,
2379 call the corresponding file handler. */
2380 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2381 if (!NILP (handler))
2382 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2383 linkname, ok_if_already_exists));
2385 /* If the new link name has special constructs in it,
2386 call the corresponding file handler. */
2387 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2388 if (!NILP (handler))
2389 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2390 linkname, ok_if_already_exists));
2392 encoded_filename = ENCODE_FILE (filename);
2393 encoded_linkname = ENCODE_FILE (linkname);
2395 if (NILP (ok_if_already_exists)
2396 || INTEGERP (ok_if_already_exists))
2397 barf_or_query_if_file_exists (linkname, false, "make it a link",
2398 INTEGERP (ok_if_already_exists), false);
2399 if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname)) < 0)
2401 /* If we didn't complain already, silently delete existing file. */
2402 int symlink_errno;
2403 if (errno == EEXIST)
2405 unlink (SSDATA (encoded_linkname));
2406 if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname))
2407 >= 0)
2409 UNGCPRO;
2410 return Qnil;
2413 if (errno == ENOSYS)
2415 UNGCPRO;
2416 xsignal1 (Qfile_error,
2417 build_string ("Symbolic links are not supported"));
2420 symlink_errno = errno;
2421 report_file_errno ("Making symbolic link", list2 (filename, linkname),
2422 symlink_errno);
2424 UNGCPRO;
2425 return Qnil;
2429 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
2430 1, 1, 0,
2431 doc: /* Return t if file FILENAME specifies an absolute file name.
2432 On Unix, this is a name starting with a `/' or a `~'. */)
2433 (Lisp_Object filename)
2435 CHECK_STRING (filename);
2436 return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
2439 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
2440 doc: /* Return t if file FILENAME exists (whether or not you can read it.)
2441 See also `file-readable-p' and `file-attributes'.
2442 This returns nil for a symlink to a nonexistent file.
2443 Use `file-symlink-p' to test for such links. */)
2444 (Lisp_Object filename)
2446 Lisp_Object absname;
2447 Lisp_Object handler;
2449 CHECK_STRING (filename);
2450 absname = Fexpand_file_name (filename, Qnil);
2452 /* If the file name has special constructs in it,
2453 call the corresponding file handler. */
2454 handler = Ffind_file_name_handler (absname, Qfile_exists_p);
2455 if (!NILP (handler))
2457 Lisp_Object result = call2 (handler, Qfile_exists_p, absname);
2458 errno = 0;
2459 return result;
2462 absname = ENCODE_FILE (absname);
2464 return check_existing (SSDATA (absname)) ? Qt : Qnil;
2467 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
2468 doc: /* Return t if FILENAME can be executed by you.
2469 For a directory, this means you can access files in that directory.
2470 \(It is generally better to use `file-accessible-directory-p' for that
2471 purpose, though.) */)
2472 (Lisp_Object filename)
2474 Lisp_Object absname;
2475 Lisp_Object handler;
2477 CHECK_STRING (filename);
2478 absname = Fexpand_file_name (filename, Qnil);
2480 /* If the file name has special constructs in it,
2481 call the corresponding file handler. */
2482 handler = Ffind_file_name_handler (absname, Qfile_executable_p);
2483 if (!NILP (handler))
2484 return call2 (handler, Qfile_executable_p, absname);
2486 absname = ENCODE_FILE (absname);
2488 return (check_executable (SSDATA (absname)) ? Qt : Qnil);
2491 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
2492 doc: /* Return t if file FILENAME exists and you can read it.
2493 See also `file-exists-p' and `file-attributes'. */)
2494 (Lisp_Object filename)
2496 Lisp_Object absname;
2497 Lisp_Object handler;
2499 CHECK_STRING (filename);
2500 absname = Fexpand_file_name (filename, Qnil);
2502 /* If the file name has special constructs in it,
2503 call the corresponding file handler. */
2504 handler = Ffind_file_name_handler (absname, Qfile_readable_p);
2505 if (!NILP (handler))
2506 return call2 (handler, Qfile_readable_p, absname);
2508 absname = ENCODE_FILE (absname);
2509 return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0
2510 ? Qt : Qnil);
2513 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2514 doc: /* Return t if file FILENAME can be written or created by you. */)
2515 (Lisp_Object filename)
2517 Lisp_Object absname, dir, encoded;
2518 Lisp_Object handler;
2520 CHECK_STRING (filename);
2521 absname = Fexpand_file_name (filename, Qnil);
2523 /* If the file name has special constructs in it,
2524 call the corresponding file handler. */
2525 handler = Ffind_file_name_handler (absname, Qfile_writable_p);
2526 if (!NILP (handler))
2527 return call2 (handler, Qfile_writable_p, absname);
2529 encoded = ENCODE_FILE (absname);
2530 if (check_writable (SSDATA (encoded), W_OK))
2531 return Qt;
2532 if (errno != ENOENT)
2533 return Qnil;
2535 dir = Ffile_name_directory (absname);
2536 eassert (!NILP (dir));
2537 #ifdef MSDOS
2538 dir = Fdirectory_file_name (dir);
2539 #endif /* MSDOS */
2541 dir = ENCODE_FILE (dir);
2542 #ifdef WINDOWSNT
2543 /* The read-only attribute of the parent directory doesn't affect
2544 whether a file or directory can be created within it. Some day we
2545 should check ACLs though, which do affect this. */
2546 return file_directory_p (SDATA (dir)) ? Qt : Qnil;
2547 #else
2548 return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil;
2549 #endif
2552 DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
2553 doc: /* Access file FILENAME, and get an error if that does not work.
2554 The second argument STRING is used in the error message.
2555 If there is no error, returns nil. */)
2556 (Lisp_Object filename, Lisp_Object string)
2558 Lisp_Object handler, encoded_filename, absname;
2560 CHECK_STRING (filename);
2561 absname = Fexpand_file_name (filename, Qnil);
2563 CHECK_STRING (string);
2565 /* If the file name has special constructs in it,
2566 call the corresponding file handler. */
2567 handler = Ffind_file_name_handler (absname, Qaccess_file);
2568 if (!NILP (handler))
2569 return call3 (handler, Qaccess_file, absname, string);
2571 encoded_filename = ENCODE_FILE (absname);
2573 if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0)
2574 report_file_error (SSDATA (string), filename);
2576 return Qnil;
2579 /* Relative to directory FD, return the symbolic link value of FILENAME.
2580 On failure, return nil. */
2581 Lisp_Object
2582 emacs_readlinkat (int fd, char const *filename)
2584 static struct allocator const emacs_norealloc_allocator =
2585 { xmalloc, NULL, xfree, memory_full };
2586 Lisp_Object val;
2587 char readlink_buf[1024];
2588 char *buf = careadlinkat (fd, filename, readlink_buf, sizeof readlink_buf,
2589 &emacs_norealloc_allocator, readlinkat);
2590 if (!buf)
2591 return Qnil;
2593 val = build_unibyte_string (buf);
2594 if (buf[0] == '/' && strchr (buf, ':'))
2596 AUTO_STRING (slash_colon, "/:");
2597 val = concat2 (slash_colon, val);
2599 if (buf != readlink_buf)
2600 xfree (buf);
2601 val = DECODE_FILE (val);
2602 return val;
2605 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
2606 doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
2607 The value is the link target, as a string.
2608 Otherwise it returns nil.
2610 This function does not check whether the link target exists. */)
2611 (Lisp_Object filename)
2613 Lisp_Object handler;
2615 CHECK_STRING (filename);
2616 filename = Fexpand_file_name (filename, Qnil);
2618 /* If the file name has special constructs in it,
2619 call the corresponding file handler. */
2620 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2621 if (!NILP (handler))
2622 return call2 (handler, Qfile_symlink_p, filename);
2624 filename = ENCODE_FILE (filename);
2626 return emacs_readlinkat (AT_FDCWD, SSDATA (filename));
2629 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
2630 doc: /* Return t if FILENAME names an existing directory.
2631 Symbolic links to directories count as directories.
2632 See `file-symlink-p' to distinguish symlinks. */)
2633 (Lisp_Object filename)
2635 Lisp_Object absname;
2636 Lisp_Object handler;
2638 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
2640 /* If the file name has special constructs in it,
2641 call the corresponding file handler. */
2642 handler = Ffind_file_name_handler (absname, Qfile_directory_p);
2643 if (!NILP (handler))
2644 return call2 (handler, Qfile_directory_p, absname);
2646 absname = ENCODE_FILE (absname);
2648 return file_directory_p (SSDATA (absname)) ? Qt : Qnil;
2651 /* Return true if FILE is a directory or a symlink to a directory. */
2652 bool
2653 file_directory_p (char const *file)
2655 #ifdef WINDOWSNT
2656 /* This is cheaper than 'stat'. */
2657 return faccessat (AT_FDCWD, file, D_OK, AT_EACCESS) == 0;
2658 #else
2659 struct stat st;
2660 return stat (file, &st) == 0 && S_ISDIR (st.st_mode);
2661 #endif
2664 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p,
2665 Sfile_accessible_directory_p, 1, 1, 0,
2666 doc: /* Return t if file FILENAME names a directory you can open.
2667 For the value to be t, FILENAME must specify the name of a directory as a file,
2668 and the directory must allow you to open files in it. In order to use a
2669 directory as a buffer's current directory, this predicate must return true.
2670 A directory name spec may be given instead; then the value is t
2671 if the directory so specified exists and really is a readable and
2672 searchable directory. */)
2673 (Lisp_Object filename)
2675 Lisp_Object absname;
2676 Lisp_Object handler;
2678 CHECK_STRING (filename);
2679 absname = Fexpand_file_name (filename, Qnil);
2681 /* If the file name has special constructs in it,
2682 call the corresponding file handler. */
2683 handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p);
2684 if (!NILP (handler))
2686 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
2687 errno = 0;
2688 return r;
2691 absname = ENCODE_FILE (absname);
2692 return file_accessible_directory_p (absname) ? Qt : Qnil;
2695 /* If FILE is a searchable directory or a symlink to a
2696 searchable directory, return true. Otherwise return
2697 false and set errno to an error number. */
2698 bool
2699 file_accessible_directory_p (Lisp_Object file)
2701 #ifdef DOS_NT
2702 /* There's no need to test whether FILE is searchable, as the
2703 searchable/executable bit is invented on DOS_NT platforms. */
2704 return file_directory_p (SSDATA (file));
2705 #else
2706 /* On POSIXish platforms, use just one system call; this avoids a
2707 race and is typically faster. */
2708 const char *data = SSDATA (file);
2709 ptrdiff_t len = SBYTES (file);
2710 char const *dir;
2711 bool ok;
2712 int saved_errno;
2713 USE_SAFE_ALLOCA;
2715 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2716 There are three exceptions: "", "/", and "//". Leave "" alone,
2717 as it's invalid. Append only "." to the other two exceptions as
2718 "/" and "//" are distinct on some platforms, whereas "/", "///",
2719 "////", etc. are all equivalent. */
2720 if (! len)
2721 dir = data;
2722 else
2724 /* Just check for trailing '/' when deciding whether to append '/'.
2725 That's simpler than testing the two special cases "/" and "//",
2726 and it's a safe optimization here. */
2727 char *buf = SAFE_ALLOCA (len + 3);
2728 memcpy (buf, data, len);
2729 strcpy (buf + len, &"/."[data[len - 1] == '/']);
2730 dir = buf;
2733 ok = check_existing (dir);
2734 saved_errno = errno;
2735 SAFE_FREE ();
2736 errno = saved_errno;
2737 return ok;
2738 #endif
2741 DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
2742 doc: /* Return t if FILENAME names a regular file.
2743 This is the sort of file that holds an ordinary stream of data bytes.
2744 Symbolic links to regular files count as regular files.
2745 See `file-symlink-p' to distinguish symlinks. */)
2746 (Lisp_Object filename)
2748 register Lisp_Object absname;
2749 struct stat st;
2750 Lisp_Object handler;
2752 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
2754 /* If the file name has special constructs in it,
2755 call the corresponding file handler. */
2756 handler = Ffind_file_name_handler (absname, Qfile_regular_p);
2757 if (!NILP (handler))
2758 return call2 (handler, Qfile_regular_p, absname);
2760 absname = ENCODE_FILE (absname);
2762 #ifdef WINDOWSNT
2764 int result;
2765 Lisp_Object tem = Vw32_get_true_file_attributes;
2767 /* Tell stat to use expensive method to get accurate info. */
2768 Vw32_get_true_file_attributes = Qt;
2769 result = stat (SDATA (absname), &st);
2770 Vw32_get_true_file_attributes = tem;
2772 if (result < 0)
2773 return Qnil;
2774 return S_ISREG (st.st_mode) ? Qt : Qnil;
2776 #else
2777 if (stat (SSDATA (absname), &st) < 0)
2778 return Qnil;
2779 return S_ISREG (st.st_mode) ? Qt : Qnil;
2780 #endif
2783 DEFUN ("file-selinux-context", Ffile_selinux_context,
2784 Sfile_selinux_context, 1, 1, 0,
2785 doc: /* Return SELinux context of file named FILENAME.
2786 The return value is a list (USER ROLE TYPE RANGE), where the list
2787 elements are strings naming the user, role, type, and range of the
2788 file's SELinux security context.
2790 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2791 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2792 (Lisp_Object filename)
2794 Lisp_Object absname;
2795 Lisp_Object user = Qnil, role = Qnil, type = Qnil, range = Qnil;
2797 Lisp_Object handler;
2798 #if HAVE_LIBSELINUX
2799 security_context_t con;
2800 int conlength;
2801 context_t context;
2802 #endif
2804 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
2806 /* If the file name has special constructs in it,
2807 call the corresponding file handler. */
2808 handler = Ffind_file_name_handler (absname, Qfile_selinux_context);
2809 if (!NILP (handler))
2810 return call2 (handler, Qfile_selinux_context, absname);
2812 absname = ENCODE_FILE (absname);
2814 #if HAVE_LIBSELINUX
2815 if (is_selinux_enabled ())
2817 conlength = lgetfilecon (SSDATA (absname), &con);
2818 if (conlength > 0)
2820 context = context_new (con);
2821 if (context_user_get (context))
2822 user = build_string (context_user_get (context));
2823 if (context_role_get (context))
2824 role = build_string (context_role_get (context));
2825 if (context_type_get (context))
2826 type = build_string (context_type_get (context));
2827 if (context_range_get (context))
2828 range = build_string (context_range_get (context));
2829 context_free (context);
2830 freecon (con);
2833 #endif
2835 return list4 (user, role, type, range);
2838 DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
2839 Sset_file_selinux_context, 2, 2, 0,
2840 doc: /* Set SELinux context of file named FILENAME to CONTEXT.
2841 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2842 elements are strings naming the components of a SELinux context.
2844 Value is t if setting of SELinux context was successful, nil otherwise.
2846 This function does nothing and returns nil if SELinux is disabled,
2847 or if Emacs was not compiled with SELinux support. */)
2848 (Lisp_Object filename, Lisp_Object context)
2850 Lisp_Object absname;
2851 Lisp_Object handler;
2852 #if HAVE_LIBSELINUX
2853 Lisp_Object encoded_absname;
2854 Lisp_Object user = CAR_SAFE (context);
2855 Lisp_Object role = CAR_SAFE (CDR_SAFE (context));
2856 Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
2857 Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
2858 security_context_t con;
2859 bool fail;
2860 int conlength;
2861 context_t parsed_con;
2862 #endif
2864 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
2866 /* If the file name has special constructs in it,
2867 call the corresponding file handler. */
2868 handler = Ffind_file_name_handler (absname, Qset_file_selinux_context);
2869 if (!NILP (handler))
2870 return call3 (handler, Qset_file_selinux_context, absname, context);
2872 #if HAVE_LIBSELINUX
2873 if (is_selinux_enabled ())
2875 /* Get current file context. */
2876 encoded_absname = ENCODE_FILE (absname);
2877 conlength = lgetfilecon (SSDATA (encoded_absname), &con);
2878 if (conlength > 0)
2880 parsed_con = context_new (con);
2881 /* Change the parts defined in the parameter.*/
2882 if (STRINGP (user))
2884 if (context_user_set (parsed_con, SSDATA (user)))
2885 error ("Doing context_user_set");
2887 if (STRINGP (role))
2889 if (context_role_set (parsed_con, SSDATA (role)))
2890 error ("Doing context_role_set");
2892 if (STRINGP (type))
2894 if (context_type_set (parsed_con, SSDATA (type)))
2895 error ("Doing context_type_set");
2897 if (STRINGP (range))
2899 if (context_range_set (parsed_con, SSDATA (range)))
2900 error ("Doing context_range_set");
2903 /* Set the modified context back to the file. */
2904 fail = (lsetfilecon (SSDATA (encoded_absname),
2905 context_str (parsed_con))
2906 != 0);
2907 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2908 if (fail && errno != ENOTSUP)
2909 report_file_error ("Doing lsetfilecon", absname);
2911 context_free (parsed_con);
2912 freecon (con);
2913 return fail ? Qnil : Qt;
2915 else
2916 report_file_error ("Doing lgetfilecon", absname);
2918 #endif
2920 return Qnil;
2923 DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0,
2924 doc: /* Return ACL entries of file named FILENAME.
2925 The entries are returned in a format suitable for use in `set-file-acl'
2926 but is otherwise undocumented and subject to change.
2927 Return nil if file does not exist or is not accessible, or if Emacs
2928 was unable to determine the ACL entries. */)
2929 (Lisp_Object filename)
2931 Lisp_Object absname;
2932 Lisp_Object handler;
2933 #ifdef HAVE_ACL_SET_FILE
2934 acl_t acl;
2935 Lisp_Object acl_string;
2936 char *str;
2937 # ifndef HAVE_ACL_TYPE_EXTENDED
2938 acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS;
2939 # endif
2940 #endif
2942 absname = expand_and_dir_to_file (filename,
2943 BVAR (current_buffer, directory));
2945 /* If the file name has special constructs in it,
2946 call the corresponding file handler. */
2947 handler = Ffind_file_name_handler (absname, Qfile_acl);
2948 if (!NILP (handler))
2949 return call2 (handler, Qfile_acl, absname);
2951 #ifdef HAVE_ACL_SET_FILE
2952 absname = ENCODE_FILE (absname);
2954 acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED);
2955 if (acl == NULL)
2956 return Qnil;
2958 str = acl_to_text (acl, NULL);
2959 if (str == NULL)
2961 acl_free (acl);
2962 return Qnil;
2965 acl_string = build_string (str);
2966 acl_free (str);
2967 acl_free (acl);
2969 return acl_string;
2970 #endif
2972 return Qnil;
2975 DEFUN ("set-file-acl", Fset_file_acl, Sset_file_acl,
2976 2, 2, 0,
2977 doc: /* Set ACL of file named FILENAME to ACL-STRING.
2978 ACL-STRING should contain the textual representation of the ACL
2979 entries in a format suitable for the platform.
2981 Value is t if setting of ACL was successful, nil otherwise.
2983 Setting ACL for local files requires Emacs to be built with ACL
2984 support. */)
2985 (Lisp_Object filename, Lisp_Object acl_string)
2987 Lisp_Object absname;
2988 Lisp_Object handler;
2989 #ifdef HAVE_ACL_SET_FILE
2990 Lisp_Object encoded_absname;
2991 acl_t acl;
2992 bool fail;
2993 #endif
2995 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
2997 /* If the file name has special constructs in it,
2998 call the corresponding file handler. */
2999 handler = Ffind_file_name_handler (absname, Qset_file_acl);
3000 if (!NILP (handler))
3001 return call3 (handler, Qset_file_acl, absname, acl_string);
3003 #ifdef HAVE_ACL_SET_FILE
3004 if (STRINGP (acl_string))
3006 acl = acl_from_text (SSDATA (acl_string));
3007 if (acl == NULL)
3009 report_file_error ("Converting ACL", absname);
3010 return Qnil;
3013 encoded_absname = ENCODE_FILE (absname);
3015 fail = (acl_set_file (SSDATA (encoded_absname), ACL_TYPE_ACCESS,
3016 acl)
3017 != 0);
3018 if (fail && acl_errno_valid (errno))
3019 report_file_error ("Setting ACL", absname);
3021 acl_free (acl);
3022 return fail ? Qnil : Qt;
3024 #endif
3026 return Qnil;
3029 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
3030 doc: /* Return mode bits of file named FILENAME, as an integer.
3031 Return nil, if file does not exist or is not accessible. */)
3032 (Lisp_Object filename)
3034 Lisp_Object absname;
3035 struct stat st;
3036 Lisp_Object handler;
3038 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
3040 /* If the file name has special constructs in it,
3041 call the corresponding file handler. */
3042 handler = Ffind_file_name_handler (absname, Qfile_modes);
3043 if (!NILP (handler))
3044 return call2 (handler, Qfile_modes, absname);
3046 absname = ENCODE_FILE (absname);
3048 if (stat (SSDATA (absname), &st) < 0)
3049 return Qnil;
3051 return make_number (st.st_mode & 07777);
3054 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2,
3055 "(let ((file (read-file-name \"File: \"))) \
3056 (list file (read-file-modes nil file)))",
3057 doc: /* Set mode bits of file named FILENAME to MODE (an integer).
3058 Only the 12 low bits of MODE are used.
3060 Interactively, mode bits are read by `read-file-modes', which accepts
3061 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3062 (Lisp_Object filename, Lisp_Object mode)
3064 Lisp_Object absname, encoded_absname;
3065 Lisp_Object handler;
3067 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3068 CHECK_NUMBER (mode);
3070 /* If the file name has special constructs in it,
3071 call the corresponding file handler. */
3072 handler = Ffind_file_name_handler (absname, Qset_file_modes);
3073 if (!NILP (handler))
3074 return call3 (handler, Qset_file_modes, absname, mode);
3076 encoded_absname = ENCODE_FILE (absname);
3078 if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
3079 report_file_error ("Doing chmod", absname);
3081 return Qnil;
3084 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
3085 doc: /* Set the file permission bits for newly created files.
3086 The argument MODE should be an integer; only the low 9 bits are used.
3087 This setting is inherited by subprocesses. */)
3088 (Lisp_Object mode)
3090 mode_t oldrealmask, oldumask, newumask;
3091 CHECK_NUMBER (mode);
3092 oldrealmask = realmask;
3093 newumask = ~ XINT (mode) & 0777;
3095 block_input ();
3096 realmask = newumask;
3097 oldumask = umask (newumask);
3098 unblock_input ();
3100 eassert (oldumask == oldrealmask);
3101 return Qnil;
3104 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
3105 doc: /* Return the default file protection for created files.
3106 The value is an integer. */)
3107 (void)
3109 Lisp_Object value;
3110 XSETINT (value, (~ realmask) & 0777);
3111 return value;
3115 DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
3116 doc: /* Set times of file FILENAME to TIMESTAMP.
3117 Set both access and modification times.
3118 Return t on success, else nil.
3119 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3120 `current-time'. */)
3121 (Lisp_Object filename, Lisp_Object timestamp)
3123 Lisp_Object absname, encoded_absname;
3124 Lisp_Object handler;
3125 struct timespec t = lisp_time_argument (timestamp);
3127 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3129 /* If the file name has special constructs in it,
3130 call the corresponding file handler. */
3131 handler = Ffind_file_name_handler (absname, Qset_file_times);
3132 if (!NILP (handler))
3133 return call3 (handler, Qset_file_times, absname, timestamp);
3135 encoded_absname = ENCODE_FILE (absname);
3138 if (set_file_times (-1, SSDATA (encoded_absname), t, t) != 0)
3140 #ifdef MSDOS
3141 /* Setting times on a directory always fails. */
3142 if (file_directory_p (SSDATA (encoded_absname)))
3143 return Qnil;
3144 #endif
3145 report_file_error ("Setting file times", absname);
3149 return Qt;
3152 #ifdef HAVE_SYNC
3153 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
3154 doc: /* Tell Unix to finish all pending disk updates. */)
3155 (void)
3157 sync ();
3158 return Qnil;
3161 #endif /* HAVE_SYNC */
3163 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
3164 doc: /* Return t if file FILE1 is newer than file FILE2.
3165 If FILE1 does not exist, the answer is nil;
3166 otherwise, if FILE2 does not exist, the answer is t. */)
3167 (Lisp_Object file1, Lisp_Object file2)
3169 Lisp_Object absname1, absname2;
3170 struct stat st1, st2;
3171 Lisp_Object handler;
3172 struct gcpro gcpro1, gcpro2;
3174 CHECK_STRING (file1);
3175 CHECK_STRING (file2);
3177 absname1 = Qnil;
3178 GCPRO2 (absname1, file2);
3179 absname1 = expand_and_dir_to_file (file1, BVAR (current_buffer, directory));
3180 absname2 = expand_and_dir_to_file (file2, BVAR (current_buffer, directory));
3181 UNGCPRO;
3183 /* If the file name has special constructs in it,
3184 call the corresponding file handler. */
3185 handler = Ffind_file_name_handler (absname1, Qfile_newer_than_file_p);
3186 if (NILP (handler))
3187 handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p);
3188 if (!NILP (handler))
3189 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
3191 GCPRO2 (absname1, absname2);
3192 absname1 = ENCODE_FILE (absname1);
3193 absname2 = ENCODE_FILE (absname2);
3194 UNGCPRO;
3196 if (stat (SSDATA (absname1), &st1) < 0)
3197 return Qnil;
3199 if (stat (SSDATA (absname2), &st2) < 0)
3200 return Qt;
3202 return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0
3203 ? Qt : Qnil);
3206 #ifndef READ_BUF_SIZE
3207 #define READ_BUF_SIZE (64 << 10)
3208 #endif
3209 /* Some buffer offsets are stored in 'int' variables. */
3210 verify (READ_BUF_SIZE <= INT_MAX);
3212 /* This function is called after Lisp functions to decide a coding
3213 system are called, or when they cause an error. Before they are
3214 called, the current buffer is set unibyte and it contains only a
3215 newly inserted text (thus the buffer was empty before the
3216 insertion).
3218 The functions may set markers, overlays, text properties, or even
3219 alter the buffer contents, change the current buffer.
3221 Here, we reset all those changes by:
3222 o set back the current buffer.
3223 o move all markers and overlays to BEG.
3224 o remove all text properties.
3225 o set back the buffer multibyteness. */
3227 static void
3228 decide_coding_unwind (Lisp_Object unwind_data)
3230 Lisp_Object multibyte, undo_list, buffer;
3232 multibyte = XCAR (unwind_data);
3233 unwind_data = XCDR (unwind_data);
3234 undo_list = XCAR (unwind_data);
3235 buffer = XCDR (unwind_data);
3237 set_buffer_internal (XBUFFER (buffer));
3238 adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
3239 adjust_overlays_for_delete (BEG, Z - BEG);
3240 set_buffer_intervals (current_buffer, NULL);
3241 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3243 /* Now we are safe to change the buffer's multibyteness directly. */
3244 bset_enable_multibyte_characters (current_buffer, multibyte);
3245 bset_undo_list (current_buffer, undo_list);
3248 /* Read from a non-regular file. STATE is a Lisp_Save_Value
3249 object where slot 0 is the file descriptor, slot 1 specifies
3250 an offset to put the read bytes, and slot 2 is the maximum
3251 amount of bytes to read. Value is the number of bytes read. */
3253 static Lisp_Object
3254 read_non_regular (Lisp_Object state)
3256 int nbytes;
3258 immediate_quit = 1;
3259 QUIT;
3260 nbytes = emacs_read (XSAVE_INTEGER (state, 0),
3261 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3262 + XSAVE_INTEGER (state, 1)),
3263 XSAVE_INTEGER (state, 2));
3264 immediate_quit = 0;
3265 /* Fast recycle this object for the likely next call. */
3266 free_misc (state);
3267 return make_number (nbytes);
3271 /* Condition-case handler used when reading from non-regular files
3272 in insert-file-contents. */
3274 static Lisp_Object
3275 read_non_regular_quit (Lisp_Object ignore)
3277 return Qnil;
3280 /* Return the file offset that VAL represents, checking for type
3281 errors and overflow. */
3282 static off_t
3283 file_offset (Lisp_Object val)
3285 if (RANGED_INTEGERP (0, val, TYPE_MAXIMUM (off_t)))
3286 return XINT (val);
3288 if (FLOATP (val))
3290 double v = XFLOAT_DATA (val);
3291 if (0 <= v
3292 && (sizeof (off_t) < sizeof v
3293 ? v <= TYPE_MAXIMUM (off_t)
3294 : v < TYPE_MAXIMUM (off_t)))
3295 return v;
3298 wrong_type_argument (intern ("file-offset"), val);
3301 /* Return a special time value indicating the error number ERRNUM. */
3302 static struct timespec
3303 time_error_value (int errnum)
3305 int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR
3306 ? NONEXISTENT_MODTIME_NSECS
3307 : UNKNOWN_MODTIME_NSECS);
3308 return make_timespec (0, ns);
3311 static Lisp_Object
3312 get_window_points_and_markers (void)
3314 Lisp_Object pt_marker = Fpoint_marker ();
3315 Lisp_Object windows
3316 = call3 (Qget_buffer_window_list, Fcurrent_buffer (), Qnil, Qt);
3317 Lisp_Object window_markers = windows;
3318 /* Window markers (and point) are handled specially: rather than move to
3319 just before or just after the modified text, we try to keep the
3320 markers at the same distance (bug#19161).
3321 In general, this is wrong, but for window-markers, this should be harmless
3322 and is convenient for the end user when most of the file is unmodified,
3323 except for a few minor details near the beginning and near the end. */
3324 for (; CONSP (windows); windows = XCDR (windows))
3325 if (WINDOWP (XCAR (windows)))
3327 Lisp_Object window_marker = XWINDOW (XCAR (windows))->pointm;
3328 XSETCAR (windows,
3329 Fcons (window_marker, Fmarker_position (window_marker)));
3331 return Fcons (Fcons (pt_marker, Fpoint ()), window_markers);
3334 static void
3335 restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted,
3336 ptrdiff_t same_at_start, ptrdiff_t same_at_end)
3338 for (; CONSP (window_markers); window_markers = XCDR (window_markers))
3339 if (CONSP (XCAR (window_markers)))
3341 Lisp_Object car = XCAR (window_markers);
3342 Lisp_Object marker = XCAR (car);
3343 Lisp_Object oldpos = XCDR (car);
3344 if (MARKERP (marker) && INTEGERP (oldpos)
3345 && XINT (oldpos) > same_at_start
3346 && XINT (oldpos) < same_at_end)
3348 ptrdiff_t oldsize = same_at_end - same_at_start;
3349 ptrdiff_t newsize = inserted;
3350 double growth = newsize / (double)oldsize;
3351 ptrdiff_t newpos
3352 = same_at_start + growth * (XINT (oldpos) - same_at_start);
3353 Fset_marker (marker, make_number (newpos), Qnil);
3358 /* FIXME: insert-file-contents should be split with the top-level moved to
3359 Elisp and only the core kept in C. */
3361 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
3362 1, 5, 0,
3363 doc: /* Insert contents of file FILENAME after point.
3364 Returns list of absolute file name and number of characters inserted.
3365 If second argument VISIT is non-nil, the buffer's visited filename and
3366 last save file modtime are set, and it is marked unmodified. If
3367 visiting and the file does not exist, visiting is completed before the
3368 error is signaled.
3370 The optional third and fourth arguments BEG and END specify what portion
3371 of the file to insert. These arguments count bytes in the file, not
3372 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3374 If optional fifth argument REPLACE is non-nil, replace the current
3375 buffer contents (in the accessible portion) with the file contents.
3376 This is better than simply deleting and inserting the whole thing
3377 because (1) it preserves some marker positions and (2) it puts less data
3378 in the undo list. When REPLACE is non-nil, the second return value is
3379 the number of characters that replace previous buffer contents.
3381 This function does code conversion according to the value of
3382 `coding-system-for-read' or `file-coding-system-alist', and sets the
3383 variable `last-coding-system-used' to the coding system actually used.
3385 In addition, this function decodes the inserted text from known formats
3386 by calling `format-decode', which see. */)
3387 (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
3389 struct stat st;
3390 struct timespec mtime;
3391 int fd;
3392 ptrdiff_t inserted = 0;
3393 ptrdiff_t how_much;
3394 off_t beg_offset, end_offset;
3395 int unprocessed;
3396 ptrdiff_t count = SPECPDL_INDEX ();
3397 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3398 Lisp_Object handler, val, insval, orig_filename, old_undo;
3399 Lisp_Object p;
3400 ptrdiff_t total = 0;
3401 bool not_regular = 0;
3402 int save_errno = 0;
3403 char read_buf[READ_BUF_SIZE];
3404 struct coding_system coding;
3405 bool replace_handled = false;
3406 bool set_coding_system = false;
3407 Lisp_Object coding_system;
3408 bool read_quit = false;
3409 /* If the undo log only contains the insertion, there's no point
3410 keeping it. It's typically when we first fill a file-buffer. */
3411 bool empty_undo_list_p
3412 = (!NILP (visit) && NILP (BVAR (current_buffer, undo_list))
3413 && BEG == Z);
3414 Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
3415 bool we_locked_file = false;
3416 ptrdiff_t fd_index;
3417 Lisp_Object window_markers = Qnil;
3418 /* same_at_start and same_at_end count bytes, because file access counts
3419 bytes and BEG and END count bytes. */
3420 ptrdiff_t same_at_start = BEGV_BYTE;
3421 ptrdiff_t same_at_end = ZV_BYTE;
3422 /* SAME_AT_END_CHARPOS counts characters, because
3423 restore_window_points needs the old character count. */
3424 ptrdiff_t same_at_end_charpos = ZV;
3426 if (current_buffer->base_buffer && ! NILP (visit))
3427 error ("Cannot do file visiting in an indirect buffer");
3429 if (!NILP (BVAR (current_buffer, read_only)))
3430 Fbarf_if_buffer_read_only (Qnil);
3432 val = Qnil;
3433 p = Qnil;
3434 orig_filename = Qnil;
3435 old_undo = Qnil;
3437 GCPRO5 (filename, val, p, orig_filename, old_undo);
3439 CHECK_STRING (filename);
3440 filename = Fexpand_file_name (filename, Qnil);
3442 /* The value Qnil means that the coding system is not yet
3443 decided. */
3444 coding_system = Qnil;
3446 /* If the file name has special constructs in it,
3447 call the corresponding file handler. */
3448 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
3449 if (!NILP (handler))
3451 val = call6 (handler, Qinsert_file_contents, filename,
3452 visit, beg, end, replace);
3453 if (CONSP (val) && CONSP (XCDR (val))
3454 && RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT))
3455 inserted = XINT (XCAR (XCDR (val)));
3456 goto handled;
3459 orig_filename = filename;
3460 filename = ENCODE_FILE (filename);
3462 fd = emacs_open (SSDATA (filename), O_RDONLY, 0);
3463 if (fd < 0)
3465 save_errno = errno;
3466 if (NILP (visit))
3467 report_file_error ("Opening input file", orig_filename);
3468 mtime = time_error_value (save_errno);
3469 st.st_size = -1;
3470 if (!NILP (Vcoding_system_for_read))
3471 Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
3472 goto notfound;
3475 fd_index = SPECPDL_INDEX ();
3476 record_unwind_protect_int (close_file_unwind, fd);
3478 /* Replacement should preserve point as it preserves markers. */
3479 if (!NILP (replace))
3481 window_markers = get_window_points_and_markers ();
3482 record_unwind_protect (restore_point_unwind,
3483 XCAR (XCAR (window_markers)));
3486 if (fstat (fd, &st) != 0)
3487 report_file_error ("Input file status", orig_filename);
3488 mtime = get_stat_mtime (&st);
3490 /* This code will need to be changed in order to work on named
3491 pipes, and it's probably just not worth it. So we should at
3492 least signal an error. */
3493 if (!S_ISREG (st.st_mode))
3495 not_regular = 1;
3497 if (! NILP (visit))
3498 goto notfound;
3500 if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
3501 xsignal2 (Qfile_error,
3502 build_string ("not a regular file"), orig_filename);
3505 if (!NILP (visit))
3507 if (!NILP (beg) || !NILP (end))
3508 error ("Attempt to visit less than an entire file");
3509 if (BEG < Z && NILP (replace))
3510 error ("Cannot do file visiting in a non-empty buffer");
3513 if (!NILP (beg))
3514 beg_offset = file_offset (beg);
3515 else
3516 beg_offset = 0;
3518 if (!NILP (end))
3519 end_offset = file_offset (end);
3520 else
3522 if (not_regular)
3523 end_offset = TYPE_MAXIMUM (off_t);
3524 else
3526 end_offset = st.st_size;
3528 /* A negative size can happen on a platform that allows file
3529 sizes greater than the maximum off_t value. */
3530 if (end_offset < 0)
3531 buffer_overflow ();
3533 /* The file size returned from stat may be zero, but data
3534 may be readable nonetheless, for example when this is a
3535 file in the /proc filesystem. */
3536 if (end_offset == 0)
3537 end_offset = READ_BUF_SIZE;
3541 /* Check now whether the buffer will become too large,
3542 in the likely case where the file's length is not changing.
3543 This saves a lot of needless work before a buffer overflow. */
3544 if (! not_regular)
3546 /* The likely offset where we will stop reading. We could read
3547 more (or less), if the file grows (or shrinks) as we read it. */
3548 off_t likely_end = min (end_offset, st.st_size);
3550 if (beg_offset < likely_end)
3552 ptrdiff_t buf_bytes
3553 = Z_BYTE - (!NILP (replace) ? ZV_BYTE - BEGV_BYTE : 0);
3554 ptrdiff_t buf_growth_max = BUF_BYTES_MAX - buf_bytes;
3555 off_t likely_growth = likely_end - beg_offset;
3556 if (buf_growth_max < likely_growth)
3557 buffer_overflow ();
3561 /* Prevent redisplay optimizations. */
3562 current_buffer->clip_changed = true;
3564 if (EQ (Vcoding_system_for_read, Qauto_save_coding))
3566 coding_system = coding_inherit_eol_type (Qutf_8_emacs, Qunix);
3567 setup_coding_system (coding_system, &coding);
3568 /* Ensure we set Vlast_coding_system_used. */
3569 set_coding_system = true;
3571 else if (BEG < Z)
3573 /* Decide the coding system to use for reading the file now
3574 because we can't use an optimized method for handling
3575 `coding:' tag if the current buffer is not empty. */
3576 if (!NILP (Vcoding_system_for_read))
3577 coding_system = Vcoding_system_for_read;
3578 else
3580 /* Don't try looking inside a file for a coding system
3581 specification if it is not seekable. */
3582 if (! not_regular && ! NILP (Vset_auto_coding_function))
3584 /* Find a coding system specified in the heading two
3585 lines or in the tailing several lines of the file.
3586 We assume that the 1K-byte and 3K-byte for heading
3587 and tailing respectively are sufficient for this
3588 purpose. */
3589 int nread;
3591 if (st.st_size <= (1024 * 4))
3592 nread = emacs_read (fd, read_buf, 1024 * 4);
3593 else
3595 nread = emacs_read (fd, read_buf, 1024);
3596 if (nread == 1024)
3598 int ntail;
3599 if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
3600 report_file_error ("Setting file position",
3601 orig_filename);
3602 ntail = emacs_read (fd, read_buf + nread, 1024 * 3);
3603 nread = ntail < 0 ? ntail : nread + ntail;
3607 if (nread < 0)
3608 report_file_error ("Read error", orig_filename);
3609 else if (nread > 0)
3611 AUTO_STRING (name, " *code-converting-work*");
3612 struct buffer *prev = current_buffer;
3613 Lisp_Object workbuf;
3614 struct buffer *buf;
3616 record_unwind_current_buffer ();
3618 workbuf = Fget_buffer_create (name);
3619 buf = XBUFFER (workbuf);
3621 delete_all_overlays (buf);
3622 bset_directory (buf, BVAR (current_buffer, directory));
3623 bset_read_only (buf, Qnil);
3624 bset_filename (buf, Qnil);
3625 bset_undo_list (buf, Qt);
3626 eassert (buf->overlays_before == NULL);
3627 eassert (buf->overlays_after == NULL);
3629 set_buffer_internal (buf);
3630 Ferase_buffer ();
3631 bset_enable_multibyte_characters (buf, Qnil);
3633 insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
3634 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3635 coding_system = call2 (Vset_auto_coding_function,
3636 filename, make_number (nread));
3637 set_buffer_internal (prev);
3639 /* Discard the unwind protect for recovering the
3640 current buffer. */
3641 specpdl_ptr--;
3643 /* Rewind the file for the actual read done later. */
3644 if (lseek (fd, 0, SEEK_SET) < 0)
3645 report_file_error ("Setting file position", orig_filename);
3649 if (NILP (coding_system))
3651 /* If we have not yet decided a coding system, check
3652 file-coding-system-alist. */
3653 coding_system = CALLN (Ffind_operation_coding_system,
3654 Qinsert_file_contents, orig_filename,
3655 visit, beg, end, replace);
3656 if (CONSP (coding_system))
3657 coding_system = XCAR (coding_system);
3661 if (NILP (coding_system))
3662 coding_system = Qundecided;
3663 else
3664 CHECK_CODING_SYSTEM (coding_system);
3666 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3667 /* We must suppress all character code conversion except for
3668 end-of-line conversion. */
3669 coding_system = raw_text_coding_system (coding_system);
3671 setup_coding_system (coding_system, &coding);
3672 /* Ensure we set Vlast_coding_system_used. */
3673 set_coding_system = true;
3676 /* If requested, replace the accessible part of the buffer
3677 with the file contents. Avoid replacing text at the
3678 beginning or end of the buffer that matches the file contents;
3679 that preserves markers pointing to the unchanged parts.
3681 Here we implement this feature in an optimized way
3682 for the case where code conversion is NOT needed.
3683 The following if-statement handles the case of conversion
3684 in a less optimal way.
3686 If the code conversion is "automatic" then we try using this
3687 method and hope for the best.
3688 But if we discover the need for conversion, we give up on this method
3689 and let the following if-statement handle the replace job. */
3690 if (!NILP (replace)
3691 && BEGV < ZV
3692 && (NILP (coding_system)
3693 || ! CODING_REQUIRE_DECODING (&coding)))
3695 ptrdiff_t overlap;
3696 /* There is still a possibility we will find the need to do code
3697 conversion. If that happens, set this variable to
3698 give up on handling REPLACE in the optimized way. */
3699 bool giveup_match_end = false;
3701 if (beg_offset != 0)
3703 if (lseek (fd, beg_offset, SEEK_SET) < 0)
3704 report_file_error ("Setting file position", orig_filename);
3707 immediate_quit = 1;
3708 QUIT;
3709 /* Count how many chars at the start of the file
3710 match the text at the beginning of the buffer. */
3711 while (1)
3713 int nread, bufpos;
3715 nread = emacs_read (fd, read_buf, sizeof read_buf);
3716 if (nread < 0)
3717 report_file_error ("Read error", orig_filename);
3718 else if (nread == 0)
3719 break;
3721 if (CODING_REQUIRE_DETECTION (&coding))
3723 coding_system = detect_coding_system ((unsigned char *) read_buf,
3724 nread, nread, 1, 0,
3725 coding_system);
3726 setup_coding_system (coding_system, &coding);
3729 if (CODING_REQUIRE_DECODING (&coding))
3730 /* We found that the file should be decoded somehow.
3731 Let's give up here. */
3733 giveup_match_end = true;
3734 break;
3737 bufpos = 0;
3738 while (bufpos < nread && same_at_start < ZV_BYTE
3739 && FETCH_BYTE (same_at_start) == read_buf[bufpos])
3740 same_at_start++, bufpos++;
3741 /* If we found a discrepancy, stop the scan.
3742 Otherwise loop around and scan the next bufferful. */
3743 if (bufpos != nread)
3744 break;
3746 immediate_quit = false;
3747 /* If the file matches the buffer completely,
3748 there's no need to replace anything. */
3749 if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
3751 emacs_close (fd);
3752 clear_unwind_protect (fd_index);
3754 /* Truncate the buffer to the size of the file. */
3755 del_range_1 (same_at_start, same_at_end, 0, 0);
3756 goto handled;
3758 immediate_quit = true;
3759 QUIT;
3760 /* Count how many chars at the end of the file
3761 match the text at the end of the buffer. But, if we have
3762 already found that decoding is necessary, don't waste time. */
3763 while (!giveup_match_end)
3765 int total_read, nread, bufpos, trial;
3766 off_t curpos;
3768 /* At what file position are we now scanning? */
3769 curpos = end_offset - (ZV_BYTE - same_at_end);
3770 /* If the entire file matches the buffer tail, stop the scan. */
3771 if (curpos == 0)
3772 break;
3773 /* How much can we scan in the next step? */
3774 trial = min (curpos, sizeof read_buf);
3775 if (lseek (fd, curpos - trial, SEEK_SET) < 0)
3776 report_file_error ("Setting file position", orig_filename);
3778 total_read = nread = 0;
3779 while (total_read < trial)
3781 nread = emacs_read (fd, read_buf + total_read, trial - total_read);
3782 if (nread < 0)
3783 report_file_error ("Read error", orig_filename);
3784 else if (nread == 0)
3785 break;
3786 total_read += nread;
3789 /* Scan this bufferful from the end, comparing with
3790 the Emacs buffer. */
3791 bufpos = total_read;
3793 /* Compare with same_at_start to avoid counting some buffer text
3794 as matching both at the file's beginning and at the end. */
3795 while (bufpos > 0 && same_at_end > same_at_start
3796 && FETCH_BYTE (same_at_end - 1) == read_buf[bufpos - 1])
3797 same_at_end--, bufpos--;
3799 /* If we found a discrepancy, stop the scan.
3800 Otherwise loop around and scan the preceding bufferful. */
3801 if (bufpos != 0)
3803 /* If this discrepancy is because of code conversion,
3804 we cannot use this method; giveup and try the other. */
3805 if (same_at_end > same_at_start
3806 && FETCH_BYTE (same_at_end - 1) >= 0200
3807 && ! NILP (BVAR (current_buffer, enable_multibyte_characters))
3808 && (CODING_MAY_REQUIRE_DECODING (&coding)))
3809 giveup_match_end = true;
3810 break;
3813 if (nread == 0)
3814 break;
3816 immediate_quit = 0;
3818 if (! giveup_match_end)
3820 ptrdiff_t temp;
3822 /* We win! We can handle REPLACE the optimized way. */
3824 /* Extend the start of non-matching text area to multibyte
3825 character boundary. */
3826 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3827 while (same_at_start > BEGV_BYTE
3828 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
3829 same_at_start--;
3831 /* Extend the end of non-matching text area to multibyte
3832 character boundary. */
3833 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3834 while (same_at_end < ZV_BYTE
3835 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
3836 same_at_end++;
3838 /* Don't try to reuse the same piece of text twice. */
3839 overlap = (same_at_start - BEGV_BYTE
3840 - (same_at_end
3841 + (! NILP (end) ? end_offset : st.st_size) - ZV_BYTE));
3842 if (overlap > 0)
3843 same_at_end += overlap;
3844 same_at_end_charpos = BYTE_TO_CHAR (same_at_end);
3846 /* Arrange to read only the nonmatching middle part of the file. */
3847 beg_offset += same_at_start - BEGV_BYTE;
3848 end_offset -= ZV_BYTE - same_at_end;
3850 invalidate_buffer_caches (current_buffer,
3851 BYTE_TO_CHAR (same_at_start),
3852 same_at_end_charpos);
3853 del_range_byte (same_at_start, same_at_end, 0);
3854 /* Insert from the file at the proper position. */
3855 temp = BYTE_TO_CHAR (same_at_start);
3856 SET_PT_BOTH (temp, same_at_start);
3858 /* If display currently starts at beginning of line,
3859 keep it that way. */
3860 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
3861 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
3863 replace_handled = true;
3867 /* If requested, replace the accessible part of the buffer
3868 with the file contents. Avoid replacing text at the
3869 beginning or end of the buffer that matches the file contents;
3870 that preserves markers pointing to the unchanged parts.
3872 Here we implement this feature for the case where code conversion
3873 is needed, in a simple way that needs a lot of memory.
3874 The preceding if-statement handles the case of no conversion
3875 in a more optimized way. */
3876 if (!NILP (replace) && ! replace_handled && BEGV < ZV)
3878 ptrdiff_t same_at_start_charpos;
3879 ptrdiff_t inserted_chars;
3880 ptrdiff_t overlap;
3881 ptrdiff_t bufpos;
3882 unsigned char *decoded;
3883 ptrdiff_t temp;
3884 ptrdiff_t this = 0;
3885 ptrdiff_t this_count = SPECPDL_INDEX ();
3886 bool multibyte
3887 = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
3888 Lisp_Object conversion_buffer;
3889 struct gcpro gcpro1;
3891 conversion_buffer = code_conversion_save (1, multibyte);
3893 /* First read the whole file, performing code conversion into
3894 CONVERSION_BUFFER. */
3896 if (lseek (fd, beg_offset, SEEK_SET) < 0)
3897 report_file_error ("Setting file position", orig_filename);
3899 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
3900 unprocessed = 0; /* Bytes not processed in previous loop. */
3902 GCPRO1 (conversion_buffer);
3903 while (1)
3905 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3906 quitting while reading a huge file. */
3908 /* Allow quitting out of the actual I/O. */
3909 immediate_quit = 1;
3910 QUIT;
3911 this = emacs_read (fd, read_buf + unprocessed,
3912 READ_BUF_SIZE - unprocessed);
3913 immediate_quit = 0;
3915 if (this <= 0)
3916 break;
3918 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
3919 BUF_Z (XBUFFER (conversion_buffer)));
3920 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3921 unprocessed + this, conversion_buffer);
3922 unprocessed = coding.carryover_bytes;
3923 if (coding.carryover_bytes > 0)
3924 memcpy (read_buf, coding.carryover, unprocessed);
3926 UNGCPRO;
3927 if (this < 0)
3928 report_file_error ("Read error", orig_filename);
3929 emacs_close (fd);
3930 clear_unwind_protect (fd_index);
3932 if (unprocessed > 0)
3934 coding.mode |= CODING_MODE_LAST_BLOCK;
3935 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3936 unprocessed, conversion_buffer);
3937 coding.mode &= ~CODING_MODE_LAST_BLOCK;
3940 coding_system = CODING_ID_NAME (coding.id);
3941 set_coding_system = true;
3942 decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer));
3943 inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer))
3944 - BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
3946 /* Compare the beginning of the converted string with the buffer
3947 text. */
3949 bufpos = 0;
3950 while (bufpos < inserted && same_at_start < same_at_end
3951 && FETCH_BYTE (same_at_start) == decoded[bufpos])
3952 same_at_start++, bufpos++;
3954 /* If the file matches the head of buffer completely,
3955 there's no need to replace anything. */
3957 if (bufpos == inserted)
3959 /* Truncate the buffer to the size of the file. */
3960 if (same_at_start != same_at_end)
3962 invalidate_buffer_caches (current_buffer,
3963 BYTE_TO_CHAR (same_at_start),
3964 BYTE_TO_CHAR (same_at_end));
3965 del_range_byte (same_at_start, same_at_end, 0);
3967 inserted = 0;
3969 unbind_to (this_count, Qnil);
3970 goto handled;
3973 /* Extend the start of non-matching text area to the previous
3974 multibyte character boundary. */
3975 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3976 while (same_at_start > BEGV_BYTE
3977 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
3978 same_at_start--;
3980 /* Scan this bufferful from the end, comparing with
3981 the Emacs buffer. */
3982 bufpos = inserted;
3984 /* Compare with same_at_start to avoid counting some buffer text
3985 as matching both at the file's beginning and at the end. */
3986 while (bufpos > 0 && same_at_end > same_at_start
3987 && FETCH_BYTE (same_at_end - 1) == decoded[bufpos - 1])
3988 same_at_end--, bufpos--;
3990 /* Extend the end of non-matching text area to the next
3991 multibyte character boundary. */
3992 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3993 while (same_at_end < ZV_BYTE
3994 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
3995 same_at_end++;
3997 /* Don't try to reuse the same piece of text twice. */
3998 overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
3999 if (overlap > 0)
4000 same_at_end += overlap;
4001 same_at_end_charpos = BYTE_TO_CHAR (same_at_end);
4003 /* If display currently starts at beginning of line,
4004 keep it that way. */
4005 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
4006 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
4008 /* Replace the chars that we need to replace,
4009 and update INSERTED to equal the number of bytes
4010 we are taking from the decoded string. */
4011 inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
4013 if (same_at_end != same_at_start)
4015 invalidate_buffer_caches (current_buffer,
4016 BYTE_TO_CHAR (same_at_start),
4017 same_at_end_charpos);
4018 del_range_byte (same_at_start, same_at_end, 0);
4019 temp = GPT;
4020 eassert (same_at_start == GPT_BYTE);
4021 same_at_start = GPT_BYTE;
4023 else
4025 temp = same_at_end_charpos;
4027 /* Insert from the file at the proper position. */
4028 SET_PT_BOTH (temp, same_at_start);
4029 same_at_start_charpos
4030 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
4031 same_at_start - BEGV_BYTE
4032 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
4033 eassert (same_at_start_charpos == temp - (BEGV - BEG));
4034 inserted_chars
4035 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
4036 same_at_start + inserted - BEGV_BYTE
4037 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)))
4038 - same_at_start_charpos);
4039 /* This binding is to avoid ask-user-about-supersession-threat
4040 being called in insert_from_buffer (via in
4041 prepare_to_modify_buffer). */
4042 specbind (intern ("buffer-file-name"), Qnil);
4043 insert_from_buffer (XBUFFER (conversion_buffer),
4044 same_at_start_charpos, inserted_chars, 0);
4045 /* Set `inserted' to the number of inserted characters. */
4046 inserted = PT - temp;
4047 /* Set point before the inserted characters. */
4048 SET_PT_BOTH (temp, same_at_start);
4050 unbind_to (this_count, Qnil);
4052 goto handled;
4055 if (! not_regular)
4056 total = end_offset - beg_offset;
4057 else
4058 /* For a special file, all we can do is guess. */
4059 total = READ_BUF_SIZE;
4061 if (NILP (visit) && total > 0)
4063 if (!NILP (BVAR (current_buffer, file_truename))
4064 /* Make binding buffer-file-name to nil effective. */
4065 && !NILP (BVAR (current_buffer, filename))
4066 && SAVE_MODIFF >= MODIFF)
4067 we_locked_file = true;
4068 prepare_to_modify_buffer (PT, PT, NULL);
4071 move_gap_both (PT, PT_BYTE);
4072 if (GAP_SIZE < total)
4073 make_gap (total - GAP_SIZE);
4075 if (beg_offset != 0 || !NILP (replace))
4077 if (lseek (fd, beg_offset, SEEK_SET) < 0)
4078 report_file_error ("Setting file position", orig_filename);
4081 /* In the following loop, HOW_MUCH contains the total bytes read so
4082 far for a regular file, and not changed for a special file. But,
4083 before exiting the loop, it is set to a negative value if I/O
4084 error occurs. */
4085 how_much = 0;
4087 /* Total bytes inserted. */
4088 inserted = 0;
4090 /* Here, we don't do code conversion in the loop. It is done by
4091 decode_coding_gap after all data are read into the buffer. */
4093 ptrdiff_t gap_size = GAP_SIZE;
4095 while (how_much < total)
4097 /* `try' is reserved in some compilers (Microsoft C). */
4098 ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE);
4099 ptrdiff_t this;
4101 if (not_regular)
4103 Lisp_Object nbytes;
4105 /* Maybe make more room. */
4106 if (gap_size < trytry)
4108 make_gap (trytry - gap_size);
4109 gap_size = GAP_SIZE - inserted;
4112 /* Read from the file, capturing `quit'. When an
4113 error occurs, end the loop, and arrange for a quit
4114 to be signaled after decoding the text we read. */
4115 nbytes = internal_condition_case_1
4116 (read_non_regular,
4117 make_save_int_int_int (fd, inserted, trytry),
4118 Qerror, read_non_regular_quit);
4120 if (NILP (nbytes))
4122 read_quit = true;
4123 break;
4126 this = XINT (nbytes);
4128 else
4130 /* Allow quitting out of the actual I/O. We don't make text
4131 part of the buffer until all the reading is done, so a C-g
4132 here doesn't do any harm. */
4133 immediate_quit = 1;
4134 QUIT;
4135 this = emacs_read (fd,
4136 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
4137 + inserted),
4138 trytry);
4139 immediate_quit = 0;
4142 if (this <= 0)
4144 how_much = this;
4145 break;
4148 gap_size -= this;
4150 /* For a regular file, where TOTAL is the real size,
4151 count HOW_MUCH to compare with it.
4152 For a special file, where TOTAL is just a buffer size,
4153 so don't bother counting in HOW_MUCH.
4154 (INSERTED is where we count the number of characters inserted.) */
4155 if (! not_regular)
4156 how_much += this;
4157 inserted += this;
4161 /* Now we have either read all the file data into the gap,
4162 or stop reading on I/O error or quit. If nothing was
4163 read, undo marking the buffer modified. */
4165 if (inserted == 0)
4167 if (we_locked_file)
4168 unlock_file (BVAR (current_buffer, file_truename));
4169 Vdeactivate_mark = old_Vdeactivate_mark;
4171 else
4172 Vdeactivate_mark = Qt;
4174 emacs_close (fd);
4175 clear_unwind_protect (fd_index);
4177 if (how_much < 0)
4178 report_file_error ("Read error", orig_filename);
4180 /* Make the text read part of the buffer. */
4181 GAP_SIZE -= inserted;
4182 GPT += inserted;
4183 GPT_BYTE += inserted;
4184 ZV += inserted;
4185 ZV_BYTE += inserted;
4186 Z += inserted;
4187 Z_BYTE += inserted;
4189 if (GAP_SIZE > 0)
4190 /* Put an anchor to ensure multi-byte form ends at gap. */
4191 *GPT_ADDR = 0;
4193 notfound:
4195 if (NILP (coding_system))
4197 /* The coding system is not yet decided. Decide it by an
4198 optimized method for handling `coding:' tag.
4200 Note that we can get here only if the buffer was empty
4201 before the insertion. */
4203 if (!NILP (Vcoding_system_for_read))
4204 coding_system = Vcoding_system_for_read;
4205 else
4207 /* Since we are sure that the current buffer was empty
4208 before the insertion, we can toggle
4209 enable-multibyte-characters directly here without taking
4210 care of marker adjustment. By this way, we can run Lisp
4211 program safely before decoding the inserted text. */
4212 Lisp_Object unwind_data;
4213 ptrdiff_t count1 = SPECPDL_INDEX ();
4215 unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters),
4216 Fcons (BVAR (current_buffer, undo_list),
4217 Fcurrent_buffer ()));
4218 bset_enable_multibyte_characters (current_buffer, Qnil);
4219 bset_undo_list (current_buffer, Qt);
4220 record_unwind_protect (decide_coding_unwind, unwind_data);
4222 if (inserted > 0 && ! NILP (Vset_auto_coding_function))
4224 coding_system = call2 (Vset_auto_coding_function,
4225 filename, make_number (inserted));
4228 if (NILP (coding_system))
4230 /* If the coding system is not yet decided, check
4231 file-coding-system-alist. */
4232 coding_system = CALLN (Ffind_operation_coding_system,
4233 Qinsert_file_contents, orig_filename,
4234 visit, beg, end, Qnil);
4235 if (CONSP (coding_system))
4236 coding_system = XCAR (coding_system);
4238 unbind_to (count1, Qnil);
4239 inserted = Z_BYTE - BEG_BYTE;
4242 if (NILP (coding_system))
4243 coding_system = Qundecided;
4244 else
4245 CHECK_CODING_SYSTEM (coding_system);
4247 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
4248 /* We must suppress all character code conversion except for
4249 end-of-line conversion. */
4250 coding_system = raw_text_coding_system (coding_system);
4251 setup_coding_system (coding_system, &coding);
4252 /* Ensure we set Vlast_coding_system_used. */
4253 set_coding_system = true;
4256 if (!NILP (visit))
4258 /* When we visit a file by raw-text, we change the buffer to
4259 unibyte. */
4260 if (CODING_FOR_UNIBYTE (&coding)
4261 /* Can't do this if part of the buffer might be preserved. */
4262 && NILP (replace))
4263 /* Visiting a file with these coding system makes the buffer
4264 unibyte. */
4265 bset_enable_multibyte_characters (current_buffer, Qnil);
4268 coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
4269 if (CODING_MAY_REQUIRE_DECODING (&coding)
4270 && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding)))
4272 move_gap_both (PT, PT_BYTE);
4273 GAP_SIZE += inserted;
4274 ZV_BYTE -= inserted;
4275 Z_BYTE -= inserted;
4276 ZV -= inserted;
4277 Z -= inserted;
4278 decode_coding_gap (&coding, inserted, inserted);
4279 inserted = coding.produced_char;
4280 coding_system = CODING_ID_NAME (coding.id);
4282 else if (inserted > 0)
4284 invalidate_buffer_caches (current_buffer, PT, PT + inserted);
4285 adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
4286 inserted);
4289 /* Call after-change hooks for the inserted text, aside from the case
4290 of normal visiting (not with REPLACE), which is done in a new buffer
4291 "before" the buffer is changed. */
4292 if (inserted > 0 && total > 0
4293 && (NILP (visit) || !NILP (replace)))
4295 signal_after_change (PT, 0, inserted);
4296 update_compositions (PT, PT, CHECK_BORDER);
4299 /* Now INSERTED is measured in characters. */
4301 handled:
4303 if (inserted > 0)
4304 restore_window_points (window_markers, inserted,
4305 BYTE_TO_CHAR (same_at_start),
4306 same_at_end_charpos);
4308 if (!NILP (visit))
4310 if (empty_undo_list_p)
4311 bset_undo_list (current_buffer, Qnil);
4313 if (NILP (handler))
4315 current_buffer->modtime = mtime;
4316 current_buffer->modtime_size = st.st_size;
4317 bset_filename (current_buffer, orig_filename);
4320 SAVE_MODIFF = MODIFF;
4321 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
4322 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
4323 if (NILP (handler))
4325 if (!NILP (BVAR (current_buffer, file_truename)))
4326 unlock_file (BVAR (current_buffer, file_truename));
4327 unlock_file (filename);
4329 if (not_regular)
4330 xsignal2 (Qfile_error,
4331 build_string ("not a regular file"), orig_filename);
4334 if (set_coding_system)
4335 Vlast_coding_system_used = coding_system;
4337 if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
4339 insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
4340 visit);
4341 if (! NILP (insval))
4343 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4344 wrong_type_argument (intern ("inserted-chars"), insval);
4345 inserted = XFASTINT (insval);
4349 /* Decode file format. */
4350 if (inserted > 0)
4352 /* Don't run point motion or modification hooks when decoding. */
4353 ptrdiff_t count1 = SPECPDL_INDEX ();
4354 ptrdiff_t old_inserted = inserted;
4355 specbind (Qinhibit_point_motion_hooks, Qt);
4356 specbind (Qinhibit_modification_hooks, Qt);
4358 /* Save old undo list and don't record undo for decoding. */
4359 old_undo = BVAR (current_buffer, undo_list);
4360 bset_undo_list (current_buffer, Qt);
4362 if (NILP (replace))
4364 insval = call3 (Qformat_decode,
4365 Qnil, make_number (inserted), visit);
4366 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4367 wrong_type_argument (intern ("inserted-chars"), insval);
4368 inserted = XFASTINT (insval);
4370 else
4372 /* If REPLACE is non-nil and we succeeded in not replacing the
4373 beginning or end of the buffer text with the file's contents,
4374 call format-decode with `point' positioned at the beginning
4375 of the buffer and `inserted' equaling the number of
4376 characters in the buffer. Otherwise, format-decode might
4377 fail to correctly analyze the beginning or end of the buffer.
4378 Hence we temporarily save `point' and `inserted' here and
4379 restore `point' iff format-decode did not insert or delete
4380 any text. Otherwise we leave `point' at point-min. */
4381 ptrdiff_t opoint = PT;
4382 ptrdiff_t opoint_byte = PT_BYTE;
4383 ptrdiff_t oinserted = ZV - BEGV;
4384 EMACS_INT ochars_modiff = CHARS_MODIFF;
4386 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4387 insval = call3 (Qformat_decode,
4388 Qnil, make_number (oinserted), visit);
4389 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4390 wrong_type_argument (intern ("inserted-chars"), insval);
4391 if (ochars_modiff == CHARS_MODIFF)
4392 /* format_decode didn't modify buffer's characters => move
4393 point back to position before inserted text and leave
4394 value of inserted alone. */
4395 SET_PT_BOTH (opoint, opoint_byte);
4396 else
4397 /* format_decode modified buffer's characters => consider
4398 entire buffer changed and leave point at point-min. */
4399 inserted = XFASTINT (insval);
4402 /* For consistency with format-decode call these now iff inserted > 0
4403 (martin 2007-06-28). */
4404 p = Vafter_insert_file_functions;
4405 while (CONSP (p))
4407 if (NILP (replace))
4409 insval = call1 (XCAR (p), make_number (inserted));
4410 if (!NILP (insval))
4412 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4413 wrong_type_argument (intern ("inserted-chars"), insval);
4414 inserted = XFASTINT (insval);
4417 else
4419 /* For the rationale of this see the comment on
4420 format-decode above. */
4421 ptrdiff_t opoint = PT;
4422 ptrdiff_t opoint_byte = PT_BYTE;
4423 ptrdiff_t oinserted = ZV - BEGV;
4424 EMACS_INT ochars_modiff = CHARS_MODIFF;
4426 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4427 insval = call1 (XCAR (p), make_number (oinserted));
4428 if (!NILP (insval))
4430 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4431 wrong_type_argument (intern ("inserted-chars"), insval);
4432 if (ochars_modiff == CHARS_MODIFF)
4433 /* after_insert_file_functions didn't modify
4434 buffer's characters => move point back to
4435 position before inserted text and leave value of
4436 inserted alone. */
4437 SET_PT_BOTH (opoint, opoint_byte);
4438 else
4439 /* after_insert_file_functions did modify buffer's
4440 characters => consider entire buffer changed and
4441 leave point at point-min. */
4442 inserted = XFASTINT (insval);
4446 QUIT;
4447 p = XCDR (p);
4450 if (!empty_undo_list_p)
4452 bset_undo_list (current_buffer, old_undo);
4453 if (CONSP (old_undo) && inserted != old_inserted)
4455 /* Adjust the last undo record for the size change during
4456 the format conversion. */
4457 Lisp_Object tem = XCAR (old_undo);
4458 if (CONSP (tem) && INTEGERP (XCAR (tem))
4459 && INTEGERP (XCDR (tem))
4460 && XFASTINT (XCDR (tem)) == PT + old_inserted)
4461 XSETCDR (tem, make_number (PT + inserted));
4464 else
4465 /* If undo_list was Qt before, keep it that way.
4466 Otherwise start with an empty undo_list. */
4467 bset_undo_list (current_buffer, EQ (old_undo, Qt) ? Qt : Qnil);
4469 unbind_to (count1, Qnil);
4472 if (!NILP (visit)
4473 && current_buffer->modtime.tv_nsec == NONEXISTENT_MODTIME_NSECS)
4475 /* If visiting nonexistent file, return nil. */
4476 report_file_errno ("Opening input file", orig_filename, save_errno);
4479 /* We made a lot of deletions and insertions above, so invalidate
4480 the newline cache for the entire region of the inserted
4481 characters. */
4482 if (current_buffer->base_buffer && current_buffer->base_buffer->newline_cache)
4483 invalidate_region_cache (current_buffer->base_buffer,
4484 current_buffer->base_buffer->newline_cache,
4485 PT - BEG, Z - PT - inserted);
4486 else if (current_buffer->newline_cache)
4487 invalidate_region_cache (current_buffer,
4488 current_buffer->newline_cache,
4489 PT - BEG, Z - PT - inserted);
4491 if (read_quit)
4492 Fsignal (Qquit, Qnil);
4494 /* Retval needs to be dealt with in all cases consistently. */
4495 if (NILP (val))
4496 val = list2 (orig_filename, make_number (inserted));
4498 RETURN_UNGCPRO (unbind_to (count, val));
4501 static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
4503 static void
4504 build_annotations_unwind (Lisp_Object arg)
4506 Vwrite_region_annotation_buffers = arg;
4509 /* Decide the coding-system to encode the data with. */
4511 static Lisp_Object
4512 choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4513 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4514 struct coding_system *coding)
4516 Lisp_Object val;
4517 Lisp_Object eol_parent = Qnil;
4519 if (auto_saving
4520 && NILP (Fstring_equal (BVAR (current_buffer, filename),
4521 BVAR (current_buffer, auto_save_file_name))))
4523 val = Qutf_8_emacs;
4524 eol_parent = Qunix;
4526 else if (!NILP (Vcoding_system_for_write))
4528 val = Vcoding_system_for_write;
4529 if (coding_system_require_warning
4530 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4531 /* Confirm that VAL can surely encode the current region. */
4532 val = call5 (Vselect_safe_coding_system_function,
4533 start, end, list2 (Qt, val),
4534 Qnil, filename);
4536 else
4538 /* If the variable `buffer-file-coding-system' is set locally,
4539 it means that the file was read with some kind of code
4540 conversion or the variable is explicitly set by users. We
4541 had better write it out with the same coding system even if
4542 `enable-multibyte-characters' is nil.
4544 If it is not set locally, we anyway have to convert EOL
4545 format if the default value of `buffer-file-coding-system'
4546 tells that it is not Unix-like (LF only) format. */
4547 bool using_default_coding = 0;
4548 bool force_raw_text = 0;
4550 val = BVAR (current_buffer, buffer_file_coding_system);
4551 if (NILP (val)
4552 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
4554 val = Qnil;
4555 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
4556 force_raw_text = 1;
4559 if (NILP (val))
4561 /* Check file-coding-system-alist. */
4562 Lisp_Object coding_systems
4563 = CALLN (Ffind_operation_coding_system, Qwrite_region, start, end,
4564 filename, append, visit, lockname);
4565 if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
4566 val = XCDR (coding_systems);
4569 if (NILP (val))
4571 /* If we still have not decided a coding system, use the
4572 default value of buffer-file-coding-system. */
4573 val = BVAR (current_buffer, buffer_file_coding_system);
4574 using_default_coding = 1;
4577 if (! NILP (val) && ! force_raw_text)
4579 Lisp_Object spec, attrs;
4581 CHECK_CODING_SYSTEM_GET_SPEC (val, spec);
4582 attrs = AREF (spec, 0);
4583 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
4584 force_raw_text = 1;
4587 if (!force_raw_text
4588 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4589 /* Confirm that VAL can surely encode the current region. */
4590 val = call5 (Vselect_safe_coding_system_function,
4591 start, end, val, Qnil, filename);
4593 /* If the decided coding-system doesn't specify end-of-line
4594 format, we use that of
4595 `default-buffer-file-coding-system'. */
4596 if (! using_default_coding
4597 && ! NILP (BVAR (&buffer_defaults, buffer_file_coding_system)))
4598 val = (coding_inherit_eol_type
4599 (val, BVAR (&buffer_defaults, buffer_file_coding_system)));
4601 /* If we decide not to encode text, use `raw-text' or one of its
4602 subsidiaries. */
4603 if (force_raw_text)
4604 val = raw_text_coding_system (val);
4607 val = coding_inherit_eol_type (val, eol_parent);
4608 setup_coding_system (val, coding);
4610 if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display)))
4611 coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
4612 return val;
4615 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
4616 "r\nFWrite region to file: \ni\ni\ni\np",
4617 doc: /* Write current region into specified file.
4618 When called from a program, requires three arguments:
4619 START, END and FILENAME. START and END are normally buffer positions
4620 specifying the part of the buffer to write.
4621 If START is nil, that means to use the entire buffer contents.
4622 If START is a string, then output that string to the file
4623 instead of any buffer contents; END is ignored.
4625 Optional fourth argument APPEND if non-nil means
4626 append to existing file contents (if any). If it is a number,
4627 seek to that offset in the file before writing.
4628 Optional fifth argument VISIT, if t or a string, means
4629 set the last-save-file-modtime of buffer to this file's modtime
4630 and mark buffer not modified.
4631 If VISIT is a string, it is a second file name;
4632 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4633 VISIT is also the file name to lock and unlock for clash detection.
4634 If VISIT is neither t nor nil nor a string, or if Emacs is in batch mode,
4635 do not display the \"Wrote file\" message.
4636 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4637 use for locking and unlocking, overriding FILENAME and VISIT.
4638 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4639 for an existing file with the same name. If MUSTBENEW is `excl',
4640 that means to get an error if the file already exists; never overwrite.
4641 If MUSTBENEW is neither nil nor `excl', that means ask for
4642 confirmation before overwriting, but do go ahead and overwrite the file
4643 if the user confirms.
4645 This does code conversion according to the value of
4646 `coding-system-for-write', `buffer-file-coding-system', or
4647 `file-coding-system-alist', and sets the variable
4648 `last-coding-system-used' to the coding system actually used.
4650 This calls `write-region-annotate-functions' at the start, and
4651 `write-region-post-annotation-function' at the end. */)
4652 (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append,
4653 Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
4655 return write_region (start, end, filename, append, visit, lockname, mustbenew,
4656 -1);
4659 /* Like Fwrite_region, except that if DESC is nonnegative, it is a file
4660 descriptor for FILENAME, so do not open or close FILENAME. */
4662 Lisp_Object
4663 write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4664 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4665 Lisp_Object mustbenew, int desc)
4667 int open_flags;
4668 int mode;
4669 off_t offset IF_LINT (= 0);
4670 bool open_and_close_file = desc < 0;
4671 bool ok;
4672 int save_errno = 0;
4673 const char *fn;
4674 struct stat st;
4675 struct timespec modtime;
4676 ptrdiff_t count = SPECPDL_INDEX ();
4677 ptrdiff_t count1 IF_LINT (= 0);
4678 Lisp_Object handler;
4679 Lisp_Object visit_file;
4680 Lisp_Object annotations;
4681 Lisp_Object encoded_filename;
4682 bool visiting = (EQ (visit, Qt) || STRINGP (visit));
4683 bool quietly = !NILP (visit);
4684 bool file_locked = 0;
4685 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4686 struct buffer *given_buffer;
4687 struct coding_system coding;
4689 if (current_buffer->base_buffer && visiting)
4690 error ("Cannot do file visiting in an indirect buffer");
4692 if (!NILP (start) && !STRINGP (start))
4693 validate_region (&start, &end);
4695 visit_file = Qnil;
4696 GCPRO5 (start, filename, visit, visit_file, lockname);
4698 filename = Fexpand_file_name (filename, Qnil);
4700 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
4701 barf_or_query_if_file_exists (filename, false, "overwrite", true, true);
4703 if (STRINGP (visit))
4704 visit_file = Fexpand_file_name (visit, Qnil);
4705 else
4706 visit_file = filename;
4708 if (NILP (lockname))
4709 lockname = visit_file;
4711 annotations = Qnil;
4713 /* If the file name has special constructs in it,
4714 call the corresponding file handler. */
4715 handler = Ffind_file_name_handler (filename, Qwrite_region);
4716 /* If FILENAME has no handler, see if VISIT has one. */
4717 if (NILP (handler) && STRINGP (visit))
4718 handler = Ffind_file_name_handler (visit, Qwrite_region);
4720 if (!NILP (handler))
4722 Lisp_Object val;
4723 val = call6 (handler, Qwrite_region, start, end,
4724 filename, append, visit);
4726 if (visiting)
4728 SAVE_MODIFF = MODIFF;
4729 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
4730 bset_filename (current_buffer, visit_file);
4732 UNGCPRO;
4733 return val;
4736 record_unwind_protect (save_restriction_restore, save_restriction_save ());
4738 /* Special kludge to simplify auto-saving. */
4739 if (NILP (start))
4741 /* Do it later, so write-region-annotate-function can work differently
4742 if we save "the buffer" vs "a region".
4743 This is useful in tar-mode. --Stef
4744 XSETFASTINT (start, BEG);
4745 XSETFASTINT (end, Z); */
4746 Fwiden ();
4749 record_unwind_protect (build_annotations_unwind,
4750 Vwrite_region_annotation_buffers);
4751 Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ());
4753 given_buffer = current_buffer;
4755 if (!STRINGP (start))
4757 annotations = build_annotations (start, end);
4759 if (current_buffer != given_buffer)
4761 XSETFASTINT (start, BEGV);
4762 XSETFASTINT (end, ZV);
4766 if (NILP (start))
4768 XSETFASTINT (start, BEGV);
4769 XSETFASTINT (end, ZV);
4772 UNGCPRO;
4774 GCPRO5 (start, filename, annotations, visit_file, lockname);
4776 /* Decide the coding-system to encode the data with.
4777 We used to make this choice before calling build_annotations, but that
4778 leads to problems when a write-annotate-function takes care of
4779 unsavable chars (as was the case with X-Symbol). */
4780 Vlast_coding_system_used
4781 = choose_write_coding_system (start, end, filename,
4782 append, visit, lockname, &coding);
4784 if (open_and_close_file && !auto_saving)
4786 lock_file (lockname);
4787 file_locked = 1;
4790 encoded_filename = ENCODE_FILE (filename);
4791 fn = SSDATA (encoded_filename);
4792 open_flags = O_WRONLY | O_BINARY | O_CREAT;
4793 open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
4794 if (NUMBERP (append))
4795 offset = file_offset (append);
4796 else if (!NILP (append))
4797 open_flags |= O_APPEND;
4798 #ifdef DOS_NT
4799 mode = S_IREAD | S_IWRITE;
4800 #else
4801 mode = auto_saving ? auto_save_mode_bits : 0666;
4802 #endif
4804 if (open_and_close_file)
4806 desc = emacs_open (fn, open_flags, mode);
4807 if (desc < 0)
4809 int open_errno = errno;
4810 if (file_locked)
4811 unlock_file (lockname);
4812 UNGCPRO;
4813 report_file_errno ("Opening output file", filename, open_errno);
4816 count1 = SPECPDL_INDEX ();
4817 record_unwind_protect_int (close_file_unwind, desc);
4820 if (NUMBERP (append))
4822 off_t ret = lseek (desc, offset, SEEK_SET);
4823 if (ret < 0)
4825 int lseek_errno = errno;
4826 if (file_locked)
4827 unlock_file (lockname);
4828 UNGCPRO;
4829 report_file_errno ("Lseek error", filename, lseek_errno);
4833 UNGCPRO;
4835 immediate_quit = 1;
4837 if (STRINGP (start))
4838 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
4839 else if (XINT (start) != XINT (end))
4840 ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start),
4841 &annotations, &coding);
4842 else
4844 /* If file was empty, still need to write the annotations. */
4845 coding.mode |= CODING_MODE_LAST_BLOCK;
4846 ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
4848 save_errno = errno;
4850 if (ok && CODING_REQUIRE_FLUSHING (&coding)
4851 && !(coding.mode & CODING_MODE_LAST_BLOCK))
4853 /* We have to flush out a data. */
4854 coding.mode |= CODING_MODE_LAST_BLOCK;
4855 ok = e_write (desc, Qnil, 1, 1, &coding);
4856 save_errno = errno;
4859 immediate_quit = 0;
4861 /* fsync is not crucial for temporary files. Nor for auto-save
4862 files, since they might lose some work anyway. */
4863 if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
4865 /* Transfer data and metadata to disk, retrying if interrupted.
4866 fsync can report a write failure here, e.g., due to disk full
4867 under NFS. But ignore EINVAL, which means fsync is not
4868 supported on this file. */
4869 while (fsync (desc) != 0)
4870 if (errno != EINTR)
4872 if (errno != EINVAL)
4873 ok = 0, save_errno = errno;
4874 break;
4878 modtime = invalid_timespec ();
4879 if (visiting)
4881 if (fstat (desc, &st) == 0)
4882 modtime = get_stat_mtime (&st);
4883 else
4884 ok = 0, save_errno = errno;
4887 if (open_and_close_file)
4889 /* NFS can report a write failure now. */
4890 if (emacs_close (desc) < 0)
4891 ok = 0, save_errno = errno;
4893 /* Discard the unwind protect for close_file_unwind. */
4894 specpdl_ptr = specpdl + count1;
4897 /* Some file systems have a bug where st_mtime is not updated
4898 properly after a write. For example, CIFS might not see the
4899 st_mtime change until after the file is opened again.
4901 Attempt to detect this file system bug, and update MODTIME to the
4902 newer st_mtime if the bug appears to be present. This introduces
4903 a race condition, so to avoid most instances of the race condition
4904 on non-buggy file systems, skip this check if the most recently
4905 encountered non-buggy file system was the current file system.
4907 A race condition can occur if some other process modifies the
4908 file between the fstat above and the fstat below, but the race is
4909 unlikely and a similar race between the last write and the fstat
4910 above cannot possibly be closed anyway. */
4912 if (timespec_valid_p (modtime)
4913 && ! (valid_timestamp_file_system && st.st_dev == timestamp_file_system))
4915 int desc1 = emacs_open (fn, O_WRONLY | O_BINARY, 0);
4916 if (desc1 >= 0)
4918 struct stat st1;
4919 if (fstat (desc1, &st1) == 0
4920 && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino)
4922 /* Use the heuristic if it appears to be valid. With neither
4923 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
4924 file, the time stamp won't change. Also, some non-POSIX
4925 systems don't update an empty file's time stamp when
4926 truncating it. Finally, file systems with 100 ns or worse
4927 resolution sometimes seem to have bugs: on a system with ns
4928 resolution, checking ns % 100 incorrectly avoids the heuristic
4929 1% of the time, but the problem should be temporary as we will
4930 try again on the next time stamp. */
4931 bool use_heuristic
4932 = ((open_flags & (O_EXCL | O_TRUNC)) != 0
4933 && st.st_size != 0
4934 && modtime.tv_nsec % 100 != 0);
4936 struct timespec modtime1 = get_stat_mtime (&st1);
4937 if (use_heuristic
4938 && timespec_cmp (modtime, modtime1) == 0
4939 && st.st_size == st1.st_size)
4941 timestamp_file_system = st.st_dev;
4942 valid_timestamp_file_system = 1;
4944 else
4946 st.st_size = st1.st_size;
4947 modtime = modtime1;
4950 emacs_close (desc1);
4954 /* Call write-region-post-annotation-function. */
4955 while (CONSP (Vwrite_region_annotation_buffers))
4957 Lisp_Object buf = XCAR (Vwrite_region_annotation_buffers);
4958 if (!NILP (Fbuffer_live_p (buf)))
4960 Fset_buffer (buf);
4961 if (FUNCTIONP (Vwrite_region_post_annotation_function))
4962 call0 (Vwrite_region_post_annotation_function);
4964 Vwrite_region_annotation_buffers
4965 = XCDR (Vwrite_region_annotation_buffers);
4968 unbind_to (count, Qnil);
4970 if (file_locked)
4971 unlock_file (lockname);
4973 /* Do this before reporting IO error
4974 to avoid a "file has changed on disk" warning on
4975 next attempt to save. */
4976 if (timespec_valid_p (modtime))
4978 current_buffer->modtime = modtime;
4979 current_buffer->modtime_size = st.st_size;
4982 if (! ok)
4983 report_file_errno ("Write error", filename, save_errno);
4985 if (visiting)
4987 SAVE_MODIFF = MODIFF;
4988 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
4989 bset_filename (current_buffer, visit_file);
4990 update_mode_lines = 14;
4992 else if (quietly)
4994 if (auto_saving
4995 && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
4996 BVAR (current_buffer, auto_save_file_name))))
4997 SAVE_MODIFF = MODIFF;
4999 return Qnil;
5002 if (!auto_saving && !noninteractive)
5003 message_with_string ((NUMBERP (append)
5004 ? "Updated %s"
5005 : ! NILP (append)
5006 ? "Added to %s"
5007 : "Wrote %s"),
5008 visit_file, 1);
5010 return Qnil;
5013 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
5014 doc: /* Return t if (car A) is numerically less than (car B). */)
5015 (Lisp_Object a, Lisp_Object b)
5017 return CALLN (Flss, Fcar (a), Fcar (b));
5020 /* Build the complete list of annotations appropriate for writing out
5021 the text between START and END, by calling all the functions in
5022 write-region-annotate-functions and merging the lists they return.
5023 If one of these functions switches to a different buffer, we assume
5024 that buffer contains altered text. Therefore, the caller must
5025 make sure to restore the current buffer in all cases,
5026 as save-excursion would do. */
5028 static Lisp_Object
5029 build_annotations (Lisp_Object start, Lisp_Object end)
5031 Lisp_Object annotations;
5032 Lisp_Object p, res;
5033 struct gcpro gcpro1, gcpro2;
5034 Lisp_Object original_buffer;
5035 int i;
5036 bool used_global = false;
5038 XSETBUFFER (original_buffer, current_buffer);
5040 annotations = Qnil;
5041 p = Vwrite_region_annotate_functions;
5042 GCPRO2 (annotations, p);
5043 while (CONSP (p))
5045 struct buffer *given_buffer = current_buffer;
5046 if (EQ (Qt, XCAR (p)) && !used_global)
5047 { /* Use the global value of the hook. */
5048 used_global = true;
5049 p = CALLN (Fappend,
5050 Fdefault_value (Qwrite_region_annotate_functions),
5051 XCDR (p));
5052 continue;
5054 Vwrite_region_annotations_so_far = annotations;
5055 res = call2 (XCAR (p), start, end);
5056 /* If the function makes a different buffer current,
5057 assume that means this buffer contains altered text to be output.
5058 Reset START and END from the buffer bounds
5059 and discard all previous annotations because they should have
5060 been dealt with by this function. */
5061 if (current_buffer != given_buffer)
5063 Vwrite_region_annotation_buffers
5064 = Fcons (Fcurrent_buffer (),
5065 Vwrite_region_annotation_buffers);
5066 XSETFASTINT (start, BEGV);
5067 XSETFASTINT (end, ZV);
5068 annotations = Qnil;
5070 Flength (res); /* Check basic validity of return value */
5071 annotations = merge (annotations, res, Qcar_less_than_car);
5072 p = XCDR (p);
5075 /* Now do the same for annotation functions implied by the file-format */
5076 if (auto_saving && (!EQ (BVAR (current_buffer, auto_save_file_format), Qt)))
5077 p = BVAR (current_buffer, auto_save_file_format);
5078 else
5079 p = BVAR (current_buffer, file_format);
5080 for (i = 0; CONSP (p); p = XCDR (p), ++i)
5082 struct buffer *given_buffer = current_buffer;
5084 Vwrite_region_annotations_so_far = annotations;
5086 /* Value is either a list of annotations or nil if the function
5087 has written annotations to a temporary buffer, which is now
5088 current. */
5089 res = call5 (Qformat_annotate_function, XCAR (p), start, end,
5090 original_buffer, make_number (i));
5091 if (current_buffer != given_buffer)
5093 XSETFASTINT (start, BEGV);
5094 XSETFASTINT (end, ZV);
5095 annotations = Qnil;
5098 if (CONSP (res))
5099 annotations = merge (annotations, res, Qcar_less_than_car);
5102 UNGCPRO;
5103 return annotations;
5107 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5108 If STRING is nil, POS is the character position in the current buffer.
5109 Intersperse with them the annotations from *ANNOT
5110 which fall within the range of POS to POS + NCHARS,
5111 each at its appropriate position.
5113 We modify *ANNOT by discarding elements as we use them up.
5115 Return true if successful. */
5117 static bool
5118 a_write (int desc, Lisp_Object string, ptrdiff_t pos,
5119 ptrdiff_t nchars, Lisp_Object *annot,
5120 struct coding_system *coding)
5122 Lisp_Object tem;
5123 ptrdiff_t nextpos;
5124 ptrdiff_t lastpos = pos + nchars;
5126 while (NILP (*annot) || CONSP (*annot))
5128 tem = Fcar_safe (Fcar (*annot));
5129 nextpos = pos - 1;
5130 if (INTEGERP (tem))
5131 nextpos = XFASTINT (tem);
5133 /* If there are no more annotations in this range,
5134 output the rest of the range all at once. */
5135 if (! (nextpos >= pos && nextpos <= lastpos))
5136 return e_write (desc, string, pos, lastpos, coding);
5138 /* Output buffer text up to the next annotation's position. */
5139 if (nextpos > pos)
5141 if (!e_write (desc, string, pos, nextpos, coding))
5142 return 0;
5143 pos = nextpos;
5145 /* Output the annotation. */
5146 tem = Fcdr (Fcar (*annot));
5147 if (STRINGP (tem))
5149 if (!e_write (desc, tem, 0, SCHARS (tem), coding))
5150 return 0;
5152 *annot = Fcdr (*annot);
5154 return 1;
5157 /* Maximum number of characters that the next
5158 function encodes per one loop iteration. */
5160 enum { E_WRITE_MAX = 8 * 1024 * 1024 };
5162 /* Write text in the range START and END into descriptor DESC,
5163 encoding them with coding system CODING. If STRING is nil, START
5164 and END are character positions of the current buffer, else they
5165 are indexes to the string STRING. Return true if successful. */
5167 static bool
5168 e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
5169 struct coding_system *coding)
5171 if (STRINGP (string))
5173 start = 0;
5174 end = SCHARS (string);
5177 /* We used to have a code for handling selective display here. But,
5178 now it is handled within encode_coding. */
5180 while (start < end)
5182 if (STRINGP (string))
5184 coding->src_multibyte = SCHARS (string) < SBYTES (string);
5185 if (CODING_REQUIRE_ENCODING (coding))
5187 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5189 /* Avoid creating huge Lisp string in encode_coding_object. */
5190 if (nchars == E_WRITE_MAX)
5191 coding->raw_destination = 1;
5193 encode_coding_object
5194 (coding, string, start, string_char_to_byte (string, start),
5195 start + nchars, string_char_to_byte (string, start + nchars),
5196 Qt);
5198 else
5200 coding->dst_object = string;
5201 coding->consumed_char = SCHARS (string);
5202 coding->produced = SBYTES (string);
5205 else
5207 ptrdiff_t start_byte = CHAR_TO_BYTE (start);
5208 ptrdiff_t end_byte = CHAR_TO_BYTE (end);
5210 coding->src_multibyte = (end - start) < (end_byte - start_byte);
5211 if (CODING_REQUIRE_ENCODING (coding))
5213 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5215 /* Likewise. */
5216 if (nchars == E_WRITE_MAX)
5217 coding->raw_destination = 1;
5219 encode_coding_object
5220 (coding, Fcurrent_buffer (), start, start_byte,
5221 start + nchars, CHAR_TO_BYTE (start + nchars), Qt);
5223 else
5225 coding->dst_object = Qnil;
5226 coding->dst_pos_byte = start_byte;
5227 if (start >= GPT || end <= GPT)
5229 coding->consumed_char = end - start;
5230 coding->produced = end_byte - start_byte;
5232 else
5234 coding->consumed_char = GPT - start;
5235 coding->produced = GPT_BYTE - start_byte;
5240 if (coding->produced > 0)
5242 char *buf = (coding->raw_destination ? (char *) coding->destination
5243 : (STRINGP (coding->dst_object)
5244 ? SSDATA (coding->dst_object)
5245 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
5246 coding->produced -= emacs_write_sig (desc, buf, coding->produced);
5248 if (coding->raw_destination)
5250 /* We're responsible for freeing this, see
5251 encode_coding_object to check why. */
5252 xfree (coding->destination);
5253 coding->raw_destination = 0;
5255 if (coding->produced)
5256 return 0;
5258 start += coding->consumed_char;
5261 return 1;
5264 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
5265 Sverify_visited_file_modtime, 0, 1, 0,
5266 doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
5267 This means that the file has not been changed since it was visited or saved.
5268 If BUF is omitted or nil, it defaults to the current buffer.
5269 See Info node `(elisp)Modification Time' for more details. */)
5270 (Lisp_Object buf)
5272 struct buffer *b = decode_buffer (buf);
5273 struct stat st;
5274 Lisp_Object handler;
5275 Lisp_Object filename;
5276 struct timespec mtime;
5278 if (!STRINGP (BVAR (b, filename))) return Qt;
5279 if (b->modtime.tv_nsec == UNKNOWN_MODTIME_NSECS) return Qt;
5281 /* If the file name has special constructs in it,
5282 call the corresponding file handler. */
5283 handler = Ffind_file_name_handler (BVAR (b, filename),
5284 Qverify_visited_file_modtime);
5285 if (!NILP (handler))
5286 return call2 (handler, Qverify_visited_file_modtime, buf);
5288 filename = ENCODE_FILE (BVAR (b, filename));
5290 mtime = (stat (SSDATA (filename), &st) == 0
5291 ? get_stat_mtime (&st)
5292 : time_error_value (errno));
5293 if (timespec_cmp (mtime, b->modtime) == 0
5294 && (b->modtime_size < 0
5295 || st.st_size == b->modtime_size))
5296 return Qt;
5297 return Qnil;
5300 DEFUN ("visited-file-modtime", Fvisited_file_modtime,
5301 Svisited_file_modtime, 0, 0, 0,
5302 doc: /* Return the current buffer's recorded visited file modification time.
5303 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5304 `file-attributes' returns. If the current buffer has no recorded file
5305 modification time, this function returns 0. If the visited file
5306 doesn't exist, return -1.
5307 See Info node `(elisp)Modification Time' for more details. */)
5308 (void)
5310 int ns = current_buffer->modtime.tv_nsec;
5311 if (ns < 0)
5312 return make_number (UNKNOWN_MODTIME_NSECS - ns);
5313 return make_lisp_time (current_buffer->modtime);
5316 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
5317 Sset_visited_file_modtime, 0, 1, 0,
5318 doc: /* Update buffer's recorded modification time from the visited file's time.
5319 Useful if the buffer was not read from the file normally
5320 or if the file itself has been changed for some known benign reason.
5321 An argument specifies the modification time value to use
5322 \(instead of that of the visited file), in the form of a list
5323 \(HIGH LOW USEC PSEC) or an integer flag as returned by
5324 `visited-file-modtime'. */)
5325 (Lisp_Object time_flag)
5327 if (!NILP (time_flag))
5329 struct timespec mtime;
5330 if (INTEGERP (time_flag))
5332 CHECK_RANGED_INTEGER (time_flag, -1, 0);
5333 mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag));
5335 else
5336 mtime = lisp_time_argument (time_flag);
5338 current_buffer->modtime = mtime;
5339 current_buffer->modtime_size = -1;
5341 else
5343 register Lisp_Object filename;
5344 struct stat st;
5345 Lisp_Object handler;
5347 filename = Fexpand_file_name (BVAR (current_buffer, filename), Qnil);
5349 /* If the file name has special constructs in it,
5350 call the corresponding file handler. */
5351 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
5352 if (!NILP (handler))
5353 /* The handler can find the file name the same way we did. */
5354 return call2 (handler, Qset_visited_file_modtime, Qnil);
5356 filename = ENCODE_FILE (filename);
5358 if (stat (SSDATA (filename), &st) >= 0)
5360 current_buffer->modtime = get_stat_mtime (&st);
5361 current_buffer->modtime_size = st.st_size;
5365 return Qnil;
5368 static Lisp_Object
5369 auto_save_error (Lisp_Object error_val)
5371 Lisp_Object msg;
5372 int i;
5373 struct gcpro gcpro1;
5375 auto_save_error_occurred = 1;
5377 ring_bell (XFRAME (selected_frame));
5379 AUTO_STRING (format, "Auto-saving %s: %s");
5380 msg = CALLN (Fformat, format, BVAR (current_buffer, name),
5381 Ferror_message_string (error_val));
5382 GCPRO1 (msg);
5384 for (i = 0; i < 3; ++i)
5386 if (i == 0)
5387 message3 (msg);
5388 else
5389 message3_nolog (msg);
5390 Fsleep_for (make_number (1), Qnil);
5393 UNGCPRO;
5394 return Qnil;
5397 static Lisp_Object
5398 auto_save_1 (void)
5400 struct stat st;
5401 Lisp_Object modes;
5403 auto_save_mode_bits = 0666;
5405 /* Get visited file's mode to become the auto save file's mode. */
5406 if (! NILP (BVAR (current_buffer, filename)))
5408 if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0)
5409 /* But make sure we can overwrite it later! */
5410 auto_save_mode_bits = (st.st_mode | 0600) & 0777;
5411 else if (modes = Ffile_modes (BVAR (current_buffer, filename)),
5412 INTEGERP (modes))
5413 /* Remote files don't cooperate with stat. */
5414 auto_save_mode_bits = (XINT (modes) | 0600) & 0777;
5417 return
5418 Fwrite_region (Qnil, Qnil, BVAR (current_buffer, auto_save_file_name), Qnil,
5419 NILP (Vauto_save_visited_file_name) ? Qlambda : Qt,
5420 Qnil, Qnil);
5423 struct auto_save_unwind
5425 FILE *stream;
5426 bool auto_raise;
5429 static void
5430 do_auto_save_unwind (void *arg)
5432 struct auto_save_unwind *p = arg;
5433 FILE *stream = p->stream;
5434 minibuffer_auto_raise = p->auto_raise;
5435 auto_saving = 0;
5436 if (stream != NULL)
5438 block_input ();
5439 fclose (stream);
5440 unblock_input ();
5444 static Lisp_Object
5445 do_auto_save_make_dir (Lisp_Object dir)
5447 Lisp_Object result;
5449 auto_saving_dir_umask = 077;
5450 result = call2 (Qmake_directory, dir, Qt);
5451 auto_saving_dir_umask = 0;
5452 return result;
5455 static Lisp_Object
5456 do_auto_save_eh (Lisp_Object ignore)
5458 auto_saving_dir_umask = 0;
5459 return Qnil;
5462 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
5463 doc: /* Auto-save all buffers that need it.
5464 This is all buffers that have auto-saving enabled
5465 and are changed since last auto-saved.
5466 Auto-saving writes the buffer into a file
5467 so that your editing is not lost if the system crashes.
5468 This file is not the file you visited; that changes only when you save.
5469 Normally we run the normal hook `auto-save-hook' before saving.
5471 A non-nil NO-MESSAGE argument means do not print any message if successful.
5472 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5473 (Lisp_Object no_message, Lisp_Object current_only)
5475 struct buffer *old = current_buffer, *b;
5476 Lisp_Object tail, buf, hook;
5477 bool auto_saved = 0;
5478 int do_handled_files;
5479 Lisp_Object oquit;
5480 FILE *stream = NULL;
5481 ptrdiff_t count = SPECPDL_INDEX ();
5482 bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
5483 bool old_message_p = 0;
5484 struct auto_save_unwind auto_save_unwind;
5485 struct gcpro gcpro1, gcpro2;
5487 if (max_specpdl_size < specpdl_size + 40)
5488 max_specpdl_size = specpdl_size + 40;
5490 if (minibuf_level)
5491 no_message = Qt;
5493 if (NILP (no_message))
5495 old_message_p = push_message ();
5496 record_unwind_protect_void (pop_message_unwind);
5499 /* Ordinarily don't quit within this function,
5500 but don't make it impossible to quit (in case we get hung in I/O). */
5501 oquit = Vquit_flag;
5502 Vquit_flag = Qnil;
5504 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5505 point to non-strings reached from Vbuffer_alist. */
5507 hook = intern ("auto-save-hook");
5508 safe_run_hooks (hook);
5510 if (STRINGP (Vauto_save_list_file_name))
5512 Lisp_Object listfile;
5514 listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
5516 /* Don't try to create the directory when shutting down Emacs,
5517 because creating the directory might signal an error, and
5518 that would leave Emacs in a strange state. */
5519 if (!NILP (Vrun_hooks))
5521 Lisp_Object dir;
5522 dir = Qnil;
5523 GCPRO2 (dir, listfile);
5524 dir = Ffile_name_directory (listfile);
5525 if (NILP (Ffile_directory_p (dir)))
5526 internal_condition_case_1 (do_auto_save_make_dir,
5527 dir, Qt,
5528 do_auto_save_eh);
5529 UNGCPRO;
5532 stream = emacs_fopen (SSDATA (listfile), "w");
5535 auto_save_unwind.stream = stream;
5536 auto_save_unwind.auto_raise = minibuffer_auto_raise;
5537 record_unwind_protect_ptr (do_auto_save_unwind, &auto_save_unwind);
5538 minibuffer_auto_raise = 0;
5539 auto_saving = 1;
5540 auto_save_error_occurred = 0;
5542 /* On first pass, save all files that don't have handlers.
5543 On second pass, save all files that do have handlers.
5545 If Emacs is crashing, the handlers may tweak what is causing
5546 Emacs to crash in the first place, and it would be a shame if
5547 Emacs failed to autosave perfectly ordinary files because it
5548 couldn't handle some ange-ftp'd file. */
5550 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
5551 FOR_EACH_LIVE_BUFFER (tail, buf)
5553 b = XBUFFER (buf);
5555 /* Record all the buffers that have auto save mode
5556 in the special file that lists them. For each of these buffers,
5557 Record visited name (if any) and auto save name. */
5558 if (STRINGP (BVAR (b, auto_save_file_name))
5559 && stream != NULL && do_handled_files == 0)
5561 block_input ();
5562 if (!NILP (BVAR (b, filename)))
5564 fwrite (SDATA (BVAR (b, filename)), 1,
5565 SBYTES (BVAR (b, filename)), stream);
5567 putc ('\n', stream);
5568 fwrite (SDATA (BVAR (b, auto_save_file_name)), 1,
5569 SBYTES (BVAR (b, auto_save_file_name)), stream);
5570 putc ('\n', stream);
5571 unblock_input ();
5574 if (!NILP (current_only)
5575 && b != current_buffer)
5576 continue;
5578 /* Don't auto-save indirect buffers.
5579 The base buffer takes care of it. */
5580 if (b->base_buffer)
5581 continue;
5583 /* Check for auto save enabled
5584 and file changed since last auto save
5585 and file changed since last real save. */
5586 if (STRINGP (BVAR (b, auto_save_file_name))
5587 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
5588 && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b)
5589 /* -1 means we've turned off autosaving for a while--see below. */
5590 && XINT (BVAR (b, save_length)) >= 0
5591 && (do_handled_files
5592 || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
5593 Qwrite_region))))
5595 struct timespec before_time = current_timespec ();
5596 struct timespec after_time;
5598 /* If we had a failure, don't try again for 20 minutes. */
5599 if (b->auto_save_failure_time > 0
5600 && before_time.tv_sec - b->auto_save_failure_time < 1200)
5601 continue;
5603 set_buffer_internal (b);
5604 if (NILP (Vauto_save_include_big_deletions)
5605 && (XFASTINT (BVAR (b, save_length)) * 10
5606 > (BUF_Z (b) - BUF_BEG (b)) * 13)
5607 /* A short file is likely to change a large fraction;
5608 spare the user annoying messages. */
5609 && XFASTINT (BVAR (b, save_length)) > 5000
5610 /* These messages are frequent and annoying for `*mail*'. */
5611 && !EQ (BVAR (b, filename), Qnil)
5612 && NILP (no_message))
5614 /* It has shrunk too much; turn off auto-saving here. */
5615 minibuffer_auto_raise = orig_minibuffer_auto_raise;
5616 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5617 BVAR (b, name), 1);
5618 minibuffer_auto_raise = 0;
5619 /* Turn off auto-saving until there's a real save,
5620 and prevent any more warnings. */
5621 XSETINT (BVAR (b, save_length), -1);
5622 Fsleep_for (make_number (1), Qnil);
5623 continue;
5625 if (!auto_saved && NILP (no_message))
5626 message1 ("Auto-saving...");
5627 internal_condition_case (auto_save_1, Qt, auto_save_error);
5628 auto_saved = 1;
5629 BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
5630 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5631 set_buffer_internal (old);
5633 after_time = current_timespec ();
5635 /* If auto-save took more than 60 seconds,
5636 assume it was an NFS failure that got a timeout. */
5637 if (after_time.tv_sec - before_time.tv_sec > 60)
5638 b->auto_save_failure_time = after_time.tv_sec;
5642 /* Prevent another auto save till enough input events come in. */
5643 record_auto_save ();
5645 if (auto_saved && NILP (no_message))
5647 if (old_message_p)
5649 /* If we are going to restore an old message,
5650 give time to read ours. */
5651 sit_for (make_number (1), 0, 0);
5652 restore_message ();
5654 else if (!auto_save_error_occurred)
5655 /* Don't overwrite the error message if an error occurred.
5656 If we displayed a message and then restored a state
5657 with no message, leave a "done" message on the screen. */
5658 message1 ("Auto-saving...done");
5661 Vquit_flag = oquit;
5663 /* This restores the message-stack status. */
5664 unbind_to (count, Qnil);
5665 return Qnil;
5668 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
5669 Sset_buffer_auto_saved, 0, 0, 0,
5670 doc: /* Mark current buffer as auto-saved with its current text.
5671 No auto-save file will be written until the buffer changes again. */)
5672 (void)
5674 /* FIXME: This should not be called in indirect buffers, since
5675 they're not autosaved. */
5676 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
5677 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5678 current_buffer->auto_save_failure_time = 0;
5679 return Qnil;
5682 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
5683 Sclear_buffer_auto_save_failure, 0, 0, 0,
5684 doc: /* Clear any record of a recent auto-save failure in the current buffer. */)
5685 (void)
5687 current_buffer->auto_save_failure_time = 0;
5688 return Qnil;
5691 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
5692 0, 0, 0,
5693 doc: /* Return t if current buffer has been auto-saved recently.
5694 More precisely, if it has been auto-saved since last read from or saved
5695 in the visited file. If the buffer has no visited file,
5696 then any auto-save counts as "recent". */)
5697 (void)
5699 /* FIXME: maybe we should return nil for indirect buffers since
5700 they're never autosaved. */
5701 return (SAVE_MODIFF < BUF_AUTOSAVE_MODIFF (current_buffer) ? Qt : Qnil);
5704 /* Reading and completing file names. */
5706 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
5707 Snext_read_file_uses_dialog_p, 0, 0, 0,
5708 doc: /* Return t if a call to `read-file-name' will use a dialog.
5709 The return value is only relevant for a call to `read-file-name' that happens
5710 before any other event (mouse or keypress) is handled. */)
5711 (void)
5713 #if (defined USE_GTK || defined USE_MOTIF \
5714 || defined HAVE_NS || defined HAVE_NTGUI)
5715 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
5716 && use_dialog_box
5717 && use_file_dialog
5718 && window_system_available (SELECTED_FRAME ()))
5719 return Qt;
5720 #endif
5721 return Qnil;
5725 DEFUN ("set-binary-mode", Fset_binary_mode, Sset_binary_mode, 2, 2, 0,
5726 doc: /* Switch STREAM to binary I/O mode or text I/O mode.
5727 STREAM can be one of the symbols `stdin', `stdout', or `stderr'.
5728 If MODE is non-nil, switch STREAM to binary mode, otherwise switch
5729 it to text mode.
5731 As a side effect, this function flushes any pending STREAM's data.
5733 Value is the previous value of STREAM's I/O mode, nil for text mode,
5734 non-nil for binary mode.
5736 On MS-Windows and MS-DOS, binary mode is needed to read or write
5737 arbitrary binary data, and for disabling translation between CR-LF
5738 pairs and a single newline character. Examples include generation
5739 of text files with Unix-style end-of-line format using `princ' in
5740 batch mode, with standard output redirected to a file.
5742 On Posix systems, this function always returns non-nil, and has no
5743 effect except for flushing STREAM's data. */)
5744 (Lisp_Object stream, Lisp_Object mode)
5746 FILE *fp = NULL;
5747 int binmode;
5749 CHECK_SYMBOL (stream);
5750 if (EQ (stream, Qstdin))
5751 fp = stdin;
5752 else if (EQ (stream, Qstdout))
5753 fp = stdout;
5754 else if (EQ (stream, Qstderr))
5755 fp = stderr;
5756 else
5757 xsignal2 (Qerror, build_string ("unsupported stream"), stream);
5759 binmode = NILP (mode) ? O_TEXT : O_BINARY;
5760 if (fp != stdin)
5761 fflush (fp);
5763 return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil;
5766 void
5767 init_fileio (void)
5769 realmask = umask (0);
5770 umask (realmask);
5772 valid_timestamp_file_system = 0;
5774 /* fsync can be a significant performance hit. Often it doesn't
5775 suffice to make the file-save operation survive a crash. For
5776 batch scripts, which are typically part of larger shell commands
5777 that don't fsync other files, its effect on performance can be
5778 significant so its utility is particularly questionable.
5779 Hence, for now by default fsync is used only when interactive.
5781 For more on why fsync often fails to work on today's hardware, see:
5782 Zheng M et al. Understanding the robustness of SSDs under power fault.
5783 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
5784 http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
5786 For more on why fsync does not suffice even if it works properly, see:
5787 Roche X. Necessary step(s) to synchronize filename operations on disk.
5788 Austin Group Defect 672, 2013-03-19
5789 http://austingroupbugs.net/view.php?id=672 */
5790 write_region_inhibit_fsync = noninteractive;
5793 void
5794 syms_of_fileio (void)
5796 /* Property name of a file name handler,
5797 which gives a list of operations it handles. */
5798 DEFSYM (Qoperations, "operations");
5800 DEFSYM (Qexpand_file_name, "expand-file-name");
5801 DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name");
5802 DEFSYM (Qdirectory_file_name, "directory-file-name");
5803 DEFSYM (Qfile_name_directory, "file-name-directory");
5804 DEFSYM (Qfile_name_nondirectory, "file-name-nondirectory");
5805 DEFSYM (Qunhandled_file_name_directory, "unhandled-file-name-directory");
5806 DEFSYM (Qfile_name_as_directory, "file-name-as-directory");
5807 DEFSYM (Qcopy_file, "copy-file");
5808 DEFSYM (Qmake_directory_internal, "make-directory-internal");
5809 DEFSYM (Qmake_directory, "make-directory");
5810 DEFSYM (Qdelete_directory_internal, "delete-directory-internal");
5811 DEFSYM (Qdelete_file, "delete-file");
5812 DEFSYM (Qrename_file, "rename-file");
5813 DEFSYM (Qadd_name_to_file, "add-name-to-file");
5814 DEFSYM (Qmake_symbolic_link, "make-symbolic-link");
5815 DEFSYM (Qfile_exists_p, "file-exists-p");
5816 DEFSYM (Qfile_executable_p, "file-executable-p");
5817 DEFSYM (Qfile_readable_p, "file-readable-p");
5818 DEFSYM (Qfile_writable_p, "file-writable-p");
5819 DEFSYM (Qfile_symlink_p, "file-symlink-p");
5820 DEFSYM (Qaccess_file, "access-file");
5821 DEFSYM (Qfile_directory_p, "file-directory-p");
5822 DEFSYM (Qfile_regular_p, "file-regular-p");
5823 DEFSYM (Qfile_accessible_directory_p, "file-accessible-directory-p");
5824 DEFSYM (Qfile_modes, "file-modes");
5825 DEFSYM (Qset_file_modes, "set-file-modes");
5826 DEFSYM (Qset_file_times, "set-file-times");
5827 DEFSYM (Qfile_selinux_context, "file-selinux-context");
5828 DEFSYM (Qset_file_selinux_context, "set-file-selinux-context");
5829 DEFSYM (Qfile_acl, "file-acl");
5830 DEFSYM (Qset_file_acl, "set-file-acl");
5831 DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
5832 DEFSYM (Qinsert_file_contents, "insert-file-contents");
5833 DEFSYM (Qwrite_region, "write-region");
5834 DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
5835 DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
5837 /* The symbol bound to coding-system-for-read when
5838 insert-file-contents is called for recovering a file. This is not
5839 an actual coding system name, but just an indicator to tell
5840 insert-file-contents to use `emacs-mule' with a special flag for
5841 auto saving and recovering a file. */
5842 DEFSYM (Qauto_save_coding, "auto-save-coding");
5844 DEFSYM (Qfile_name_history, "file-name-history");
5845 Fset (Qfile_name_history, Qnil);
5847 DEFSYM (Qfile_error, "file-error");
5848 DEFSYM (Qfile_already_exists, "file-already-exists");
5849 DEFSYM (Qfile_date_error, "file-date-error");
5850 DEFSYM (Qfile_notify_error, "file-notify-error");
5851 DEFSYM (Qexcl, "excl");
5853 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
5854 doc: /* Coding system for encoding file names.
5855 If it is nil, `default-file-name-coding-system' (which see) is used.
5857 On MS-Windows, the value of this variable is largely ignored if
5858 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5859 behaves as if file names were encoded in `utf-8'. */);
5860 Vfile_name_coding_system = Qnil;
5862 DEFVAR_LISP ("default-file-name-coding-system",
5863 Vdefault_file_name_coding_system,
5864 doc: /* Default coding system for encoding file names.
5865 This variable is used only when `file-name-coding-system' is nil.
5867 This variable is set/changed by the command `set-language-environment'.
5868 User should not set this variable manually,
5869 instead use `file-name-coding-system' to get a constant encoding
5870 of file names regardless of the current language environment.
5872 On MS-Windows, the value of this variable is largely ignored if
5873 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5874 behaves as if file names were encoded in `utf-8'. */);
5875 Vdefault_file_name_coding_system = Qnil;
5877 /* Lisp functions for translating file formats. */
5878 DEFSYM (Qformat_decode, "format-decode");
5879 DEFSYM (Qformat_annotate_function, "format-annotate-function");
5881 /* Lisp function for setting buffer-file-coding-system and the
5882 multibyteness of the current buffer after inserting a file. */
5883 DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding");
5885 DEFSYM (Qcar_less_than_car, "car-less-than-car");
5887 Fput (Qfile_error, Qerror_conditions,
5888 Fpurecopy (list2 (Qfile_error, Qerror)));
5889 Fput (Qfile_error, Qerror_message,
5890 build_pure_c_string ("File error"));
5892 Fput (Qfile_already_exists, Qerror_conditions,
5893 Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
5894 Fput (Qfile_already_exists, Qerror_message,
5895 build_pure_c_string ("File already exists"));
5897 Fput (Qfile_date_error, Qerror_conditions,
5898 Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
5899 Fput (Qfile_date_error, Qerror_message,
5900 build_pure_c_string ("Cannot set file date"));
5902 Fput (Qfile_notify_error, Qerror_conditions,
5903 Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
5904 Fput (Qfile_notify_error, Qerror_message,
5905 build_pure_c_string ("File notification error"));
5907 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
5908 doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5909 If a file name matches REGEXP, all I/O on that file is done by calling
5910 HANDLER. If a file name matches more than one handler, the handler
5911 whose match starts last in the file name gets precedence. The
5912 function `find-file-name-handler' checks this list for a handler for
5913 its argument.
5915 HANDLER should be a function. The first argument given to it is the
5916 name of the I/O primitive to be handled; the remaining arguments are
5917 the arguments that were passed to that primitive. For example, if you
5918 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5919 HANDLER is called like this:
5921 (funcall HANDLER 'file-exists-p FILENAME)
5923 Note that HANDLER must be able to handle all I/O primitives; if it has
5924 nothing special to do for a primitive, it should reinvoke the
5925 primitive to handle the operation \"the usual way\".
5926 See Info node `(elisp)Magic File Names' for more details. */);
5927 Vfile_name_handler_alist = Qnil;
5929 DEFVAR_LISP ("set-auto-coding-function",
5930 Vset_auto_coding_function,
5931 doc: /* If non-nil, a function to call to decide a coding system of file.
5932 Two arguments are passed to this function: the file name
5933 and the length of a file contents following the point.
5934 This function should return a coding system to decode the file contents.
5935 It should check the file name against `auto-coding-alist'.
5936 If no coding system is decided, it should check a coding system
5937 specified in the heading lines with the format:
5938 -*- ... coding: CODING-SYSTEM; ... -*-
5939 or local variable spec of the tailing lines with `coding:' tag. */);
5940 Vset_auto_coding_function = Qnil;
5942 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions,
5943 doc: /* A list of functions to be called at the end of `insert-file-contents'.
5944 Each is passed one argument, the number of characters inserted,
5945 with point at the start of the inserted text. Each function
5946 should leave point the same, and return the new character count.
5947 If `insert-file-contents' is intercepted by a handler from
5948 `file-name-handler-alist', that handler is responsible for calling the
5949 functions in `after-insert-file-functions' if appropriate. */);
5950 Vafter_insert_file_functions = Qnil;
5952 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions,
5953 doc: /* A list of functions to be called at the start of `write-region'.
5954 Each is passed two arguments, START and END as for `write-region'.
5955 These are usually two numbers but not always; see the documentation
5956 for `write-region'. The function should return a list of pairs
5957 of the form (POSITION . STRING), consisting of strings to be effectively
5958 inserted at the specified positions of the file being written (1 means to
5959 insert before the first byte written). The POSITIONs must be sorted into
5960 increasing order.
5962 If there are several annotation functions, the lists returned by these
5963 functions are merged destructively. As each annotation function runs,
5964 the variable `write-region-annotations-so-far' contains a list of all
5965 annotations returned by previous annotation functions.
5967 An annotation function can return with a different buffer current.
5968 Doing so removes the annotations returned by previous functions, and
5969 resets START and END to `point-min' and `point-max' of the new buffer.
5971 After `write-region' completes, Emacs calls the function stored in
5972 `write-region-post-annotation-function', once for each buffer that was
5973 current when building the annotations (i.e., at least once), with that
5974 buffer current. */);
5975 Vwrite_region_annotate_functions = Qnil;
5976 DEFSYM (Qwrite_region_annotate_functions, "write-region-annotate-functions");
5978 DEFVAR_LISP ("write-region-post-annotation-function",
5979 Vwrite_region_post_annotation_function,
5980 doc: /* Function to call after `write-region' completes.
5981 The function is called with no arguments. If one or more of the
5982 annotation functions in `write-region-annotate-functions' changed the
5983 current buffer, the function stored in this variable is called for
5984 each of those additional buffers as well, in addition to the original
5985 buffer. The relevant buffer is current during each function call. */);
5986 Vwrite_region_post_annotation_function = Qnil;
5987 staticpro (&Vwrite_region_annotation_buffers);
5989 DEFVAR_LISP ("write-region-annotations-so-far",
5990 Vwrite_region_annotations_so_far,
5991 doc: /* When an annotation function is called, this holds the previous annotations.
5992 These are the annotations made by other annotation functions
5993 that were already called. See also `write-region-annotate-functions'. */);
5994 Vwrite_region_annotations_so_far = Qnil;
5996 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers,
5997 doc: /* A list of file name handlers that temporarily should not be used.
5998 This applies only to the operation `inhibit-file-name-operation'. */);
5999 Vinhibit_file_name_handlers = Qnil;
6001 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation,
6002 doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
6003 Vinhibit_file_name_operation = Qnil;
6005 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name,
6006 doc: /* File name in which we write a list of all auto save file names.
6007 This variable is initialized automatically from `auto-save-list-file-prefix'
6008 shortly after Emacs reads your init file, if you have not yet given it
6009 a non-nil value. */);
6010 Vauto_save_list_file_name = Qnil;
6012 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name,
6013 doc: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
6014 Normally auto-save files are written under other names. */);
6015 Vauto_save_visited_file_name = Qnil;
6017 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions,
6018 doc: /* If non-nil, auto-save even if a large part of the text is deleted.
6019 If nil, deleting a substantial portion of the text disables auto-save
6020 in the buffer; this is the default behavior, because the auto-save
6021 file is usually more useful if it contains the deleted text. */);
6022 Vauto_save_include_big_deletions = Qnil;
6024 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync,
6025 doc: /* Non-nil means don't call fsync in `write-region'.
6026 This variable affects calls to `write-region' as well as save commands.
6027 Setting this to nil may avoid data loss if the system loses power or
6028 the operating system crashes. By default, it is non-nil in batch mode. */);
6029 write_region_inhibit_fsync = 0; /* See also `init_fileio' above. */
6031 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash,
6032 doc: /* Specifies whether to use the system's trash can.
6033 When non-nil, certain file deletion commands use the function
6034 `move-file-to-trash' instead of deleting files outright.
6035 This includes interactive calls to `delete-file' and
6036 `delete-directory' and the Dired deletion commands. */);
6037 delete_by_moving_to_trash = 0;
6038 DEFSYM (Qdelete_by_moving_to_trash, "delete-by-moving-to-trash");
6040 /* Lisp function for moving files to trash. */
6041 DEFSYM (Qmove_file_to_trash, "move-file-to-trash");
6043 /* Lisp function for recursively copying directories. */
6044 DEFSYM (Qcopy_directory, "copy-directory");
6046 /* Lisp function for recursively deleting directories. */
6047 DEFSYM (Qdelete_directory, "delete-directory");
6049 DEFSYM (Qsubstitute_env_in_file_name, "substitute-env-in-file-name");
6050 DEFSYM (Qget_buffer_window_list, "get-buffer-window-list");
6052 DEFSYM (Qstdin, "stdin");
6053 DEFSYM (Qstdout, "stdout");
6054 DEFSYM (Qstderr, "stderr");
6056 defsubr (&Sfind_file_name_handler);
6057 defsubr (&Sfile_name_directory);
6058 defsubr (&Sfile_name_nondirectory);
6059 defsubr (&Sunhandled_file_name_directory);
6060 defsubr (&Sfile_name_as_directory);
6061 defsubr (&Sdirectory_file_name);
6062 defsubr (&Smake_temp_name);
6063 defsubr (&Sexpand_file_name);
6064 defsubr (&Ssubstitute_in_file_name);
6065 defsubr (&Scopy_file);
6066 defsubr (&Smake_directory_internal);
6067 defsubr (&Sdelete_directory_internal);
6068 defsubr (&Sdelete_file);
6069 defsubr (&Srename_file);
6070 defsubr (&Sadd_name_to_file);
6071 defsubr (&Smake_symbolic_link);
6072 defsubr (&Sfile_name_absolute_p);
6073 defsubr (&Sfile_exists_p);
6074 defsubr (&Sfile_executable_p);
6075 defsubr (&Sfile_readable_p);
6076 defsubr (&Sfile_writable_p);
6077 defsubr (&Saccess_file);
6078 defsubr (&Sfile_symlink_p);
6079 defsubr (&Sfile_directory_p);
6080 defsubr (&Sfile_accessible_directory_p);
6081 defsubr (&Sfile_regular_p);
6082 defsubr (&Sfile_modes);
6083 defsubr (&Sset_file_modes);
6084 defsubr (&Sset_file_times);
6085 defsubr (&Sfile_selinux_context);
6086 defsubr (&Sfile_acl);
6087 defsubr (&Sset_file_acl);
6088 defsubr (&Sset_file_selinux_context);
6089 defsubr (&Sset_default_file_modes);
6090 defsubr (&Sdefault_file_modes);
6091 defsubr (&Sfile_newer_than_file_p);
6092 defsubr (&Sinsert_file_contents);
6093 defsubr (&Swrite_region);
6094 defsubr (&Scar_less_than_car);
6095 defsubr (&Sverify_visited_file_modtime);
6096 defsubr (&Svisited_file_modtime);
6097 defsubr (&Sset_visited_file_modtime);
6098 defsubr (&Sdo_auto_save);
6099 defsubr (&Sset_buffer_auto_saved);
6100 defsubr (&Sclear_buffer_auto_save_failure);
6101 defsubr (&Srecent_auto_save_p);
6103 defsubr (&Snext_read_file_uses_dialog_p);
6105 defsubr (&Sset_binary_mode);
6107 #ifdef HAVE_SYNC
6108 defsubr (&Sunix_sync);
6109 #endif