* lisp/emacs-lisp/lisp.el (lisp-completion-at-point): Don't use
[emacs.git] / src / fileio.c
blob80905c63d3a2acd8d047a00710ce507ee23c5b46
1 /* File IO for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-2014 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
21 #include <limits.h>
22 #include <fcntl.h>
23 #include "sysstdio.h"
24 #include <sys/types.h>
25 #include <sys/stat.h>
26 #include <unistd.h>
28 #ifdef HAVE_PWD_H
29 #include <pwd.h>
30 #endif
32 #include <errno.h>
34 #ifdef HAVE_LIBSELINUX
35 #include <selinux/selinux.h>
36 #include <selinux/context.h>
37 #endif
39 #ifdef HAVE_ACL_SET_FILE
40 #include <sys/acl.h>
41 #endif
43 #include <c-ctype.h>
45 #include "lisp.h"
46 #include "intervals.h"
47 #include "character.h"
48 #include "buffer.h"
49 #include "coding.h"
50 #include "window.h"
51 #include "blockinput.h"
52 #include "region-cache.h"
53 #include "frame.h"
54 #include "dispextern.h"
56 #ifdef WINDOWSNT
57 #define NOMINMAX 1
58 #include <windows.h>
59 #include <sys/file.h>
60 #include "w32.h"
61 #endif /* not WINDOWSNT */
63 #ifdef MSDOS
64 #include "msdos.h"
65 #include <sys/param.h>
66 #endif
68 #ifdef DOS_NT
69 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
70 redirector allows the six letters between 'Z' and 'a' as well. */
71 #ifdef MSDOS
72 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
73 #endif
74 #ifdef WINDOWSNT
75 #define IS_DRIVE(x) c_isalpha (x)
76 #endif
77 /* Need to lower-case the drive letter, or else expanded
78 filenames will sometimes compare unequal, because
79 `expand-file-name' doesn't always down-case the drive letter. */
80 #define DRIVE_LETTER(x) c_tolower (x)
81 #endif
83 #include "systime.h"
84 #include <acl.h>
85 #include <allocator.h>
86 #include <careadlinkat.h>
87 #include <stat-time.h>
89 #ifdef HPUX
90 #include <netio.h>
91 #endif
93 #include "commands.h"
95 /* True during writing of auto-save files. */
96 static bool auto_saving;
98 /* Emacs's real umask. */
99 static mode_t realmask;
101 /* Nonzero umask during creation of auto-save directories. */
102 static mode_t auto_saving_dir_umask;
104 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
105 a new file with the same mode as the original. */
106 static mode_t auto_save_mode_bits;
108 /* Set by auto_save_1 if an error occurred during the last auto-save. */
109 static bool auto_save_error_occurred;
111 /* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
112 number of a file system where time stamps were observed to to work. */
113 static bool valid_timestamp_file_system;
114 static dev_t timestamp_file_system;
116 /* The symbol bound to coding-system-for-read when
117 insert-file-contents is called for recovering a file. This is not
118 an actual coding system name, but just an indicator to tell
119 insert-file-contents to use `emacs-mule' with a special flag for
120 auto saving and recovering a file. */
121 static Lisp_Object Qauto_save_coding;
123 /* Property name of a file name handler,
124 which gives a list of operations it handles.. */
125 static Lisp_Object Qoperations;
127 /* Lisp functions for translating file formats. */
128 static Lisp_Object Qformat_decode, Qformat_annotate_function;
130 /* Lisp function for setting buffer-file-coding-system and the
131 multibyteness of the current buffer after inserting a file. */
132 static Lisp_Object Qafter_insert_file_set_coding;
134 static Lisp_Object Qwrite_region_annotate_functions;
135 /* Each time an annotation function changes the buffer, the new buffer
136 is added here. */
137 static Lisp_Object Vwrite_region_annotation_buffers;
139 static Lisp_Object Qdelete_by_moving_to_trash;
141 /* Lisp function for moving files to trash. */
142 static Lisp_Object Qmove_file_to_trash;
144 /* Lisp function for recursively copying directories. */
145 static Lisp_Object Qcopy_directory;
147 /* Lisp function for recursively deleting directories. */
148 static Lisp_Object Qdelete_directory;
150 static Lisp_Object Qsubstitute_env_in_file_name;
152 Lisp_Object Qfile_error, Qfile_notify_error;
153 static Lisp_Object Qfile_already_exists, Qfile_date_error;
154 static Lisp_Object Qexcl;
155 Lisp_Object Qfile_name_history;
157 static Lisp_Object Qcar_less_than_car;
159 static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
160 Lisp_Object *, struct coding_system *);
161 static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
162 struct coding_system *);
165 /* Return true if FILENAME exists. */
167 static bool
168 check_existing (const char *filename)
170 return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
173 /* Return true if file FILENAME exists and can be executed. */
175 static bool
176 check_executable (char *filename)
178 return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
181 /* Return true if file FILENAME exists and can be accessed
182 according to AMODE, which should include W_OK.
183 On failure, return false and set errno. */
185 static bool
186 check_writable (const char *filename, int amode)
188 #ifdef MSDOS
189 /* FIXME: an faccessat implementation should be added to the
190 DOS/Windows ports and this #ifdef branch should be removed. */
191 struct stat st;
192 if (stat (filename, &st) < 0)
193 return 0;
194 errno = EPERM;
195 return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
196 #else /* not MSDOS */
197 bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
198 #ifdef CYGWIN
199 /* faccessat may have returned failure because Cygwin couldn't
200 determine the file's UID or GID; if so, we return success. */
201 if (!res)
203 int faccessat_errno = errno;
204 struct stat st;
205 if (stat (filename, &st) < 0)
206 return 0;
207 res = (st.st_uid == -1 || st.st_gid == -1);
208 errno = faccessat_errno;
210 #endif /* CYGWIN */
211 return res;
212 #endif /* not MSDOS */
215 /* Signal a file-access failure. STRING describes the failure,
216 NAME the file involved, and ERRORNO the errno value.
218 If NAME is neither null nor a pair, package it up as a singleton
219 list before reporting it; this saves report_file_errno's caller the
220 trouble of preserving errno before calling list1. */
222 void
223 report_file_errno (char const *string, Lisp_Object name, int errorno)
225 Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
226 Lisp_Object errstring;
227 char *str;
229 synchronize_system_messages_locale ();
230 str = strerror (errorno);
231 errstring = code_convert_string_norecord (build_unibyte_string (str),
232 Vlocale_coding_system, 0);
234 while (1)
235 switch (errorno)
237 case EEXIST:
238 xsignal (Qfile_already_exists, Fcons (errstring, data));
239 break;
240 default:
241 /* System error messages are capitalized. Downcase the initial
242 unless it is followed by a slash. (The slash case caters to
243 error messages that begin with "I/O" or, in German, "E/A".) */
244 if (STRING_MULTIBYTE (errstring)
245 && ! EQ (Faref (errstring, make_number (1)), make_number ('/')))
247 int c;
249 str = SSDATA (errstring);
250 c = STRING_CHAR ((unsigned char *) str);
251 Faset (errstring, make_number (0), make_number (downcase (c)));
254 xsignal (Qfile_error,
255 Fcons (build_string (string), Fcons (errstring, data)));
259 /* Signal a file-access failure that set errno. STRING describes the
260 failure, NAME the file involved. When invoking this function, take
261 care to not use arguments such as build_string ("foo") that involve
262 side effects that may set errno. */
264 void
265 report_file_error (char const *string, Lisp_Object name)
267 report_file_errno (string, name, errno);
270 void
271 close_file_unwind (int fd)
273 emacs_close (fd);
276 void
277 fclose_unwind (void *arg)
279 FILE *stream = arg;
280 fclose (stream);
283 /* Restore point, having saved it as a marker. */
285 void
286 restore_point_unwind (Lisp_Object location)
288 Fgoto_char (location);
289 unchain_marker (XMARKER (location));
293 static Lisp_Object Qexpand_file_name;
294 static Lisp_Object Qsubstitute_in_file_name;
295 static Lisp_Object Qdirectory_file_name;
296 static Lisp_Object Qfile_name_directory;
297 static Lisp_Object Qfile_name_nondirectory;
298 static Lisp_Object Qunhandled_file_name_directory;
299 static Lisp_Object Qfile_name_as_directory;
300 static Lisp_Object Qcopy_file;
301 static Lisp_Object Qmake_directory_internal;
302 static Lisp_Object Qmake_directory;
303 static Lisp_Object Qdelete_directory_internal;
304 Lisp_Object Qdelete_file;
305 static Lisp_Object Qrename_file;
306 static Lisp_Object Qadd_name_to_file;
307 static Lisp_Object Qmake_symbolic_link;
308 Lisp_Object Qfile_exists_p;
309 static Lisp_Object Qfile_executable_p;
310 static Lisp_Object Qfile_readable_p;
311 static Lisp_Object Qfile_writable_p;
312 static Lisp_Object Qfile_symlink_p;
313 static Lisp_Object Qaccess_file;
314 Lisp_Object Qfile_directory_p;
315 static Lisp_Object Qfile_regular_p;
316 static Lisp_Object Qfile_accessible_directory_p;
317 static Lisp_Object Qfile_modes;
318 static Lisp_Object Qset_file_modes;
319 static Lisp_Object Qset_file_times;
320 static Lisp_Object Qfile_selinux_context;
321 static Lisp_Object Qset_file_selinux_context;
322 static Lisp_Object Qfile_acl;
323 static Lisp_Object Qset_file_acl;
324 static Lisp_Object Qfile_newer_than_file_p;
325 Lisp_Object Qinsert_file_contents;
326 Lisp_Object Qwrite_region;
327 static Lisp_Object Qverify_visited_file_modtime;
328 static Lisp_Object Qset_visited_file_modtime;
330 DEFUN ("find-file-name-handler", Ffind_file_name_handler,
331 Sfind_file_name_handler, 2, 2, 0,
332 doc: /* Return FILENAME's handler function for OPERATION, if it has one.
333 Otherwise, return nil.
334 A file name is handled if one of the regular expressions in
335 `file-name-handler-alist' matches it.
337 If OPERATION equals `inhibit-file-name-operation', then we ignore
338 any handlers that are members of `inhibit-file-name-handlers',
339 but we still do run any other handlers. This lets handlers
340 use the standard functions without calling themselves recursively. */)
341 (Lisp_Object filename, Lisp_Object operation)
343 /* This function must not munge the match data. */
344 Lisp_Object chain, inhibited_handlers, result;
345 ptrdiff_t pos = -1;
347 result = Qnil;
348 CHECK_STRING (filename);
350 if (EQ (operation, Vinhibit_file_name_operation))
351 inhibited_handlers = Vinhibit_file_name_handlers;
352 else
353 inhibited_handlers = Qnil;
355 for (chain = Vfile_name_handler_alist; CONSP (chain);
356 chain = XCDR (chain))
358 Lisp_Object elt;
359 elt = XCAR (chain);
360 if (CONSP (elt))
362 Lisp_Object string = XCAR (elt);
363 ptrdiff_t match_pos;
364 Lisp_Object handler = XCDR (elt);
365 Lisp_Object operations = Qnil;
367 if (SYMBOLP (handler))
368 operations = Fget (handler, Qoperations);
370 if (STRINGP (string)
371 && (match_pos = fast_string_match (string, filename)) > pos
372 && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
374 Lisp_Object tem;
376 handler = XCDR (elt);
377 tem = Fmemq (handler, inhibited_handlers);
378 if (NILP (tem))
380 result = handler;
381 pos = match_pos;
386 QUIT;
388 return result;
391 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
392 1, 1, 0,
393 doc: /* Return the directory component in file name FILENAME.
394 Return nil if FILENAME does not include a directory.
395 Otherwise return a directory name.
396 Given a Unix syntax file name, returns a string ending in slash. */)
397 (Lisp_Object filename)
399 Lisp_Object handler;
401 CHECK_STRING (filename);
403 /* If the file name has special constructs in it,
404 call the corresponding file handler. */
405 handler = Ffind_file_name_handler (filename, Qfile_name_directory);
406 if (!NILP (handler))
408 Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
409 filename);
410 return STRINGP (handled_name) ? handled_name : Qnil;
413 char *beg = SSDATA (filename);
414 char const *p = beg + SBYTES (filename);
416 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
417 #ifdef DOS_NT
418 /* only recognize drive specifier at the beginning */
419 && !(p[-1] == ':'
420 /* handle the "/:d:foo" and "/:foo" cases correctly */
421 && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
422 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
423 #endif
424 ) p--;
426 if (p == beg)
427 return Qnil;
428 #ifdef DOS_NT
429 /* Expansion of "c:" to drive and default directory. */
430 Lisp_Object tem_fn;
431 USE_SAFE_ALLOCA;
432 SAFE_ALLOCA_STRING (beg, filename);
433 p = beg + (p - SSDATA (filename));
435 if (p[-1] == ':')
437 /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
438 char *res = alloca (MAXPATHLEN + 1);
439 char *r = res;
441 if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
443 memcpy (res, beg, 2);
444 beg += 2;
445 r += 2;
448 if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
450 size_t l = strlen (res);
452 if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
453 strcat (res, "/");
454 beg = res;
455 p = beg + strlen (beg);
456 dostounix_filename (beg);
457 tem_fn = make_specified_string (beg, -1, p - beg,
458 STRING_MULTIBYTE (filename));
460 else
461 tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
462 STRING_MULTIBYTE (filename));
464 else if (STRING_MULTIBYTE (filename))
466 tem_fn = make_specified_string (beg, -1, p - beg, 1);
467 dostounix_filename (SSDATA (tem_fn));
468 #ifdef WINDOWSNT
469 if (!NILP (Vw32_downcase_file_names))
470 tem_fn = Fdowncase (tem_fn);
471 #endif
473 else
475 dostounix_filename (beg);
476 tem_fn = make_specified_string (beg, -1, p - beg, 0);
478 SAFE_FREE ();
479 return tem_fn;
480 #else /* DOS_NT */
481 return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
482 #endif /* DOS_NT */
485 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
486 Sfile_name_nondirectory, 1, 1, 0,
487 doc: /* Return file name FILENAME sans its directory.
488 For example, in a Unix-syntax file name,
489 this is everything after the last slash,
490 or the entire name if it contains no slash. */)
491 (Lisp_Object filename)
493 register const char *beg, *p, *end;
494 Lisp_Object handler;
496 CHECK_STRING (filename);
498 /* If the file name has special constructs in it,
499 call the corresponding file handler. */
500 handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
501 if (!NILP (handler))
503 Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory,
504 filename);
505 if (STRINGP (handled_name))
506 return handled_name;
507 error ("Invalid handler in `file-name-handler-alist'");
510 beg = SSDATA (filename);
511 end = p = beg + SBYTES (filename);
513 while (p != beg && !IS_DIRECTORY_SEP (p[-1])
514 #ifdef DOS_NT
515 /* only recognize drive specifier at beginning */
516 && !(p[-1] == ':'
517 /* handle the "/:d:foo" case correctly */
518 && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
519 #endif
521 p--;
523 return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
526 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
527 Sunhandled_file_name_directory, 1, 1, 0,
528 doc: /* Return a directly usable directory name somehow associated with FILENAME.
529 A `directly usable' directory name is one that may be used without the
530 intervention of any file handler.
531 If FILENAME is a directly usable file itself, return
532 \(file-name-directory FILENAME).
533 If FILENAME refers to a file which is not accessible from a local process,
534 then this should return nil.
535 The `call-process' and `start-process' functions use this function to
536 get a current directory to run processes in. */)
537 (Lisp_Object filename)
539 Lisp_Object handler;
541 /* If the file name has special constructs in it,
542 call the corresponding file handler. */
543 handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
544 if (!NILP (handler))
546 Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
547 filename);
548 return STRINGP (handled_name) ? handled_name : Qnil;
551 return Ffile_name_directory (filename);
554 /* Maximum number of bytes that DST will be longer than SRC
555 in file_name_as_directory. This occurs when SRCLEN == 0. */
556 enum { file_name_as_directory_slop = 2 };
558 /* Convert from file name SRC of length SRCLEN to directory name in
559 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
560 string. On UNIX, just make sure there is a terminating /. Return
561 the length of DST in bytes. */
563 static ptrdiff_t
564 file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
565 bool multibyte)
567 if (srclen == 0)
569 dst[0] = '.';
570 dst[1] = '/';
571 dst[2] = '\0';
572 return 2;
575 memcpy (dst, src, srclen);
576 if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
577 dst[srclen++] = DIRECTORY_SEP;
578 dst[srclen] = 0;
579 #ifdef DOS_NT
580 dostounix_filename (dst);
581 #endif
582 return srclen;
585 DEFUN ("file-name-as-directory", Ffile_name_as_directory,
586 Sfile_name_as_directory, 1, 1, 0,
587 doc: /* Return a string representing the file name FILE interpreted as a directory.
588 This operation exists because a directory is also a file, but its name as
589 a directory is different from its name as a file.
590 The result can be used as the value of `default-directory'
591 or passed as second argument to `expand-file-name'.
592 For a Unix-syntax file name, just appends a slash. */)
593 (Lisp_Object file)
595 char *buf;
596 ptrdiff_t length;
597 Lisp_Object handler, val;
598 USE_SAFE_ALLOCA;
600 CHECK_STRING (file);
601 if (NILP (file))
602 return Qnil;
604 /* If the file name has special constructs in it,
605 call the corresponding file handler. */
606 handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
607 if (!NILP (handler))
609 Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory,
610 file);
611 if (STRINGP (handled_name))
612 return handled_name;
613 error ("Invalid handler in `file-name-handler-alist'");
616 #ifdef WINDOWSNT
617 if (!NILP (Vw32_downcase_file_names))
618 file = Fdowncase (file);
619 #endif
620 buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
621 length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
622 STRING_MULTIBYTE (file));
623 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
624 SAFE_FREE ();
625 return val;
628 /* Convert from directory name SRC of length SRCLEN to file name in
629 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
630 string. On UNIX, just make sure there isn't a terminating /.
631 Return the length of DST in bytes. */
633 static ptrdiff_t
634 directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
636 /* Process as Unix format: just remove any final slash.
637 But leave "/" and "//" unchanged. */
638 while (srclen > 1
639 #ifdef DOS_NT
640 && !IS_ANY_SEP (src[srclen - 2])
641 #endif
642 && IS_DIRECTORY_SEP (src[srclen - 1])
643 && ! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
644 srclen--;
646 memcpy (dst, src, srclen);
647 dst[srclen] = 0;
648 #ifdef DOS_NT
649 dostounix_filename (dst);
650 #endif
651 return srclen;
654 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
655 1, 1, 0,
656 doc: /* Returns the file name of the directory named DIRECTORY.
657 This is the name of the file that holds the data for the directory DIRECTORY.
658 This operation exists because a directory is also a file, but its name as
659 a directory is different from its name as a file.
660 In Unix-syntax, this function just removes the final slash. */)
661 (Lisp_Object directory)
663 char *buf;
664 ptrdiff_t length;
665 Lisp_Object handler, val;
666 USE_SAFE_ALLOCA;
668 CHECK_STRING (directory);
670 if (NILP (directory))
671 return Qnil;
673 /* If the file name has special constructs in it,
674 call the corresponding file handler. */
675 handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
676 if (!NILP (handler))
678 Lisp_Object handled_name = call2 (handler, Qdirectory_file_name,
679 directory);
680 if (STRINGP (handled_name))
681 return handled_name;
682 error ("Invalid handler in `file-name-handler-alist'");
685 #ifdef WINDOWSNT
686 if (!NILP (Vw32_downcase_file_names))
687 directory = Fdowncase (directory);
688 #endif
689 buf = SAFE_ALLOCA (SBYTES (directory) + 1);
690 length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
691 STRING_MULTIBYTE (directory));
692 val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
693 SAFE_FREE ();
694 return val;
697 static const char make_temp_name_tbl[64] =
699 'A','B','C','D','E','F','G','H',
700 'I','J','K','L','M','N','O','P',
701 'Q','R','S','T','U','V','W','X',
702 'Y','Z','a','b','c','d','e','f',
703 'g','h','i','j','k','l','m','n',
704 'o','p','q','r','s','t','u','v',
705 'w','x','y','z','0','1','2','3',
706 '4','5','6','7','8','9','-','_'
709 static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
711 /* Value is a temporary file name starting with PREFIX, a string.
713 The Emacs process number forms part of the result, so there is
714 no danger of generating a name being used by another process.
715 In addition, this function makes an attempt to choose a name
716 which has no existing file. To make this work, PREFIX should be
717 an absolute file name.
719 BASE64_P means add the pid as 3 characters in base64
720 encoding. In this case, 6 characters will be added to PREFIX to
721 form the file name. Otherwise, if Emacs is running on a system
722 with long file names, add the pid as a decimal number.
724 This function signals an error if no unique file name could be
725 generated. */
727 Lisp_Object
728 make_temp_name (Lisp_Object prefix, bool base64_p)
730 Lisp_Object val, encoded_prefix;
731 ptrdiff_t len;
732 printmax_t pid;
733 char *p, *data;
734 char pidbuf[INT_BUFSIZE_BOUND (printmax_t)];
735 int pidlen;
737 CHECK_STRING (prefix);
739 /* VAL is created by adding 6 characters to PREFIX. The first
740 three are the PID of this process, in base 64, and the second
741 three are incremented if the file already exists. This ensures
742 262144 unique file names per PID per PREFIX. */
744 pid = getpid ();
746 if (base64_p)
748 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
749 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
750 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
751 pidlen = 3;
753 else
755 #ifdef HAVE_LONG_FILE_NAMES
756 pidlen = sprintf (pidbuf, "%"pMd, pid);
757 #else
758 pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
759 pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
760 pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
761 pidlen = 3;
762 #endif
765 encoded_prefix = ENCODE_FILE (prefix);
766 len = SBYTES (encoded_prefix);
767 val = make_uninit_string (len + 3 + pidlen);
768 data = SSDATA (val);
769 memcpy (data, SSDATA (encoded_prefix), len);
770 p = data + len;
772 memcpy (p, pidbuf, pidlen);
773 p += pidlen;
775 /* Here we try to minimize useless stat'ing when this function is
776 invoked many times successively with the same PREFIX. We achieve
777 this by initializing count to a random value, and incrementing it
778 afterwards.
780 We don't want make-temp-name to be called while dumping,
781 because then make_temp_name_count_initialized_p would get set
782 and then make_temp_name_count would not be set when Emacs starts. */
784 if (!make_temp_name_count_initialized_p)
786 make_temp_name_count = time (NULL);
787 make_temp_name_count_initialized_p = 1;
790 while (1)
792 unsigned num = make_temp_name_count;
794 p[0] = make_temp_name_tbl[num & 63], num >>= 6;
795 p[1] = make_temp_name_tbl[num & 63], num >>= 6;
796 p[2] = make_temp_name_tbl[num & 63], num >>= 6;
798 /* Poor man's congruential RN generator. Replace with
799 ++make_temp_name_count for debugging. */
800 make_temp_name_count += 25229;
801 make_temp_name_count %= 225307;
803 if (!check_existing (data))
805 /* We want to return only if errno is ENOENT. */
806 if (errno == ENOENT)
807 return DECODE_FILE (val);
808 else
809 /* The error here is dubious, but there is little else we
810 can do. The alternatives are to return nil, which is
811 as bad as (and in many cases worse than) throwing the
812 error, or to ignore the error, which will likely result
813 in looping through 225307 stat's, which is not only
814 dog-slow, but also useless since eventually nil would
815 have to be returned anyway. */
816 report_file_error ("Cannot create temporary name for prefix",
817 prefix);
818 /* not reached */
824 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
825 doc: /* Generate temporary file name (string) starting with PREFIX (a string).
826 The Emacs process number forms part of the result,
827 so there is no danger of generating a name being used by another process.
829 In addition, this function makes an attempt to choose a name
830 which has no existing file. To make this work,
831 PREFIX should be an absolute file name.
833 There is a race condition between calling `make-temp-name' and creating the
834 file which opens all kinds of security holes. For that reason, you should
835 probably use `make-temp-file' instead, except in three circumstances:
837 * If you are creating the file in the user's home directory.
838 * If you are creating a directory rather than an ordinary file.
839 * If you are taking special precautions as `make-temp-file' does. */)
840 (Lisp_Object prefix)
842 return make_temp_name (prefix, 0);
845 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
846 doc: /* Convert filename NAME to absolute, and canonicalize it.
847 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
848 \(does not start with slash or tilde); both the directory name and
849 a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or
850 missing, the current buffer's value of `default-directory' is used.
851 NAME should be a string that is a valid file name for the underlying
852 filesystem.
853 File name components that are `.' are removed, and
854 so are file name components followed by `..', along with the `..' itself;
855 note that these simplifications are done without checking the resulting
856 file names in the file system.
857 Multiple consecutive slashes are collapsed into a single slash,
858 except at the beginning of the file name when they are significant (e.g.,
859 UNC file names on MS-Windows.)
860 An initial `~/' expands to your home directory.
861 An initial `~USER/' expands to USER's home directory.
862 See also the function `substitute-in-file-name'.
864 For technical reasons, this function can return correct but
865 non-intuitive results for the root directory; for instance,
866 \(expand-file-name ".." "/") returns "/..". For this reason, use
867 \(directory-file-name (file-name-directory dirname)) to traverse a
868 filesystem tree, not (expand-file-name ".." dirname). */)
869 (Lisp_Object name, Lisp_Object default_directory)
871 /* These point to SDATA and need to be careful with string-relocation
872 during GC (via DECODE_FILE). */
873 char *nm;
874 char *nmlim;
875 const char *newdir;
876 const char *newdirlim;
877 /* This should only point to alloca'd data. */
878 char *target;
880 ptrdiff_t tlen;
881 struct passwd *pw;
882 #ifdef DOS_NT
883 int drive = 0;
884 bool collapse_newdir = true;
885 bool is_escaped = 0;
886 #endif /* DOS_NT */
887 ptrdiff_t length, nbytes;
888 Lisp_Object handler, result, handled_name;
889 bool multibyte;
890 Lisp_Object hdir;
891 USE_SAFE_ALLOCA;
893 CHECK_STRING (name);
895 /* If the file name has special constructs in it,
896 call the corresponding file handler. */
897 handler = Ffind_file_name_handler (name, Qexpand_file_name);
898 if (!NILP (handler))
900 handled_name = call3 (handler, Qexpand_file_name,
901 name, default_directory);
902 if (STRINGP (handled_name))
903 return handled_name;
904 error ("Invalid handler in `file-name-handler-alist'");
908 /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
909 if (NILP (default_directory))
910 default_directory = BVAR (current_buffer, directory);
911 if (! STRINGP (default_directory))
913 #ifdef DOS_NT
914 /* "/" is not considered a root directory on DOS_NT, so using "/"
915 here causes an infinite recursion in, e.g., the following:
917 (let (default-directory)
918 (expand-file-name "a"))
920 To avoid this, we set default_directory to the root of the
921 current drive. */
922 default_directory = build_string (emacs_root_dir ());
923 #else
924 default_directory = build_string ("/");
925 #endif
928 if (!NILP (default_directory))
930 handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
931 if (!NILP (handler))
933 handled_name = call3 (handler, Qexpand_file_name,
934 name, default_directory);
935 if (STRINGP (handled_name))
936 return handled_name;
937 error ("Invalid handler in `file-name-handler-alist'");
942 char *o = SSDATA (default_directory);
944 /* Make sure DEFAULT_DIRECTORY is properly expanded.
945 It would be better to do this down below where we actually use
946 default_directory. Unfortunately, calling Fexpand_file_name recursively
947 could invoke GC, and the strings might be relocated. This would
948 be annoying because we have pointers into strings lying around
949 that would need adjusting, and people would add new pointers to
950 the code and forget to adjust them, resulting in intermittent bugs.
951 Putting this call here avoids all that crud.
953 The EQ test avoids infinite recursion. */
954 if (! NILP (default_directory) && !EQ (default_directory, name)
955 /* Save time in some common cases - as long as default_directory
956 is not relative, it can be canonicalized with name below (if it
957 is needed at all) without requiring it to be expanded now. */
958 #ifdef DOS_NT
959 /* Detect MSDOS file names with drive specifiers. */
960 && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1])
961 && IS_DIRECTORY_SEP (o[2]))
962 #ifdef WINDOWSNT
963 /* Detect Windows file names in UNC format. */
964 && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
965 #endif
966 #else /* not DOS_NT */
967 /* Detect Unix absolute file names (/... alone is not absolute on
968 DOS or Windows). */
969 && ! (IS_DIRECTORY_SEP (o[0]))
970 #endif /* not DOS_NT */
973 struct gcpro gcpro1;
975 GCPRO1 (name);
976 default_directory = Fexpand_file_name (default_directory, Qnil);
977 UNGCPRO;
980 multibyte = STRING_MULTIBYTE (name);
981 if (multibyte != STRING_MULTIBYTE (default_directory))
983 if (multibyte)
985 unsigned char *p = SDATA (name);
987 while (*p && ASCII_CHAR_P (*p))
988 p++;
989 if (*p == '\0')
991 /* NAME is a pure ASCII string, and DEFAULT_DIRECTORY is
992 unibyte. Do not convert DEFAULT_DIRECTORY to
993 multibyte; instead, convert NAME to a unibyte string,
994 so that the result of this function is also a unibyte
995 string. This is needed during bootstrapping and
996 dumping, when Emacs cannot decode file names, because
997 the locale environment is not set up. */
998 name = make_unibyte_string (SSDATA (name), SBYTES (name));
999 multibyte = 0;
1001 else
1002 default_directory = string_to_multibyte (default_directory);
1004 else
1006 name = string_to_multibyte (name);
1007 multibyte = 1;
1011 #ifdef WINDOWSNT
1012 if (!NILP (Vw32_downcase_file_names))
1013 default_directory = Fdowncase (default_directory);
1014 #endif
1016 /* Make a local copy of NAME to protect it from GC in DECODE_FILE below. */
1017 SAFE_ALLOCA_STRING (nm, name);
1018 nmlim = nm + SBYTES (name);
1020 #ifdef DOS_NT
1021 /* Note if special escape prefix is present, but remove for now. */
1022 if (nm[0] == '/' && nm[1] == ':')
1024 is_escaped = 1;
1025 nm += 2;
1028 /* Find and remove drive specifier if present; this makes nm absolute
1029 even if the rest of the name appears to be relative. Only look for
1030 drive specifier at the beginning. */
1031 if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
1033 drive = (unsigned char) nm[0];
1034 nm += 2;
1037 #ifdef WINDOWSNT
1038 /* If we see "c://somedir", we want to strip the first slash after the
1039 colon when stripping the drive letter. Otherwise, this expands to
1040 "//somedir". */
1041 if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
1042 nm++;
1044 /* Discard any previous drive specifier if nm is now in UNC format. */
1045 if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
1046 && !IS_DIRECTORY_SEP (nm[2]))
1047 drive = 0;
1048 #endif /* WINDOWSNT */
1049 #endif /* DOS_NT */
1051 /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
1052 none are found, we can probably return right away. We will avoid
1053 allocating a new string if name is already fully expanded. */
1054 if (
1055 IS_DIRECTORY_SEP (nm[0])
1056 #ifdef MSDOS
1057 && drive && !is_escaped
1058 #endif
1059 #ifdef WINDOWSNT
1060 && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
1061 #endif
1064 /* If it turns out that the filename we want to return is just a
1065 suffix of FILENAME, we don't need to go through and edit
1066 things; we just need to construct a new string using data
1067 starting at the middle of FILENAME. If we set LOSE, that
1068 means we've discovered that we can't do that cool trick. */
1069 bool lose = 0;
1070 char *p = nm;
1072 while (*p)
1074 /* Since we know the name is absolute, we can assume that each
1075 element starts with a "/". */
1077 /* "." and ".." are hairy. */
1078 if (IS_DIRECTORY_SEP (p[0])
1079 && p[1] == '.'
1080 && (IS_DIRECTORY_SEP (p[2])
1081 || p[2] == 0
1082 || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
1083 || p[3] == 0))))
1084 lose = 1;
1085 /* Replace multiple slashes with a single one, except
1086 leave leading "//" alone. */
1087 else if (IS_DIRECTORY_SEP (p[0])
1088 && IS_DIRECTORY_SEP (p[1])
1089 && (p != nm || IS_DIRECTORY_SEP (p[2])))
1090 lose = 1;
1091 p++;
1093 if (!lose)
1095 #ifdef DOS_NT
1096 /* Make sure directories are all separated with /, but
1097 avoid allocation of a new string when not required. */
1098 dostounix_filename (nm);
1099 #ifdef WINDOWSNT
1100 if (IS_DIRECTORY_SEP (nm[1]))
1102 if (strcmp (nm, SSDATA (name)) != 0)
1103 name = make_specified_string (nm, -1, nmlim - nm, multibyte);
1105 else
1106 #endif
1107 /* Drive must be set, so this is okay. */
1108 if (strcmp (nm - 2, SSDATA (name)) != 0)
1110 char temp[] = " :";
1112 name = make_specified_string (nm, -1, p - nm, multibyte);
1113 temp[0] = DRIVE_LETTER (drive);
1114 name = concat2 (build_local_string (temp), name);
1116 #ifdef WINDOWSNT
1117 if (!NILP (Vw32_downcase_file_names))
1118 name = Fdowncase (name);
1119 #endif
1120 #else /* not DOS_NT */
1121 if (strcmp (nm, SSDATA (name)) != 0)
1122 name = make_specified_string (nm, -1, nmlim - nm, multibyte);
1123 #endif /* not DOS_NT */
1124 SAFE_FREE ();
1125 return name;
1129 /* At this point, nm might or might not be an absolute file name. We
1130 need to expand ~ or ~user if present, otherwise prefix nm with
1131 default_directory if nm is not absolute, and finally collapse /./
1132 and /foo/../ sequences.
1134 We set newdir to be the appropriate prefix if one is needed:
1135 - the relevant user directory if nm starts with ~ or ~user
1136 - the specified drive's working dir (DOS/NT only) if nm does not
1137 start with /
1138 - the value of default_directory.
1140 Note that these prefixes are not guaranteed to be absolute (except
1141 for the working dir of a drive). Therefore, to ensure we always
1142 return an absolute name, if the final prefix is not absolute we
1143 append it to the current working directory. */
1145 newdir = newdirlim = 0;
1147 if (nm[0] == '~') /* prefix ~ */
1149 if (IS_DIRECTORY_SEP (nm[1])
1150 || nm[1] == 0) /* ~ by itself */
1152 Lisp_Object tem;
1154 if (!(newdir = egetenv ("HOME")))
1155 newdir = newdirlim = "";
1156 nm++;
1157 /* `egetenv' may return a unibyte string, which will bite us since
1158 we expect the directory to be multibyte. */
1159 #ifdef WINDOWSNT
1160 if (newdir[0])
1162 char newdir_utf8[MAX_UTF8_PATH];
1164 filename_from_ansi (newdir, newdir_utf8);
1165 tem = build_local_string (newdir_utf8);
1167 else
1168 #endif
1169 tem = build_local_string (newdir);
1170 newdirlim = newdir + SBYTES (tem);
1171 if (multibyte && !STRING_MULTIBYTE (tem))
1173 hdir = DECODE_FILE (tem);
1174 newdir = SSDATA (hdir);
1175 newdirlim = newdir + SBYTES (hdir);
1177 #ifdef DOS_NT
1178 collapse_newdir = false;
1179 #endif
1181 else /* ~user/filename */
1183 char *o, *p;
1184 for (p = nm; *p && !IS_DIRECTORY_SEP (*p); p++)
1185 continue;
1186 o = SAFE_ALLOCA (p - nm + 1);
1187 memcpy (o, nm, p - nm);
1188 o[p - nm] = 0;
1190 block_input ();
1191 pw = getpwnam (o + 1);
1192 unblock_input ();
1193 if (pw)
1195 Lisp_Object tem;
1197 newdir = pw->pw_dir;
1198 /* `getpwnam' may return a unibyte string, which will
1199 bite us since we expect the directory to be
1200 multibyte. */
1201 tem = build_local_string (newdir);
1202 newdirlim = newdir + SBYTES (tem);
1203 if (multibyte && !STRING_MULTIBYTE (tem))
1205 hdir = DECODE_FILE (tem);
1206 newdir = SSDATA (hdir);
1207 newdirlim = newdir + SBYTES (hdir);
1209 nm = p;
1210 #ifdef DOS_NT
1211 collapse_newdir = false;
1212 #endif
1215 /* If we don't find a user of that name, leave the name
1216 unchanged; don't move nm forward to p. */
1220 #ifdef DOS_NT
1221 /* On DOS and Windows, nm is absolute if a drive name was specified;
1222 use the drive's current directory as the prefix if needed. */
1223 if (!newdir && drive)
1225 /* Get default directory if needed to make nm absolute. */
1226 char *adir = NULL;
1227 if (!IS_DIRECTORY_SEP (nm[0]))
1229 adir = alloca (MAXPATHLEN + 1);
1230 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1231 adir = NULL;
1232 else if (multibyte)
1234 Lisp_Object tem = build_local_string (adir);
1236 tem = DECODE_FILE (tem);
1237 newdirlim = adir + SBYTES (tem);
1238 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1241 if (!adir)
1243 /* Either nm starts with /, or drive isn't mounted. */
1244 adir = alloca (4);
1245 adir[0] = DRIVE_LETTER (drive);
1246 adir[1] = ':';
1247 adir[2] = '/';
1248 adir[3] = 0;
1249 newdirlim = adir + 3;
1251 newdir = adir;
1253 #endif /* DOS_NT */
1255 /* Finally, if no prefix has been specified and nm is not absolute,
1256 then it must be expanded relative to default_directory. */
1258 if (1
1259 #ifndef DOS_NT
1260 /* /... alone is not absolute on DOS and Windows. */
1261 && !IS_DIRECTORY_SEP (nm[0])
1262 #endif
1263 #ifdef WINDOWSNT
1264 && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
1265 && !IS_DIRECTORY_SEP (nm[2]))
1266 #endif
1267 && !newdir)
1269 newdir = SSDATA (default_directory);
1270 newdirlim = newdir + SBYTES (default_directory);
1271 #ifdef DOS_NT
1272 /* Note if special escape prefix is present, but remove for now. */
1273 if (newdir[0] == '/' && newdir[1] == ':')
1275 is_escaped = 1;
1276 newdir += 2;
1278 #endif
1281 #ifdef DOS_NT
1282 if (newdir)
1284 /* First ensure newdir is an absolute name. */
1285 if (
1286 /* Detect MSDOS file names with drive specifiers. */
1287 ! (IS_DRIVE (newdir[0])
1288 && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
1289 #ifdef WINDOWSNT
1290 /* Detect Windows file names in UNC format. */
1291 && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
1292 && !IS_DIRECTORY_SEP (newdir[2]))
1293 #endif
1296 /* Effectively, let newdir be (expand-file-name newdir cwd).
1297 Because of the admonition against calling expand-file-name
1298 when we have pointers into lisp strings, we accomplish this
1299 indirectly by prepending newdir to nm if necessary, and using
1300 cwd (or the wd of newdir's drive) as the new newdir. */
1301 char *adir;
1302 #ifdef WINDOWSNT
1303 const int adir_size = MAX_UTF8_PATH;
1304 #else
1305 const int adir_size = MAXPATHLEN + 1;
1306 #endif
1308 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1310 drive = (unsigned char) newdir[0];
1311 newdir += 2;
1313 if (!IS_DIRECTORY_SEP (nm[0]))
1315 ptrdiff_t nmlen = nmlim - nm;
1316 ptrdiff_t newdirlen = newdirlim - newdir;
1317 char *tmp = alloca (newdirlen + file_name_as_directory_slop
1318 + nmlen + 1);
1319 ptrdiff_t dlen = file_name_as_directory (tmp, newdir, newdirlen,
1320 multibyte);
1321 memcpy (tmp + dlen, nm, nmlen + 1);
1322 nm = tmp;
1323 nmlim = nm + dlen + nmlen;
1325 adir = alloca (adir_size);
1326 if (drive)
1328 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1329 strcpy (adir, "/");
1331 else
1332 getcwd (adir, adir_size);
1333 if (multibyte)
1335 Lisp_Object tem = build_local_string (adir);
1337 tem = DECODE_FILE (tem);
1338 newdirlim = adir + SBYTES (tem);
1339 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1341 else
1342 newdirlim = adir + strlen (adir);
1343 newdir = adir;
1346 /* Strip off drive name from prefix, if present. */
1347 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1349 drive = newdir[0];
1350 newdir += 2;
1353 /* Keep only a prefix from newdir if nm starts with slash
1354 (//server/share for UNC, nothing otherwise). */
1355 if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
1357 #ifdef WINDOWSNT
1358 if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
1359 && !IS_DIRECTORY_SEP (newdir[2]))
1361 char *adir = strcpy (alloca (newdirlim - newdir + 1), newdir);
1362 char *p = adir + 2;
1363 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1364 p++;
1365 while (*p && !IS_DIRECTORY_SEP (*p)) p++;
1366 *p = 0;
1367 newdir = adir;
1368 newdirlim = newdir + strlen (adir);
1370 else
1371 #endif
1372 newdir = newdirlim = "";
1375 #endif /* DOS_NT */
1377 /* Ignore any slash at the end of newdir, unless newdir is
1378 just "/" or "//". */
1379 length = newdirlim - newdir;
1380 while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
1381 && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0])))
1382 length--;
1384 /* Now concatenate the directory and name to new space in the stack frame. */
1385 tlen = length + file_name_as_directory_slop + (nmlim - nm) + 1;
1386 #ifdef DOS_NT
1387 /* Reserve space for drive specifier and escape prefix, since either
1388 or both may need to be inserted. (The Microsoft x86 compiler
1389 produces incorrect code if the following two lines are combined.) */
1390 target = alloca (tlen + 4);
1391 target += 4;
1392 #else /* not DOS_NT */
1393 target = SAFE_ALLOCA (tlen);
1394 #endif /* not DOS_NT */
1395 *target = 0;
1396 nbytes = 0;
1398 if (newdir)
1400 if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
1402 #ifdef DOS_NT
1403 /* If newdir is effectively "C:/", then the drive letter will have
1404 been stripped and newdir will be "/". Concatenating with an
1405 absolute directory in nm produces "//", which will then be
1406 incorrectly treated as a network share. Ignore newdir in
1407 this case (keeping the drive letter). */
1408 if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
1409 && newdir[1] == '\0'))
1410 #endif
1412 memcpy (target, newdir, length);
1413 target[length] = 0;
1414 nbytes = length;
1417 else
1418 nbytes = file_name_as_directory (target, newdir, length, multibyte);
1421 memcpy (target + nbytes, nm, nmlim - nm + 1);
1423 /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
1424 appear. */
1426 char *p = target;
1427 char *o = target;
1429 while (*p)
1431 if (!IS_DIRECTORY_SEP (*p))
1433 *o++ = *p++;
1435 else if (p[1] == '.'
1436 && (IS_DIRECTORY_SEP (p[2])
1437 || p[2] == 0))
1439 /* If "/." is the entire filename, keep the "/". Otherwise,
1440 just delete the whole "/.". */
1441 if (o == target && p[2] == '\0')
1442 *o++ = *p;
1443 p += 2;
1445 else if (p[1] == '.' && p[2] == '.'
1446 /* `/../' is the "superroot" on certain file systems.
1447 Turned off on DOS_NT systems because they have no
1448 "superroot" and because this causes us to produce
1449 file names like "d:/../foo" which fail file-related
1450 functions of the underlying OS. (To reproduce, try a
1451 long series of "../../" in default_directory, longer
1452 than the number of levels from the root.) */
1453 #ifndef DOS_NT
1454 && o != target
1455 #endif
1456 && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
1458 #ifdef WINDOWSNT
1459 char *prev_o = o;
1460 #endif
1461 while (o != target && (--o, !IS_DIRECTORY_SEP (*o)))
1462 continue;
1463 #ifdef WINDOWSNT
1464 /* Don't go below server level in UNC filenames. */
1465 if (o == target + 1 && IS_DIRECTORY_SEP (*o)
1466 && IS_DIRECTORY_SEP (*target))
1467 o = prev_o;
1468 else
1469 #endif
1470 /* Keep initial / only if this is the whole name. */
1471 if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
1472 ++o;
1473 p += 3;
1475 else if (IS_DIRECTORY_SEP (p[1])
1476 && (p != target || IS_DIRECTORY_SEP (p[2])))
1477 /* Collapse multiple "/", except leave leading "//" alone. */
1478 p++;
1479 else
1481 *o++ = *p++;
1485 #ifdef DOS_NT
1486 /* At last, set drive name. */
1487 #ifdef WINDOWSNT
1488 /* Except for network file name. */
1489 if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
1490 #endif /* WINDOWSNT */
1492 if (!drive) emacs_abort ();
1493 target -= 2;
1494 target[0] = DRIVE_LETTER (drive);
1495 target[1] = ':';
1497 /* Reinsert the escape prefix if required. */
1498 if (is_escaped)
1500 target -= 2;
1501 target[0] = '/';
1502 target[1] = ':';
1504 result = make_specified_string (target, -1, o - target, multibyte);
1505 dostounix_filename (SSDATA (result));
1506 #ifdef WINDOWSNT
1507 if (!NILP (Vw32_downcase_file_names))
1508 result = Fdowncase (result);
1509 #endif
1510 #else /* !DOS_NT */
1511 result = make_specified_string (target, -1, o - target, multibyte);
1512 #endif /* !DOS_NT */
1515 /* Again look to see if the file name has special constructs in it
1516 and perhaps call the corresponding file handler. This is needed
1517 for filenames such as "/foo/../user@host:/bar/../baz". Expanding
1518 the ".." component gives us "/user@host:/bar/../baz" which needs
1519 to be expanded again. */
1520 handler = Ffind_file_name_handler (result, Qexpand_file_name);
1521 if (!NILP (handler))
1523 handled_name = call3 (handler, Qexpand_file_name,
1524 result, default_directory);
1525 if (! STRINGP (handled_name))
1526 error ("Invalid handler in `file-name-handler-alist'");
1527 result = handled_name;
1530 SAFE_FREE ();
1531 return result;
1534 #if 0
1535 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
1536 This is the old version of expand-file-name, before it was thoroughly
1537 rewritten for Emacs 10.31. We leave this version here commented-out,
1538 because the code is very complex and likely to have subtle bugs. If
1539 bugs _are_ found, it might be of interest to look at the old code and
1540 see what did it do in the relevant situation.
1542 Don't remove this code: it's true that it will be accessible
1543 from the repository, but a few years from deletion, people will
1544 forget it is there. */
1546 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
1547 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
1548 "Convert FILENAME to absolute, and canonicalize it.\n\
1549 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
1550 \(does not start with slash); if DEFAULT is nil or missing,\n\
1551 the current buffer's value of default-directory is used.\n\
1552 Filenames containing `.' or `..' as components are simplified;\n\
1553 initial `~/' expands to your home directory.\n\
1554 See also the function `substitute-in-file-name'.")
1555 (name, defalt)
1556 Lisp_Object name, defalt;
1558 unsigned char *nm;
1560 register unsigned char *newdir, *p, *o;
1561 ptrdiff_t tlen;
1562 unsigned char *target;
1563 struct passwd *pw;
1565 CHECK_STRING (name);
1566 nm = SDATA (name);
1568 /* If nm is absolute, flush ...// and detect /./ and /../.
1569 If no /./ or /../ we can return right away. */
1570 if (nm[0] == '/')
1572 bool lose = 0;
1573 p = nm;
1574 while (*p)
1576 if (p[0] == '/' && p[1] == '/')
1577 nm = p + 1;
1578 if (p[0] == '/' && p[1] == '~')
1579 nm = p + 1, lose = 1;
1580 if (p[0] == '/' && p[1] == '.'
1581 && (p[2] == '/' || p[2] == 0
1582 || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
1583 lose = 1;
1584 p++;
1586 if (!lose)
1588 if (nm == SDATA (name))
1589 return name;
1590 return build_string (nm);
1594 /* Now determine directory to start with and put it in NEWDIR. */
1596 newdir = 0;
1598 if (nm[0] == '~') /* prefix ~ */
1599 if (nm[1] == '/' || nm[1] == 0)/* ~/filename */
1601 if (!(newdir = (unsigned char *) egetenv ("HOME")))
1602 newdir = (unsigned char *) "";
1603 nm++;
1605 else /* ~user/filename */
1607 /* Get past ~ to user. */
1608 unsigned char *user = nm + 1;
1609 /* Find end of name. */
1610 unsigned char *ptr = (unsigned char *) strchr (user, '/');
1611 ptrdiff_t len = ptr ? ptr - user : strlen (user);
1612 /* Copy the user name into temp storage. */
1613 o = alloca (len + 1);
1614 memcpy (o, user, len);
1615 o[len] = 0;
1617 /* Look up the user name. */
1618 block_input ();
1619 pw = (struct passwd *) getpwnam (o + 1);
1620 unblock_input ();
1621 if (!pw)
1622 error ("\"%s\" isn't a registered user", o + 1);
1624 newdir = (unsigned char *) pw->pw_dir;
1626 /* Discard the user name from NM. */
1627 nm += len;
1630 if (nm[0] != '/' && !newdir)
1632 if (NILP (defalt))
1633 defalt = current_buffer->directory;
1634 CHECK_STRING (defalt);
1635 newdir = SDATA (defalt);
1638 /* Now concatenate the directory and name to new space in the stack frame. */
1640 tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
1641 target = alloca (tlen);
1642 *target = 0;
1644 if (newdir)
1646 if (nm[0] == 0 || nm[0] == '/')
1647 strcpy (target, newdir);
1648 else
1649 file_name_as_directory (target, newdir);
1652 strcat (target, nm);
1654 /* Now canonicalize by removing /. and /foo/.. if they appear. */
1656 p = target;
1657 o = target;
1659 while (*p)
1661 if (*p != '/')
1663 *o++ = *p++;
1665 else if (!strncmp (p, "//", 2)
1668 o = target;
1669 p++;
1671 else if (p[0] == '/' && p[1] == '.'
1672 && (p[2] == '/' || p[2] == 0))
1673 p += 2;
1674 else if (!strncmp (p, "/..", 3)
1675 /* `/../' is the "superroot" on certain file systems. */
1676 && o != target
1677 && (p[3] == '/' || p[3] == 0))
1679 while (o != target && *--o != '/')
1681 if (o == target && *o == '/')
1682 ++o;
1683 p += 3;
1685 else
1687 *o++ = *p++;
1691 return make_string (target, o - target);
1693 #endif
1695 /* If /~ or // appears, discard everything through first slash. */
1696 static bool
1697 file_name_absolute_p (const char *filename)
1699 return
1700 (IS_DIRECTORY_SEP (*filename) || *filename == '~'
1701 #ifdef DOS_NT
1702 || (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
1703 && IS_DIRECTORY_SEP (filename[2]))
1704 #endif
1708 static char *
1709 search_embedded_absfilename (char *nm, char *endp)
1711 char *p, *s;
1713 for (p = nm + 1; p < endp; p++)
1715 if (IS_DIRECTORY_SEP (p[-1])
1716 && file_name_absolute_p (p)
1717 #if defined (WINDOWSNT) || defined (CYGWIN)
1718 /* // at start of file name is meaningful in Apollo,
1719 WindowsNT and Cygwin systems. */
1720 && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
1721 #endif /* not (WINDOWSNT || CYGWIN) */
1724 for (s = p; *s && !IS_DIRECTORY_SEP (*s); s++);
1725 if (p[0] == '~' && s > p + 1) /* We've got "/~something/". */
1727 USE_SAFE_ALLOCA;
1728 char *o = SAFE_ALLOCA (s - p + 1);
1729 struct passwd *pw;
1730 memcpy (o, p, s - p);
1731 o [s - p] = 0;
1733 /* If we have ~user and `user' exists, discard
1734 everything up to ~. But if `user' does not exist, leave
1735 ~user alone, it might be a literal file name. */
1736 block_input ();
1737 pw = getpwnam (o + 1);
1738 unblock_input ();
1739 SAFE_FREE ();
1740 if (pw)
1741 return p;
1743 else
1744 return p;
1747 return NULL;
1750 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
1751 Ssubstitute_in_file_name, 1, 1, 0,
1752 doc: /* Substitute environment variables referred to in FILENAME.
1753 `$FOO' where FOO is an environment variable name means to substitute
1754 the value of that variable. The variable name should be terminated
1755 with a character not a letter, digit or underscore; otherwise, enclose
1756 the entire variable name in braces.
1758 If `/~' appears, all of FILENAME through that `/' is discarded.
1759 If `//' appears, everything up to and including the first of
1760 those `/' is discarded. */)
1761 (Lisp_Object filename)
1763 char *nm, *p, *x, *endp;
1764 bool substituted = false;
1765 bool multibyte;
1766 char *xnm;
1767 Lisp_Object handler;
1769 CHECK_STRING (filename);
1771 multibyte = STRING_MULTIBYTE (filename);
1773 /* If the file name has special constructs in it,
1774 call the corresponding file handler. */
1775 handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
1776 if (!NILP (handler))
1778 Lisp_Object handled_name = call2 (handler, Qsubstitute_in_file_name,
1779 filename);
1780 if (STRINGP (handled_name))
1781 return handled_name;
1782 error ("Invalid handler in `file-name-handler-alist'");
1785 /* Always work on a copy of the string, in case GC happens during
1786 decode of environment variables, causing the original Lisp_String
1787 data to be relocated. */
1788 USE_SAFE_ALLOCA;
1789 SAFE_ALLOCA_STRING (nm, filename);
1791 #ifdef DOS_NT
1792 dostounix_filename (nm);
1793 substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
1794 #endif
1795 endp = nm + SBYTES (filename);
1797 /* If /~ or // appears, discard everything through first slash. */
1798 p = search_embedded_absfilename (nm, endp);
1799 if (p)
1800 /* Start over with the new string, so we check the file-name-handler
1801 again. Important with filenames like "/home/foo//:/hello///there"
1802 which would substitute to "/:/hello///there" rather than "/there". */
1804 Lisp_Object result
1805 = (Fsubstitute_in_file_name
1806 (make_specified_string (p, -1, endp - p, multibyte)));
1807 SAFE_FREE ();
1808 return result;
1811 /* See if any variables are substituted into the string. */
1813 if (!NILP (Ffboundp (Qsubstitute_env_in_file_name)))
1815 Lisp_Object name
1816 = (!substituted ? filename
1817 : make_specified_string (nm, -1, endp - nm, multibyte));
1818 Lisp_Object tmp = call1 (Qsubstitute_env_in_file_name, name);
1819 CHECK_STRING (tmp);
1820 if (!EQ (tmp, name))
1821 substituted = true;
1822 filename = tmp;
1825 if (!substituted)
1827 #ifdef WINDOWSNT
1828 if (!NILP (Vw32_downcase_file_names))
1829 filename = Fdowncase (filename);
1830 #endif
1831 SAFE_FREE ();
1832 return filename;
1835 xnm = SSDATA (filename);
1836 x = xnm + SBYTES (filename);
1838 /* If /~ or // appears, discard everything through first slash. */
1839 while ((p = search_embedded_absfilename (xnm, x)) != NULL)
1840 /* This time we do not start over because we've already expanded envvars
1841 and replaced $$ with $. Maybe we should start over as well, but we'd
1842 need to quote some $ to $$ first. */
1843 xnm = p;
1845 #ifdef WINDOWSNT
1846 if (!NILP (Vw32_downcase_file_names))
1848 Lisp_Object xname = make_specified_string (xnm, -1, x - xnm, multibyte);
1850 filename = Fdowncase (xname);
1852 else
1853 #endif
1854 if (xnm != SSDATA (filename))
1855 filename = make_specified_string (xnm, -1, x - xnm, multibyte);
1856 SAFE_FREE ();
1857 return filename;
1860 /* A slightly faster and more convenient way to get
1861 (directory-file-name (expand-file-name FOO)). */
1863 Lisp_Object
1864 expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
1866 register Lisp_Object absname;
1868 absname = Fexpand_file_name (filename, defdir);
1870 /* Remove final slash, if any (unless this is the root dir).
1871 stat behaves differently depending! */
1872 if (SCHARS (absname) > 1
1873 && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
1874 && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2)))
1875 /* We cannot take shortcuts; they might be wrong for magic file names. */
1876 absname = Fdirectory_file_name (absname);
1877 return absname;
1880 /* Signal an error if the file ABSNAME already exists.
1881 If KNOWN_TO_EXIST, the file is known to exist.
1882 QUERYSTRING is a name for the action that is being considered
1883 to alter the file.
1884 If INTERACTIVE, ask the user whether to proceed,
1885 and bypass the error if the user says to go ahead.
1886 If QUICK, ask for y or n, not yes or no. */
1888 static void
1889 barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist,
1890 const char *querystring, bool interactive,
1891 bool quick)
1893 Lisp_Object tem, encoded_filename;
1894 struct stat statbuf;
1895 struct gcpro gcpro1;
1897 encoded_filename = ENCODE_FILE (absname);
1899 if (! known_to_exist && lstat (SSDATA (encoded_filename), &statbuf) == 0)
1901 if (S_ISDIR (statbuf.st_mode))
1902 xsignal2 (Qfile_error,
1903 build_string ("File is a directory"), absname);
1904 known_to_exist = true;
1907 if (known_to_exist)
1909 if (! interactive)
1910 xsignal2 (Qfile_already_exists,
1911 build_string ("File already exists"), absname);
1912 GCPRO1 (absname);
1913 tem = format2 ("File %s already exists; %s anyway? ",
1914 absname, build_string (querystring));
1915 if (quick)
1916 tem = call1 (intern ("y-or-n-p"), tem);
1917 else
1918 tem = do_yes_or_no_p (tem);
1919 UNGCPRO;
1920 if (NILP (tem))
1921 xsignal2 (Qfile_already_exists,
1922 build_string ("File already exists"), absname);
1926 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
1927 "fCopy file: \nGCopy %s to file: \np\nP",
1928 doc: /* Copy FILE to NEWNAME. Both args must be strings.
1929 If NEWNAME names a directory, copy FILE there.
1931 This function always sets the file modes of the output file to match
1932 the input file.
1934 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
1935 if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
1936 signal a `file-already-exists' error without overwriting. If
1937 OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
1938 about overwriting; this is what happens in interactive use with M-x.
1939 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
1940 existing file.
1942 Fourth arg KEEP-TIME non-nil means give the output file the same
1943 last-modified time as the old one. (This works on only some systems.)
1945 A prefix arg makes KEEP-TIME non-nil.
1947 If PRESERVE-UID-GID is non-nil, we try to transfer the
1948 uid and gid of FILE to NEWNAME.
1950 If PRESERVE-PERMISSIONS is non-nil, copy permissions of FILE to NEWNAME;
1951 this includes the file modes, along with ACL entries and SELinux
1952 context if present. Otherwise, if NEWNAME is created its file
1953 permission bits are those of FILE, masked by the default file
1954 permissions. */)
1955 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists,
1956 Lisp_Object keep_time, Lisp_Object preserve_uid_gid,
1957 Lisp_Object preserve_permissions)
1959 Lisp_Object handler;
1960 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1961 ptrdiff_t count = SPECPDL_INDEX ();
1962 Lisp_Object encoded_file, encoded_newname;
1963 #if HAVE_LIBSELINUX
1964 security_context_t con;
1965 int conlength = 0;
1966 #endif
1967 #ifdef WINDOWSNT
1968 int result;
1969 #else
1970 bool already_exists = false;
1971 mode_t new_mask;
1972 int ifd, ofd;
1973 int n;
1974 char buf[16 * 1024];
1975 struct stat st;
1976 #endif
1978 encoded_file = encoded_newname = Qnil;
1979 GCPRO4 (file, newname, encoded_file, encoded_newname);
1980 CHECK_STRING (file);
1981 CHECK_STRING (newname);
1983 if (!NILP (Ffile_directory_p (newname)))
1984 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
1985 else
1986 newname = Fexpand_file_name (newname, Qnil);
1988 file = Fexpand_file_name (file, Qnil);
1990 /* If the input file name has special constructs in it,
1991 call the corresponding file handler. */
1992 handler = Ffind_file_name_handler (file, Qcopy_file);
1993 /* Likewise for output file name. */
1994 if (NILP (handler))
1995 handler = Ffind_file_name_handler (newname, Qcopy_file);
1996 if (!NILP (handler))
1997 RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname,
1998 ok_if_already_exists, keep_time, preserve_uid_gid,
1999 preserve_permissions));
2001 encoded_file = ENCODE_FILE (file);
2002 encoded_newname = ENCODE_FILE (newname);
2004 #ifdef WINDOWSNT
2005 if (NILP (ok_if_already_exists)
2006 || INTEGERP (ok_if_already_exists))
2007 barf_or_query_if_file_exists (newname, false, "copy to it",
2008 INTEGERP (ok_if_already_exists), false);
2010 result = w32_copy_file (SSDATA (encoded_file), SSDATA (encoded_newname),
2011 !NILP (keep_time), !NILP (preserve_uid_gid),
2012 !NILP (preserve_permissions));
2013 switch (result)
2015 case -1:
2016 report_file_error ("Copying file", list2 (file, newname));
2017 case -2:
2018 report_file_error ("Copying permissions from", file);
2019 case -3:
2020 xsignal2 (Qfile_date_error,
2021 build_string ("Resetting file times"), newname);
2022 case -4:
2023 report_file_error ("Copying permissions to", newname);
2025 #else /* not WINDOWSNT */
2026 immediate_quit = 1;
2027 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
2028 immediate_quit = 0;
2030 if (ifd < 0)
2031 report_file_error ("Opening input file", file);
2033 record_unwind_protect_int (close_file_unwind, ifd);
2035 if (fstat (ifd, &st) != 0)
2036 report_file_error ("Input file status", file);
2038 if (!NILP (preserve_permissions))
2040 #if HAVE_LIBSELINUX
2041 if (is_selinux_enabled ())
2043 conlength = fgetfilecon (ifd, &con);
2044 if (conlength == -1)
2045 report_file_error ("Doing fgetfilecon", file);
2047 #endif
2050 /* We can copy only regular files. */
2051 if (!S_ISREG (st.st_mode))
2052 report_file_errno ("Non-regular file", file,
2053 S_ISDIR (st.st_mode) ? EISDIR : EINVAL);
2055 #ifndef MSDOS
2056 new_mask = st.st_mode & (!NILP (preserve_uid_gid) ? 0700 : 0777);
2057 #else
2058 new_mask = S_IREAD | S_IWRITE;
2059 #endif
2061 ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY | O_CREAT | O_EXCL,
2062 new_mask);
2063 if (ofd < 0 && errno == EEXIST)
2065 if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists))
2066 barf_or_query_if_file_exists (newname, true, "copy to it",
2067 INTEGERP (ok_if_already_exists), false);
2068 already_exists = true;
2069 ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY, 0);
2071 if (ofd < 0)
2072 report_file_error ("Opening output file", newname);
2074 record_unwind_protect_int (close_file_unwind, ofd);
2076 if (already_exists)
2078 struct stat out_st;
2079 if (fstat (ofd, &out_st) != 0)
2080 report_file_error ("Output file status", newname);
2081 if (st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
2082 report_file_errno ("Input and output files are the same",
2083 list2 (file, newname), 0);
2084 if (ftruncate (ofd, 0) != 0)
2085 report_file_error ("Truncating output file", newname);
2088 immediate_quit = 1;
2089 QUIT;
2090 while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
2091 if (emacs_write_sig (ofd, buf, n) != n)
2092 report_file_error ("Write error", newname);
2093 immediate_quit = 0;
2095 #ifndef MSDOS
2096 /* Preserve the original file permissions, and if requested, also its
2097 owner and group. */
2099 mode_t preserved_permissions = st.st_mode & 07777;
2100 mode_t default_permissions = st.st_mode & 0777 & ~realmask;
2101 if (!NILP (preserve_uid_gid))
2103 /* Attempt to change owner and group. If that doesn't work
2104 attempt to change just the group, as that is sometimes allowed.
2105 Adjust the mode mask to eliminate setuid or setgid bits
2106 or group permissions bits that are inappropriate if the
2107 owner or group are wrong. */
2108 if (fchown (ofd, st.st_uid, st.st_gid) != 0)
2110 if (fchown (ofd, -1, st.st_gid) == 0)
2111 preserved_permissions &= ~04000;
2112 else
2114 preserved_permissions &= ~06000;
2116 /* Copy the other bits to the group bits, since the
2117 group is wrong. */
2118 preserved_permissions &= ~070;
2119 preserved_permissions |= (preserved_permissions & 7) << 3;
2120 default_permissions &= ~070;
2121 default_permissions |= (default_permissions & 7) << 3;
2126 switch (!NILP (preserve_permissions)
2127 ? qcopy_acl (SSDATA (encoded_file), ifd,
2128 SSDATA (encoded_newname), ofd,
2129 preserved_permissions)
2130 : (already_exists
2131 || (new_mask & ~realmask) == default_permissions)
2133 : fchmod (ofd, default_permissions))
2135 case -2: report_file_error ("Copying permissions from", file);
2136 case -1: report_file_error ("Copying permissions to", newname);
2139 #endif /* not MSDOS */
2141 #if HAVE_LIBSELINUX
2142 if (conlength > 0)
2144 /* Set the modified context back to the file. */
2145 bool fail = fsetfilecon (ofd, con) != 0;
2146 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
2147 if (fail && errno != ENOTSUP)
2148 report_file_error ("Doing fsetfilecon", newname);
2150 freecon (con);
2152 #endif
2154 if (!NILP (keep_time))
2156 struct timespec atime = get_stat_atime (&st);
2157 struct timespec mtime = get_stat_mtime (&st);
2158 if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime) != 0)
2159 xsignal2 (Qfile_date_error,
2160 build_string ("Cannot set file date"), newname);
2163 if (emacs_close (ofd) < 0)
2164 report_file_error ("Write error", newname);
2166 emacs_close (ifd);
2168 #ifdef MSDOS
2169 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2170 and if it can't, it tells so. Otherwise, under MSDOS we usually
2171 get only the READ bit, which will make the copied file read-only,
2172 so it's better not to chmod at all. */
2173 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
2174 chmod (SDATA (encoded_newname), st.st_mode & 07777);
2175 #endif /* MSDOS */
2176 #endif /* not WINDOWSNT */
2178 /* Discard the unwind protects. */
2179 specpdl_ptr = specpdl + count;
2181 UNGCPRO;
2182 return Qnil;
2185 DEFUN ("make-directory-internal", Fmake_directory_internal,
2186 Smake_directory_internal, 1, 1, 0,
2187 doc: /* Create a new directory named DIRECTORY. */)
2188 (Lisp_Object directory)
2190 const char *dir;
2191 Lisp_Object handler;
2192 Lisp_Object encoded_dir;
2194 CHECK_STRING (directory);
2195 directory = Fexpand_file_name (directory, Qnil);
2197 handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
2198 if (!NILP (handler))
2199 return call2 (handler, Qmake_directory_internal, directory);
2201 encoded_dir = ENCODE_FILE (directory);
2203 dir = SSDATA (encoded_dir);
2205 #ifdef WINDOWSNT
2206 if (mkdir (dir) != 0)
2207 #else
2208 if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
2209 #endif
2210 report_file_error ("Creating directory", directory);
2212 return Qnil;
2215 DEFUN ("delete-directory-internal", Fdelete_directory_internal,
2216 Sdelete_directory_internal, 1, 1, 0,
2217 doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
2218 (Lisp_Object directory)
2220 const char *dir;
2221 Lisp_Object encoded_dir;
2223 CHECK_STRING (directory);
2224 directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
2225 encoded_dir = ENCODE_FILE (directory);
2226 dir = SSDATA (encoded_dir);
2228 if (rmdir (dir) != 0)
2229 report_file_error ("Removing directory", directory);
2231 return Qnil;
2234 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 2,
2235 "(list (read-file-name \
2236 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
2237 \"Move file to trash: \" \"Delete file: \") \
2238 nil default-directory (confirm-nonexistent-file-or-buffer)) \
2239 (null current-prefix-arg))",
2240 doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
2241 If file has multiple names, it continues to exist with the other names.
2242 TRASH non-nil means to trash the file instead of deleting, provided
2243 `delete-by-moving-to-trash' is non-nil.
2245 When called interactively, TRASH is t if no prefix argument is given.
2246 With a prefix argument, TRASH is nil. */)
2247 (Lisp_Object filename, Lisp_Object trash)
2249 Lisp_Object handler;
2250 Lisp_Object encoded_file;
2251 struct gcpro gcpro1;
2253 GCPRO1 (filename);
2254 if (!NILP (Ffile_directory_p (filename))
2255 && NILP (Ffile_symlink_p (filename)))
2256 xsignal2 (Qfile_error,
2257 build_string ("Removing old name: is a directory"),
2258 filename);
2259 UNGCPRO;
2260 filename = Fexpand_file_name (filename, Qnil);
2262 handler = Ffind_file_name_handler (filename, Qdelete_file);
2263 if (!NILP (handler))
2264 return call3 (handler, Qdelete_file, filename, trash);
2266 if (delete_by_moving_to_trash && !NILP (trash))
2267 return call1 (Qmove_file_to_trash, filename);
2269 encoded_file = ENCODE_FILE (filename);
2271 if (unlink (SSDATA (encoded_file)) < 0)
2272 report_file_error ("Removing old name", filename);
2273 return Qnil;
2276 static Lisp_Object
2277 internal_delete_file_1 (Lisp_Object ignore)
2279 return Qt;
2282 /* Delete file FILENAME, returning true if successful.
2283 This ignores `delete-by-moving-to-trash'. */
2285 bool
2286 internal_delete_file (Lisp_Object filename)
2288 Lisp_Object tem;
2290 tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
2291 Qt, internal_delete_file_1);
2292 return NILP (tem);
2295 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
2296 "fRename file: \nGRename %s to file: \np",
2297 doc: /* Rename FILE as NEWNAME. Both args must be strings.
2298 If file has names other than FILE, it continues to have those names.
2299 Signals a `file-already-exists' error if a file NEWNAME already exists
2300 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2301 A number as third arg means request confirmation if NEWNAME already exists.
2302 This is what happens in interactive use with M-x. */)
2303 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2305 Lisp_Object handler;
2306 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2307 Lisp_Object encoded_file, encoded_newname, symlink_target;
2309 symlink_target = encoded_file = encoded_newname = Qnil;
2310 GCPRO5 (file, newname, encoded_file, encoded_newname, symlink_target);
2311 CHECK_STRING (file);
2312 CHECK_STRING (newname);
2313 file = Fexpand_file_name (file, Qnil);
2315 if ((!NILP (Ffile_directory_p (newname)))
2316 #ifdef DOS_NT
2317 /* If the file names are identical but for the case,
2318 don't attempt to move directory to itself. */
2319 && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
2320 #endif
2323 Lisp_Object fname = (NILP (Ffile_directory_p (file))
2324 ? file : Fdirectory_file_name (file));
2325 newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname);
2327 else
2328 newname = Fexpand_file_name (newname, Qnil);
2330 /* If the file name has special constructs in it,
2331 call the corresponding file handler. */
2332 handler = Ffind_file_name_handler (file, Qrename_file);
2333 if (NILP (handler))
2334 handler = Ffind_file_name_handler (newname, Qrename_file);
2335 if (!NILP (handler))
2336 RETURN_UNGCPRO (call4 (handler, Qrename_file,
2337 file, newname, ok_if_already_exists));
2339 encoded_file = ENCODE_FILE (file);
2340 encoded_newname = ENCODE_FILE (newname);
2342 #ifdef DOS_NT
2343 /* If the file names are identical but for the case, don't ask for
2344 confirmation: they simply want to change the letter-case of the
2345 file name. */
2346 if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
2347 #endif
2348 if (NILP (ok_if_already_exists)
2349 || INTEGERP (ok_if_already_exists))
2350 barf_or_query_if_file_exists (newname, false, "rename to it",
2351 INTEGERP (ok_if_already_exists), false);
2352 if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
2354 int rename_errno = errno;
2355 if (rename_errno == EXDEV)
2357 ptrdiff_t count;
2358 symlink_target = Ffile_symlink_p (file);
2359 if (! NILP (symlink_target))
2360 Fmake_symbolic_link (symlink_target, newname,
2361 NILP (ok_if_already_exists) ? Qnil : Qt);
2362 else if (!NILP (Ffile_directory_p (file)))
2363 call4 (Qcopy_directory, file, newname, Qt, Qnil);
2364 else
2365 /* We have already prompted if it was an integer, so don't
2366 have copy-file prompt again. */
2367 Fcopy_file (file, newname,
2368 NILP (ok_if_already_exists) ? Qnil : Qt,
2369 Qt, Qt, Qt);
2371 count = SPECPDL_INDEX ();
2372 specbind (Qdelete_by_moving_to_trash, Qnil);
2374 if (!NILP (Ffile_directory_p (file)) && NILP (symlink_target))
2375 call2 (Qdelete_directory, file, Qt);
2376 else
2377 Fdelete_file (file, Qnil);
2378 unbind_to (count, Qnil);
2380 else
2381 report_file_errno ("Renaming", list2 (file, newname), rename_errno);
2383 UNGCPRO;
2384 return Qnil;
2387 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
2388 "fAdd name to file: \nGName to add to %s: \np",
2389 doc: /* Give FILE additional name NEWNAME. Both args must be strings.
2390 Signals a `file-already-exists' error if a file NEWNAME already exists
2391 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2392 A number as third arg means request confirmation if NEWNAME already exists.
2393 This is what happens in interactive use with M-x. */)
2394 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
2396 Lisp_Object handler;
2397 Lisp_Object encoded_file, encoded_newname;
2398 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2400 GCPRO4 (file, newname, encoded_file, encoded_newname);
2401 encoded_file = encoded_newname = Qnil;
2402 CHECK_STRING (file);
2403 CHECK_STRING (newname);
2404 file = Fexpand_file_name (file, Qnil);
2406 if (!NILP (Ffile_directory_p (newname)))
2407 newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
2408 else
2409 newname = Fexpand_file_name (newname, Qnil);
2411 /* If the file name has special constructs in it,
2412 call the corresponding file handler. */
2413 handler = Ffind_file_name_handler (file, Qadd_name_to_file);
2414 if (!NILP (handler))
2415 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
2416 newname, ok_if_already_exists));
2418 /* If the new name has special constructs in it,
2419 call the corresponding file handler. */
2420 handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
2421 if (!NILP (handler))
2422 RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
2423 newname, ok_if_already_exists));
2425 encoded_file = ENCODE_FILE (file);
2426 encoded_newname = ENCODE_FILE (newname);
2428 if (NILP (ok_if_already_exists)
2429 || INTEGERP (ok_if_already_exists))
2430 barf_or_query_if_file_exists (newname, false, "make it a new name",
2431 INTEGERP (ok_if_already_exists), false);
2433 unlink (SSDATA (newname));
2434 if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
2436 int link_errno = errno;
2437 report_file_errno ("Adding new name", list2 (file, newname), link_errno);
2440 UNGCPRO;
2441 return Qnil;
2444 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
2445 "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
2446 doc: /* Make a symbolic link to FILENAME, named LINKNAME.
2447 Both args must be strings.
2448 Signals a `file-already-exists' error if a file LINKNAME already exists
2449 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
2450 A number as third arg means request confirmation if LINKNAME already exists.
2451 This happens for interactive use with M-x. */)
2452 (Lisp_Object filename, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
2454 Lisp_Object handler;
2455 Lisp_Object encoded_filename, encoded_linkname;
2456 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2458 GCPRO4 (filename, linkname, encoded_filename, encoded_linkname);
2459 encoded_filename = encoded_linkname = Qnil;
2460 CHECK_STRING (filename);
2461 CHECK_STRING (linkname);
2462 /* If the link target has a ~, we must expand it to get
2463 a truly valid file name. Otherwise, do not expand;
2464 we want to permit links to relative file names. */
2465 if (SREF (filename, 0) == '~')
2466 filename = Fexpand_file_name (filename, Qnil);
2468 if (!NILP (Ffile_directory_p (linkname)))
2469 linkname = Fexpand_file_name (Ffile_name_nondirectory (filename), linkname);
2470 else
2471 linkname = Fexpand_file_name (linkname, Qnil);
2473 /* If the file name has special constructs in it,
2474 call the corresponding file handler. */
2475 handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
2476 if (!NILP (handler))
2477 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2478 linkname, ok_if_already_exists));
2480 /* If the new link name has special constructs in it,
2481 call the corresponding file handler. */
2482 handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
2483 if (!NILP (handler))
2484 RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
2485 linkname, ok_if_already_exists));
2487 encoded_filename = ENCODE_FILE (filename);
2488 encoded_linkname = ENCODE_FILE (linkname);
2490 if (NILP (ok_if_already_exists)
2491 || INTEGERP (ok_if_already_exists))
2492 barf_or_query_if_file_exists (linkname, false, "make it a link",
2493 INTEGERP (ok_if_already_exists), false);
2494 if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname)) < 0)
2496 /* If we didn't complain already, silently delete existing file. */
2497 int symlink_errno;
2498 if (errno == EEXIST)
2500 unlink (SSDATA (encoded_linkname));
2501 if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname))
2502 >= 0)
2504 UNGCPRO;
2505 return Qnil;
2508 if (errno == ENOSYS)
2510 UNGCPRO;
2511 xsignal1 (Qfile_error,
2512 build_string ("Symbolic links are not supported"));
2515 symlink_errno = errno;
2516 report_file_errno ("Making symbolic link", list2 (filename, linkname),
2517 symlink_errno);
2519 UNGCPRO;
2520 return Qnil;
2524 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
2525 1, 1, 0,
2526 doc: /* Return t if file FILENAME specifies an absolute file name.
2527 On Unix, this is a name starting with a `/' or a `~'. */)
2528 (Lisp_Object filename)
2530 CHECK_STRING (filename);
2531 return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
2534 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
2535 doc: /* Return t if file FILENAME exists (whether or not you can read it.)
2536 See also `file-readable-p' and `file-attributes'.
2537 This returns nil for a symlink to a nonexistent file.
2538 Use `file-symlink-p' to test for such links. */)
2539 (Lisp_Object filename)
2541 Lisp_Object absname;
2542 Lisp_Object handler;
2544 CHECK_STRING (filename);
2545 absname = Fexpand_file_name (filename, Qnil);
2547 /* If the file name has special constructs in it,
2548 call the corresponding file handler. */
2549 handler = Ffind_file_name_handler (absname, Qfile_exists_p);
2550 if (!NILP (handler))
2552 Lisp_Object result = call2 (handler, Qfile_exists_p, absname);
2553 errno = 0;
2554 return result;
2557 absname = ENCODE_FILE (absname);
2559 return check_existing (SSDATA (absname)) ? Qt : Qnil;
2562 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
2563 doc: /* Return t if FILENAME can be executed by you.
2564 For a directory, this means you can access files in that directory.
2565 \(It is generally better to use `file-accessible-directory-p' for that
2566 purpose, though.) */)
2567 (Lisp_Object filename)
2569 Lisp_Object absname;
2570 Lisp_Object handler;
2572 CHECK_STRING (filename);
2573 absname = Fexpand_file_name (filename, Qnil);
2575 /* If the file name has special constructs in it,
2576 call the corresponding file handler. */
2577 handler = Ffind_file_name_handler (absname, Qfile_executable_p);
2578 if (!NILP (handler))
2579 return call2 (handler, Qfile_executable_p, absname);
2581 absname = ENCODE_FILE (absname);
2583 return (check_executable (SSDATA (absname)) ? Qt : Qnil);
2586 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
2587 doc: /* Return t if file FILENAME exists and you can read it.
2588 See also `file-exists-p' and `file-attributes'. */)
2589 (Lisp_Object filename)
2591 Lisp_Object absname;
2592 Lisp_Object handler;
2594 CHECK_STRING (filename);
2595 absname = Fexpand_file_name (filename, Qnil);
2597 /* If the file name has special constructs in it,
2598 call the corresponding file handler. */
2599 handler = Ffind_file_name_handler (absname, Qfile_readable_p);
2600 if (!NILP (handler))
2601 return call2 (handler, Qfile_readable_p, absname);
2603 absname = ENCODE_FILE (absname);
2604 return (faccessat (AT_FDCWD, SSDATA (absname), R_OK, AT_EACCESS) == 0
2605 ? Qt : Qnil);
2608 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
2609 doc: /* Return t if file FILENAME can be written or created by you. */)
2610 (Lisp_Object filename)
2612 Lisp_Object absname, dir, encoded;
2613 Lisp_Object handler;
2615 CHECK_STRING (filename);
2616 absname = 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 (absname, Qfile_writable_p);
2621 if (!NILP (handler))
2622 return call2 (handler, Qfile_writable_p, absname);
2624 encoded = ENCODE_FILE (absname);
2625 if (check_writable (SSDATA (encoded), W_OK))
2626 return Qt;
2627 if (errno != ENOENT)
2628 return Qnil;
2630 dir = Ffile_name_directory (absname);
2631 eassert (!NILP (dir));
2632 #ifdef MSDOS
2633 dir = Fdirectory_file_name (dir);
2634 #endif /* MSDOS */
2636 dir = ENCODE_FILE (dir);
2637 #ifdef WINDOWSNT
2638 /* The read-only attribute of the parent directory doesn't affect
2639 whether a file or directory can be created within it. Some day we
2640 should check ACLs though, which do affect this. */
2641 return file_directory_p (SDATA (dir)) ? Qt : Qnil;
2642 #else
2643 return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil;
2644 #endif
2647 DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
2648 doc: /* Access file FILENAME, and get an error if that does not work.
2649 The second argument STRING is used in the error message.
2650 If there is no error, returns nil. */)
2651 (Lisp_Object filename, Lisp_Object string)
2653 Lisp_Object handler, encoded_filename, absname;
2655 CHECK_STRING (filename);
2656 absname = Fexpand_file_name (filename, Qnil);
2658 CHECK_STRING (string);
2660 /* If the file name has special constructs in it,
2661 call the corresponding file handler. */
2662 handler = Ffind_file_name_handler (absname, Qaccess_file);
2663 if (!NILP (handler))
2664 return call3 (handler, Qaccess_file, absname, string);
2666 encoded_filename = ENCODE_FILE (absname);
2668 if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0)
2669 report_file_error (SSDATA (string), filename);
2671 return Qnil;
2674 /* Relative to directory FD, return the symbolic link value of FILENAME.
2675 On failure, return nil. */
2676 Lisp_Object
2677 emacs_readlinkat (int fd, char const *filename)
2679 static struct allocator const emacs_norealloc_allocator =
2680 { xmalloc, NULL, xfree, memory_full };
2681 Lisp_Object val;
2682 char readlink_buf[1024];
2683 char *buf = careadlinkat (fd, filename, readlink_buf, sizeof readlink_buf,
2684 &emacs_norealloc_allocator, readlinkat);
2685 if (!buf)
2686 return Qnil;
2688 val = build_unibyte_string (buf);
2689 if (buf[0] == '/' && strchr (buf, ':'))
2690 val = concat2 (build_unibyte_string ("/:"), val);
2691 if (buf != readlink_buf)
2692 xfree (buf);
2693 val = DECODE_FILE (val);
2694 return val;
2697 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
2698 doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
2699 The value is the link target, as a string.
2700 Otherwise it returns nil.
2702 This function does not check whether the link target exists. */)
2703 (Lisp_Object filename)
2705 Lisp_Object handler;
2707 CHECK_STRING (filename);
2708 filename = Fexpand_file_name (filename, Qnil);
2710 /* If the file name has special constructs in it,
2711 call the corresponding file handler. */
2712 handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
2713 if (!NILP (handler))
2714 return call2 (handler, Qfile_symlink_p, filename);
2716 filename = ENCODE_FILE (filename);
2718 return emacs_readlinkat (AT_FDCWD, SSDATA (filename));
2721 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
2722 doc: /* Return t if FILENAME names an existing directory.
2723 Symbolic links to directories count as directories.
2724 See `file-symlink-p' to distinguish symlinks. */)
2725 (Lisp_Object filename)
2727 Lisp_Object absname;
2728 Lisp_Object handler;
2730 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
2732 /* If the file name has special constructs in it,
2733 call the corresponding file handler. */
2734 handler = Ffind_file_name_handler (absname, Qfile_directory_p);
2735 if (!NILP (handler))
2736 return call2 (handler, Qfile_directory_p, absname);
2738 absname = ENCODE_FILE (absname);
2740 return file_directory_p (SSDATA (absname)) ? Qt : Qnil;
2743 /* Return true if FILE is a directory or a symlink to a directory. */
2744 bool
2745 file_directory_p (char const *file)
2747 #ifdef WINDOWSNT
2748 /* This is cheaper than 'stat'. */
2749 return faccessat (AT_FDCWD, file, D_OK, AT_EACCESS) == 0;
2750 #else
2751 struct stat st;
2752 return stat (file, &st) == 0 && S_ISDIR (st.st_mode);
2753 #endif
2756 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p,
2757 Sfile_accessible_directory_p, 1, 1, 0,
2758 doc: /* Return t if file FILENAME names a directory you can open.
2759 For the value to be t, FILENAME must specify the name of a directory as a file,
2760 and the directory must allow you to open files in it. In order to use a
2761 directory as a buffer's current directory, this predicate must return true.
2762 A directory name spec may be given instead; then the value is t
2763 if the directory so specified exists and really is a readable and
2764 searchable directory. */)
2765 (Lisp_Object filename)
2767 Lisp_Object absname;
2768 Lisp_Object handler;
2770 CHECK_STRING (filename);
2771 absname = Fexpand_file_name (filename, Qnil);
2773 /* If the file name has special constructs in it,
2774 call the corresponding file handler. */
2775 handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p);
2776 if (!NILP (handler))
2778 Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
2779 errno = 0;
2780 return r;
2783 absname = ENCODE_FILE (absname);
2784 return file_accessible_directory_p (absname) ? Qt : Qnil;
2787 /* If FILE is a searchable directory or a symlink to a
2788 searchable directory, return true. Otherwise return
2789 false and set errno to an error number. */
2790 bool
2791 file_accessible_directory_p (Lisp_Object file)
2793 #ifdef DOS_NT
2794 /* There's no need to test whether FILE is searchable, as the
2795 searchable/executable bit is invented on DOS_NT platforms. */
2796 return file_directory_p (SSDATA (file));
2797 #else
2798 /* On POSIXish platforms, use just one system call; this avoids a
2799 race and is typically faster. */
2800 const char *data = SSDATA (file);
2801 ptrdiff_t len = SBYTES (file);
2802 char const *dir;
2803 bool ok;
2804 int saved_errno;
2805 USE_SAFE_ALLOCA;
2807 /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
2808 There are three exceptions: "", "/", and "//". Leave "" alone,
2809 as it's invalid. Append only "." to the other two exceptions as
2810 "/" and "//" are distinct on some platforms, whereas "/", "///",
2811 "////", etc. are all equivalent. */
2812 if (! len)
2813 dir = data;
2814 else
2816 /* Just check for trailing '/' when deciding whether to append '/'.
2817 That's simpler than testing the two special cases "/" and "//",
2818 and it's a safe optimization here. */
2819 char *buf = SAFE_ALLOCA (len + 3);
2820 memcpy (buf, data, len);
2821 strcpy (buf + len, &"/."[data[len - 1] == '/']);
2822 dir = buf;
2825 ok = check_existing (dir);
2826 saved_errno = errno;
2827 SAFE_FREE ();
2828 errno = saved_errno;
2829 return ok;
2830 #endif
2833 DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
2834 doc: /* Return t if FILENAME names a regular file.
2835 This is the sort of file that holds an ordinary stream of data bytes.
2836 Symbolic links to regular files count as regular files.
2837 See `file-symlink-p' to distinguish symlinks. */)
2838 (Lisp_Object filename)
2840 register Lisp_Object absname;
2841 struct stat st;
2842 Lisp_Object handler;
2844 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
2846 /* If the file name has special constructs in it,
2847 call the corresponding file handler. */
2848 handler = Ffind_file_name_handler (absname, Qfile_regular_p);
2849 if (!NILP (handler))
2850 return call2 (handler, Qfile_regular_p, absname);
2852 absname = ENCODE_FILE (absname);
2854 #ifdef WINDOWSNT
2856 int result;
2857 Lisp_Object tem = Vw32_get_true_file_attributes;
2859 /* Tell stat to use expensive method to get accurate info. */
2860 Vw32_get_true_file_attributes = Qt;
2861 result = stat (SDATA (absname), &st);
2862 Vw32_get_true_file_attributes = tem;
2864 if (result < 0)
2865 return Qnil;
2866 return S_ISREG (st.st_mode) ? Qt : Qnil;
2868 #else
2869 if (stat (SSDATA (absname), &st) < 0)
2870 return Qnil;
2871 return S_ISREG (st.st_mode) ? Qt : Qnil;
2872 #endif
2875 DEFUN ("file-selinux-context", Ffile_selinux_context,
2876 Sfile_selinux_context, 1, 1, 0,
2877 doc: /* Return SELinux context of file named FILENAME.
2878 The return value is a list (USER ROLE TYPE RANGE), where the list
2879 elements are strings naming the user, role, type, and range of the
2880 file's SELinux security context.
2882 Return (nil nil nil nil) if the file is nonexistent or inaccessible,
2883 or if SELinux is disabled, or if Emacs lacks SELinux support. */)
2884 (Lisp_Object filename)
2886 Lisp_Object absname;
2887 Lisp_Object values[4];
2888 Lisp_Object handler;
2889 #if HAVE_LIBSELINUX
2890 security_context_t con;
2891 int conlength;
2892 context_t context;
2893 #endif
2895 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
2897 /* If the file name has special constructs in it,
2898 call the corresponding file handler. */
2899 handler = Ffind_file_name_handler (absname, Qfile_selinux_context);
2900 if (!NILP (handler))
2901 return call2 (handler, Qfile_selinux_context, absname);
2903 absname = ENCODE_FILE (absname);
2905 values[0] = Qnil;
2906 values[1] = Qnil;
2907 values[2] = Qnil;
2908 values[3] = Qnil;
2909 #if HAVE_LIBSELINUX
2910 if (is_selinux_enabled ())
2912 conlength = lgetfilecon (SSDATA (absname), &con);
2913 if (conlength > 0)
2915 context = context_new (con);
2916 if (context_user_get (context))
2917 values[0] = build_string (context_user_get (context));
2918 if (context_role_get (context))
2919 values[1] = build_string (context_role_get (context));
2920 if (context_type_get (context))
2921 values[2] = build_string (context_type_get (context));
2922 if (context_range_get (context))
2923 values[3] = build_string (context_range_get (context));
2924 context_free (context);
2925 freecon (con);
2928 #endif
2930 return Flist (ARRAYELTS (values), values);
2933 DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
2934 Sset_file_selinux_context, 2, 2, 0,
2935 doc: /* Set SELinux context of file named FILENAME to CONTEXT.
2936 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2937 elements are strings naming the components of a SELinux context.
2939 Value is t if setting of SELinux context was successful, nil otherwise.
2941 This function does nothing and returns nil if SELinux is disabled,
2942 or if Emacs was not compiled with SELinux support. */)
2943 (Lisp_Object filename, Lisp_Object context)
2945 Lisp_Object absname;
2946 Lisp_Object handler;
2947 #if HAVE_LIBSELINUX
2948 Lisp_Object encoded_absname;
2949 Lisp_Object user = CAR_SAFE (context);
2950 Lisp_Object role = CAR_SAFE (CDR_SAFE (context));
2951 Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
2952 Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
2953 security_context_t con;
2954 bool fail;
2955 int conlength;
2956 context_t parsed_con;
2957 #endif
2959 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
2961 /* If the file name has special constructs in it,
2962 call the corresponding file handler. */
2963 handler = Ffind_file_name_handler (absname, Qset_file_selinux_context);
2964 if (!NILP (handler))
2965 return call3 (handler, Qset_file_selinux_context, absname, context);
2967 #if HAVE_LIBSELINUX
2968 if (is_selinux_enabled ())
2970 /* Get current file context. */
2971 encoded_absname = ENCODE_FILE (absname);
2972 conlength = lgetfilecon (SSDATA (encoded_absname), &con);
2973 if (conlength > 0)
2975 parsed_con = context_new (con);
2976 /* Change the parts defined in the parameter.*/
2977 if (STRINGP (user))
2979 if (context_user_set (parsed_con, SSDATA (user)))
2980 error ("Doing context_user_set");
2982 if (STRINGP (role))
2984 if (context_role_set (parsed_con, SSDATA (role)))
2985 error ("Doing context_role_set");
2987 if (STRINGP (type))
2989 if (context_type_set (parsed_con, SSDATA (type)))
2990 error ("Doing context_type_set");
2992 if (STRINGP (range))
2994 if (context_range_set (parsed_con, SSDATA (range)))
2995 error ("Doing context_range_set");
2998 /* Set the modified context back to the file. */
2999 fail = (lsetfilecon (SSDATA (encoded_absname),
3000 context_str (parsed_con))
3001 != 0);
3002 /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
3003 if (fail && errno != ENOTSUP)
3004 report_file_error ("Doing lsetfilecon", absname);
3006 context_free (parsed_con);
3007 freecon (con);
3008 return fail ? Qnil : Qt;
3010 else
3011 report_file_error ("Doing lgetfilecon", absname);
3013 #endif
3015 return Qnil;
3018 DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0,
3019 doc: /* Return ACL entries of file named FILENAME.
3020 The entries are returned in a format suitable for use in `set-file-acl'
3021 but is otherwise undocumented and subject to change.
3022 Return nil if file does not exist or is not accessible, or if Emacs
3023 was unable to determine the ACL entries. */)
3024 (Lisp_Object filename)
3026 Lisp_Object absname;
3027 Lisp_Object handler;
3028 #ifdef HAVE_ACL_SET_FILE
3029 acl_t acl;
3030 Lisp_Object acl_string;
3031 char *str;
3032 # ifndef HAVE_ACL_TYPE_EXTENDED
3033 acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS;
3034 # endif
3035 #endif
3037 absname = expand_and_dir_to_file (filename,
3038 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_acl);
3043 if (!NILP (handler))
3044 return call2 (handler, Qfile_acl, absname);
3046 #ifdef HAVE_ACL_SET_FILE
3047 absname = ENCODE_FILE (absname);
3049 acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED);
3050 if (acl == NULL)
3051 return Qnil;
3053 str = acl_to_text (acl, NULL);
3054 if (str == NULL)
3056 acl_free (acl);
3057 return Qnil;
3060 acl_string = build_string (str);
3061 acl_free (str);
3062 acl_free (acl);
3064 return acl_string;
3065 #endif
3067 return Qnil;
3070 DEFUN ("set-file-acl", Fset_file_acl, Sset_file_acl,
3071 2, 2, 0,
3072 doc: /* Set ACL of file named FILENAME to ACL-STRING.
3073 ACL-STRING should contain the textual representation of the ACL
3074 entries in a format suitable for the platform.
3076 Value is t if setting of ACL was successful, nil otherwise.
3078 Setting ACL for local files requires Emacs to be built with ACL
3079 support. */)
3080 (Lisp_Object filename, Lisp_Object acl_string)
3082 Lisp_Object absname;
3083 Lisp_Object handler;
3084 #ifdef HAVE_ACL_SET_FILE
3085 Lisp_Object encoded_absname;
3086 acl_t acl;
3087 bool fail;
3088 #endif
3090 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3092 /* If the file name has special constructs in it,
3093 call the corresponding file handler. */
3094 handler = Ffind_file_name_handler (absname, Qset_file_acl);
3095 if (!NILP (handler))
3096 return call3 (handler, Qset_file_acl, absname, acl_string);
3098 #ifdef HAVE_ACL_SET_FILE
3099 if (STRINGP (acl_string))
3101 acl = acl_from_text (SSDATA (acl_string));
3102 if (acl == NULL)
3104 report_file_error ("Converting ACL", absname);
3105 return Qnil;
3108 encoded_absname = ENCODE_FILE (absname);
3110 fail = (acl_set_file (SSDATA (encoded_absname), ACL_TYPE_ACCESS,
3111 acl)
3112 != 0);
3113 if (fail && acl_errno_valid (errno))
3114 report_file_error ("Setting ACL", absname);
3116 acl_free (acl);
3117 return fail ? Qnil : Qt;
3119 #endif
3121 return Qnil;
3124 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
3125 doc: /* Return mode bits of file named FILENAME, as an integer.
3126 Return nil, if file does not exist or is not accessible. */)
3127 (Lisp_Object filename)
3129 Lisp_Object absname;
3130 struct stat st;
3131 Lisp_Object handler;
3133 absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
3135 /* If the file name has special constructs in it,
3136 call the corresponding file handler. */
3137 handler = Ffind_file_name_handler (absname, Qfile_modes);
3138 if (!NILP (handler))
3139 return call2 (handler, Qfile_modes, absname);
3141 absname = ENCODE_FILE (absname);
3143 if (stat (SSDATA (absname), &st) < 0)
3144 return Qnil;
3146 return make_number (st.st_mode & 07777);
3149 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2,
3150 "(let ((file (read-file-name \"File: \"))) \
3151 (list file (read-file-modes nil file)))",
3152 doc: /* Set mode bits of file named FILENAME to MODE (an integer).
3153 Only the 12 low bits of MODE are used.
3155 Interactively, mode bits are read by `read-file-modes', which accepts
3156 symbolic notation, like the `chmod' command from GNU Coreutils. */)
3157 (Lisp_Object filename, Lisp_Object mode)
3159 Lisp_Object absname, encoded_absname;
3160 Lisp_Object handler;
3162 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3163 CHECK_NUMBER (mode);
3165 /* If the file name has special constructs in it,
3166 call the corresponding file handler. */
3167 handler = Ffind_file_name_handler (absname, Qset_file_modes);
3168 if (!NILP (handler))
3169 return call3 (handler, Qset_file_modes, absname, mode);
3171 encoded_absname = ENCODE_FILE (absname);
3173 if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
3174 report_file_error ("Doing chmod", absname);
3176 return Qnil;
3179 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
3180 doc: /* Set the file permission bits for newly created files.
3181 The argument MODE should be an integer; only the low 9 bits are used.
3182 This setting is inherited by subprocesses. */)
3183 (Lisp_Object mode)
3185 mode_t oldrealmask, oldumask, newumask;
3186 CHECK_NUMBER (mode);
3187 oldrealmask = realmask;
3188 newumask = ~ XINT (mode) & 0777;
3190 block_input ();
3191 realmask = newumask;
3192 oldumask = umask (newumask);
3193 unblock_input ();
3195 eassert (oldumask == oldrealmask);
3196 return Qnil;
3199 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
3200 doc: /* Return the default file protection for created files.
3201 The value is an integer. */)
3202 (void)
3204 Lisp_Object value;
3205 XSETINT (value, (~ realmask) & 0777);
3206 return value;
3210 DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
3211 doc: /* Set times of file FILENAME to TIMESTAMP.
3212 Set both access and modification times.
3213 Return t on success, else nil.
3214 Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3215 `current-time'. */)
3216 (Lisp_Object filename, Lisp_Object timestamp)
3218 Lisp_Object absname, encoded_absname;
3219 Lisp_Object handler;
3220 struct timespec t = lisp_time_argument (timestamp);
3222 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3224 /* If the file name has special constructs in it,
3225 call the corresponding file handler. */
3226 handler = Ffind_file_name_handler (absname, Qset_file_times);
3227 if (!NILP (handler))
3228 return call3 (handler, Qset_file_times, absname, timestamp);
3230 encoded_absname = ENCODE_FILE (absname);
3233 if (set_file_times (-1, SSDATA (encoded_absname), t, t) != 0)
3235 #ifdef MSDOS
3236 /* Setting times on a directory always fails. */
3237 if (file_directory_p (SSDATA (encoded_absname)))
3238 return Qnil;
3239 #endif
3240 report_file_error ("Setting file times", absname);
3244 return Qt;
3247 #ifdef HAVE_SYNC
3248 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
3249 doc: /* Tell Unix to finish all pending disk updates. */)
3250 (void)
3252 sync ();
3253 return Qnil;
3256 #endif /* HAVE_SYNC */
3258 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
3259 doc: /* Return t if file FILE1 is newer than file FILE2.
3260 If FILE1 does not exist, the answer is nil;
3261 otherwise, if FILE2 does not exist, the answer is t. */)
3262 (Lisp_Object file1, Lisp_Object file2)
3264 Lisp_Object absname1, absname2;
3265 struct stat st1, st2;
3266 Lisp_Object handler;
3267 struct gcpro gcpro1, gcpro2;
3269 CHECK_STRING (file1);
3270 CHECK_STRING (file2);
3272 absname1 = Qnil;
3273 GCPRO2 (absname1, file2);
3274 absname1 = expand_and_dir_to_file (file1, BVAR (current_buffer, directory));
3275 absname2 = expand_and_dir_to_file (file2, BVAR (current_buffer, directory));
3276 UNGCPRO;
3278 /* If the file name has special constructs in it,
3279 call the corresponding file handler. */
3280 handler = Ffind_file_name_handler (absname1, Qfile_newer_than_file_p);
3281 if (NILP (handler))
3282 handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p);
3283 if (!NILP (handler))
3284 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
3286 GCPRO2 (absname1, absname2);
3287 absname1 = ENCODE_FILE (absname1);
3288 absname2 = ENCODE_FILE (absname2);
3289 UNGCPRO;
3291 if (stat (SSDATA (absname1), &st1) < 0)
3292 return Qnil;
3294 if (stat (SSDATA (absname2), &st2) < 0)
3295 return Qt;
3297 return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0
3298 ? Qt : Qnil);
3301 #ifndef READ_BUF_SIZE
3302 #define READ_BUF_SIZE (64 << 10)
3303 #endif
3304 /* Some buffer offsets are stored in 'int' variables. */
3305 verify (READ_BUF_SIZE <= INT_MAX);
3307 /* This function is called after Lisp functions to decide a coding
3308 system are called, or when they cause an error. Before they are
3309 called, the current buffer is set unibyte and it contains only a
3310 newly inserted text (thus the buffer was empty before the
3311 insertion).
3313 The functions may set markers, overlays, text properties, or even
3314 alter the buffer contents, change the current buffer.
3316 Here, we reset all those changes by:
3317 o set back the current buffer.
3318 o move all markers and overlays to BEG.
3319 o remove all text properties.
3320 o set back the buffer multibyteness. */
3322 static void
3323 decide_coding_unwind (Lisp_Object unwind_data)
3325 Lisp_Object multibyte, undo_list, buffer;
3327 multibyte = XCAR (unwind_data);
3328 unwind_data = XCDR (unwind_data);
3329 undo_list = XCAR (unwind_data);
3330 buffer = XCDR (unwind_data);
3332 set_buffer_internal (XBUFFER (buffer));
3333 adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
3334 adjust_overlays_for_delete (BEG, Z - BEG);
3335 set_buffer_intervals (current_buffer, NULL);
3336 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3338 /* Now we are safe to change the buffer's multibyteness directly. */
3339 bset_enable_multibyte_characters (current_buffer, multibyte);
3340 bset_undo_list (current_buffer, undo_list);
3343 /* Read from a non-regular file. STATE is a Lisp_Save_Value
3344 object where slot 0 is the file descriptor, slot 1 specifies
3345 an offset to put the read bytes, and slot 2 is the maximum
3346 amount of bytes to read. Value is the number of bytes read. */
3348 static Lisp_Object
3349 read_non_regular (Lisp_Object state)
3351 int nbytes;
3353 immediate_quit = 1;
3354 QUIT;
3355 nbytes = emacs_read (XSAVE_INTEGER (state, 0),
3356 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3357 + XSAVE_INTEGER (state, 1)),
3358 XSAVE_INTEGER (state, 2));
3359 immediate_quit = 0;
3360 /* Fast recycle this object for the likely next call. */
3361 free_misc (state);
3362 return make_number (nbytes);
3366 /* Condition-case handler used when reading from non-regular files
3367 in insert-file-contents. */
3369 static Lisp_Object
3370 read_non_regular_quit (Lisp_Object ignore)
3372 return Qnil;
3375 /* Return the file offset that VAL represents, checking for type
3376 errors and overflow. */
3377 static off_t
3378 file_offset (Lisp_Object val)
3380 if (RANGED_INTEGERP (0, val, TYPE_MAXIMUM (off_t)))
3381 return XINT (val);
3383 if (FLOATP (val))
3385 double v = XFLOAT_DATA (val);
3386 if (0 <= v
3387 && (sizeof (off_t) < sizeof v
3388 ? v <= TYPE_MAXIMUM (off_t)
3389 : v < TYPE_MAXIMUM (off_t)))
3390 return v;
3393 wrong_type_argument (intern ("file-offset"), val);
3396 /* Return a special time value indicating the error number ERRNUM. */
3397 static struct timespec
3398 time_error_value (int errnum)
3400 int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR
3401 ? NONEXISTENT_MODTIME_NSECS
3402 : UNKNOWN_MODTIME_NSECS);
3403 return make_timespec (0, ns);
3406 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
3407 1, 5, 0,
3408 doc: /* Insert contents of file FILENAME after point.
3409 Returns list of absolute file name and number of characters inserted.
3410 If second argument VISIT is non-nil, the buffer's visited filename and
3411 last save file modtime are set, and it is marked unmodified. If
3412 visiting and the file does not exist, visiting is completed before the
3413 error is signaled.
3415 The optional third and fourth arguments BEG and END specify what portion
3416 of the file to insert. These arguments count bytes in the file, not
3417 characters in the buffer. If VISIT is non-nil, BEG and END must be nil.
3419 If optional fifth argument REPLACE is non-nil, replace the current
3420 buffer contents (in the accessible portion) with the file contents.
3421 This is better than simply deleting and inserting the whole thing
3422 because (1) it preserves some marker positions and (2) it puts less data
3423 in the undo list. When REPLACE is non-nil, the second return value is
3424 the number of characters that replace previous buffer contents.
3426 This function does code conversion according to the value of
3427 `coding-system-for-read' or `file-coding-system-alist', and sets the
3428 variable `last-coding-system-used' to the coding system actually used.
3430 In addition, this function decodes the inserted text from known formats
3431 by calling `format-decode', which see. */)
3432 (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
3434 struct stat st;
3435 struct timespec mtime;
3436 int fd;
3437 ptrdiff_t inserted = 0;
3438 ptrdiff_t how_much;
3439 off_t beg_offset, end_offset;
3440 int unprocessed;
3441 ptrdiff_t count = SPECPDL_INDEX ();
3442 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
3443 Lisp_Object handler, val, insval, orig_filename, old_undo;
3444 Lisp_Object p;
3445 ptrdiff_t total = 0;
3446 bool not_regular = 0;
3447 int save_errno = 0;
3448 char read_buf[READ_BUF_SIZE];
3449 struct coding_system coding;
3450 bool replace_handled = 0;
3451 bool set_coding_system = 0;
3452 Lisp_Object coding_system;
3453 bool read_quit = 0;
3454 /* If the undo log only contains the insertion, there's no point
3455 keeping it. It's typically when we first fill a file-buffer. */
3456 bool empty_undo_list_p
3457 = (!NILP (visit) && NILP (BVAR (current_buffer, undo_list))
3458 && BEG == Z);
3459 Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
3460 bool we_locked_file = 0;
3461 ptrdiff_t fd_index;
3463 if (current_buffer->base_buffer && ! NILP (visit))
3464 error ("Cannot do file visiting in an indirect buffer");
3466 if (!NILP (BVAR (current_buffer, read_only)))
3467 Fbarf_if_buffer_read_only ();
3469 val = Qnil;
3470 p = Qnil;
3471 orig_filename = Qnil;
3472 old_undo = Qnil;
3474 GCPRO5 (filename, val, p, orig_filename, old_undo);
3476 CHECK_STRING (filename);
3477 filename = Fexpand_file_name (filename, Qnil);
3479 /* The value Qnil means that the coding system is not yet
3480 decided. */
3481 coding_system = Qnil;
3483 /* If the file name has special constructs in it,
3484 call the corresponding file handler. */
3485 handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
3486 if (!NILP (handler))
3488 val = call6 (handler, Qinsert_file_contents, filename,
3489 visit, beg, end, replace);
3490 if (CONSP (val) && CONSP (XCDR (val))
3491 && RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT))
3492 inserted = XINT (XCAR (XCDR (val)));
3493 goto handled;
3496 orig_filename = filename;
3497 filename = ENCODE_FILE (filename);
3499 fd = emacs_open (SSDATA (filename), O_RDONLY, 0);
3500 if (fd < 0)
3502 save_errno = errno;
3503 if (NILP (visit))
3504 report_file_error ("Opening input file", orig_filename);
3505 mtime = time_error_value (save_errno);
3506 st.st_size = -1;
3507 if (!NILP (Vcoding_system_for_read))
3508 Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
3509 goto notfound;
3512 fd_index = SPECPDL_INDEX ();
3513 record_unwind_protect_int (close_file_unwind, fd);
3515 /* Replacement should preserve point as it preserves markers. */
3516 if (!NILP (replace))
3517 record_unwind_protect (restore_point_unwind, Fpoint_marker ());
3519 if (fstat (fd, &st) != 0)
3520 report_file_error ("Input file status", orig_filename);
3521 mtime = get_stat_mtime (&st);
3523 /* This code will need to be changed in order to work on named
3524 pipes, and it's probably just not worth it. So we should at
3525 least signal an error. */
3526 if (!S_ISREG (st.st_mode))
3528 not_regular = 1;
3530 if (! NILP (visit))
3531 goto notfound;
3533 if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
3534 xsignal2 (Qfile_error,
3535 build_string ("not a regular file"), orig_filename);
3538 if (!NILP (visit))
3540 if (!NILP (beg) || !NILP (end))
3541 error ("Attempt to visit less than an entire file");
3542 if (BEG < Z && NILP (replace))
3543 error ("Cannot do file visiting in a non-empty buffer");
3546 if (!NILP (beg))
3547 beg_offset = file_offset (beg);
3548 else
3549 beg_offset = 0;
3551 if (!NILP (end))
3552 end_offset = file_offset (end);
3553 else
3555 if (not_regular)
3556 end_offset = TYPE_MAXIMUM (off_t);
3557 else
3559 end_offset = st.st_size;
3561 /* A negative size can happen on a platform that allows file
3562 sizes greater than the maximum off_t value. */
3563 if (end_offset < 0)
3564 buffer_overflow ();
3566 /* The file size returned from stat may be zero, but data
3567 may be readable nonetheless, for example when this is a
3568 file in the /proc filesystem. */
3569 if (end_offset == 0)
3570 end_offset = READ_BUF_SIZE;
3574 /* Check now whether the buffer will become too large,
3575 in the likely case where the file's length is not changing.
3576 This saves a lot of needless work before a buffer overflow. */
3577 if (! not_regular)
3579 /* The likely offset where we will stop reading. We could read
3580 more (or less), if the file grows (or shrinks) as we read it. */
3581 off_t likely_end = min (end_offset, st.st_size);
3583 if (beg_offset < likely_end)
3585 ptrdiff_t buf_bytes
3586 = Z_BYTE - (!NILP (replace) ? ZV_BYTE - BEGV_BYTE : 0);
3587 ptrdiff_t buf_growth_max = BUF_BYTES_MAX - buf_bytes;
3588 off_t likely_growth = likely_end - beg_offset;
3589 if (buf_growth_max < likely_growth)
3590 buffer_overflow ();
3594 /* Prevent redisplay optimizations. */
3595 current_buffer->clip_changed = 1;
3597 if (EQ (Vcoding_system_for_read, Qauto_save_coding))
3599 coding_system = coding_inherit_eol_type (Qutf_8_emacs, Qunix);
3600 setup_coding_system (coding_system, &coding);
3601 /* Ensure we set Vlast_coding_system_used. */
3602 set_coding_system = 1;
3604 else if (BEG < Z)
3606 /* Decide the coding system to use for reading the file now
3607 because we can't use an optimized method for handling
3608 `coding:' tag if the current buffer is not empty. */
3609 if (!NILP (Vcoding_system_for_read))
3610 coding_system = Vcoding_system_for_read;
3611 else
3613 /* Don't try looking inside a file for a coding system
3614 specification if it is not seekable. */
3615 if (! not_regular && ! NILP (Vset_auto_coding_function))
3617 /* Find a coding system specified in the heading two
3618 lines or in the tailing several lines of the file.
3619 We assume that the 1K-byte and 3K-byte for heading
3620 and tailing respectively are sufficient for this
3621 purpose. */
3622 int nread;
3624 if (st.st_size <= (1024 * 4))
3625 nread = emacs_read (fd, read_buf, 1024 * 4);
3626 else
3628 nread = emacs_read (fd, read_buf, 1024);
3629 if (nread == 1024)
3631 int ntail;
3632 if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
3633 report_file_error ("Setting file position",
3634 orig_filename);
3635 ntail = emacs_read (fd, read_buf + nread, 1024 * 3);
3636 nread = ntail < 0 ? ntail : nread + ntail;
3640 if (nread < 0)
3641 report_file_error ("Read error", orig_filename);
3642 else if (nread > 0)
3644 struct buffer *prev = current_buffer;
3645 Lisp_Object workbuf;
3646 struct buffer *buf;
3648 record_unwind_current_buffer ();
3650 workbuf = Fget_buffer_create (build_string (" *code-converting-work*"));
3651 buf = XBUFFER (workbuf);
3653 delete_all_overlays (buf);
3654 bset_directory (buf, BVAR (current_buffer, directory));
3655 bset_read_only (buf, Qnil);
3656 bset_filename (buf, Qnil);
3657 bset_undo_list (buf, Qt);
3658 eassert (buf->overlays_before == NULL);
3659 eassert (buf->overlays_after == NULL);
3661 set_buffer_internal (buf);
3662 Ferase_buffer ();
3663 bset_enable_multibyte_characters (buf, Qnil);
3665 insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
3666 TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
3667 coding_system = call2 (Vset_auto_coding_function,
3668 filename, make_number (nread));
3669 set_buffer_internal (prev);
3671 /* Discard the unwind protect for recovering the
3672 current buffer. */
3673 specpdl_ptr--;
3675 /* Rewind the file for the actual read done later. */
3676 if (lseek (fd, 0, SEEK_SET) < 0)
3677 report_file_error ("Setting file position", orig_filename);
3681 if (NILP (coding_system))
3683 /* If we have not yet decided a coding system, check
3684 file-coding-system-alist. */
3685 Lisp_Object args[6];
3687 args[0] = Qinsert_file_contents, args[1] = orig_filename;
3688 args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace;
3689 coding_system = Ffind_operation_coding_system (6, args);
3690 if (CONSP (coding_system))
3691 coding_system = XCAR (coding_system);
3695 if (NILP (coding_system))
3696 coding_system = Qundecided;
3697 else
3698 CHECK_CODING_SYSTEM (coding_system);
3700 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3701 /* We must suppress all character code conversion except for
3702 end-of-line conversion. */
3703 coding_system = raw_text_coding_system (coding_system);
3705 setup_coding_system (coding_system, &coding);
3706 /* Ensure we set Vlast_coding_system_used. */
3707 set_coding_system = 1;
3710 /* If requested, replace the accessible part of the buffer
3711 with the file contents. Avoid replacing text at the
3712 beginning or end of the buffer that matches the file contents;
3713 that preserves markers pointing to the unchanged parts.
3715 Here we implement this feature in an optimized way
3716 for the case where code conversion is NOT needed.
3717 The following if-statement handles the case of conversion
3718 in a less optimal way.
3720 If the code conversion is "automatic" then we try using this
3721 method and hope for the best.
3722 But if we discover the need for conversion, we give up on this method
3723 and let the following if-statement handle the replace job. */
3724 if (!NILP (replace)
3725 && BEGV < ZV
3726 && (NILP (coding_system)
3727 || ! CODING_REQUIRE_DECODING (&coding)))
3729 /* same_at_start and same_at_end count bytes,
3730 because file access counts bytes
3731 and BEG and END count bytes. */
3732 ptrdiff_t same_at_start = BEGV_BYTE;
3733 ptrdiff_t same_at_end = ZV_BYTE;
3734 ptrdiff_t overlap;
3735 /* There is still a possibility we will find the need to do code
3736 conversion. If that happens, set this variable to
3737 give up on handling REPLACE in the optimized way. */
3738 bool giveup_match_end = 0;
3740 if (beg_offset != 0)
3742 if (lseek (fd, beg_offset, SEEK_SET) < 0)
3743 report_file_error ("Setting file position", orig_filename);
3746 immediate_quit = 1;
3747 QUIT;
3748 /* Count how many chars at the start of the file
3749 match the text at the beginning of the buffer. */
3750 while (1)
3752 int nread, bufpos;
3754 nread = emacs_read (fd, read_buf, sizeof read_buf);
3755 if (nread < 0)
3756 report_file_error ("Read error", orig_filename);
3757 else if (nread == 0)
3758 break;
3760 if (CODING_REQUIRE_DETECTION (&coding))
3762 coding_system = detect_coding_system ((unsigned char *) read_buf,
3763 nread, nread, 1, 0,
3764 coding_system);
3765 setup_coding_system (coding_system, &coding);
3768 if (CODING_REQUIRE_DECODING (&coding))
3769 /* We found that the file should be decoded somehow.
3770 Let's give up here. */
3772 giveup_match_end = 1;
3773 break;
3776 bufpos = 0;
3777 while (bufpos < nread && same_at_start < ZV_BYTE
3778 && FETCH_BYTE (same_at_start) == read_buf[bufpos])
3779 same_at_start++, bufpos++;
3780 /* If we found a discrepancy, stop the scan.
3781 Otherwise loop around and scan the next bufferful. */
3782 if (bufpos != nread)
3783 break;
3785 immediate_quit = 0;
3786 /* If the file matches the buffer completely,
3787 there's no need to replace anything. */
3788 if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
3790 emacs_close (fd);
3791 clear_unwind_protect (fd_index);
3793 /* Truncate the buffer to the size of the file. */
3794 del_range_1 (same_at_start, same_at_end, 0, 0);
3795 goto handled;
3797 immediate_quit = 1;
3798 QUIT;
3799 /* Count how many chars at the end of the file
3800 match the text at the end of the buffer. But, if we have
3801 already found that decoding is necessary, don't waste time. */
3802 while (!giveup_match_end)
3804 int total_read, nread, bufpos, trial;
3805 off_t curpos;
3807 /* At what file position are we now scanning? */
3808 curpos = end_offset - (ZV_BYTE - same_at_end);
3809 /* If the entire file matches the buffer tail, stop the scan. */
3810 if (curpos == 0)
3811 break;
3812 /* How much can we scan in the next step? */
3813 trial = min (curpos, sizeof read_buf);
3814 if (lseek (fd, curpos - trial, SEEK_SET) < 0)
3815 report_file_error ("Setting file position", orig_filename);
3817 total_read = nread = 0;
3818 while (total_read < trial)
3820 nread = emacs_read (fd, read_buf + total_read, trial - total_read);
3821 if (nread < 0)
3822 report_file_error ("Read error", orig_filename);
3823 else if (nread == 0)
3824 break;
3825 total_read += nread;
3828 /* Scan this bufferful from the end, comparing with
3829 the Emacs buffer. */
3830 bufpos = total_read;
3832 /* Compare with same_at_start to avoid counting some buffer text
3833 as matching both at the file's beginning and at the end. */
3834 while (bufpos > 0 && same_at_end > same_at_start
3835 && FETCH_BYTE (same_at_end - 1) == read_buf[bufpos - 1])
3836 same_at_end--, bufpos--;
3838 /* If we found a discrepancy, stop the scan.
3839 Otherwise loop around and scan the preceding bufferful. */
3840 if (bufpos != 0)
3842 /* If this discrepancy is because of code conversion,
3843 we cannot use this method; giveup and try the other. */
3844 if (same_at_end > same_at_start
3845 && FETCH_BYTE (same_at_end - 1) >= 0200
3846 && ! NILP (BVAR (current_buffer, enable_multibyte_characters))
3847 && (CODING_MAY_REQUIRE_DECODING (&coding)))
3848 giveup_match_end = 1;
3849 break;
3852 if (nread == 0)
3853 break;
3855 immediate_quit = 0;
3857 if (! giveup_match_end)
3859 ptrdiff_t temp;
3861 /* We win! We can handle REPLACE the optimized way. */
3863 /* Extend the start of non-matching text area to multibyte
3864 character boundary. */
3865 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3866 while (same_at_start > BEGV_BYTE
3867 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
3868 same_at_start--;
3870 /* Extend the end of non-matching text area to multibyte
3871 character boundary. */
3872 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
3873 while (same_at_end < ZV_BYTE
3874 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
3875 same_at_end++;
3877 /* Don't try to reuse the same piece of text twice. */
3878 overlap = (same_at_start - BEGV_BYTE
3879 - (same_at_end
3880 + (! NILP (end) ? end_offset : st.st_size) - ZV_BYTE));
3881 if (overlap > 0)
3882 same_at_end += overlap;
3884 /* Arrange to read only the nonmatching middle part of the file. */
3885 beg_offset += same_at_start - BEGV_BYTE;
3886 end_offset -= ZV_BYTE - same_at_end;
3888 invalidate_buffer_caches (current_buffer,
3889 BYTE_TO_CHAR (same_at_start),
3890 BYTE_TO_CHAR (same_at_end));
3891 del_range_byte (same_at_start, same_at_end, 0);
3892 /* Insert from the file at the proper position. */
3893 temp = BYTE_TO_CHAR (same_at_start);
3894 SET_PT_BOTH (temp, same_at_start);
3896 /* If display currently starts at beginning of line,
3897 keep it that way. */
3898 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
3899 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
3901 replace_handled = 1;
3905 /* If requested, replace the accessible part of the buffer
3906 with the file contents. Avoid replacing text at the
3907 beginning or end of the buffer that matches the file contents;
3908 that preserves markers pointing to the unchanged parts.
3910 Here we implement this feature for the case where code conversion
3911 is needed, in a simple way that needs a lot of memory.
3912 The preceding if-statement handles the case of no conversion
3913 in a more optimized way. */
3914 if (!NILP (replace) && ! replace_handled && BEGV < ZV)
3916 ptrdiff_t same_at_start = BEGV_BYTE;
3917 ptrdiff_t same_at_end = ZV_BYTE;
3918 ptrdiff_t same_at_start_charpos;
3919 ptrdiff_t inserted_chars;
3920 ptrdiff_t overlap;
3921 ptrdiff_t bufpos;
3922 unsigned char *decoded;
3923 ptrdiff_t temp;
3924 ptrdiff_t this = 0;
3925 ptrdiff_t this_count = SPECPDL_INDEX ();
3926 bool multibyte
3927 = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
3928 Lisp_Object conversion_buffer;
3929 struct gcpro gcpro1;
3931 conversion_buffer = code_conversion_save (1, multibyte);
3933 /* First read the whole file, performing code conversion into
3934 CONVERSION_BUFFER. */
3936 if (lseek (fd, beg_offset, SEEK_SET) < 0)
3937 report_file_error ("Setting file position", orig_filename);
3939 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
3940 unprocessed = 0; /* Bytes not processed in previous loop. */
3942 GCPRO1 (conversion_buffer);
3943 while (1)
3945 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3946 quitting while reading a huge file. */
3948 /* Allow quitting out of the actual I/O. */
3949 immediate_quit = 1;
3950 QUIT;
3951 this = emacs_read (fd, read_buf + unprocessed,
3952 READ_BUF_SIZE - unprocessed);
3953 immediate_quit = 0;
3955 if (this <= 0)
3956 break;
3958 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
3959 BUF_Z (XBUFFER (conversion_buffer)));
3960 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3961 unprocessed + this, conversion_buffer);
3962 unprocessed = coding.carryover_bytes;
3963 if (coding.carryover_bytes > 0)
3964 memcpy (read_buf, coding.carryover, unprocessed);
3966 UNGCPRO;
3967 if (this < 0)
3968 report_file_error ("Read error", orig_filename);
3969 emacs_close (fd);
3970 clear_unwind_protect (fd_index);
3972 if (unprocessed > 0)
3974 coding.mode |= CODING_MODE_LAST_BLOCK;
3975 decode_coding_c_string (&coding, (unsigned char *) read_buf,
3976 unprocessed, conversion_buffer);
3977 coding.mode &= ~CODING_MODE_LAST_BLOCK;
3980 coding_system = CODING_ID_NAME (coding.id);
3981 set_coding_system = 1;
3982 decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer));
3983 inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer))
3984 - BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
3986 /* Compare the beginning of the converted string with the buffer
3987 text. */
3989 bufpos = 0;
3990 while (bufpos < inserted && same_at_start < same_at_end
3991 && FETCH_BYTE (same_at_start) == decoded[bufpos])
3992 same_at_start++, bufpos++;
3994 /* If the file matches the head of buffer completely,
3995 there's no need to replace anything. */
3997 if (bufpos == inserted)
3999 /* Truncate the buffer to the size of the file. */
4000 if (same_at_start != same_at_end)
4002 invalidate_buffer_caches (current_buffer,
4003 BYTE_TO_CHAR (same_at_start),
4004 BYTE_TO_CHAR (same_at_end));
4005 del_range_byte (same_at_start, same_at_end, 0);
4007 inserted = 0;
4009 unbind_to (this_count, Qnil);
4010 goto handled;
4013 /* Extend the start of non-matching text area to the previous
4014 multibyte character boundary. */
4015 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
4016 while (same_at_start > BEGV_BYTE
4017 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
4018 same_at_start--;
4020 /* Scan this bufferful from the end, comparing with
4021 the Emacs buffer. */
4022 bufpos = inserted;
4024 /* Compare with same_at_start to avoid counting some buffer text
4025 as matching both at the file's beginning and at the end. */
4026 while (bufpos > 0 && same_at_end > same_at_start
4027 && FETCH_BYTE (same_at_end - 1) == decoded[bufpos - 1])
4028 same_at_end--, bufpos--;
4030 /* Extend the end of non-matching text area to the next
4031 multibyte character boundary. */
4032 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
4033 while (same_at_end < ZV_BYTE
4034 && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
4035 same_at_end++;
4037 /* Don't try to reuse the same piece of text twice. */
4038 overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
4039 if (overlap > 0)
4040 same_at_end += overlap;
4042 /* If display currently starts at beginning of line,
4043 keep it that way. */
4044 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
4045 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
4047 /* Replace the chars that we need to replace,
4048 and update INSERTED to equal the number of bytes
4049 we are taking from the decoded string. */
4050 inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
4052 if (same_at_end != same_at_start)
4054 invalidate_buffer_caches (current_buffer,
4055 BYTE_TO_CHAR (same_at_start),
4056 BYTE_TO_CHAR (same_at_end));
4057 del_range_byte (same_at_start, same_at_end, 0);
4058 temp = GPT;
4059 eassert (same_at_start == GPT_BYTE);
4060 same_at_start = GPT_BYTE;
4062 else
4064 temp = BYTE_TO_CHAR (same_at_start);
4066 /* Insert from the file at the proper position. */
4067 SET_PT_BOTH (temp, same_at_start);
4068 same_at_start_charpos
4069 = buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
4070 same_at_start - BEGV_BYTE
4071 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
4072 eassert (same_at_start_charpos == temp - (BEGV - BEG));
4073 inserted_chars
4074 = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
4075 same_at_start + inserted - BEGV_BYTE
4076 + BUF_BEG_BYTE (XBUFFER (conversion_buffer)))
4077 - same_at_start_charpos);
4078 /* This binding is to avoid ask-user-about-supersession-threat
4079 being called in insert_from_buffer (via in
4080 prepare_to_modify_buffer). */
4081 specbind (intern ("buffer-file-name"), Qnil);
4082 insert_from_buffer (XBUFFER (conversion_buffer),
4083 same_at_start_charpos, inserted_chars, 0);
4084 /* Set `inserted' to the number of inserted characters. */
4085 inserted = PT - temp;
4086 /* Set point before the inserted characters. */
4087 SET_PT_BOTH (temp, same_at_start);
4089 unbind_to (this_count, Qnil);
4091 goto handled;
4094 if (! not_regular)
4095 total = end_offset - beg_offset;
4096 else
4097 /* For a special file, all we can do is guess. */
4098 total = READ_BUF_SIZE;
4100 if (NILP (visit) && total > 0)
4102 if (!NILP (BVAR (current_buffer, file_truename))
4103 /* Make binding buffer-file-name to nil effective. */
4104 && !NILP (BVAR (current_buffer, filename))
4105 && SAVE_MODIFF >= MODIFF)
4106 we_locked_file = 1;
4107 prepare_to_modify_buffer (PT, PT, NULL);
4110 move_gap_both (PT, PT_BYTE);
4111 if (GAP_SIZE < total)
4112 make_gap (total - GAP_SIZE);
4114 if (beg_offset != 0 || !NILP (replace))
4116 if (lseek (fd, beg_offset, SEEK_SET) < 0)
4117 report_file_error ("Setting file position", orig_filename);
4120 /* In the following loop, HOW_MUCH contains the total bytes read so
4121 far for a regular file, and not changed for a special file. But,
4122 before exiting the loop, it is set to a negative value if I/O
4123 error occurs. */
4124 how_much = 0;
4126 /* Total bytes inserted. */
4127 inserted = 0;
4129 /* Here, we don't do code conversion in the loop. It is done by
4130 decode_coding_gap after all data are read into the buffer. */
4132 ptrdiff_t gap_size = GAP_SIZE;
4134 while (how_much < total)
4136 /* try is reserved in some compilers (Microsoft C) */
4137 ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE);
4138 ptrdiff_t this;
4140 if (not_regular)
4142 Lisp_Object nbytes;
4144 /* Maybe make more room. */
4145 if (gap_size < trytry)
4147 make_gap (trytry - gap_size);
4148 gap_size = GAP_SIZE - inserted;
4151 /* Read from the file, capturing `quit'. When an
4152 error occurs, end the loop, and arrange for a quit
4153 to be signaled after decoding the text we read. */
4154 nbytes = internal_condition_case_1
4155 (read_non_regular,
4156 make_save_int_int_int (fd, inserted, trytry),
4157 Qerror, read_non_regular_quit);
4159 if (NILP (nbytes))
4161 read_quit = 1;
4162 break;
4165 this = XINT (nbytes);
4167 else
4169 /* Allow quitting out of the actual I/O. We don't make text
4170 part of the buffer until all the reading is done, so a C-g
4171 here doesn't do any harm. */
4172 immediate_quit = 1;
4173 QUIT;
4174 this = emacs_read (fd,
4175 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
4176 + inserted),
4177 trytry);
4178 immediate_quit = 0;
4181 if (this <= 0)
4183 how_much = this;
4184 break;
4187 gap_size -= this;
4189 /* For a regular file, where TOTAL is the real size,
4190 count HOW_MUCH to compare with it.
4191 For a special file, where TOTAL is just a buffer size,
4192 so don't bother counting in HOW_MUCH.
4193 (INSERTED is where we count the number of characters inserted.) */
4194 if (! not_regular)
4195 how_much += this;
4196 inserted += this;
4200 /* Now we have either read all the file data into the gap,
4201 or stop reading on I/O error or quit. If nothing was
4202 read, undo marking the buffer modified. */
4204 if (inserted == 0)
4206 if (we_locked_file)
4207 unlock_file (BVAR (current_buffer, file_truename));
4208 Vdeactivate_mark = old_Vdeactivate_mark;
4210 else
4211 Vdeactivate_mark = Qt;
4213 emacs_close (fd);
4214 clear_unwind_protect (fd_index);
4216 if (how_much < 0)
4217 report_file_error ("Read error", orig_filename);
4219 /* Make the text read part of the buffer. */
4220 GAP_SIZE -= inserted;
4221 GPT += inserted;
4222 GPT_BYTE += inserted;
4223 ZV += inserted;
4224 ZV_BYTE += inserted;
4225 Z += inserted;
4226 Z_BYTE += inserted;
4228 if (GAP_SIZE > 0)
4229 /* Put an anchor to ensure multi-byte form ends at gap. */
4230 *GPT_ADDR = 0;
4232 notfound:
4234 if (NILP (coding_system))
4236 /* The coding system is not yet decided. Decide it by an
4237 optimized method for handling `coding:' tag.
4239 Note that we can get here only if the buffer was empty
4240 before the insertion. */
4242 if (!NILP (Vcoding_system_for_read))
4243 coding_system = Vcoding_system_for_read;
4244 else
4246 /* Since we are sure that the current buffer was empty
4247 before the insertion, we can toggle
4248 enable-multibyte-characters directly here without taking
4249 care of marker adjustment. By this way, we can run Lisp
4250 program safely before decoding the inserted text. */
4251 Lisp_Object unwind_data;
4252 ptrdiff_t count1 = SPECPDL_INDEX ();
4254 unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters),
4255 Fcons (BVAR (current_buffer, undo_list),
4256 Fcurrent_buffer ()));
4257 bset_enable_multibyte_characters (current_buffer, Qnil);
4258 bset_undo_list (current_buffer, Qt);
4259 record_unwind_protect (decide_coding_unwind, unwind_data);
4261 if (inserted > 0 && ! NILP (Vset_auto_coding_function))
4263 coding_system = call2 (Vset_auto_coding_function,
4264 filename, make_number (inserted));
4267 if (NILP (coding_system))
4269 /* If the coding system is not yet decided, check
4270 file-coding-system-alist. */
4271 Lisp_Object args[6];
4273 args[0] = Qinsert_file_contents, args[1] = orig_filename;
4274 args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
4275 coding_system = Ffind_operation_coding_system (6, args);
4276 if (CONSP (coding_system))
4277 coding_system = XCAR (coding_system);
4279 unbind_to (count1, Qnil);
4280 inserted = Z_BYTE - BEG_BYTE;
4283 if (NILP (coding_system))
4284 coding_system = Qundecided;
4285 else
4286 CHECK_CODING_SYSTEM (coding_system);
4288 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
4289 /* We must suppress all character code conversion except for
4290 end-of-line conversion. */
4291 coding_system = raw_text_coding_system (coding_system);
4292 setup_coding_system (coding_system, &coding);
4293 /* Ensure we set Vlast_coding_system_used. */
4294 set_coding_system = 1;
4297 if (!NILP (visit))
4299 /* When we visit a file by raw-text, we change the buffer to
4300 unibyte. */
4301 if (CODING_FOR_UNIBYTE (&coding)
4302 /* Can't do this if part of the buffer might be preserved. */
4303 && NILP (replace))
4304 /* Visiting a file with these coding system makes the buffer
4305 unibyte. */
4306 bset_enable_multibyte_characters (current_buffer, Qnil);
4309 coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
4310 if (CODING_MAY_REQUIRE_DECODING (&coding)
4311 && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding)))
4313 move_gap_both (PT, PT_BYTE);
4314 GAP_SIZE += inserted;
4315 ZV_BYTE -= inserted;
4316 Z_BYTE -= inserted;
4317 ZV -= inserted;
4318 Z -= inserted;
4319 decode_coding_gap (&coding, inserted, inserted);
4320 inserted = coding.produced_char;
4321 coding_system = CODING_ID_NAME (coding.id);
4323 else if (inserted > 0)
4324 adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
4325 inserted);
4327 /* Call after-change hooks for the inserted text, aside from the case
4328 of normal visiting (not with REPLACE), which is done in a new buffer
4329 "before" the buffer is changed. */
4330 if (inserted > 0 && total > 0
4331 && (NILP (visit) || !NILP (replace)))
4333 signal_after_change (PT, 0, inserted);
4334 update_compositions (PT, PT, CHECK_BORDER);
4337 /* Now INSERTED is measured in characters. */
4339 handled:
4341 if (!NILP (visit))
4343 if (empty_undo_list_p)
4344 bset_undo_list (current_buffer, Qnil);
4346 if (NILP (handler))
4348 current_buffer->modtime = mtime;
4349 current_buffer->modtime_size = st.st_size;
4350 bset_filename (current_buffer, orig_filename);
4353 SAVE_MODIFF = MODIFF;
4354 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
4355 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
4356 if (NILP (handler))
4358 if (!NILP (BVAR (current_buffer, file_truename)))
4359 unlock_file (BVAR (current_buffer, file_truename));
4360 unlock_file (filename);
4362 if (not_regular)
4363 xsignal2 (Qfile_error,
4364 build_string ("not a regular file"), orig_filename);
4367 if (set_coding_system)
4368 Vlast_coding_system_used = coding_system;
4370 if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
4372 insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
4373 visit);
4374 if (! NILP (insval))
4376 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4377 wrong_type_argument (intern ("inserted-chars"), insval);
4378 inserted = XFASTINT (insval);
4382 /* Decode file format. */
4383 if (inserted > 0)
4385 /* Don't run point motion or modification hooks when decoding. */
4386 ptrdiff_t count1 = SPECPDL_INDEX ();
4387 ptrdiff_t old_inserted = inserted;
4388 specbind (Qinhibit_point_motion_hooks, Qt);
4389 specbind (Qinhibit_modification_hooks, Qt);
4391 /* Save old undo list and don't record undo for decoding. */
4392 old_undo = BVAR (current_buffer, undo_list);
4393 bset_undo_list (current_buffer, Qt);
4395 if (NILP (replace))
4397 insval = call3 (Qformat_decode,
4398 Qnil, make_number (inserted), visit);
4399 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4400 wrong_type_argument (intern ("inserted-chars"), insval);
4401 inserted = XFASTINT (insval);
4403 else
4405 /* If REPLACE is non-nil and we succeeded in not replacing the
4406 beginning or end of the buffer text with the file's contents,
4407 call format-decode with `point' positioned at the beginning
4408 of the buffer and `inserted' equaling the number of
4409 characters in the buffer. Otherwise, format-decode might
4410 fail to correctly analyze the beginning or end of the buffer.
4411 Hence we temporarily save `point' and `inserted' here and
4412 restore `point' iff format-decode did not insert or delete
4413 any text. Otherwise we leave `point' at point-min. */
4414 ptrdiff_t opoint = PT;
4415 ptrdiff_t opoint_byte = PT_BYTE;
4416 ptrdiff_t oinserted = ZV - BEGV;
4417 EMACS_INT ochars_modiff = CHARS_MODIFF;
4419 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4420 insval = call3 (Qformat_decode,
4421 Qnil, make_number (oinserted), visit);
4422 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4423 wrong_type_argument (intern ("inserted-chars"), insval);
4424 if (ochars_modiff == CHARS_MODIFF)
4425 /* format_decode didn't modify buffer's characters => move
4426 point back to position before inserted text and leave
4427 value of inserted alone. */
4428 SET_PT_BOTH (opoint, opoint_byte);
4429 else
4430 /* format_decode modified buffer's characters => consider
4431 entire buffer changed and leave point at point-min. */
4432 inserted = XFASTINT (insval);
4435 /* For consistency with format-decode call these now iff inserted > 0
4436 (martin 2007-06-28). */
4437 p = Vafter_insert_file_functions;
4438 while (CONSP (p))
4440 if (NILP (replace))
4442 insval = call1 (XCAR (p), make_number (inserted));
4443 if (!NILP (insval))
4445 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4446 wrong_type_argument (intern ("inserted-chars"), insval);
4447 inserted = XFASTINT (insval);
4450 else
4452 /* For the rationale of this see the comment on
4453 format-decode above. */
4454 ptrdiff_t opoint = PT;
4455 ptrdiff_t opoint_byte = PT_BYTE;
4456 ptrdiff_t oinserted = ZV - BEGV;
4457 EMACS_INT ochars_modiff = CHARS_MODIFF;
4459 TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
4460 insval = call1 (XCAR (p), make_number (oinserted));
4461 if (!NILP (insval))
4463 if (! RANGED_INTEGERP (0, insval, ZV - PT))
4464 wrong_type_argument (intern ("inserted-chars"), insval);
4465 if (ochars_modiff == CHARS_MODIFF)
4466 /* after_insert_file_functions didn't modify
4467 buffer's characters => move point back to
4468 position before inserted text and leave value of
4469 inserted alone. */
4470 SET_PT_BOTH (opoint, opoint_byte);
4471 else
4472 /* after_insert_file_functions did modify buffer's
4473 characters => consider entire buffer changed and
4474 leave point at point-min. */
4475 inserted = XFASTINT (insval);
4479 QUIT;
4480 p = XCDR (p);
4483 if (!empty_undo_list_p)
4485 bset_undo_list (current_buffer, old_undo);
4486 if (CONSP (old_undo) && inserted != old_inserted)
4488 /* Adjust the last undo record for the size change during
4489 the format conversion. */
4490 Lisp_Object tem = XCAR (old_undo);
4491 if (CONSP (tem) && INTEGERP (XCAR (tem))
4492 && INTEGERP (XCDR (tem))
4493 && XFASTINT (XCDR (tem)) == PT + old_inserted)
4494 XSETCDR (tem, make_number (PT + inserted));
4497 else
4498 /* If undo_list was Qt before, keep it that way.
4499 Otherwise start with an empty undo_list. */
4500 bset_undo_list (current_buffer, EQ (old_undo, Qt) ? Qt : Qnil);
4502 unbind_to (count1, Qnil);
4505 if (!NILP (visit)
4506 && current_buffer->modtime.tv_nsec == NONEXISTENT_MODTIME_NSECS)
4508 /* If visiting nonexistent file, return nil. */
4509 report_file_errno ("Opening input file", orig_filename, save_errno);
4512 /* We made a lot of deletions and insertions above, so invalidate
4513 the newline cache for the entire region of the inserted
4514 characters. */
4515 if (current_buffer->base_buffer && current_buffer->base_buffer->newline_cache)
4516 invalidate_region_cache (current_buffer->base_buffer,
4517 current_buffer->base_buffer->newline_cache,
4518 PT - BEG, Z - PT - inserted);
4519 else if (current_buffer->newline_cache)
4520 invalidate_region_cache (current_buffer,
4521 current_buffer->newline_cache,
4522 PT - BEG, Z - PT - inserted);
4524 if (read_quit)
4525 Fsignal (Qquit, Qnil);
4527 /* Retval needs to be dealt with in all cases consistently. */
4528 if (NILP (val))
4529 val = list2 (orig_filename, make_number (inserted));
4531 RETURN_UNGCPRO (unbind_to (count, val));
4534 static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
4536 static void
4537 build_annotations_unwind (Lisp_Object arg)
4539 Vwrite_region_annotation_buffers = arg;
4542 /* Decide the coding-system to encode the data with. */
4544 static Lisp_Object
4545 choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4546 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4547 struct coding_system *coding)
4549 Lisp_Object val;
4550 Lisp_Object eol_parent = Qnil;
4552 if (auto_saving
4553 && NILP (Fstring_equal (BVAR (current_buffer, filename),
4554 BVAR (current_buffer, auto_save_file_name))))
4556 val = Qutf_8_emacs;
4557 eol_parent = Qunix;
4559 else if (!NILP (Vcoding_system_for_write))
4561 val = Vcoding_system_for_write;
4562 if (coding_system_require_warning
4563 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4564 /* Confirm that VAL can surely encode the current region. */
4565 val = call5 (Vselect_safe_coding_system_function,
4566 start, end, list2 (Qt, val),
4567 Qnil, filename);
4569 else
4571 /* If the variable `buffer-file-coding-system' is set locally,
4572 it means that the file was read with some kind of code
4573 conversion or the variable is explicitly set by users. We
4574 had better write it out with the same coding system even if
4575 `enable-multibyte-characters' is nil.
4577 If it is not set locally, we anyway have to convert EOL
4578 format if the default value of `buffer-file-coding-system'
4579 tells that it is not Unix-like (LF only) format. */
4580 bool using_default_coding = 0;
4581 bool force_raw_text = 0;
4583 val = BVAR (current_buffer, buffer_file_coding_system);
4584 if (NILP (val)
4585 || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
4587 val = Qnil;
4588 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
4589 force_raw_text = 1;
4592 if (NILP (val))
4594 /* Check file-coding-system-alist. */
4595 Lisp_Object args[7], coding_systems;
4597 args[0] = Qwrite_region; args[1] = start; args[2] = end;
4598 args[3] = filename; args[4] = append; args[5] = visit;
4599 args[6] = lockname;
4600 coding_systems = Ffind_operation_coding_system (7, args);
4601 if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
4602 val = XCDR (coding_systems);
4605 if (NILP (val))
4607 /* If we still have not decided a coding system, use the
4608 default value of buffer-file-coding-system. */
4609 val = BVAR (current_buffer, buffer_file_coding_system);
4610 using_default_coding = 1;
4613 if (! NILP (val) && ! force_raw_text)
4615 Lisp_Object spec, attrs;
4617 CHECK_CODING_SYSTEM_GET_SPEC (val, spec);
4618 attrs = AREF (spec, 0);
4619 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
4620 force_raw_text = 1;
4623 if (!force_raw_text
4624 && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
4625 /* Confirm that VAL can surely encode the current region. */
4626 val = call5 (Vselect_safe_coding_system_function,
4627 start, end, val, Qnil, filename);
4629 /* If the decided coding-system doesn't specify end-of-line
4630 format, we use that of
4631 `default-buffer-file-coding-system'. */
4632 if (! using_default_coding
4633 && ! NILP (BVAR (&buffer_defaults, buffer_file_coding_system)))
4634 val = (coding_inherit_eol_type
4635 (val, BVAR (&buffer_defaults, buffer_file_coding_system)));
4637 /* If we decide not to encode text, use `raw-text' or one of its
4638 subsidiaries. */
4639 if (force_raw_text)
4640 val = raw_text_coding_system (val);
4643 val = coding_inherit_eol_type (val, eol_parent);
4644 setup_coding_system (val, coding);
4646 if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display)))
4647 coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
4648 return val;
4651 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
4652 "r\nFWrite region to file: \ni\ni\ni\np",
4653 doc: /* Write current region into specified file.
4654 When called from a program, requires three arguments:
4655 START, END and FILENAME. START and END are normally buffer positions
4656 specifying the part of the buffer to write.
4657 If START is nil, that means to use the entire buffer contents.
4658 If START is a string, then output that string to the file
4659 instead of any buffer contents; END is ignored.
4661 Optional fourth argument APPEND if non-nil means
4662 append to existing file contents (if any). If it is a number,
4663 seek to that offset in the file before writing.
4664 Optional fifth argument VISIT, if t or a string, means
4665 set the last-save-file-modtime of buffer to this file's modtime
4666 and mark buffer not modified.
4667 If VISIT is a string, it is a second file name;
4668 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4669 VISIT is also the file name to lock and unlock for clash detection.
4670 If VISIT is neither t nor nil nor a string,
4671 that means do not display the \"Wrote file\" message.
4672 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
4673 use for locking and unlocking, overriding FILENAME and VISIT.
4674 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
4675 for an existing file with the same name. If MUSTBENEW is `excl',
4676 that means to get an error if the file already exists; never overwrite.
4677 If MUSTBENEW is neither nil nor `excl', that means ask for
4678 confirmation before overwriting, but do go ahead and overwrite the file
4679 if the user confirms.
4681 This does code conversion according to the value of
4682 `coding-system-for-write', `buffer-file-coding-system', or
4683 `file-coding-system-alist', and sets the variable
4684 `last-coding-system-used' to the coding system actually used.
4686 This calls `write-region-annotate-functions' at the start, and
4687 `write-region-post-annotation-function' at the end. */)
4688 (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append,
4689 Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
4691 return write_region (start, end, filename, append, visit, lockname, mustbenew,
4692 -1);
4695 /* Like Fwrite_region, except that if DESC is nonnegative, it is a file
4696 descriptor for FILENAME, so do not open or close FILENAME. */
4698 Lisp_Object
4699 write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4700 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
4701 Lisp_Object mustbenew, int desc)
4703 int open_flags;
4704 int mode;
4705 off_t offset IF_LINT (= 0);
4706 bool open_and_close_file = desc < 0;
4707 bool ok;
4708 int save_errno = 0;
4709 const char *fn;
4710 struct stat st;
4711 struct timespec modtime;
4712 ptrdiff_t count = SPECPDL_INDEX ();
4713 ptrdiff_t count1 IF_LINT (= 0);
4714 Lisp_Object handler;
4715 Lisp_Object visit_file;
4716 Lisp_Object annotations;
4717 Lisp_Object encoded_filename;
4718 bool visiting = (EQ (visit, Qt) || STRINGP (visit));
4719 bool quietly = !NILP (visit);
4720 bool file_locked = 0;
4721 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
4722 struct buffer *given_buffer;
4723 struct coding_system coding;
4725 if (current_buffer->base_buffer && visiting)
4726 error ("Cannot do file visiting in an indirect buffer");
4728 if (!NILP (start) && !STRINGP (start))
4729 validate_region (&start, &end);
4731 visit_file = Qnil;
4732 GCPRO5 (start, filename, visit, visit_file, lockname);
4734 filename = Fexpand_file_name (filename, Qnil);
4736 if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
4737 barf_or_query_if_file_exists (filename, false, "overwrite", true, true);
4739 if (STRINGP (visit))
4740 visit_file = Fexpand_file_name (visit, Qnil);
4741 else
4742 visit_file = filename;
4744 if (NILP (lockname))
4745 lockname = visit_file;
4747 annotations = Qnil;
4749 /* If the file name has special constructs in it,
4750 call the corresponding file handler. */
4751 handler = Ffind_file_name_handler (filename, Qwrite_region);
4752 /* If FILENAME has no handler, see if VISIT has one. */
4753 if (NILP (handler) && STRINGP (visit))
4754 handler = Ffind_file_name_handler (visit, Qwrite_region);
4756 if (!NILP (handler))
4758 Lisp_Object val;
4759 val = call6 (handler, Qwrite_region, start, end,
4760 filename, append, visit);
4762 if (visiting)
4764 SAVE_MODIFF = MODIFF;
4765 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
4766 bset_filename (current_buffer, visit_file);
4768 UNGCPRO;
4769 return val;
4772 record_unwind_protect (save_restriction_restore, save_restriction_save ());
4774 /* Special kludge to simplify auto-saving. */
4775 if (NILP (start))
4777 /* Do it later, so write-region-annotate-function can work differently
4778 if we save "the buffer" vs "a region".
4779 This is useful in tar-mode. --Stef
4780 XSETFASTINT (start, BEG);
4781 XSETFASTINT (end, Z); */
4782 Fwiden ();
4785 record_unwind_protect (build_annotations_unwind,
4786 Vwrite_region_annotation_buffers);
4787 Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ());
4789 given_buffer = current_buffer;
4791 if (!STRINGP (start))
4793 annotations = build_annotations (start, end);
4795 if (current_buffer != given_buffer)
4797 XSETFASTINT (start, BEGV);
4798 XSETFASTINT (end, ZV);
4802 if (NILP (start))
4804 XSETFASTINT (start, BEGV);
4805 XSETFASTINT (end, ZV);
4808 UNGCPRO;
4810 GCPRO5 (start, filename, annotations, visit_file, lockname);
4812 /* Decide the coding-system to encode the data with.
4813 We used to make this choice before calling build_annotations, but that
4814 leads to problems when a write-annotate-function takes care of
4815 unsavable chars (as was the case with X-Symbol). */
4816 Vlast_coding_system_used
4817 = choose_write_coding_system (start, end, filename,
4818 append, visit, lockname, &coding);
4820 if (open_and_close_file && !auto_saving)
4822 lock_file (lockname);
4823 file_locked = 1;
4826 encoded_filename = ENCODE_FILE (filename);
4827 fn = SSDATA (encoded_filename);
4828 open_flags = O_WRONLY | O_BINARY | O_CREAT;
4829 open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
4830 if (NUMBERP (append))
4831 offset = file_offset (append);
4832 else if (!NILP (append))
4833 open_flags |= O_APPEND;
4834 #ifdef DOS_NT
4835 mode = S_IREAD | S_IWRITE;
4836 #else
4837 mode = auto_saving ? auto_save_mode_bits : 0666;
4838 #endif
4840 if (open_and_close_file)
4842 desc = emacs_open (fn, open_flags, mode);
4843 if (desc < 0)
4845 int open_errno = errno;
4846 if (file_locked)
4847 unlock_file (lockname);
4848 UNGCPRO;
4849 report_file_errno ("Opening output file", filename, open_errno);
4852 count1 = SPECPDL_INDEX ();
4853 record_unwind_protect_int (close_file_unwind, desc);
4856 if (NUMBERP (append))
4858 off_t ret = lseek (desc, offset, SEEK_SET);
4859 if (ret < 0)
4861 int lseek_errno = errno;
4862 if (file_locked)
4863 unlock_file (lockname);
4864 UNGCPRO;
4865 report_file_errno ("Lseek error", filename, lseek_errno);
4869 UNGCPRO;
4871 immediate_quit = 1;
4873 if (STRINGP (start))
4874 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
4875 else if (XINT (start) != XINT (end))
4876 ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start),
4877 &annotations, &coding);
4878 else
4880 /* If file was empty, still need to write the annotations. */
4881 coding.mode |= CODING_MODE_LAST_BLOCK;
4882 ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
4884 save_errno = errno;
4886 if (ok && CODING_REQUIRE_FLUSHING (&coding)
4887 && !(coding.mode & CODING_MODE_LAST_BLOCK))
4889 /* We have to flush out a data. */
4890 coding.mode |= CODING_MODE_LAST_BLOCK;
4891 ok = e_write (desc, Qnil, 1, 1, &coding);
4892 save_errno = errno;
4895 immediate_quit = 0;
4897 /* fsync is not crucial for temporary files. Nor for auto-save
4898 files, since they might lose some work anyway. */
4899 if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
4901 /* Transfer data and metadata to disk, retrying if interrupted.
4902 fsync can report a write failure here, e.g., due to disk full
4903 under NFS. But ignore EINVAL, which means fsync is not
4904 supported on this file. */
4905 while (fsync (desc) != 0)
4906 if (errno != EINTR)
4908 if (errno != EINVAL)
4909 ok = 0, save_errno = errno;
4910 break;
4914 modtime = invalid_timespec ();
4915 if (visiting)
4917 if (fstat (desc, &st) == 0)
4918 modtime = get_stat_mtime (&st);
4919 else
4920 ok = 0, save_errno = errno;
4923 if (open_and_close_file)
4925 /* NFS can report a write failure now. */
4926 if (emacs_close (desc) < 0)
4927 ok = 0, save_errno = errno;
4929 /* Discard the unwind protect for close_file_unwind. */
4930 specpdl_ptr = specpdl + count1;
4933 /* Some file systems have a bug where st_mtime is not updated
4934 properly after a write. For example, CIFS might not see the
4935 st_mtime change until after the file is opened again.
4937 Attempt to detect this file system bug, and update MODTIME to the
4938 newer st_mtime if the bug appears to be present. This introduces
4939 a race condition, so to avoid most instances of the race condition
4940 on non-buggy file systems, skip this check if the most recently
4941 encountered non-buggy file system was the current file system.
4943 A race condition can occur if some other process modifies the
4944 file between the fstat above and the fstat below, but the race is
4945 unlikely and a similar race between the last write and the fstat
4946 above cannot possibly be closed anyway. */
4948 if (timespec_valid_p (modtime)
4949 && ! (valid_timestamp_file_system && st.st_dev == timestamp_file_system))
4951 int desc1 = emacs_open (fn, O_WRONLY | O_BINARY, 0);
4952 if (desc1 >= 0)
4954 struct stat st1;
4955 if (fstat (desc1, &st1) == 0
4956 && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino)
4958 /* Use the heuristic if it appears to be valid. With neither
4959 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
4960 file, the time stamp won't change. Also, some non-POSIX
4961 systems don't update an empty file's time stamp when
4962 truncating it. Finally, file systems with 100 ns or worse
4963 resolution sometimes seem to have bugs: on a system with ns
4964 resolution, checking ns % 100 incorrectly avoids the heuristic
4965 1% of the time, but the problem should be temporary as we will
4966 try again on the next time stamp. */
4967 bool use_heuristic
4968 = ((open_flags & (O_EXCL | O_TRUNC)) != 0
4969 && st.st_size != 0
4970 && modtime.tv_nsec % 100 != 0);
4972 struct timespec modtime1 = get_stat_mtime (&st1);
4973 if (use_heuristic
4974 && timespec_cmp (modtime, modtime1) == 0
4975 && st.st_size == st1.st_size)
4977 timestamp_file_system = st.st_dev;
4978 valid_timestamp_file_system = 1;
4980 else
4982 st.st_size = st1.st_size;
4983 modtime = modtime1;
4986 emacs_close (desc1);
4990 /* Call write-region-post-annotation-function. */
4991 while (CONSP (Vwrite_region_annotation_buffers))
4993 Lisp_Object buf = XCAR (Vwrite_region_annotation_buffers);
4994 if (!NILP (Fbuffer_live_p (buf)))
4996 Fset_buffer (buf);
4997 if (FUNCTIONP (Vwrite_region_post_annotation_function))
4998 call0 (Vwrite_region_post_annotation_function);
5000 Vwrite_region_annotation_buffers
5001 = XCDR (Vwrite_region_annotation_buffers);
5004 unbind_to (count, Qnil);
5006 if (file_locked)
5007 unlock_file (lockname);
5009 /* Do this before reporting IO error
5010 to avoid a "file has changed on disk" warning on
5011 next attempt to save. */
5012 if (timespec_valid_p (modtime))
5014 current_buffer->modtime = modtime;
5015 current_buffer->modtime_size = st.st_size;
5018 if (! ok)
5019 report_file_errno ("Write error", filename, save_errno);
5021 if (visiting)
5023 SAVE_MODIFF = MODIFF;
5024 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5025 bset_filename (current_buffer, visit_file);
5026 update_mode_lines = 14;
5028 else if (quietly)
5030 if (auto_saving
5031 && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
5032 BVAR (current_buffer, auto_save_file_name))))
5033 SAVE_MODIFF = MODIFF;
5035 return Qnil;
5038 if (!auto_saving)
5039 message_with_string ((NUMBERP (append)
5040 ? "Updated %s"
5041 : ! NILP (append)
5042 ? "Added to %s"
5043 : "Wrote %s"),
5044 visit_file, 1);
5046 return Qnil;
5049 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
5050 doc: /* Return t if (car A) is numerically less than (car B). */)
5051 (Lisp_Object a, Lisp_Object b)
5053 Lisp_Object args[2];
5054 args[0] = Fcar (a);
5055 args[1] = Fcar (b);
5056 return Flss (2, args);
5059 /* Build the complete list of annotations appropriate for writing out
5060 the text between START and END, by calling all the functions in
5061 write-region-annotate-functions and merging the lists they return.
5062 If one of these functions switches to a different buffer, we assume
5063 that buffer contains altered text. Therefore, the caller must
5064 make sure to restore the current buffer in all cases,
5065 as save-excursion would do. */
5067 static Lisp_Object
5068 build_annotations (Lisp_Object start, Lisp_Object end)
5070 Lisp_Object annotations;
5071 Lisp_Object p, res;
5072 struct gcpro gcpro1, gcpro2;
5073 Lisp_Object original_buffer;
5074 int i;
5075 bool used_global = 0;
5077 XSETBUFFER (original_buffer, current_buffer);
5079 annotations = Qnil;
5080 p = Vwrite_region_annotate_functions;
5081 GCPRO2 (annotations, p);
5082 while (CONSP (p))
5084 struct buffer *given_buffer = current_buffer;
5085 if (EQ (Qt, XCAR (p)) && !used_global)
5086 { /* Use the global value of the hook. */
5087 Lisp_Object arg[2];
5088 used_global = 1;
5089 arg[0] = Fdefault_value (Qwrite_region_annotate_functions);
5090 arg[1] = XCDR (p);
5091 p = Fappend (2, arg);
5092 continue;
5094 Vwrite_region_annotations_so_far = annotations;
5095 res = call2 (XCAR (p), start, end);
5096 /* If the function makes a different buffer current,
5097 assume that means this buffer contains altered text to be output.
5098 Reset START and END from the buffer bounds
5099 and discard all previous annotations because they should have
5100 been dealt with by this function. */
5101 if (current_buffer != given_buffer)
5103 Vwrite_region_annotation_buffers
5104 = Fcons (Fcurrent_buffer (),
5105 Vwrite_region_annotation_buffers);
5106 XSETFASTINT (start, BEGV);
5107 XSETFASTINT (end, ZV);
5108 annotations = Qnil;
5110 Flength (res); /* Check basic validity of return value */
5111 annotations = merge (annotations, res, Qcar_less_than_car);
5112 p = XCDR (p);
5115 /* Now do the same for annotation functions implied by the file-format */
5116 if (auto_saving && (!EQ (BVAR (current_buffer, auto_save_file_format), Qt)))
5117 p = BVAR (current_buffer, auto_save_file_format);
5118 else
5119 p = BVAR (current_buffer, file_format);
5120 for (i = 0; CONSP (p); p = XCDR (p), ++i)
5122 struct buffer *given_buffer = current_buffer;
5124 Vwrite_region_annotations_so_far = annotations;
5126 /* Value is either a list of annotations or nil if the function
5127 has written annotations to a temporary buffer, which is now
5128 current. */
5129 res = call5 (Qformat_annotate_function, XCAR (p), start, end,
5130 original_buffer, make_number (i));
5131 if (current_buffer != given_buffer)
5133 XSETFASTINT (start, BEGV);
5134 XSETFASTINT (end, ZV);
5135 annotations = Qnil;
5138 if (CONSP (res))
5139 annotations = merge (annotations, res, Qcar_less_than_car);
5142 UNGCPRO;
5143 return annotations;
5147 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
5148 If STRING is nil, POS is the character position in the current buffer.
5149 Intersperse with them the annotations from *ANNOT
5150 which fall within the range of POS to POS + NCHARS,
5151 each at its appropriate position.
5153 We modify *ANNOT by discarding elements as we use them up.
5155 Return true if successful. */
5157 static bool
5158 a_write (int desc, Lisp_Object string, ptrdiff_t pos,
5159 ptrdiff_t nchars, Lisp_Object *annot,
5160 struct coding_system *coding)
5162 Lisp_Object tem;
5163 ptrdiff_t nextpos;
5164 ptrdiff_t lastpos = pos + nchars;
5166 while (NILP (*annot) || CONSP (*annot))
5168 tem = Fcar_safe (Fcar (*annot));
5169 nextpos = pos - 1;
5170 if (INTEGERP (tem))
5171 nextpos = XFASTINT (tem);
5173 /* If there are no more annotations in this range,
5174 output the rest of the range all at once. */
5175 if (! (nextpos >= pos && nextpos <= lastpos))
5176 return e_write (desc, string, pos, lastpos, coding);
5178 /* Output buffer text up to the next annotation's position. */
5179 if (nextpos > pos)
5181 if (!e_write (desc, string, pos, nextpos, coding))
5182 return 0;
5183 pos = nextpos;
5185 /* Output the annotation. */
5186 tem = Fcdr (Fcar (*annot));
5187 if (STRINGP (tem))
5189 if (!e_write (desc, tem, 0, SCHARS (tem), coding))
5190 return 0;
5192 *annot = Fcdr (*annot);
5194 return 1;
5197 /* Maximum number of characters that the next
5198 function encodes per one loop iteration. */
5200 enum { E_WRITE_MAX = 8 * 1024 * 1024 };
5202 /* Write text in the range START and END into descriptor DESC,
5203 encoding them with coding system CODING. If STRING is nil, START
5204 and END are character positions of the current buffer, else they
5205 are indexes to the string STRING. Return true if successful. */
5207 static bool
5208 e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
5209 struct coding_system *coding)
5211 if (STRINGP (string))
5213 start = 0;
5214 end = SCHARS (string);
5217 /* We used to have a code for handling selective display here. But,
5218 now it is handled within encode_coding. */
5220 while (start < end)
5222 if (STRINGP (string))
5224 coding->src_multibyte = SCHARS (string) < SBYTES (string);
5225 if (CODING_REQUIRE_ENCODING (coding))
5227 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5229 /* Avoid creating huge Lisp string in encode_coding_object. */
5230 if (nchars == E_WRITE_MAX)
5231 coding->raw_destination = 1;
5233 encode_coding_object
5234 (coding, string, start, string_char_to_byte (string, start),
5235 start + nchars, string_char_to_byte (string, start + nchars),
5236 Qt);
5238 else
5240 coding->dst_object = string;
5241 coding->consumed_char = SCHARS (string);
5242 coding->produced = SBYTES (string);
5245 else
5247 ptrdiff_t start_byte = CHAR_TO_BYTE (start);
5248 ptrdiff_t end_byte = CHAR_TO_BYTE (end);
5250 coding->src_multibyte = (end - start) < (end_byte - start_byte);
5251 if (CODING_REQUIRE_ENCODING (coding))
5253 ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
5255 /* Likewise. */
5256 if (nchars == E_WRITE_MAX)
5257 coding->raw_destination = 1;
5259 encode_coding_object
5260 (coding, Fcurrent_buffer (), start, start_byte,
5261 start + nchars, CHAR_TO_BYTE (start + nchars), Qt);
5263 else
5265 coding->dst_object = Qnil;
5266 coding->dst_pos_byte = start_byte;
5267 if (start >= GPT || end <= GPT)
5269 coding->consumed_char = end - start;
5270 coding->produced = end_byte - start_byte;
5272 else
5274 coding->consumed_char = GPT - start;
5275 coding->produced = GPT_BYTE - start_byte;
5280 if (coding->produced > 0)
5282 char *buf = (coding->raw_destination ? (char *) coding->destination
5283 : (STRINGP (coding->dst_object)
5284 ? SSDATA (coding->dst_object)
5285 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
5286 coding->produced -= emacs_write_sig (desc, buf, coding->produced);
5288 if (coding->raw_destination)
5290 /* We're responsible for freeing this, see
5291 encode_coding_object to check why. */
5292 xfree (coding->destination);
5293 coding->raw_destination = 0;
5295 if (coding->produced)
5296 return 0;
5298 start += coding->consumed_char;
5301 return 1;
5304 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
5305 Sverify_visited_file_modtime, 0, 1, 0,
5306 doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
5307 This means that the file has not been changed since it was visited or saved.
5308 If BUF is omitted or nil, it defaults to the current buffer.
5309 See Info node `(elisp)Modification Time' for more details. */)
5310 (Lisp_Object buf)
5312 struct buffer *b = decode_buffer (buf);
5313 struct stat st;
5314 Lisp_Object handler;
5315 Lisp_Object filename;
5316 struct timespec mtime;
5318 if (!STRINGP (BVAR (b, filename))) return Qt;
5319 if (b->modtime.tv_nsec == UNKNOWN_MODTIME_NSECS) return Qt;
5321 /* If the file name has special constructs in it,
5322 call the corresponding file handler. */
5323 handler = Ffind_file_name_handler (BVAR (b, filename),
5324 Qverify_visited_file_modtime);
5325 if (!NILP (handler))
5326 return call2 (handler, Qverify_visited_file_modtime, buf);
5328 filename = ENCODE_FILE (BVAR (b, filename));
5330 mtime = (stat (SSDATA (filename), &st) == 0
5331 ? get_stat_mtime (&st)
5332 : time_error_value (errno));
5333 if (timespec_cmp (mtime, b->modtime) == 0
5334 && (b->modtime_size < 0
5335 || st.st_size == b->modtime_size))
5336 return Qt;
5337 return Qnil;
5340 DEFUN ("visited-file-modtime", Fvisited_file_modtime,
5341 Svisited_file_modtime, 0, 0, 0,
5342 doc: /* Return the current buffer's recorded visited file modification time.
5343 The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
5344 `file-attributes' returns. If the current buffer has no recorded file
5345 modification time, this function returns 0. If the visited file
5346 doesn't exist, return -1.
5347 See Info node `(elisp)Modification Time' for more details. */)
5348 (void)
5350 int ns = current_buffer->modtime.tv_nsec;
5351 if (ns < 0)
5352 return make_number (UNKNOWN_MODTIME_NSECS - ns);
5353 return make_lisp_time (current_buffer->modtime);
5356 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
5357 Sset_visited_file_modtime, 0, 1, 0,
5358 doc: /* Update buffer's recorded modification time from the visited file's time.
5359 Useful if the buffer was not read from the file normally
5360 or if the file itself has been changed for some known benign reason.
5361 An argument specifies the modification time value to use
5362 \(instead of that of the visited file), in the form of a list
5363 \(HIGH LOW USEC PSEC) or an integer flag as returned by
5364 `visited-file-modtime'. */)
5365 (Lisp_Object time_flag)
5367 if (!NILP (time_flag))
5369 struct timespec mtime;
5370 if (INTEGERP (time_flag))
5372 CHECK_RANGED_INTEGER (time_flag, -1, 0);
5373 mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag));
5375 else
5376 mtime = lisp_time_argument (time_flag);
5378 current_buffer->modtime = mtime;
5379 current_buffer->modtime_size = -1;
5381 else
5383 register Lisp_Object filename;
5384 struct stat st;
5385 Lisp_Object handler;
5387 filename = Fexpand_file_name (BVAR (current_buffer, filename), Qnil);
5389 /* If the file name has special constructs in it,
5390 call the corresponding file handler. */
5391 handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
5392 if (!NILP (handler))
5393 /* The handler can find the file name the same way we did. */
5394 return call2 (handler, Qset_visited_file_modtime, Qnil);
5396 filename = ENCODE_FILE (filename);
5398 if (stat (SSDATA (filename), &st) >= 0)
5400 current_buffer->modtime = get_stat_mtime (&st);
5401 current_buffer->modtime_size = st.st_size;
5405 return Qnil;
5408 static Lisp_Object
5409 auto_save_error (Lisp_Object error_val)
5411 Lisp_Object msg;
5412 int i;
5413 struct gcpro gcpro1;
5415 auto_save_error_occurred = 1;
5417 ring_bell (XFRAME (selected_frame));
5419 msg = Fformat (3, ((Lisp_Object [])
5420 { build_local_string ("Auto-saving %s: %s"),
5421 BVAR (current_buffer, name),
5422 Ferror_message_string (error_val) }));
5423 GCPRO1 (msg);
5425 for (i = 0; i < 3; ++i)
5427 if (i == 0)
5428 message3 (msg);
5429 else
5430 message3_nolog (msg);
5431 Fsleep_for (make_number (1), Qnil);
5434 UNGCPRO;
5435 return Qnil;
5438 static Lisp_Object
5439 auto_save_1 (void)
5441 struct stat st;
5442 Lisp_Object modes;
5444 auto_save_mode_bits = 0666;
5446 /* Get visited file's mode to become the auto save file's mode. */
5447 if (! NILP (BVAR (current_buffer, filename)))
5449 if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0)
5450 /* But make sure we can overwrite it later! */
5451 auto_save_mode_bits = (st.st_mode | 0600) & 0777;
5452 else if (modes = Ffile_modes (BVAR (current_buffer, filename)),
5453 INTEGERP (modes))
5454 /* Remote files don't cooperate with stat. */
5455 auto_save_mode_bits = (XINT (modes) | 0600) & 0777;
5458 return
5459 Fwrite_region (Qnil, Qnil, BVAR (current_buffer, auto_save_file_name), Qnil,
5460 NILP (Vauto_save_visited_file_name) ? Qlambda : Qt,
5461 Qnil, Qnil);
5464 struct auto_save_unwind
5466 FILE *stream;
5467 bool auto_raise;
5470 static void
5471 do_auto_save_unwind (void *arg)
5473 struct auto_save_unwind *p = arg;
5474 FILE *stream = p->stream;
5475 minibuffer_auto_raise = p->auto_raise;
5476 auto_saving = 0;
5477 if (stream != NULL)
5479 block_input ();
5480 fclose (stream);
5481 unblock_input ();
5485 static Lisp_Object
5486 do_auto_save_make_dir (Lisp_Object dir)
5488 Lisp_Object result;
5490 auto_saving_dir_umask = 077;
5491 result = call2 (Qmake_directory, dir, Qt);
5492 auto_saving_dir_umask = 0;
5493 return result;
5496 static Lisp_Object
5497 do_auto_save_eh (Lisp_Object ignore)
5499 auto_saving_dir_umask = 0;
5500 return Qnil;
5503 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
5504 doc: /* Auto-save all buffers that need it.
5505 This is all buffers that have auto-saving enabled
5506 and are changed since last auto-saved.
5507 Auto-saving writes the buffer into a file
5508 so that your editing is not lost if the system crashes.
5509 This file is not the file you visited; that changes only when you save.
5510 Normally we run the normal hook `auto-save-hook' before saving.
5512 A non-nil NO-MESSAGE argument means do not print any message if successful.
5513 A non-nil CURRENT-ONLY argument means save only current buffer. */)
5514 (Lisp_Object no_message, Lisp_Object current_only)
5516 struct buffer *old = current_buffer, *b;
5517 Lisp_Object tail, buf, hook;
5518 bool auto_saved = 0;
5519 int do_handled_files;
5520 Lisp_Object oquit;
5521 FILE *stream = NULL;
5522 ptrdiff_t count = SPECPDL_INDEX ();
5523 bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
5524 bool old_message_p = 0;
5525 struct auto_save_unwind auto_save_unwind;
5526 struct gcpro gcpro1, gcpro2;
5528 if (max_specpdl_size < specpdl_size + 40)
5529 max_specpdl_size = specpdl_size + 40;
5531 if (minibuf_level)
5532 no_message = Qt;
5534 if (NILP (no_message))
5536 old_message_p = push_message ();
5537 record_unwind_protect_void (pop_message_unwind);
5540 /* Ordinarily don't quit within this function,
5541 but don't make it impossible to quit (in case we get hung in I/O). */
5542 oquit = Vquit_flag;
5543 Vquit_flag = Qnil;
5545 /* No GCPRO needed, because (when it matters) all Lisp_Object variables
5546 point to non-strings reached from Vbuffer_alist. */
5548 hook = intern ("auto-save-hook");
5549 safe_run_hooks (hook);
5551 if (STRINGP (Vauto_save_list_file_name))
5553 Lisp_Object listfile;
5555 listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
5557 /* Don't try to create the directory when shutting down Emacs,
5558 because creating the directory might signal an error, and
5559 that would leave Emacs in a strange state. */
5560 if (!NILP (Vrun_hooks))
5562 Lisp_Object dir;
5563 dir = Qnil;
5564 GCPRO2 (dir, listfile);
5565 dir = Ffile_name_directory (listfile);
5566 if (NILP (Ffile_directory_p (dir)))
5567 internal_condition_case_1 (do_auto_save_make_dir,
5568 dir, Qt,
5569 do_auto_save_eh);
5570 UNGCPRO;
5573 stream = emacs_fopen (SSDATA (listfile), "w");
5576 auto_save_unwind.stream = stream;
5577 auto_save_unwind.auto_raise = minibuffer_auto_raise;
5578 record_unwind_protect_ptr (do_auto_save_unwind, &auto_save_unwind);
5579 minibuffer_auto_raise = 0;
5580 auto_saving = 1;
5581 auto_save_error_occurred = 0;
5583 /* On first pass, save all files that don't have handlers.
5584 On second pass, save all files that do have handlers.
5586 If Emacs is crashing, the handlers may tweak what is causing
5587 Emacs to crash in the first place, and it would be a shame if
5588 Emacs failed to autosave perfectly ordinary files because it
5589 couldn't handle some ange-ftp'd file. */
5591 for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
5592 FOR_EACH_LIVE_BUFFER (tail, buf)
5594 b = XBUFFER (buf);
5596 /* Record all the buffers that have auto save mode
5597 in the special file that lists them. For each of these buffers,
5598 Record visited name (if any) and auto save name. */
5599 if (STRINGP (BVAR (b, auto_save_file_name))
5600 && stream != NULL && do_handled_files == 0)
5602 block_input ();
5603 if (!NILP (BVAR (b, filename)))
5605 fwrite (SDATA (BVAR (b, filename)), 1,
5606 SBYTES (BVAR (b, filename)), stream);
5608 putc ('\n', stream);
5609 fwrite (SDATA (BVAR (b, auto_save_file_name)), 1,
5610 SBYTES (BVAR (b, auto_save_file_name)), stream);
5611 putc ('\n', stream);
5612 unblock_input ();
5615 if (!NILP (current_only)
5616 && b != current_buffer)
5617 continue;
5619 /* Don't auto-save indirect buffers.
5620 The base buffer takes care of it. */
5621 if (b->base_buffer)
5622 continue;
5624 /* Check for auto save enabled
5625 and file changed since last auto save
5626 and file changed since last real save. */
5627 if (STRINGP (BVAR (b, auto_save_file_name))
5628 && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
5629 && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b)
5630 /* -1 means we've turned off autosaving for a while--see below. */
5631 && XINT (BVAR (b, save_length)) >= 0
5632 && (do_handled_files
5633 || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
5634 Qwrite_region))))
5636 struct timespec before_time = current_timespec ();
5637 struct timespec after_time;
5639 /* If we had a failure, don't try again for 20 minutes. */
5640 if (b->auto_save_failure_time > 0
5641 && before_time.tv_sec - b->auto_save_failure_time < 1200)
5642 continue;
5644 set_buffer_internal (b);
5645 if (NILP (Vauto_save_include_big_deletions)
5646 && (XFASTINT (BVAR (b, save_length)) * 10
5647 > (BUF_Z (b) - BUF_BEG (b)) * 13)
5648 /* A short file is likely to change a large fraction;
5649 spare the user annoying messages. */
5650 && XFASTINT (BVAR (b, save_length)) > 5000
5651 /* These messages are frequent and annoying for `*mail*'. */
5652 && !EQ (BVAR (b, filename), Qnil)
5653 && NILP (no_message))
5655 /* It has shrunk too much; turn off auto-saving here. */
5656 minibuffer_auto_raise = orig_minibuffer_auto_raise;
5657 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
5658 BVAR (b, name), 1);
5659 minibuffer_auto_raise = 0;
5660 /* Turn off auto-saving until there's a real save,
5661 and prevent any more warnings. */
5662 XSETINT (BVAR (b, save_length), -1);
5663 Fsleep_for (make_number (1), Qnil);
5664 continue;
5666 if (!auto_saved && NILP (no_message))
5667 message1 ("Auto-saving...");
5668 internal_condition_case (auto_save_1, Qt, auto_save_error);
5669 auto_saved = 1;
5670 BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
5671 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5672 set_buffer_internal (old);
5674 after_time = current_timespec ();
5676 /* If auto-save took more than 60 seconds,
5677 assume it was an NFS failure that got a timeout. */
5678 if (after_time.tv_sec - before_time.tv_sec > 60)
5679 b->auto_save_failure_time = after_time.tv_sec;
5683 /* Prevent another auto save till enough input events come in. */
5684 record_auto_save ();
5686 if (auto_saved && NILP (no_message))
5688 if (old_message_p)
5690 /* If we are going to restore an old message,
5691 give time to read ours. */
5692 sit_for (make_number (1), 0, 0);
5693 restore_message ();
5695 else if (!auto_save_error_occurred)
5696 /* Don't overwrite the error message if an error occurred.
5697 If we displayed a message and then restored a state
5698 with no message, leave a "done" message on the screen. */
5699 message1 ("Auto-saving...done");
5702 Vquit_flag = oquit;
5704 /* This restores the message-stack status. */
5705 unbind_to (count, Qnil);
5706 return Qnil;
5709 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
5710 Sset_buffer_auto_saved, 0, 0, 0,
5711 doc: /* Mark current buffer as auto-saved with its current text.
5712 No auto-save file will be written until the buffer changes again. */)
5713 (void)
5715 /* FIXME: This should not be called in indirect buffers, since
5716 they're not autosaved. */
5717 BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
5718 XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
5719 current_buffer->auto_save_failure_time = 0;
5720 return Qnil;
5723 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
5724 Sclear_buffer_auto_save_failure, 0, 0, 0,
5725 doc: /* Clear any record of a recent auto-save failure in the current buffer. */)
5726 (void)
5728 current_buffer->auto_save_failure_time = 0;
5729 return Qnil;
5732 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
5733 0, 0, 0,
5734 doc: /* Return t if current buffer has been auto-saved recently.
5735 More precisely, if it has been auto-saved since last read from or saved
5736 in the visited file. If the buffer has no visited file,
5737 then any auto-save counts as "recent". */)
5738 (void)
5740 /* FIXME: maybe we should return nil for indirect buffers since
5741 they're never autosaved. */
5742 return (SAVE_MODIFF < BUF_AUTOSAVE_MODIFF (current_buffer) ? Qt : Qnil);
5745 /* Reading and completing file names */
5747 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
5748 Snext_read_file_uses_dialog_p, 0, 0, 0,
5749 doc: /* Return t if a call to `read-file-name' will use a dialog.
5750 The return value is only relevant for a call to `read-file-name' that happens
5751 before any other event (mouse or keypress) is handled. */)
5752 (void)
5754 #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) \
5755 || defined (HAVE_NS)
5756 if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
5757 && use_dialog_box
5758 && use_file_dialog
5759 && window_system_available (SELECTED_FRAME ()))
5760 return Qt;
5761 #endif
5762 return Qnil;
5765 void
5766 init_fileio (void)
5768 realmask = umask (0);
5769 umask (realmask);
5771 valid_timestamp_file_system = 0;
5773 /* fsync can be a significant performance hit. Often it doesn't
5774 suffice to make the file-save operation survive a crash. For
5775 batch scripts, which are typically part of larger shell commands
5776 that don't fsync other files, its effect on performance can be
5777 significant so its utility is particularly questionable.
5778 Hence, for now by default fsync is used only when interactive.
5780 For more on why fsync often fails to work on today's hardware, see:
5781 Zheng M et al. Understanding the robustness of SSDs under power fault.
5782 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
5783 http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
5785 For more on why fsync does not suffice even if it works properly, see:
5786 Roche X. Necessary step(s) to synchronize filename operations on disk.
5787 Austin Group Defect 672, 2013-03-19
5788 http://austingroupbugs.net/view.php?id=672 */
5789 write_region_inhibit_fsync = noninteractive;
5792 void
5793 syms_of_fileio (void)
5795 DEFSYM (Qoperations, "operations");
5796 DEFSYM (Qexpand_file_name, "expand-file-name");
5797 DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name");
5798 DEFSYM (Qdirectory_file_name, "directory-file-name");
5799 DEFSYM (Qfile_name_directory, "file-name-directory");
5800 DEFSYM (Qfile_name_nondirectory, "file-name-nondirectory");
5801 DEFSYM (Qunhandled_file_name_directory, "unhandled-file-name-directory");
5802 DEFSYM (Qfile_name_as_directory, "file-name-as-directory");
5803 DEFSYM (Qcopy_file, "copy-file");
5804 DEFSYM (Qmake_directory_internal, "make-directory-internal");
5805 DEFSYM (Qmake_directory, "make-directory");
5806 DEFSYM (Qdelete_directory_internal, "delete-directory-internal");
5807 DEFSYM (Qdelete_file, "delete-file");
5808 DEFSYM (Qrename_file, "rename-file");
5809 DEFSYM (Qadd_name_to_file, "add-name-to-file");
5810 DEFSYM (Qmake_symbolic_link, "make-symbolic-link");
5811 DEFSYM (Qfile_exists_p, "file-exists-p");
5812 DEFSYM (Qfile_executable_p, "file-executable-p");
5813 DEFSYM (Qfile_readable_p, "file-readable-p");
5814 DEFSYM (Qfile_writable_p, "file-writable-p");
5815 DEFSYM (Qfile_symlink_p, "file-symlink-p");
5816 DEFSYM (Qaccess_file, "access-file");
5817 DEFSYM (Qfile_directory_p, "file-directory-p");
5818 DEFSYM (Qfile_regular_p, "file-regular-p");
5819 DEFSYM (Qfile_accessible_directory_p, "file-accessible-directory-p");
5820 DEFSYM (Qfile_modes, "file-modes");
5821 DEFSYM (Qset_file_modes, "set-file-modes");
5822 DEFSYM (Qset_file_times, "set-file-times");
5823 DEFSYM (Qfile_selinux_context, "file-selinux-context");
5824 DEFSYM (Qset_file_selinux_context, "set-file-selinux-context");
5825 DEFSYM (Qfile_acl, "file-acl");
5826 DEFSYM (Qset_file_acl, "set-file-acl");
5827 DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
5828 DEFSYM (Qinsert_file_contents, "insert-file-contents");
5829 DEFSYM (Qwrite_region, "write-region");
5830 DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
5831 DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
5832 DEFSYM (Qauto_save_coding, "auto-save-coding");
5834 DEFSYM (Qfile_name_history, "file-name-history");
5835 Fset (Qfile_name_history, Qnil);
5837 DEFSYM (Qfile_error, "file-error");
5838 DEFSYM (Qfile_already_exists, "file-already-exists");
5839 DEFSYM (Qfile_date_error, "file-date-error");
5840 DEFSYM (Qfile_notify_error, "file-notify-error");
5841 DEFSYM (Qexcl, "excl");
5843 DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
5844 doc: /* Coding system for encoding file names.
5845 If it is nil, `default-file-name-coding-system' (which see) is used.
5847 On MS-Windows, the value of this variable is largely ignored if
5848 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5849 behaves as if file names were encoded in `utf-8'. */);
5850 Vfile_name_coding_system = Qnil;
5852 DEFVAR_LISP ("default-file-name-coding-system",
5853 Vdefault_file_name_coding_system,
5854 doc: /* Default coding system for encoding file names.
5855 This variable is used only when `file-name-coding-system' is nil.
5857 This variable is set/changed by the command `set-language-environment'.
5858 User should not set this variable manually,
5859 instead use `file-name-coding-system' to get a constant encoding
5860 of file names regardless of the current language environment.
5862 On MS-Windows, the value of this variable is largely ignored if
5863 \`w32-unicode-filenames' (which see) is non-nil. Emacs on Windows
5864 behaves as if file names were encoded in `utf-8'. */);
5865 Vdefault_file_name_coding_system = Qnil;
5867 DEFSYM (Qformat_decode, "format-decode");
5868 DEFSYM (Qformat_annotate_function, "format-annotate-function");
5869 DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding");
5870 DEFSYM (Qcar_less_than_car, "car-less-than-car");
5872 Fput (Qfile_error, Qerror_conditions,
5873 Fpurecopy (list2 (Qfile_error, Qerror)));
5874 Fput (Qfile_error, Qerror_message,
5875 build_pure_c_string ("File error"));
5877 Fput (Qfile_already_exists, Qerror_conditions,
5878 Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
5879 Fput (Qfile_already_exists, Qerror_message,
5880 build_pure_c_string ("File already exists"));
5882 Fput (Qfile_date_error, Qerror_conditions,
5883 Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
5884 Fput (Qfile_date_error, Qerror_message,
5885 build_pure_c_string ("Cannot set file date"));
5887 Fput (Qfile_notify_error, Qerror_conditions,
5888 Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
5889 Fput (Qfile_notify_error, Qerror_message,
5890 build_pure_c_string ("File notification error"));
5892 DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
5893 doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
5894 If a file name matches REGEXP, all I/O on that file is done by calling
5895 HANDLER. If a file name matches more than one handler, the handler
5896 whose match starts last in the file name gets precedence. The
5897 function `find-file-name-handler' checks this list for a handler for
5898 its argument.
5900 HANDLER should be a function. The first argument given to it is the
5901 name of the I/O primitive to be handled; the remaining arguments are
5902 the arguments that were passed to that primitive. For example, if you
5903 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
5904 HANDLER is called like this:
5906 (funcall HANDLER 'file-exists-p FILENAME)
5908 Note that HANDLER must be able to handle all I/O primitives; if it has
5909 nothing special to do for a primitive, it should reinvoke the
5910 primitive to handle the operation \"the usual way\".
5911 See Info node `(elisp)Magic File Names' for more details. */);
5912 Vfile_name_handler_alist = Qnil;
5914 DEFVAR_LISP ("set-auto-coding-function",
5915 Vset_auto_coding_function,
5916 doc: /* If non-nil, a function to call to decide a coding system of file.
5917 Two arguments are passed to this function: the file name
5918 and the length of a file contents following the point.
5919 This function should return a coding system to decode the file contents.
5920 It should check the file name against `auto-coding-alist'.
5921 If no coding system is decided, it should check a coding system
5922 specified in the heading lines with the format:
5923 -*- ... coding: CODING-SYSTEM; ... -*-
5924 or local variable spec of the tailing lines with `coding:' tag. */);
5925 Vset_auto_coding_function = Qnil;
5927 DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions,
5928 doc: /* A list of functions to be called at the end of `insert-file-contents'.
5929 Each is passed one argument, the number of characters inserted,
5930 with point at the start of the inserted text. Each function
5931 should leave point the same, and return the new character count.
5932 If `insert-file-contents' is intercepted by a handler from
5933 `file-name-handler-alist', that handler is responsible for calling the
5934 functions in `after-insert-file-functions' if appropriate. */);
5935 Vafter_insert_file_functions = Qnil;
5937 DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions,
5938 doc: /* A list of functions to be called at the start of `write-region'.
5939 Each is passed two arguments, START and END as for `write-region'.
5940 These are usually two numbers but not always; see the documentation
5941 for `write-region'. The function should return a list of pairs
5942 of the form (POSITION . STRING), consisting of strings to be effectively
5943 inserted at the specified positions of the file being written (1 means to
5944 insert before the first byte written). The POSITIONs must be sorted into
5945 increasing order.
5947 If there are several annotation functions, the lists returned by these
5948 functions are merged destructively. As each annotation function runs,
5949 the variable `write-region-annotations-so-far' contains a list of all
5950 annotations returned by previous annotation functions.
5952 An annotation function can return with a different buffer current.
5953 Doing so removes the annotations returned by previous functions, and
5954 resets START and END to `point-min' and `point-max' of the new buffer.
5956 After `write-region' completes, Emacs calls the function stored in
5957 `write-region-post-annotation-function', once for each buffer that was
5958 current when building the annotations (i.e., at least once), with that
5959 buffer current. */);
5960 Vwrite_region_annotate_functions = Qnil;
5961 DEFSYM (Qwrite_region_annotate_functions, "write-region-annotate-functions");
5963 DEFVAR_LISP ("write-region-post-annotation-function",
5964 Vwrite_region_post_annotation_function,
5965 doc: /* Function to call after `write-region' completes.
5966 The function is called with no arguments. If one or more of the
5967 annotation functions in `write-region-annotate-functions' changed the
5968 current buffer, the function stored in this variable is called for
5969 each of those additional buffers as well, in addition to the original
5970 buffer. The relevant buffer is current during each function call. */);
5971 Vwrite_region_post_annotation_function = Qnil;
5972 staticpro (&Vwrite_region_annotation_buffers);
5974 DEFVAR_LISP ("write-region-annotations-so-far",
5975 Vwrite_region_annotations_so_far,
5976 doc: /* When an annotation function is called, this holds the previous annotations.
5977 These are the annotations made by other annotation functions
5978 that were already called. See also `write-region-annotate-functions'. */);
5979 Vwrite_region_annotations_so_far = Qnil;
5981 DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers,
5982 doc: /* A list of file name handlers that temporarily should not be used.
5983 This applies only to the operation `inhibit-file-name-operation'. */);
5984 Vinhibit_file_name_handlers = Qnil;
5986 DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation,
5987 doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
5988 Vinhibit_file_name_operation = Qnil;
5990 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name,
5991 doc: /* File name in which we write a list of all auto save file names.
5992 This variable is initialized automatically from `auto-save-list-file-prefix'
5993 shortly after Emacs reads your init file, if you have not yet given it
5994 a non-nil value. */);
5995 Vauto_save_list_file_name = Qnil;
5997 DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name,
5998 doc: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
5999 Normally auto-save files are written under other names. */);
6000 Vauto_save_visited_file_name = Qnil;
6002 DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions,
6003 doc: /* If non-nil, auto-save even if a large part of the text is deleted.
6004 If nil, deleting a substantial portion of the text disables auto-save
6005 in the buffer; this is the default behavior, because the auto-save
6006 file is usually more useful if it contains the deleted text. */);
6007 Vauto_save_include_big_deletions = Qnil;
6009 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync,
6010 doc: /* Non-nil means don't call fsync in `write-region'.
6011 This variable affects calls to `write-region' as well as save commands.
6012 Setting this to nil may avoid data loss if the system loses power or
6013 the operating system crashes. By default, it is non-nil in batch mode. */);
6014 write_region_inhibit_fsync = 0; /* See also `init_fileio' above. */
6016 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash,
6017 doc: /* Specifies whether to use the system's trash can.
6018 When non-nil, certain file deletion commands use the function
6019 `move-file-to-trash' instead of deleting files outright.
6020 This includes interactive calls to `delete-file' and
6021 `delete-directory' and the Dired deletion commands. */);
6022 delete_by_moving_to_trash = 0;
6023 Qdelete_by_moving_to_trash = intern_c_string ("delete-by-moving-to-trash");
6025 DEFSYM (Qmove_file_to_trash, "move-file-to-trash");
6026 DEFSYM (Qcopy_directory, "copy-directory");
6027 DEFSYM (Qdelete_directory, "delete-directory");
6028 DEFSYM (Qsubstitute_env_in_file_name, "substitute-env-in-file-name");
6030 defsubr (&Sfind_file_name_handler);
6031 defsubr (&Sfile_name_directory);
6032 defsubr (&Sfile_name_nondirectory);
6033 defsubr (&Sunhandled_file_name_directory);
6034 defsubr (&Sfile_name_as_directory);
6035 defsubr (&Sdirectory_file_name);
6036 defsubr (&Smake_temp_name);
6037 defsubr (&Sexpand_file_name);
6038 defsubr (&Ssubstitute_in_file_name);
6039 defsubr (&Scopy_file);
6040 defsubr (&Smake_directory_internal);
6041 defsubr (&Sdelete_directory_internal);
6042 defsubr (&Sdelete_file);
6043 defsubr (&Srename_file);
6044 defsubr (&Sadd_name_to_file);
6045 defsubr (&Smake_symbolic_link);
6046 defsubr (&Sfile_name_absolute_p);
6047 defsubr (&Sfile_exists_p);
6048 defsubr (&Sfile_executable_p);
6049 defsubr (&Sfile_readable_p);
6050 defsubr (&Sfile_writable_p);
6051 defsubr (&Saccess_file);
6052 defsubr (&Sfile_symlink_p);
6053 defsubr (&Sfile_directory_p);
6054 defsubr (&Sfile_accessible_directory_p);
6055 defsubr (&Sfile_regular_p);
6056 defsubr (&Sfile_modes);
6057 defsubr (&Sset_file_modes);
6058 defsubr (&Sset_file_times);
6059 defsubr (&Sfile_selinux_context);
6060 defsubr (&Sfile_acl);
6061 defsubr (&Sset_file_acl);
6062 defsubr (&Sset_file_selinux_context);
6063 defsubr (&Sset_default_file_modes);
6064 defsubr (&Sdefault_file_modes);
6065 defsubr (&Sfile_newer_than_file_p);
6066 defsubr (&Sinsert_file_contents);
6067 defsubr (&Swrite_region);
6068 defsubr (&Scar_less_than_car);
6069 defsubr (&Sverify_visited_file_modtime);
6070 defsubr (&Svisited_file_modtime);
6071 defsubr (&Sset_visited_file_modtime);
6072 defsubr (&Sdo_auto_save);
6073 defsubr (&Sset_buffer_auto_saved);
6074 defsubr (&Sclear_buffer_auto_save_failure);
6075 defsubr (&Srecent_auto_save_p);
6077 defsubr (&Snext_read_file_uses_dialog_p);
6079 #ifdef HAVE_SYNC
6080 defsubr (&Sunix_sync);
6081 #endif