root/src/fileio.c

DEFINITIONS

1. file_access_p
2. get_file_errno_data
3. report_file_errno
4. report_file_error
5. report_file_notify_error
6. file_metadata_errno
7. file_attribute_errno
8. close_file_unwind
9. fclose_unwind
10. restore_point_unwind
11. DEFUN
12. file_name_directory
13. DEFUN
14. DEFUN
15. file_name_as_directory
16. DEFUN
17. directory_file_name
18. DEFUN
19. expand_cp_target
20. DEFUN
21. DEFUN
22. file_name_absolute_no_tilde_p
23. user_homedir
24. splice_dir_file
25. get_homedir
26. search_embedded_absfilename
27. DEFUN
28. expand_and_dir_to_file
29. barf_or_query_if_file_exists
30. clone_file
31. DEFUN
32. DEFUN
33. internal_delete_file_1
34. internal_delete_file
35. file_name_case_insensitive_err
36. DEFUN
37. DEFUN
38. file_name_absolute_p
39. check_file_access
40. DEFUN
41. DEFUN
42. DEFUN
43. DEFUN
44. emacs_readlinkat
45. check_emacs_readlinkat
46. DEFUN
47. DEFUN
48. file_directory_p
49. DEFUN
50. file_accessible_directory_p
51. DEFUN
52. DEFUN
53. DEFUN
54. symlink_nofollow_flag
55. DEFUN
56. DEFUN
57. DEFUN
58. decide_coding_unwind
59. read_non_regular
60. read_non_regular_quit
61. file_offset
62. time_error_value
63. get_window_points_and_markers
64. restore_window_points
65. maybe_move_gap
66. build_annotations_unwind
67. choose_write_coding_system
68. write_region
69. build_annotations
70. a_write
71. e_write
72. DEFUN
73. buffer_visited_file_modtime
74. DEFUN
75. DEFUN
76. auto_save_error
77. auto_save_1
78. do_auto_save_unwind
79. do_auto_save_make_dir
80. do_auto_save_eh
81. DEFUN
82. DEFUN
83. DEFUN
84. DEFUN
85. blocks_to_bytes
86. DEFUN
87. init_fileio
88. syms_of_fileio

     1 /* File IO for GNU Emacs.
     2 
     3 Copyright (C) 1985-1988, 1993-2023 Free Software Foundation, Inc.
     4 
     5 This file is part of GNU Emacs.
     6 
     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 (at
    10 your option) any later version.
    11 
    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.
    16 
    17 You should have received a copy of the GNU General Public License
    18 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    19 
    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>
    27 
    28 #ifdef DARWIN_OS
    29 #include <sys/attr.h>
    30 #endif
    31 
    32 #ifdef HAVE_PWD_H
    33 #include <pwd.h>
    34 #endif
    35 
    36 #include <errno.h>
    37 
    38 #ifdef HAVE_LIBSELINUX
    39 #include <selinux/selinux.h>
    40 #include <selinux/context.h>
    41 #endif
    42 
    43 #if USE_ACL && defined HAVE_ACL_SET_FILE
    44 #include <sys/acl.h>
    45 #endif
    46 
    47 #include <c-ctype.h>
    48 
    49 #include "lisp.h"
    50 #include "composite.h"
    51 #include "character.h"
    52 #include "buffer.h"
    53 #include "coding.h"
    54 #include "window.h"
    55 #include "blockinput.h"
    56 #include "region-cache.h"
    57 #include "frame.h"
    58 
    59 #ifdef HAVE_LINUX_FS_H
    60 # include <sys/ioctl.h>
    61 # include <linux/fs.h>
    62 #endif
    63 
    64 #ifdef WINDOWSNT
    65 #define NOMINMAX 1
    66 #include <windows.h>
    67 /* The redundant #ifdef is to avoid compiler warning about unused macro.  */
    68 #ifdef NOMINMAX
    69 #undef NOMINMAX
    70 #endif
    71 #include <sys/file.h>
    72 #include "w32.h"
    73 #endif /* not WINDOWSNT */
    74 
    75 #ifdef MSDOS
    76 #include "msdos.h"
    77 #include <sys/param.h>
    78 #endif
    79 
    80 #ifdef DOS_NT
    81 /* On Windows, drive letters must be alphabetic - on DOS, the Netware
    82    redirector allows the six letters between 'Z' and 'a' as well.  */
    83 #ifdef MSDOS
    84 #define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
    85 #endif
    86 #ifdef WINDOWSNT
    87 #define IS_DRIVE(x) c_isalpha (x)
    88 #endif
    89 /* Need to lower-case the drive letter, or else expanded
    90    filenames will sometimes compare unequal, because
    91    `expand-file-name' doesn't always down-case the drive letter.  */
    92 #define DRIVE_LETTER(x) c_tolower (x)
    93 #endif
    94 
    95 #include "systime.h"
    96 #include <acl.h>
    97 #include <allocator.h>
    98 #include <careadlinkat.h>
    99 #include <filename.h>
   100 #include <fsusage.h>
   101 #include <stat-time.h>
   102 #include <tempname.h>
   103 
   104 #include <binary-io.h>
   105 
   106 #ifdef HPUX
   107 #include <netio.h>
   108 #endif
   109 
   110 #include "commands.h"
   111 
   112 /* True during writing of auto-save files.  */
   113 static bool auto_saving;
   114 
   115 /* Emacs's real umask.  */
   116 static mode_t realmask;
   117 
   118 /* Nonzero umask during creation of auto-save directories.  */
   119 static mode_t auto_saving_dir_umask;
   120 
   121 /* Set by auto_save_1 to mode of original file so Fwrite_region will create
   122    a new file with the same mode as the original.  */
   123 static mode_t auto_save_mode_bits;
   124 
   125 /* Set by auto_save_1 if an error occurred during the last auto-save.  */
   126 static bool auto_save_error_occurred;
   127 
   128 /* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
   129    number of a file system where time stamps were observed to work.  */
   130 static bool valid_timestamp_file_system;
   131 static dev_t timestamp_file_system;
   132 
   133 /* Each time an annotation function changes the buffer, the new buffer
   134    is added here.  */
   135 static Lisp_Object Vwrite_region_annotation_buffers;
   136 
   137 static Lisp_Object file_name_directory (Lisp_Object);
   138 static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
   139                      Lisp_Object *, struct coding_system *);
   140 static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
   141                      struct coding_system *);
   142 
   143 
   144 /* Test whether FILE is accessible for AMODE.
   145    Return true if successful, false (setting errno) otherwise.  */
   146 
   147 bool
   148 file_access_p (char const *file, int amode)
   149 {
   150 #ifdef MSDOS
   151   if (amode & W_OK)
   152     {
   153       /* FIXME: The MS-DOS faccessat implementation should handle this.  */
   154       struct stat st;
   155       if (stat (file, &st) != 0)
   156         return false;
   157       errno = EPERM;
   158       return st.st_mode & S_IWRITE || S_ISDIR (st.st_mode);
   159     }
   160 #endif
   161 
   162   if (faccessat (AT_FDCWD, file, amode, AT_EACCESS) == 0)
   163     return true;
   164 
   165 #ifdef CYGWIN
   166   /* Return success if faccessat failed because Cygwin couldn't
   167      determine the file's UID or GID.  */
   168   int err = errno;
   169   struct stat st;
   170   if (stat (file, &st) == 0 && (st.st_uid == -1 || st.st_gid == -1))
   171     return true;
   172   errno = err;
   173 #endif
   174 
   175   return false;
   176 }
   177 
   178 /* Signal a file-access failure.  STRING describes the failure,
   179    NAME the file involved, and ERRORNO the errno value.
   180 
   181    If NAME is neither null nor a pair, package it up as a singleton
   182    list before reporting it; this saves report_file_errno's caller the
   183    trouble of preserving errno before calling list1.  */
   184 
   185 Lisp_Object
   186 get_file_errno_data (char const *string, Lisp_Object name, int errorno)
   187 {
   188   Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
   189   char *str = emacs_strerror (errorno);
   190   AUTO_STRING (unibyte_str, str);
   191   Lisp_Object errstring
   192     = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
   193   Lisp_Object errdata = Fcons (errstring, data);
   194 
   195   if (errorno == EEXIST)
   196     return Fcons (Qfile_already_exists, errdata);
   197   else
   198     return Fcons (errorno == ENOENT
   199                   ? Qfile_missing
   200                   : (errorno == EACCES
   201                      ? Qpermission_denied
   202                      : Qfile_error),
   203                   Fcons (build_string (string), errdata));
   204 }
   205 
   206 void
   207 report_file_errno (char const *string, Lisp_Object name, int errorno)
   208 {
   209   Lisp_Object data = get_file_errno_data (string, name, errorno);
   210 
   211   xsignal (Fcar (data), Fcdr (data));
   212 }
   213 
   214 /* Signal a file-access failure that set errno.  STRING describes the
   215    failure, NAME the file involved.  When invoking this function, take
   216    care to not use arguments such as build_string ("foo") that involve
   217    side effects that may set errno.  */
   218 
   219 void
   220 report_file_error (char const *string, Lisp_Object name)
   221 {
   222   report_file_errno (string, name, errno);
   223 }
   224 
   225 #ifdef USE_FILE_NOTIFY
   226 /* Like report_file_error, but reports a file-notify-error instead.  */
   227 
   228 void
   229 report_file_notify_error (const char *string, Lisp_Object name)
   230 {
   231   char *str = emacs_strerror (errno);
   232   AUTO_STRING (unibyte_str, str);
   233   Lisp_Object errstring
   234     = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
   235   Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
   236   Lisp_Object errdata = Fcons (errstring, data);
   237 
   238   xsignal (Qfile_notify_error, Fcons (build_string (string), errdata));
   239 }
   240 #endif
   241 
   242 /* ACTION failed for FILE with errno ERR.  Signal an error if ERR
   243    means the file's metadata could not be retrieved even though it may
   244    exist, otherwise return nil.  */
   245 
   246 static Lisp_Object
   247 file_metadata_errno (char const *action, Lisp_Object file, int err)
   248 {
   249   if (err == ENOENT || err == ENOTDIR || err == 0)
   250     return Qnil;
   251   report_file_errno (action, file, err);
   252 }
   253 
   254 Lisp_Object
   255 file_attribute_errno (Lisp_Object file, int err)
   256 {
   257   return file_metadata_errno ("Getting attributes", file, err);
   258 }
   259 
   260 void
   261 close_file_unwind (int fd)
   262 {
   263   emacs_close (fd);
   264 }
   265 
   266 void
   267 fclose_unwind (void *arg)
   268 {
   269   FILE *stream = arg;
   270   fclose (stream);
   271 }
   272 
   273 /* Restore point, having saved it as a marker.  */
   274 
   275 void
   276 restore_point_unwind (Lisp_Object location)
   277 {
   278   Fgoto_char (location);
   279   unchain_marker (XMARKER (location));
   280 }
   281 
   282 
   283 DEFUN ("find-file-name-handler", Ffind_file_name_handler,
   284        Sfind_file_name_handler, 2, 2, 0,
   285        doc: /* Return FILENAME's handler function for OPERATION, if it has one.
   286 Otherwise, return nil.
   287 A file name is handled if one of the regular expressions in
   288 `file-name-handler-alist' matches it.
   289 
   290 If OPERATION equals `inhibit-file-name-operation', then ignore
   291 any handlers that are members of `inhibit-file-name-handlers',
   292 but still do run any other handlers.  This lets handlers
   293 use the standard functions without calling themselves recursively.  */)
   294   (Lisp_Object filename, Lisp_Object operation)
   295 {
   296   /* This function must not munge the match data.  */
   297   Lisp_Object chain, inhibited_handlers, result;
   298   ptrdiff_t pos = -1;
   299 
   300   result = Qnil;
   301   CHECK_STRING (filename);
   302 
   303   if (EQ (operation, Vinhibit_file_name_operation))
   304     inhibited_handlers = Vinhibit_file_name_handlers;
   305   else
   306     inhibited_handlers = Qnil;
   307 
   308   for (chain = Vfile_name_handler_alist; CONSP (chain);
   309        chain = XCDR (chain))
   310     {
   311       Lisp_Object elt;
   312       elt = XCAR (chain);
   313       if (CONSP (elt))
   314         {
   315           Lisp_Object string = XCAR (elt);
   316           ptrdiff_t match_pos;
   317           Lisp_Object handler = XCDR (elt);
   318           Lisp_Object operations = Qnil;
   319 
   320           if (SYMBOLP (handler))
   321             operations = Fget (handler, Qoperations);
   322 
   323           if (STRINGP (string)
   324               && (match_pos = fast_string_match (string, filename)) > pos
   325               && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
   326             {
   327               Lisp_Object tem;
   328 
   329               handler = XCDR (elt);
   330               tem = Fmemq (handler, inhibited_handlers);
   331               if (NILP (tem))
   332                 {
   333                   result = handler;
   334                   pos = match_pos;
   335                 }
   336             }
   337         }
   338 
   339       maybe_quit ();
   340     }
   341   return result;
   342 }
   343 
   344 DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
   345        1, 1, 0,
   346        doc: /* Return the directory component in file name FILENAME.
   347 Return nil if FILENAME does not include a directory.
   348 Otherwise return a directory name.
   349 Given a Unix syntax file name, returns a string ending in slash.  */)
   350   (Lisp_Object filename)
   351 {
   352   Lisp_Object handler;
   353 
   354   CHECK_STRING (filename);
   355 
   356   /* If the file name has special constructs in it,
   357      call the corresponding file name handler.  */
   358   handler = Ffind_file_name_handler (filename, Qfile_name_directory);
   359   if (!NILP (handler))
   360     {
   361       Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
   362                                         filename);
   363       return STRINGP (handled_name) ? handled_name : Qnil;
   364     }
   365 
   366   return file_name_directory (filename);
   367 }
   368 
   369 /* Return the directory component of FILENAME, or nil if FILENAME does
   370    not contain a directory component.  */
   371 
   372 static Lisp_Object
   373 file_name_directory (Lisp_Object filename)
   374 {
   375   char *beg = SSDATA (filename);
   376   char const *p = beg + SBYTES (filename);
   377 
   378   while (p != beg && !IS_DIRECTORY_SEP (p[-1])
   379 #ifdef DOS_NT
   380          /* only recognize drive specifier at the beginning */
   381          && !(p[-1] == ':'
   382               /* handle the "/:d:foo" and "/:foo" cases correctly  */
   383               && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
   384                   || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
   385 #endif
   386          ) p--;
   387 
   388   if (p == beg)
   389     return Qnil;
   390 #ifdef DOS_NT
   391   /* Expansion of "c:" to drive and default directory.  */
   392   Lisp_Object tem_fn;
   393   USE_SAFE_ALLOCA;
   394   SAFE_ALLOCA_STRING (beg, filename);
   395   p = beg + (p - SSDATA (filename));
   396 
   397   if (p[-1] == ':')
   398     {
   399       /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir.  */
   400       char *res = alloca (MAXPATHLEN + 1);
   401       char *r = res;
   402 
   403       if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
   404         {
   405           memcpy (res, beg, 2);
   406           beg += 2;
   407           r += 2;
   408         }
   409 
   410       if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
   411         {
   412           size_t l = strlen (res);
   413 
   414           if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
   415             strcat (res, "/");
   416           beg = res;
   417           p = beg + strlen (beg);
   418           dostounix_filename (beg);
   419           tem_fn = make_specified_string (beg, -1, p - beg,
   420                                           STRING_MULTIBYTE (filename));
   421         }
   422       else
   423         tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
   424                                         STRING_MULTIBYTE (filename));
   425     }
   426   else if (STRING_MULTIBYTE (filename))
   427     {
   428       tem_fn = make_specified_string (beg, -1, p - beg, 1);
   429       dostounix_filename (SSDATA (tem_fn));
   430 #ifdef WINDOWSNT
   431       if (!NILP (Vw32_downcase_file_names))
   432         tem_fn = Fdowncase (tem_fn);
   433 #endif
   434     }
   435   else
   436     {
   437       dostounix_filename (beg);
   438       tem_fn = make_specified_string (beg, -1, p - beg, 0);
   439     }
   440   SAFE_FREE ();
   441   return tem_fn;
   442 #else  /* DOS_NT */
   443   return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
   444 #endif  /* DOS_NT */
   445 }
   446 
   447 DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
   448        Sfile_name_nondirectory, 1, 1, 0,
   449        doc: /* Return file name FILENAME sans its directory.
   450 For example, in a Unix-syntax file name,
   451 this is everything after the last slash,
   452 or the entire name if it contains no slash.  */)
   453   (Lisp_Object filename)
   454 {
   455   register const char *beg, *p, *end;
   456   Lisp_Object handler;
   457 
   458   CHECK_STRING (filename);
   459 
   460   /* If the file name has special constructs in it,
   461      call the corresponding file name handler.  */
   462   handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
   463   if (!NILP (handler))
   464     {
   465       Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory,
   466                                         filename);
   467       if (STRINGP (handled_name))
   468         return handled_name;
   469       error ("Invalid handler in `file-name-handler-alist'");
   470     }
   471 
   472   beg = SSDATA (filename);
   473   end = p = beg + SBYTES (filename);
   474 
   475   while (p != beg && !IS_DIRECTORY_SEP (p[-1])
   476 #ifdef DOS_NT
   477          /* only recognize drive specifier at beginning */
   478          && !(p[-1] == ':'
   479               /* handle the "/:d:foo" case correctly  */
   480               && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
   481 #endif
   482          )
   483     p--;
   484 
   485   return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
   486 }
   487 
   488 DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
   489        Sunhandled_file_name_directory, 1, 1, 0,
   490        doc: /* Return a directly usable directory name somehow associated with FILENAME.
   491 A `directly usable' directory name is one that may be used without the
   492 intervention of any file name handler.
   493 If FILENAME is a directly usable file itself, return
   494 \(file-name-as-directory FILENAME).
   495 If FILENAME refers to a file which is not accessible from a local process,
   496 then this should return nil.
   497 The `call-process' and `start-process' functions use this function to
   498 get a current directory to run processes in.  */)
   499   (Lisp_Object filename)
   500 {
   501   Lisp_Object handler;
   502 
   503   /* If the file name has special constructs in it,
   504      call the corresponding file name handler.  */
   505   handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
   506   if (!NILP (handler))
   507     {
   508       Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
   509                                         filename);
   510       return STRINGP (handled_name) ? handled_name : Qnil;
   511     }
   512 
   513   return Ffile_name_as_directory (filename);
   514 }
   515 
   516 /* Maximum number of bytes that DST will be longer than SRC
   517    in file_name_as_directory.  This occurs when SRCLEN == 0.  */
   518 enum { file_name_as_directory_slop = 2 };
   519 
   520 /* Convert from file name SRC of length SRCLEN to directory name in
   521    DST.  MULTIBYTE non-zero means the file name in SRC is a multibyte
   522    string.  On UNIX, just make sure there is a terminating /.  Return
   523    the length of DST in bytes.  */
   524 
   525 static ptrdiff_t
   526 file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
   527                         bool multibyte)
   528 {
   529   if (srclen == 0)
   530     {
   531       dst[0] = '.';
   532       dst[1] = '/';
   533       dst[2] = '\0';
   534       return 2;
   535     }
   536 
   537   memcpy (dst, src, srclen);
   538   if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
   539     dst[srclen++] = DIRECTORY_SEP;
   540   dst[srclen] = 0;
   541 #ifdef DOS_NT
   542   dostounix_filename (dst);
   543 #endif
   544   return srclen;
   545 }
   546 
   547 DEFUN ("file-name-as-directory", Ffile_name_as_directory,
   548        Sfile_name_as_directory, 1, 1, 0,
   549        doc: /* Return a string representing the file name FILE interpreted as a directory.
   550 This operation exists because a directory is also a file, but its name as
   551 a directory is different from its name as a file.
   552 The result can be used as the value of `default-directory'
   553 or passed as second argument to `expand-file-name'.
   554 For a Unix-syntax file name, just appends a slash unless a trailing slash
   555 is already present.  */)
   556   (Lisp_Object file)
   557 {
   558   char *buf;
   559   ptrdiff_t length;
   560   Lisp_Object handler, val;
   561   USE_SAFE_ALLOCA;
   562 
   563   CHECK_STRING (file);
   564 
   565   /* If the file name has special constructs in it,
   566      call the corresponding file name handler.  */
   567   handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
   568   if (!NILP (handler))
   569     {
   570       Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory,
   571                                         file);
   572       if (STRINGP (handled_name))
   573         return handled_name;
   574       error ("Invalid handler in `file-name-handler-alist'");
   575     }
   576 
   577 #ifdef WINDOWSNT
   578   if (!NILP (Vw32_downcase_file_names))
   579     file = Fdowncase (file);
   580 #endif
   581   buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
   582   length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
   583                                    STRING_MULTIBYTE (file));
   584   val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
   585   SAFE_FREE ();
   586   return val;
   587 }
   588 
   589 /* Convert from directory name SRC of length SRCLEN to file name in
   590    DST.  MULTIBYTE non-zero means the file name in SRC is a multibyte
   591    string.  On UNIX, just make sure there isn't a terminating /.
   592    Return the length of DST in bytes.  */
   593 
   594 static ptrdiff_t
   595 directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
   596 {
   597   /* In Unix-like systems, just remove any final slashes.  However, if
   598      they are all slashes, leave "/" and "//" alone, and treat "///"
   599      and longer as if they were "/".  */
   600   if (! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
   601     while (srclen > 1
   602 #ifdef DOS_NT
   603            && !(srclen > 2 && IS_DEVICE_SEP (src[srclen - 2]))
   604 #endif
   605            && IS_DIRECTORY_SEP (src[srclen - 1]))
   606       srclen--;
   607 
   608   memcpy (dst, src, srclen);
   609   dst[srclen] = 0;
   610 #ifdef DOS_NT
   611   dostounix_filename (dst);
   612 #endif
   613   return srclen;
   614 }
   615 
   616 DEFUN ("directory-name-p", Fdirectory_name_p, Sdirectory_name_p, 1, 1, 0,
   617        doc: /* Return non-nil if NAME ends with a directory separator character.  */)
   618   (Lisp_Object name)
   619 {
   620   CHECK_STRING (name);
   621   ptrdiff_t namelen = SBYTES (name);
   622   unsigned char c = namelen ? SREF (name, namelen - 1) : 0;
   623   return IS_DIRECTORY_SEP (c) ? Qt : Qnil;
   624 }
   625 
   626 /* Return the expansion of NEWNAME, except that if NEWNAME is a
   627    directory name then return the expansion of FILE's basename under
   628    NEWNAME.  This resembles how 'cp FILE NEWNAME' works, except that
   629    it requires NEWNAME to be a directory name (typically, by ending in
   630    "/").  */
   631 
   632 static Lisp_Object
   633 expand_cp_target (Lisp_Object file, Lisp_Object newname)
   634 {
   635   return (!NILP (Fdirectory_name_p (newname))
   636           ? Fexpand_file_name (Ffile_name_nondirectory (file), newname)
   637           : Fexpand_file_name (newname, Qnil));
   638 }
   639 
   640 DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
   641        1, 1, 0,
   642        doc: /* Returns the file name of the directory named DIRECTORY.
   643 This is the name of the file that holds the data for the directory DIRECTORY.
   644 This operation exists because a directory is also a file, but its name as
   645 a directory is different from its name as a file.
   646 In Unix-syntax, this function just removes the final slash.  */)
   647   (Lisp_Object directory)
   648 {
   649   char *buf;
   650   ptrdiff_t length;
   651   Lisp_Object handler, val;
   652   USE_SAFE_ALLOCA;
   653 
   654   CHECK_STRING (directory);
   655 
   656   /* If the file name has special constructs in it,
   657      call the corresponding file name handler.  */
   658   handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
   659   if (!NILP (handler))
   660     {
   661       Lisp_Object handled_name = call2 (handler, Qdirectory_file_name,
   662                                         directory);
   663       if (STRINGP (handled_name))
   664         return handled_name;
   665       error ("Invalid handler in `file-name-handler-alist'");
   666     }
   667 
   668 #ifdef WINDOWSNT
   669   if (!NILP (Vw32_downcase_file_names))
   670     directory = Fdowncase (directory);
   671 #endif
   672   buf = SAFE_ALLOCA (SBYTES (directory) + 1);
   673   length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
   674                                 STRING_MULTIBYTE (directory));
   675   val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
   676   SAFE_FREE ();
   677   return val;
   678 }
   679 
   680 DEFUN ("make-temp-file-internal", Fmake_temp_file_internal,
   681        Smake_temp_file_internal, 4, 4, 0,
   682        doc: /* Generate a new file whose name starts with PREFIX, a string.
   683 Return the name of the generated file.  If DIR-FLAG is zero, do not
   684 create the file, just its name.  Otherwise, if DIR-FLAG is non-nil,
   685 create an empty directory.  The file name should end in SUFFIX.
   686 Do not expand PREFIX; a non-absolute PREFIX is relative to the Emacs
   687 working directory.  If TEXT is a string, insert it into the newly
   688 created file.
   689 
   690 Signal an error if the file could not be created.
   691 
   692 This function does not grok magic file names.  */)
   693   (Lisp_Object prefix, Lisp_Object dir_flag, Lisp_Object suffix,
   694    Lisp_Object text)
   695 {
   696   CHECK_STRING (prefix);
   697   CHECK_STRING (suffix);
   698   Lisp_Object encoded_prefix = ENCODE_FILE (prefix);
   699   Lisp_Object encoded_suffix = ENCODE_FILE (suffix);
   700   ptrdiff_t prefix_len = SBYTES (encoded_prefix);
   701   ptrdiff_t suffix_len = SBYTES (encoded_suffix);
   702   if (INT_MAX < suffix_len)
   703     args_out_of_range (prefix, suffix);
   704   int nX = 6;
   705   Lisp_Object val = make_uninit_string (prefix_len + nX + suffix_len);
   706   char *data = SSDATA (val);
   707   memcpy (data, SSDATA (encoded_prefix), prefix_len);
   708   memset (data + prefix_len, 'X', nX);
   709   memcpy (data + prefix_len + nX, SSDATA (encoded_suffix), suffix_len);
   710   int kind = (NILP (dir_flag) ? GT_FILE
   711               : BASE_EQ (dir_flag, make_fixnum (0)) ? GT_NOCREATE
   712               : GT_DIR);
   713   int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind);
   714   bool failed = fd < 0;
   715   if (!failed)
   716     {
   717       specpdl_ref count = SPECPDL_INDEX ();
   718       record_unwind_protect_int (close_file_unwind, fd);
   719       val = DECODE_FILE (val);
   720       if (STRINGP (text) && SBYTES (text) != 0)
   721         write_region (text, Qnil, val, Qnil, Qnil, Qnil, Qnil, fd);
   722       failed = NILP (dir_flag) && emacs_close (fd) != 0;
   723       /* Discard the unwind protect.  */
   724       specpdl_ptr = specpdl_ref_to_ptr (count);
   725     }
   726   if (failed)
   727     {
   728       static char const kind_message[][32] =
   729         {
   730           [GT_FILE] = "Creating file with prefix",
   731           [GT_DIR] = "Creating directory with prefix",
   732           [GT_NOCREATE] = "Creating file name with prefix"
   733         };
   734       report_file_error (kind_message[kind], prefix);
   735     }
   736   return val;
   737 }
   738 
   739 
   740 DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
   741        doc: /* Generate temporary file name (string) starting with PREFIX (a string).
   742 
   743 This function tries to choose a name that has no existing file.
   744 For this to work, PREFIX should be an absolute file name, and PREFIX
   745 and the returned string should both be non-magic.
   746 
   747 There is a race condition between calling `make-temp-name' and
   748 later creating the file, which opens all kinds of security holes.
   749 For that reason, you should normally use `make-temp-file' instead.  */)
   750   (Lisp_Object prefix)
   751 {
   752   return Fmake_temp_file_internal (prefix, make_fixnum (0),
   753                                    empty_unibyte_string, Qnil);
   754 }
   755 
   756 DEFUN ("file-name-concat", Ffile_name_concat, Sfile_name_concat, 1, MANY, 0,
   757        doc: /* Append COMPONENTS to DIRECTORY and return the resulting string.
   758 Elements in COMPONENTS must be a string or nil.
   759 DIRECTORY or the non-final elements in COMPONENTS may or may not end
   760 with a slash -- if they don't end with a slash, a slash will be
   761 inserted before contatenating.
   762 usage: (record DIRECTORY &rest COMPONENTS) */)
   763   (ptrdiff_t nargs, Lisp_Object *args)
   764 {
   765   ptrdiff_t chars = 0, bytes = 0, multibytes = 0, eargs = 0;
   766   Lisp_Object *elements = args;
   767   Lisp_Object result;
   768   ptrdiff_t i;
   769 
   770   /* First go through the list to check the types and see whether
   771      they're all of the same multibytedness. */
   772   for (i = 0; i < nargs; i++)
   773     {
   774       Lisp_Object arg = args[i];
   775       /* Skip empty and nil elements. */
   776       if (NILP (arg))
   777         continue;
   778       CHECK_STRING (arg);
   779       if (SCHARS (arg) == 0)
   780         continue;
   781       eargs++;
   782       /* Multibyte and non-ASCII. */
   783       if (STRING_MULTIBYTE (arg) && SCHARS (arg) != SBYTES (arg))
   784         multibytes++;
   785       /* We're not adding a slash to the final part. */
   786       if (i == nargs - 1
   787           || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1)))
   788         {
   789           bytes += SBYTES (arg);
   790           chars += SCHARS (arg);
   791         }
   792       else
   793         {
   794           bytes += SBYTES (arg) + 1;
   795           chars += SCHARS (arg) + 1;
   796         }
   797     }
   798 
   799   /* Convert if needed. */
   800   if ((multibytes != 0 && multibytes != nargs)
   801       || eargs != nargs)
   802     {
   803       int j = 0;
   804       elements = xmalloc (eargs * sizeof *elements);
   805       bytes = 0;
   806       chars = 0;
   807 
   808       /* Filter out nil/"". */
   809       for (i = 0; i < nargs; i++)
   810         {
   811           Lisp_Object arg = args[i];
   812           if (!NILP (arg) && SCHARS (arg) != 0)
   813             elements[j++] = arg;
   814         }
   815 
   816       for (i = 0; i < eargs; i++)
   817         {
   818           Lisp_Object arg = elements[i];
   819           /* Use multibyte or all-ASCII strings as is. */
   820           if (!STRING_MULTIBYTE (arg) && !string_ascii_p (arg))
   821             elements[i] = Fstring_to_multibyte (arg);
   822           arg = elements[i];
   823           /* We have to recompute the number of bytes. */
   824           if (i == eargs - 1
   825               || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1)))
   826             {
   827               bytes += SBYTES (arg);
   828               chars += SCHARS (arg);
   829             }
   830           else
   831             {
   832               bytes += SBYTES (arg) + 1;
   833               chars += SCHARS (arg) + 1;
   834             }
   835         }
   836     }
   837 
   838   /* Allocate an empty string. */
   839   if (multibytes == 0)
   840     result = make_uninit_string (chars);
   841   else
   842     result = make_uninit_multibyte_string (chars, bytes);
   843   /* Null-terminate the string. */
   844   *(SSDATA (result) + SBYTES (result)) = 0;
   845 
   846   /* Copy over the data. */
   847   char *p = SSDATA (result);
   848   for (i = 0; i < eargs; i++)
   849     {
   850       Lisp_Object arg = elements[i];
   851       memcpy (p, SSDATA (arg), SBYTES (arg));
   852       p += SBYTES (arg);
   853       /* The last element shouldn't have a slash added at the end. */
   854       if (i < eargs - 1 && !IS_DIRECTORY_SEP (*(p - 1)))
   855         *p++ = DIRECTORY_SEP;
   856     }
   857 
   858   if (elements != args)
   859     xfree (elements);
   860 
   861   return result;
   862 }
   863 
   864 /* NAME must be a string.  */
   865 static bool
   866 file_name_absolute_no_tilde_p (Lisp_Object name)
   867 {
   868   return IS_ABSOLUTE_FILE_NAME (SSDATA (name));
   869 }
   870 
   871 /* Return the home directory of the user NAME, or a null pointer if
   872    NAME is empty or the user does not exist or the user's home
   873    directory is not an absolute file name.  NAME is an array of bytes
   874    that continues up to (but not including) the next NUL byte or
   875    directory separator.  The returned string lives in storage good
   876    until the next call to this or similar functions.  */
   877 static char *
   878 user_homedir (char const *name)
   879 {
   880   ptrdiff_t length;
   881   for (length = 0; name[length] && !IS_DIRECTORY_SEP (name[length]); length++)
   882     continue;
   883   if (length == 0)
   884     return NULL;
   885   USE_SAFE_ALLOCA;
   886   char *p = SAFE_ALLOCA (length + 1);
   887   memcpy (p, name, length);
   888   p[length] = 0;
   889   struct passwd *pw = getpwnam (p);
   890   SAFE_FREE ();
   891   if (!pw || (pw->pw_dir && !IS_ABSOLUTE_FILE_NAME (pw->pw_dir)))
   892     return NULL;
   893   return pw->pw_dir;
   894 }
   895 
   896 DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
   897        doc: /* Convert filename NAME to absolute, and canonicalize it.
   898 Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
   899 \(does not start with slash or tilde); both the directory name and
   900 a directory's file name are accepted.  If DEFAULT-DIRECTORY is nil or
   901 missing, the current buffer's value of `default-directory' is used.
   902 NAME should be a string that is a valid file name for the underlying
   903 filesystem.
   904 
   905 File name components that are `.' are removed, and so are file name
   906 components followed by `..', along with the `..' itself; note that
   907 these simplifications are done without checking the resulting file
   908 names in the file system.
   909 
   910 Multiple consecutive slashes are collapsed into a single slash, except
   911 at the beginning of the file name when they are significant (e.g., UNC
   912 file names on MS-Windows.)
   913 
   914 An initial \"~\" in NAME expands to your home directory.
   915 
   916 An initial \"~USER\" in NAME expands to USER's home directory.  If
   917 USER doesn't exist, \"~USER\" is not expanded.
   918 
   919 To do other file name substitutions, see `substitute-in-file-name'.
   920 
   921 For technical reasons, this function can return correct but
   922 non-intuitive results for the root directory; for instance,
   923 \(expand-file-name ".." "/") returns "/..".  For this reason, use
   924 \(directory-file-name (file-name-directory dirname)) to traverse a
   925 filesystem tree, not (expand-file-name ".." dirname).  Note: make
   926 sure DIRNAME in this example doesn't end in a slash, unless it's
   927 the root directory.  */)
   928   (Lisp_Object name, Lisp_Object default_directory)
   929 {
   930   /* These point to SDATA and need to be careful with string-relocation
   931      during GC (via DECODE_FILE).  */
   932   char *nm;
   933   char *nmlim;
   934   const char *newdir;
   935   const char *newdirlim;
   936   /* This should only point to alloca'd data.  */
   937   char *target;
   938 
   939   ptrdiff_t tlen;
   940 #ifdef DOS_NT
   941   int drive = 0;
   942   bool collapse_newdir = true;
   943   bool is_escaped = 0;
   944 #endif /* DOS_NT */
   945   ptrdiff_t length, nbytes;
   946   Lisp_Object handler, result, handled_name;
   947   bool multibyte;
   948   Lisp_Object hdir;
   949   USE_SAFE_ALLOCA;
   950 
   951   CHECK_STRING (name);
   952   CHECK_STRING_NULL_BYTES (name);
   953 
   954   /* If the file name has special constructs in it,
   955      call the corresponding file name handler.  */
   956   handler = Ffind_file_name_handler (name, Qexpand_file_name);
   957   if (!NILP (handler))
   958     {
   959       handled_name = call3 (handler, Qexpand_file_name,
   960                             name, default_directory);
   961       if (STRINGP (handled_name))
   962         return handled_name;
   963       error ("Invalid handler in `file-name-handler-alist'");
   964     }
   965 
   966   /* As a last resort, we may have to use the root as
   967      default_directory below.  */
   968   Lisp_Object root;
   969 #ifdef DOS_NT
   970       /* "/" is not considered a root directory on DOS_NT, so using it
   971          as default_directory causes an infinite recursion in, e.g.,
   972          the following:
   973 
   974             (let (default-directory)
   975               (expand-file-name "a"))
   976 
   977          To avoid this, we use the root of the current drive.  */
   978       root = build_string (emacs_root_dir ());
   979 #else
   980       root = build_string ("/");
   981 #endif
   982 
   983   /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted.  */
   984   if (NILP (default_directory))
   985     {
   986       Lisp_Object dir = BVAR (current_buffer, directory);
   987       /* The buffer's default-directory should be absolute or should
   988          start with `~'.  If it isn't absolute, we replace it by its
   989          expansion relative to a known absolute name ABSDIR, which is
   990          the invocation-directory if the latter is absolute, or the
   991          root otherwise.
   992 
   993          In case default-directory starts with `~' or `~user', where
   994          USER is a valid user name, this correctly expands it (and
   995          ABSDIR plays no role).  If USER is not a valid user name, the
   996          leading `~' loses its special meaning and is retained as part
   997          of the expanded name.  */
   998       if (STRINGP (dir))
   999         {
  1000           if (file_name_absolute_no_tilde_p (dir))
  1001             {
  1002               CHECK_STRING_NULL_BYTES (dir);
  1003               default_directory = dir;
  1004             }
  1005           else
  1006             {
  1007               Lisp_Object absdir
  1008                 = STRINGP (Vinvocation_directory)
  1009                 && file_name_absolute_no_tilde_p (Vinvocation_directory)
  1010                 ? Vinvocation_directory : root;
  1011               default_directory = Fexpand_file_name (dir, absdir);
  1012             }
  1013         }
  1014     }
  1015   if (! STRINGP (default_directory))
  1016     default_directory = root;
  1017 
  1018   handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
  1019   if (!NILP (handler))
  1020     {
  1021       handled_name = call3 (handler, Qexpand_file_name,
  1022                             name, default_directory);
  1023       if (STRINGP (handled_name))
  1024         return handled_name;
  1025       error ("Invalid handler in `file-name-handler-alist'");
  1026     }
  1027 
  1028   {
  1029     char *o = SSDATA (default_directory);
  1030 
  1031     /* Make sure DEFAULT_DIRECTORY is properly expanded.
  1032        It would be better to do this down below where we actually use
  1033        default_directory.  Unfortunately, calling Fexpand_file_name recursively
  1034        could invoke GC, and the strings might be relocated.  This would
  1035        be annoying because we have pointers into strings lying around
  1036        that would need adjusting, and people would add new pointers to
  1037        the code and forget to adjust them, resulting in intermittent bugs.
  1038        Putting this call here avoids all that crud.
  1039 
  1040        The EQ test avoids infinite recursion.  */
  1041     if (! NILP (default_directory) && !EQ (default_directory, name)
  1042         /* Save time in some common cases - as long as default_directory
  1043            is not relative, it can be canonicalized with name below (if it
  1044            is needed at all) without requiring it to be expanded now.  */
  1045 #ifdef DOS_NT
  1046         /* Detect MSDOS file names with drive specifiers.  */
  1047         && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1])
  1048               && IS_DIRECTORY_SEP (o[2]))
  1049         /* Detect escaped file names without drive spec after "/:".
  1050            These should not be recursively expanded, to avoid
  1051            including the default directory twice in the expanded
  1052            result.  */
  1053         && ! (o[0] == '/' && o[1] == ':')
  1054 #ifdef WINDOWSNT
  1055         /* Detect Windows file names in UNC format.  */
  1056         && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
  1057 #endif
  1058 #else /* not DOS_NT */
  1059       /* Detect Unix absolute file names (/... alone is not absolute on
  1060          DOS or Windows).  */
  1061         && ! (IS_DIRECTORY_SEP (o[0]))
  1062 #endif /* not DOS_NT */
  1063         )
  1064       {
  1065         default_directory = Fexpand_file_name (default_directory, Qnil);
  1066 
  1067         /* The above expansion might have produced a remote file name,
  1068            so give the handlers one last chance to DTRT.  This can
  1069            happen when both NAME and DEFAULT-DIRECTORY arguments are
  1070            relative file names, and the buffer's default-directory is
  1071            remote.  */
  1072         handler = Ffind_file_name_handler (default_directory,
  1073                                            Qexpand_file_name);
  1074         if (!NILP (handler))
  1075           {
  1076             handled_name = call3 (handler, Qexpand_file_name,
  1077                                   name, default_directory);
  1078             if (STRINGP (handled_name))
  1079               return handled_name;
  1080             error ("Invalid handler in `file-name-handler-alist'");
  1081           }
  1082       }
  1083   }
  1084   multibyte = STRING_MULTIBYTE (name);
  1085   bool defdir_multibyte = STRING_MULTIBYTE (default_directory);
  1086   if (multibyte != defdir_multibyte)
  1087     {
  1088       /* We want to make both NAME and DEFAULT_DIRECTORY have the same
  1089          multibyteness.  Strategy:
  1090          . If either NAME or DEFAULT_DIRECTORY is pure-ASCII, they
  1091            can be converted to the multibyteness of the other one
  1092            while keeping the same byte sequence.
  1093          . If both are non-ASCII, the only safe conversion is to
  1094            convert the multibyte one to be unibyte, because the
  1095            reverse conversion potentially adds bytes while raw bytes
  1096            are converted to their multibyte forms, which we will be
  1097            unable to account for, since the information about the
  1098            original multibyteness is lost.  If those additional bytes
  1099            later leak to system APIs because they are not encoded or
  1100            because they are converted to unibyte strings by keeping
  1101            the data, file APIs will fail.
  1102 
  1103          Note: One could argue that if we see a multibyte string, it
  1104          is evidence that file-name decoding was already set up, and
  1105          we could convert unibyte strings to multibyte using
  1106          DECODE_FILE.  However, this is risky, because the likes of
  1107          string_to_multibyte are able of creating multibyte strings
  1108          without any decoding.  */
  1109       if (multibyte)
  1110         {
  1111           bool name_ascii_p = SCHARS (name) == SBYTES (name);
  1112           unsigned char *p = SDATA (default_directory);
  1113 
  1114           if (!name_ascii_p)
  1115             while (*p && ASCII_CHAR_P (*p))
  1116               p++;
  1117           if (name_ascii_p || *p != '\0')
  1118             {
  1119               /* DEFAULT_DIRECTORY is unibyte and possibly non-ASCII.
  1120                  Make a unibyte string out of NAME, and arrange for
  1121                  the result of this function to be a unibyte string.
  1122                  This is needed during bootstrapping and dumping, when
  1123                  Emacs cannot decode file names, because the locale
  1124                  environment is not set up.  */
  1125               name = make_unibyte_string (SSDATA (name), SBYTES (name));
  1126               multibyte = 0;
  1127             }
  1128           else
  1129             {
  1130               /* NAME is non-ASCII and multibyte, and
  1131                  DEFAULT_DIRECTORY is unibyte and pure-ASCII: make a
  1132                  multibyte string out of DEFAULT_DIRECTORY's data.  */
  1133               default_directory =
  1134                 make_multibyte_string (SSDATA (default_directory),
  1135                                        SCHARS (default_directory),
  1136                                        SCHARS (default_directory));
  1137             }
  1138         }
  1139       else
  1140         {
  1141           unsigned char *p = SDATA (name);
  1142 
  1143           while (*p && ASCII_CHAR_P (*p))
  1144             p++;
  1145           if (*p == '\0')
  1146             {
  1147               /* DEFAULT_DIRECTORY is multibyte and NAME is unibyte
  1148                  and pure-ASCII.  Make a multibyte string out of
  1149                  NAME's data.  */
  1150               name = make_multibyte_string (SSDATA (name),
  1151                                             SCHARS (name), SCHARS (name));
  1152               multibyte = 1;
  1153             }
  1154           else
  1155             default_directory = make_unibyte_string (SSDATA (default_directory),
  1156                                                      SBYTES (default_directory));
  1157         }
  1158     }
  1159 
  1160 #ifdef WINDOWSNT
  1161   if (!NILP (Vw32_downcase_file_names))
  1162     default_directory = Fdowncase (default_directory);
  1163 #endif
  1164 
  1165   /* Make a local copy of NAME to protect it from GC in DECODE_FILE below.  */
  1166   SAFE_ALLOCA_STRING (nm, name);
  1167   nmlim = nm + SBYTES (name);
  1168 
  1169 #ifdef DOS_NT
  1170   /* Note if special escape prefix is present, but remove for now.  */
  1171   if (nm[0] == '/' && nm[1] == ':')
  1172     {
  1173       is_escaped = 1;
  1174       nm += 2;
  1175     }
  1176 
  1177   /* Find and remove drive specifier if present; this makes nm absolute
  1178      even if the rest of the name appears to be relative.  Only look for
  1179      drive specifier at the beginning.  */
  1180   if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
  1181     {
  1182       drive = (unsigned char) nm[0];
  1183       nm += 2;
  1184     }
  1185 
  1186 #ifdef WINDOWSNT
  1187   /* If we see "c://somedir", we want to strip the first slash after the
  1188      colon when stripping the drive letter.  Otherwise, this expands to
  1189      "//somedir".  */
  1190   if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
  1191     nm++;
  1192 
  1193   /* Discard any previous drive specifier if nm is now in UNC format.  */
  1194   if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
  1195       && !IS_DIRECTORY_SEP (nm[2]))
  1196     drive = 0;
  1197 #endif /* WINDOWSNT */
  1198 #endif /* DOS_NT */
  1199 
  1200   /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
  1201      none are found, we can probably return right away.  We will avoid
  1202      allocating a new string if name is already fully expanded.  */
  1203   if (
  1204       IS_DIRECTORY_SEP (nm[0])
  1205 #ifdef MSDOS
  1206       && drive && !is_escaped
  1207 #endif
  1208 #ifdef WINDOWSNT
  1209       && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
  1210 #endif
  1211       )
  1212     {
  1213       /* If it turns out that the filename we want to return is just a
  1214          suffix of FILENAME, we don't need to go through and edit
  1215          things; we just need to construct a new string using data
  1216          starting at the middle of FILENAME.  If we set LOSE, that
  1217          means we've discovered that we can't do that cool trick.  */
  1218       bool lose = 0;
  1219       char *p = nm;
  1220 
  1221       while (*p)
  1222         {
  1223           /* Since we know the name is absolute, we can assume that each
  1224              element starts with a "/".  */
  1225 
  1226           /* "." and ".." are hairy.  */
  1227           if (IS_DIRECTORY_SEP (p[0])
  1228               && p[1] == '.'
  1229               && (IS_DIRECTORY_SEP (p[2])
  1230                   || p[2] == 0
  1231                   || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
  1232                                       || p[3] == 0))))
  1233             lose = 1;
  1234           /* Replace multiple slashes with a single one, except
  1235              leave leading "//" alone.  */
  1236           else if (IS_DIRECTORY_SEP (p[0])
  1237                    && IS_DIRECTORY_SEP (p[1])
  1238                    && (p != nm || IS_DIRECTORY_SEP (p[2])))
  1239             lose = 1;
  1240           p++;
  1241         }
  1242       if (!lose)
  1243         {
  1244 #ifdef DOS_NT
  1245           /* Make sure directories are all separated with /, but
  1246              avoid allocation of a new string when not required. */
  1247           dostounix_filename (nm);
  1248 #ifdef WINDOWSNT
  1249           if (IS_DIRECTORY_SEP (nm[1]))
  1250             {
  1251               if (strcmp (nm, SSDATA (name)) != 0)
  1252                 name = make_specified_string (nm, -1, nmlim - nm, multibyte);
  1253             }
  1254           else
  1255 #endif
  1256           /* Drive must be set, so this is okay.  */
  1257           if (strcmp (nm - 2, SSDATA (name)) != 0)
  1258             {
  1259               name = make_specified_string (nm, -1, p - nm, multibyte);
  1260               char temp[] = { DRIVE_LETTER (drive), ':', 0 };
  1261               AUTO_STRING_WITH_LEN (drive_prefix, temp, 2);
  1262               name = concat2 (drive_prefix, name);
  1263             }
  1264 #ifdef WINDOWSNT
  1265           if (!NILP (Vw32_downcase_file_names))
  1266             name = Fdowncase (name);
  1267 #endif
  1268 #else /* not DOS_NT */
  1269           if (strcmp (nm, SSDATA (name)) != 0)
  1270             name = make_specified_string (nm, -1, nmlim - nm, multibyte);
  1271 #endif /* not DOS_NT */
  1272           SAFE_FREE ();
  1273           return name;
  1274         }
  1275     }
  1276 
  1277   /* At this point, nm might or might not be an absolute file name.  We
  1278      need to expand ~ or ~user if present, otherwise prefix nm with
  1279      default_directory if nm is not absolute, and finally collapse /./
  1280      and /foo/../ sequences.
  1281 
  1282      We set newdir to be the appropriate prefix if one is needed:
  1283        - the relevant user directory if nm starts with ~ or ~user
  1284        - the specified drive's working dir (DOS/NT only) if nm does not
  1285          start with /
  1286        - the value of default_directory.
  1287 
  1288      Note that these prefixes are not guaranteed to be absolute (except
  1289      for the working dir of a drive).  Therefore, to ensure we always
  1290      return an absolute name, if the final prefix is not absolute we
  1291      append it to the current working directory.  */
  1292 
  1293   newdir = newdirlim = 0;
  1294 
  1295   if (nm[0] == '~'              /* prefix ~ */
  1296 #ifdef DOS_NT
  1297     && !is_escaped              /* don't expand ~ in escaped file names */
  1298 #endif
  1299       )
  1300     {
  1301       if (IS_DIRECTORY_SEP (nm[1])
  1302           || nm[1] == 0)        /* ~ by itself */
  1303         {
  1304           Lisp_Object tem;
  1305 
  1306           newdir = get_homedir ();
  1307           nm++;
  1308           tem = build_string (newdir);
  1309           newdirlim = newdir + SBYTES (tem);
  1310           /* get_homedir may return a unibyte string, which will bite us
  1311              if we expect the directory to be multibyte.  */
  1312           if (multibyte && !STRING_MULTIBYTE (tem))
  1313             {
  1314               hdir = DECODE_FILE (tem);
  1315               newdir = SSDATA (hdir);
  1316               newdirlim = newdir + SBYTES (hdir);
  1317             }
  1318           else if (!multibyte && STRING_MULTIBYTE (tem))
  1319             multibyte = 1;
  1320 #ifdef DOS_NT
  1321           collapse_newdir = false;
  1322 #endif
  1323         }
  1324       else                      /* ~user/filename */
  1325         {
  1326           char *nmhome = user_homedir (nm + 1);
  1327           if (nmhome)
  1328             {
  1329               ptrdiff_t nmhomelen = strlen (nmhome);
  1330               newdir = nmhome;
  1331               newdirlim = newdir + nmhomelen;
  1332               if (multibyte)
  1333                 {
  1334                   AUTO_STRING_WITH_LEN (lisp_nmhome, nmhome, nmhomelen);
  1335                   hdir = DECODE_FILE (lisp_nmhome);
  1336                   newdir = SSDATA (hdir);
  1337                   newdirlim = newdir + SBYTES (hdir);
  1338                 }
  1339 
  1340               while (*++nm && !IS_DIRECTORY_SEP (*nm))
  1341                 continue;
  1342 #ifdef DOS_NT
  1343               collapse_newdir = false;
  1344 #endif
  1345             }
  1346 
  1347           /* If we don't find a user of that name, leave the name
  1348              unchanged.  */
  1349         }
  1350     }
  1351 
  1352 #ifdef DOS_NT
  1353   /* On DOS and Windows, nm is absolute if a drive name was specified;
  1354      use the drive's current directory as the prefix if needed.  */
  1355   if (!newdir && drive)
  1356     {
  1357       /* Get default directory if needed to make nm absolute.  */
  1358       char *adir = NULL;
  1359       if (!IS_DIRECTORY_SEP (nm[0]))
  1360         {
  1361           adir = alloca (MAXPATHLEN + 1);
  1362           if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
  1363             adir = NULL;
  1364           else if (multibyte)
  1365             {
  1366               Lisp_Object tem = build_string (adir);
  1367 
  1368               tem = DECODE_FILE (tem);
  1369               newdirlim = adir + SBYTES (tem);
  1370               memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
  1371             }
  1372           else
  1373             newdirlim = adir + strlen (adir);
  1374         }
  1375       if (!adir)
  1376         {
  1377           /* Either nm starts with /, or drive isn't mounted.  */
  1378           adir = alloca (4);
  1379           adir[0] = DRIVE_LETTER (drive);
  1380           adir[1] = ':';
  1381           adir[2] = '/';
  1382           adir[3] = 0;
  1383           newdirlim = adir + 3;
  1384         }
  1385       newdir = adir;
  1386     }
  1387 #endif /* DOS_NT */
  1388 
  1389   /* Finally, if no prefix has been specified and nm is not absolute,
  1390      then it must be expanded relative to default_directory.  */
  1391 
  1392   if (1
  1393 #ifndef DOS_NT
  1394       /* /... alone is not absolute on DOS and Windows.  */
  1395       && !IS_DIRECTORY_SEP (nm[0])
  1396 #endif
  1397 #ifdef WINDOWSNT
  1398       && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])
  1399            && !IS_DIRECTORY_SEP (nm[2]))
  1400 #endif
  1401       && !newdir)
  1402     {
  1403       newdir = SSDATA (default_directory);
  1404       newdirlim = newdir + SBYTES (default_directory);
  1405 #ifdef DOS_NT
  1406       /* Note if special escape prefix is present, but remove for now.  */
  1407       if (newdir[0] == '/' && newdir[1] == ':')
  1408         {
  1409           is_escaped = 1;
  1410           newdir += 2;
  1411         }
  1412 #endif
  1413     }
  1414 
  1415 #ifdef DOS_NT
  1416   if (newdir)
  1417     {
  1418       /* First ensure newdir is an absolute name.  */
  1419       if (
  1420           /* Detect MSDOS file names with drive specifiers.  */
  1421           ! (IS_DRIVE (newdir[0])
  1422              && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2]))
  1423 #ifdef WINDOWSNT
  1424           /* Detect Windows file names in UNC format.  */
  1425           && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
  1426                 && !IS_DIRECTORY_SEP (newdir[2]))
  1427 #endif
  1428           )
  1429         {
  1430           /* Effectively, let newdir be (expand-file-name newdir cwd).
  1431              Because of the admonition against calling expand-file-name
  1432              when we have pointers into lisp strings, we accomplish this
  1433              indirectly by prepending newdir to nm if necessary, and using
  1434              cwd (or the wd of newdir's drive) as the new newdir.  */
  1435           char *adir;
  1436 #ifdef WINDOWSNT
  1437           const int adir_size = MAX_UTF8_PATH;
  1438 #else
  1439           const int adir_size = MAXPATHLEN + 1;
  1440 #endif
  1441 
  1442           if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
  1443             {
  1444               drive = (unsigned char) newdir[0];
  1445               newdir += 2;
  1446             }
  1447           if (!IS_DIRECTORY_SEP (nm[0]))
  1448             {
  1449               ptrdiff_t nmlen = nmlim - nm;
  1450               ptrdiff_t newdirlen = newdirlim - newdir;
  1451               char *tmp = alloca (newdirlen + file_name_as_directory_slop
  1452                                   + nmlen + 1);
  1453               ptrdiff_t dlen = file_name_as_directory (tmp, newdir, newdirlen,
  1454                                                        multibyte);
  1455               memcpy (tmp + dlen, nm, nmlen + 1);
  1456               nm = tmp;
  1457               nmlim = nm + dlen + nmlen;
  1458             }
  1459           adir = alloca (adir_size);
  1460           if (drive)
  1461             {
  1462               if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
  1463                 strcpy (adir, "/");
  1464             }
  1465           else
  1466             getcwd (adir, adir_size);
  1467           if (multibyte)
  1468             {
  1469               Lisp_Object tem = build_string (adir);
  1470 
  1471               tem = DECODE_FILE (tem);
  1472               newdirlim = adir + SBYTES (tem);
  1473               memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
  1474             }
  1475           else
  1476             newdirlim = adir + strlen (adir);
  1477           newdir = adir;
  1478         }
  1479 
  1480       /* Strip off drive name from prefix, if present.  */
  1481       if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
  1482         {
  1483           drive = newdir[0];
  1484           newdir += 2;
  1485         }
  1486 
  1487       /* Keep only a prefix from newdir if nm starts with slash
  1488          (//server/share for UNC, nothing otherwise).  */
  1489       if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
  1490         {
  1491 #ifdef WINDOWSNT
  1492           if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])
  1493               && !IS_DIRECTORY_SEP (newdir[2]))
  1494             {
  1495               char *adir = strcpy (alloca (newdirlim - newdir + 1), newdir);
  1496               char *p = adir + 2;
  1497               while (*p && !IS_DIRECTORY_SEP (*p)) p++;
  1498               p++;
  1499               while (*p && !IS_DIRECTORY_SEP (*p)) p++;
  1500               *p = 0;
  1501               newdir = adir;
  1502               newdirlim = newdir + strlen (adir);
  1503             }
  1504           else
  1505 #endif
  1506             newdir = newdirlim = "";
  1507         }
  1508     }
  1509 #endif /* DOS_NT */
  1510 
  1511   /* Ignore any slash at the end of newdir, unless newdir is
  1512      just "/" or "//".  */
  1513   length = newdirlim - newdir;
  1514   while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
  1515          && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0])))
  1516     length--;
  1517 
  1518   /* Now concatenate the directory and name to new space in the stack frame.  */
  1519   tlen = length + file_name_as_directory_slop + (nmlim - nm) + 1;
  1520   eassert (tlen >= file_name_as_directory_slop + 1);
  1521 #ifdef DOS_NT
  1522   /* Reserve space for drive specifier and escape prefix, since either
  1523      or both may need to be inserted.  (The Microsoft x86 compiler
  1524      produces incorrect code if the following two lines are combined.)  */
  1525   target = alloca (tlen + 4);
  1526   target += 4;
  1527 #else  /* not DOS_NT */
  1528   target = SAFE_ALLOCA (tlen);
  1529 #endif /* not DOS_NT */
  1530   *target = 0;
  1531   nbytes = 0;
  1532 
  1533   if (newdir)
  1534     {
  1535       if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
  1536         {
  1537 #ifdef DOS_NT
  1538           /* If newdir is effectively "C:/", then the drive letter will have
  1539              been stripped and newdir will be "/".  Concatenating with an
  1540              absolute directory in nm produces "//", which will then be
  1541              incorrectly treated as a network share.  Ignore newdir in
  1542              this case (keeping the drive letter).  */
  1543           if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
  1544                 && newdir[1] == '\0'))
  1545 #endif
  1546             {
  1547               memcpy (target, newdir, length);
  1548               target[length] = 0;
  1549               nbytes = length;
  1550             }
  1551         }
  1552       else
  1553         nbytes = file_name_as_directory (target, newdir, length, multibyte);
  1554     }
  1555 
  1556   memcpy (target + nbytes, nm, nmlim - nm + 1);
  1557 
  1558   /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
  1559      appear.  */
  1560   {
  1561     char *p = target;
  1562     char *o = target;
  1563 
  1564     while (*p)
  1565       {
  1566         if (!IS_DIRECTORY_SEP (*p))
  1567           {
  1568             *o++ = *p++;
  1569           }
  1570         else if (p[1] == '.'
  1571                  && (IS_DIRECTORY_SEP (p[2])
  1572                      || p[2] == 0))
  1573           {
  1574             /* If "/." is the entire filename, keep the "/".  Otherwise,
  1575                just delete the whole "/.".  */
  1576             if (o == target && p[2] == '\0')
  1577               *o++ = *p;
  1578             p += 2;
  1579           }
  1580         else if (p[1] == '.' && p[2] == '.'
  1581                  /* `/../' is the "superroot" on certain file systems.
  1582                     Turned off on DOS_NT systems because they have no
  1583                     "superroot" and because this causes us to produce
  1584                     file names like "d:/../foo" which fail file-related
  1585                     functions of the underlying OS.  (To reproduce, try a
  1586                     long series of "../../" in default_directory, longer
  1587                     than the number of levels from the root.)  */
  1588 #ifndef DOS_NT
  1589                  && o != target
  1590 #endif
  1591                  && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
  1592           {
  1593 #ifdef WINDOWSNT
  1594             char *prev_o = o;
  1595 #endif
  1596             while (o != target && (--o, !IS_DIRECTORY_SEP (*o)))
  1597               continue;
  1598 #ifdef WINDOWSNT
  1599             /* Don't go below server level in UNC filenames.  */
  1600             if (o == target + 1 && IS_DIRECTORY_SEP (*o)
  1601                 && IS_DIRECTORY_SEP (*target))
  1602               o = prev_o;
  1603             else
  1604 #endif
  1605             /* Keep initial / only if this is the whole name.  */
  1606             if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
  1607               ++o;
  1608             p += 3;
  1609           }
  1610         else if (IS_DIRECTORY_SEP (p[1])
  1611                  && (p != target || IS_DIRECTORY_SEP (p[2])))
  1612           /* Collapse multiple "/", except leave leading "//" alone.  */
  1613           p++;
  1614         else
  1615           {
  1616             *o++ = *p++;
  1617           }
  1618       }
  1619 
  1620 #ifdef DOS_NT
  1621     /* At last, set drive name.  */
  1622 #ifdef WINDOWSNT
  1623     /* Except for network file name.  */
  1624     if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
  1625 #endif /* WINDOWSNT */
  1626       {
  1627         if (!drive) emacs_abort ();
  1628         target -= 2;
  1629         target[0] = DRIVE_LETTER (drive);
  1630         target[1] = ':';
  1631       }
  1632     /* Reinsert the escape prefix if required.  */
  1633     if (is_escaped)
  1634       {
  1635         target -= 2;
  1636         target[0] = '/';
  1637         target[1] = ':';
  1638       }
  1639     result = make_specified_string (target, -1, o - target, multibyte);
  1640     dostounix_filename (SSDATA (result));
  1641 #ifdef WINDOWSNT
  1642     if (!NILP (Vw32_downcase_file_names))
  1643       result = Fdowncase (result);
  1644 #endif
  1645 #else  /* !DOS_NT */
  1646     result = make_specified_string (target, -1, o - target, multibyte);
  1647 #endif /* !DOS_NT */
  1648   }
  1649 
  1650   /* Again look to see if the file name has special constructs in it
  1651      and perhaps call the corresponding file name handler.  This is needed
  1652      for filenames such as "/foo/../user@host:/bar/../baz".  Expanding
  1653      the ".." component gives us "/user@host:/bar/../baz" which needs
  1654      to be expanded again.  */
  1655   handler = Ffind_file_name_handler (result, Qexpand_file_name);
  1656   if (!NILP (handler))
  1657     {
  1658       handled_name = call3 (handler, Qexpand_file_name,
  1659                             result, default_directory);
  1660       if (! STRINGP (handled_name))
  1661         error ("Invalid handler in `file-name-handler-alist'");
  1662       result = handled_name;
  1663     }
  1664 
  1665   SAFE_FREE ();
  1666   return result;
  1667 }
  1668 
  1669 #if 0
  1670 /* PLEASE DO NOT DELETE THIS COMMENTED-OUT VERSION!
  1671    This is the old version of expand-file-name, before it was thoroughly
  1672    rewritten for Emacs 10.31.  We leave this version here commented-out,
  1673    because the code is very complex and likely to have subtle bugs.  If
  1674    bugs _are_ found, it might be of interest to look at the old code and
  1675    see what did it do in the relevant situation.
  1676 
  1677    Don't remove this code: it's true that it will be accessible
  1678    from the repository, but a few years from deletion, people will
  1679    forget it is there.  */
  1680 
  1681 /* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.  */
  1682 DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
  1683   "Convert FILENAME to absolute, and canonicalize it.\n\
  1684 Second arg DEFAULT is directory to start with if FILENAME is relative\n\
  1685 \(does not start with slash); if DEFAULT is nil or missing,\n\
  1686 the current buffer's value of default-directory is used.\n\
  1687 Filenames containing `.' or `..' as components are simplified;\n\
  1688 initial `~/' expands to your home directory.\n\
  1689 See also the function `substitute-in-file-name'.")
  1690      (name, defalt)
  1691      Lisp_Object name, defalt;
  1692 {
  1693   unsigned char *nm;
  1694 
  1695   register unsigned char *newdir, *p, *o;
  1696   ptrdiff_t tlen;
  1697   unsigned char *target;
  1698   struct passwd *pw;
  1699 
  1700   CHECK_STRING (name);
  1701   nm = SDATA (name);
  1702 
  1703   /* If nm is absolute, flush ...// and detect /./ and /../.
  1704      If no /./ or /../ we can return right away.  */
  1705   if (nm[0] == '/')
  1706     {
  1707       bool lose = 0;
  1708       p = nm;
  1709       while (*p)
  1710         {
  1711           if (p[0] == '/' && p[1] == '/')
  1712             nm = p + 1;
  1713           if (p[0] == '/' && p[1] == '~')
  1714             nm = p + 1, lose = 1;
  1715           if (p[0] == '/' && p[1] == '.'
  1716               && (p[2] == '/' || p[2] == 0
  1717                   || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
  1718             lose = 1;
  1719           p++;
  1720         }
  1721       if (!lose)
  1722         {
  1723           if (nm == SDATA (name))
  1724             return name;
  1725           return build_string (nm);
  1726         }
  1727     }
  1728 
  1729   /* Now determine directory to start with and put it in NEWDIR.  */
  1730 
  1731   newdir = 0;
  1732 
  1733   if (nm[0] == '~')             /* prefix ~ */
  1734     if (nm[1] == '/' || nm[1] == 0)/* ~/filename */
  1735       {
  1736         if (!(newdir = (unsigned char *) egetenv ("HOME")))
  1737           newdir = (unsigned char *) "";
  1738         nm++;
  1739       }
  1740     else  /* ~user/filename */
  1741       {
  1742         /* Get past ~ to user.  */
  1743         unsigned char *user = nm + 1;
  1744         /* Find end of name.  */
  1745         unsigned char *ptr = (unsigned char *) strchr (user, '/');
  1746         ptrdiff_t len = ptr ? ptr - user : strlen (user);
  1747         /* Copy the user name into temp storage.  */
  1748         o = alloca (len + 1);
  1749         memcpy (o, user, len);
  1750         o[len] = 0;
  1751 
  1752         /* Look up the user name.  */
  1753         block_input ();
  1754         pw = (struct passwd *) getpwnam (o + 1);
  1755         unblock_input ();
  1756         if (!pw)
  1757           error ("\"%s\" isn't a registered user", o + 1);
  1758 
  1759         newdir = (unsigned char *) pw->pw_dir;
  1760 
  1761         /* Discard the user name from NM.  */
  1762         nm += len;
  1763       }
  1764 
  1765   if (nm[0] != '/' && !newdir)
  1766     {
  1767       if (NILP (defalt))
  1768         defalt = current_buffer->directory;
  1769       CHECK_STRING (defalt);
  1770       newdir = SDATA (defalt);
  1771     }
  1772 
  1773   /* Now concatenate the directory and name to new space in the stack frame.  */
  1774 
  1775   tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
  1776   target = alloca (tlen);
  1777   *target = 0;
  1778 
  1779   if (newdir)
  1780     {
  1781       if (nm[0] == 0 || nm[0] == '/')
  1782         strcpy (target, newdir);
  1783       else
  1784       file_name_as_directory (target, newdir);
  1785     }
  1786 
  1787   strcat (target, nm);
  1788 
  1789   /* Now canonicalize by removing /. and /foo/.. if they appear.  */
  1790 
  1791   p = target;
  1792   o = target;
  1793 
  1794   while (*p)
  1795     {
  1796       if (*p != '/')
  1797         {
  1798           *o++ = *p++;
  1799         }
  1800       else if (!strncmp (p, "//", 2)
  1801                )
  1802         {
  1803           o = target;
  1804           p++;
  1805         }
  1806       else if (p[0] == '/' && p[1] == '.'
  1807                && (p[2] == '/' || p[2] == 0))
  1808         p += 2;
  1809       else if (!strncmp (p, "/..", 3)
  1810                /* `/../' is the "superroot" on certain file systems.  */
  1811                && o != target
  1812                && (p[3] == '/' || p[3] == 0))
  1813         {
  1814           while (o != target && *--o != '/')
  1815             ;
  1816           if (o == target && *o == '/')
  1817             ++o;
  1818           p += 3;
  1819         }
  1820       else
  1821         {
  1822           *o++ = *p++;
  1823         }
  1824     }
  1825 
  1826   return make_string (target, o - target);
  1827 }
  1828 #endif
  1829 
  1830 /* Put into BUF the concatenation of DIR and FILE, with an intervening
  1831    directory separator if needed.  Return a pointer to the null byte
  1832    at the end of the concatenated string.  */
  1833 char *
  1834 splice_dir_file (char *buf, char const *dir, char const *file)
  1835 {
  1836   char *e = stpcpy (buf, dir);
  1837   *e = DIRECTORY_SEP;
  1838   e += ! (buf < e && IS_DIRECTORY_SEP (e[-1]));
  1839   return stpcpy (e, file);
  1840 }
  1841 
  1842 /* Get the home directory, an absolute file name.  Return the empty
  1843    string on failure.  The returned value does not survive garbage
  1844    collection, calls to this function, or calls to the getpwnam class
  1845    of functions.  */
  1846 char const *
  1847 get_homedir (void)
  1848 {
  1849   char const *home = egetenv ("HOME");
  1850 
  1851 #ifdef WINDOWSNT
  1852   /* getpw* functions return UTF-8 encoded file names, whereas egetenv
  1853      returns strings in locale encoding, so we need to convert for
  1854      consistency.  */
  1855   static char homedir_utf8[MAX_UTF8_PATH];
  1856   if (home)
  1857     {
  1858       filename_from_ansi (home, homedir_utf8);
  1859       home = homedir_utf8;
  1860     }
  1861 #endif
  1862 
  1863   if (!home)
  1864     {
  1865       static char const *userenv[] = {"LOGNAME", "USER"};
  1866       struct passwd *pw = NULL;
  1867       for (int i = 0; i < ARRAYELTS (userenv); i++)
  1868         {
  1869           char *user = egetenv (userenv[i]);
  1870           if (user)
  1871             {
  1872               pw = getpwnam (user);
  1873               if (pw)
  1874                 break;
  1875             }
  1876         }
  1877       if (!pw)
  1878         pw = getpwuid (getuid ());
  1879       if (pw)
  1880         home = pw->pw_dir;
  1881       if (!home)
  1882         return "";
  1883     }
  1884 #ifdef DOS_NT
  1885   /* If home is a drive-relative directory, expand it.  */
  1886   if (IS_DRIVE (*home)
  1887       && IS_DEVICE_SEP (home[1])
  1888       && !IS_DIRECTORY_SEP (home[2]))
  1889     {
  1890 # ifdef WINDOWSNT
  1891       static char hdir[MAX_UTF8_PATH];
  1892 # else
  1893       static char hdir[MAXPATHLEN];
  1894 # endif
  1895       if (!getdefdir (c_toupper (*home) - 'A' + 1, hdir))
  1896         {
  1897           hdir[0] = c_toupper (*home);
  1898           hdir[1] = ':';
  1899           hdir[2] = '/';
  1900           hdir[3] = '\0';
  1901         }
  1902       if (home[2])
  1903         {
  1904           size_t homelen = strlen (hdir);
  1905           if (!IS_DIRECTORY_SEP (hdir[homelen - 1]))
  1906             strcat (hdir, "/");
  1907           strcat (hdir, home + 2);
  1908         }
  1909       home = hdir;
  1910     }
  1911 #endif
  1912   if (IS_ABSOLUTE_FILE_NAME (home))
  1913     return home;
  1914   if (!emacs_wd)
  1915     error ("$HOME is relative to unknown directory");
  1916   static char *ahome;
  1917   static ptrdiff_t ahomesize;
  1918   ptrdiff_t ahomelenbound = strlen (emacs_wd) + 1 + strlen (home) + 1;
  1919   if (ahomesize <= ahomelenbound)
  1920     ahome = xpalloc (ahome, &ahomesize, ahomelenbound + 1 - ahomesize, -1, 1);
  1921   splice_dir_file (ahome, emacs_wd, home);
  1922   return ahome;
  1923 }
  1924 
  1925 /* If a directory separator followed by an absolute file name (e.g.,
  1926    "//foo", "/~", "/~someuser") appears in NM, return the address of
  1927    the absolute file name.  Otherwise return NULL.  ENDP is the
  1928    address of the null byte at the end of NM.  */
  1929 static char *
  1930 search_embedded_absfilename (char *nm, char *endp)
  1931 {
  1932   char *p = nm + 1;
  1933 #ifdef DOUBLE_SLASH_IS_DISTINCT_ROOT
  1934   p += (IS_DIRECTORY_SEP (p[-1]) && IS_DIRECTORY_SEP (p[0])
  1935         && !IS_DIRECTORY_SEP (p[1]));
  1936 #endif
  1937   for (; p < endp; p++)
  1938     if (IS_DIRECTORY_SEP (p[-1]) && file_name_absolute_p (p))
  1939       return p;
  1940   return NULL;
  1941 }
  1942 
  1943 DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
  1944        Ssubstitute_in_file_name, 1, 1, 0,
  1945        doc: /* Substitute environment variables referred to in FILENAME.
  1946 `$FOO' where FOO is an environment variable name means to substitute
  1947 the value of that variable.  The variable name should be terminated
  1948 with a character not a letter, digit or underscore; otherwise, enclose
  1949 the entire variable name in braces.
  1950 
  1951 If FOO is not defined in the environment, `$FOO' is left unchanged in
  1952 the value of this function.
  1953 
  1954 If `/~' appears, all of FILENAME through that `/' is discarded.
  1955 If `//' appears, everything up to and including the first of
  1956 those `/' is discarded.  */)
  1957   (Lisp_Object filename)
  1958 {
  1959   char *nm, *p, *x, *endp;
  1960   bool substituted = false;
  1961   bool multibyte;
  1962   char *xnm;
  1963   Lisp_Object handler;
  1964 
  1965   CHECK_STRING (filename);
  1966 
  1967   multibyte = STRING_MULTIBYTE (filename);
  1968 
  1969   /* If the file name has special constructs in it,
  1970      call the corresponding file name handler.  */
  1971   handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
  1972   if (!NILP (handler))
  1973     {
  1974       Lisp_Object handled_name = call2 (handler, Qsubstitute_in_file_name,
  1975                                         filename);
  1976       if (STRINGP (handled_name))
  1977         return handled_name;
  1978       error ("Invalid handler in `file-name-handler-alist'");
  1979     }
  1980 
  1981   /* Always work on a copy of the string, in case GC happens during
  1982      decode of environment variables, causing the original Lisp_String
  1983      data to be relocated.  */
  1984   USE_SAFE_ALLOCA;
  1985   SAFE_ALLOCA_STRING (nm, filename);
  1986 
  1987 #ifdef DOS_NT
  1988   dostounix_filename (nm);
  1989   substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
  1990 #endif
  1991   endp = nm + SBYTES (filename);
  1992 
  1993   /* If /~ or // appears, discard everything through first slash.  */
  1994   p = search_embedded_absfilename (nm, endp);
  1995   if (p)
  1996     /* Start over with the new string, so we check the file-name-handler
  1997        again.  Important with filenames like "/home/foo//:/hello///there"
  1998        which would substitute to "/:/hello///there" rather than "/there".  */
  1999     {
  2000       Lisp_Object result
  2001         = (Fsubstitute_in_file_name
  2002            (make_specified_string (p, -1, endp - p, multibyte)));
  2003       SAFE_FREE ();
  2004       return result;
  2005     }
  2006 
  2007   /* See if any variables are substituted into the string.  */
  2008 
  2009   if (!NILP (Ffboundp (Qsubstitute_env_in_file_name)))
  2010     {
  2011       Lisp_Object name
  2012         = (!substituted ? filename
  2013            : make_specified_string (nm, -1, endp - nm, multibyte));
  2014       Lisp_Object tmp = call1 (Qsubstitute_env_in_file_name, name);
  2015       CHECK_STRING (tmp);
  2016       if (!EQ (tmp, name))
  2017         substituted = true;
  2018       filename = tmp;
  2019     }
  2020 
  2021   if (!substituted)
  2022     {
  2023 #ifdef WINDOWSNT
  2024       if (!NILP (Vw32_downcase_file_names))
  2025         filename = Fdowncase (filename);
  2026 #endif
  2027       SAFE_FREE ();
  2028       return filename;
  2029     }
  2030 
  2031   xnm = SSDATA (filename);
  2032   x = xnm + SBYTES (filename);
  2033 
  2034   /* If /~ or // appears, discard everything through first slash.  */
  2035   while ((p = search_embedded_absfilename (xnm, x)) != NULL)
  2036     /* This time we do not start over because we've already expanded envvars
  2037        and replaced $$ with $.  Maybe we should start over as well, but we'd
  2038        need to quote some $ to $$ first.  */
  2039     xnm = p;
  2040 
  2041 #ifdef WINDOWSNT
  2042   if (!NILP (Vw32_downcase_file_names))
  2043     {
  2044       Lisp_Object xname = make_specified_string (xnm, -1, x - xnm, multibyte);
  2045 
  2046       filename = Fdowncase (xname);
  2047     }
  2048   else
  2049 #endif
  2050   if (xnm != SSDATA (filename))
  2051     filename = make_specified_string (xnm, -1, x - xnm, multibyte);
  2052   SAFE_FREE ();
  2053   return filename;
  2054 }
  2055 
  2056 /* A slightly faster and more convenient way to get
  2057    (directory-file-name (expand-file-name FOO)).  */
  2058 
  2059 Lisp_Object
  2060 expand_and_dir_to_file (Lisp_Object filename)
  2061 {
  2062   Lisp_Object absname = Fexpand_file_name (filename, Qnil);
  2063 
  2064   /* Remove final slash, if any (unless this is the root dir).
  2065      stat behaves differently depending!  */
  2066   if (SCHARS (absname) > 1
  2067       && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
  2068       && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2)))
  2069     /* We cannot take shortcuts; they might be wrong for magic file names.  */
  2070     absname = Fdirectory_file_name (absname);
  2071   return absname;
  2072 }
  2073 
  2074 /* Signal an error if the file ABSNAME already exists.
  2075    If KNOWN_TO_EXIST, the file is known to exist.
  2076    QUERYSTRING is a name for the action that is being considered
  2077    to alter the file.
  2078    If INTERACTIVE, ask the user whether to proceed,
  2079    and bypass the error if the user says to go ahead.
  2080    If QUICK, ask for y or n, not yes or no.  */
  2081 
  2082 static void
  2083 barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist,
  2084                               const char *querystring, bool interactive,
  2085                               bool quick)
  2086 {
  2087   Lisp_Object tem, encoded_filename;
  2088   struct stat statbuf;
  2089 
  2090   encoded_filename = ENCODE_FILE (absname);
  2091 
  2092   if (! known_to_exist
  2093       && (emacs_fstatat (AT_FDCWD, SSDATA (encoded_filename),
  2094                          &statbuf, AT_SYMLINK_NOFOLLOW)
  2095           == 0))
  2096     {
  2097       if (S_ISDIR (statbuf.st_mode))
  2098         xsignal2 (Qfile_error,
  2099                   build_string ("File is a directory"), absname);
  2100       known_to_exist = true;
  2101     }
  2102 
  2103   if (known_to_exist)
  2104     {
  2105       if (! interactive)
  2106         xsignal2 (Qfile_already_exists,
  2107                   build_string ("File already exists"), absname);
  2108       AUTO_STRING (format, "File %s already exists; %s anyway? ");
  2109       tem = CALLN (Fformat, format, absname, build_string (querystring));
  2110       if (quick)
  2111         tem = call1 (intern ("y-or-n-p"), tem);
  2112       else
  2113         tem = do_yes_or_no_p (tem);
  2114       if (NILP (tem))
  2115         xsignal2 (Qfile_already_exists,
  2116                   build_string ("File already exists"), absname);
  2117     }
  2118 }
  2119 
  2120 #ifndef WINDOWSNT
  2121 /* Copy data to DEST from SOURCE if possible.  Return true if OK.  */
  2122 static bool
  2123 clone_file (int dest, int source)
  2124 {
  2125 #ifdef FICLONE
  2126   return ioctl (dest, FICLONE, source) == 0;
  2127 #endif
  2128   return false;
  2129 }
  2130 #endif
  2131 
  2132 DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
  2133        "fCopy file: \nGCopy %s to file: \np\nP",
  2134        doc: /* Copy FILE to NEWNAME.  Both args must be strings.
  2135 If NEWNAME is a directory name, copy FILE to a like-named file under
  2136 NEWNAME.  For NEWNAME to be recognized as a directory name, it should
  2137 end in a slash.
  2138 
  2139 This function always sets the file modes of the output file to match
  2140 the input file.
  2141 
  2142 The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
  2143 if file NEWNAME already exists.  If OK-IF-ALREADY-EXISTS is nil,
  2144 signal a `file-already-exists' error without overwriting.  If
  2145 OK-IF-ALREADY-EXISTS is an integer, request confirmation from the user
  2146 about overwriting; this is what happens in interactive use with M-x.
  2147 Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
  2148 existing file.
  2149 
  2150 Fourth arg KEEP-TIME non-nil means give the output file the same
  2151 last-modified time as the old one.  (This works on only some systems.)
  2152 
  2153 A prefix arg makes KEEP-TIME non-nil.
  2154 
  2155 If PRESERVE-UID-GID is non-nil, try to transfer the uid and gid of
  2156 FILE to NEWNAME.
  2157 
  2158 If PRESERVE-PERMISSIONS is non-nil, copy permissions of FILE to NEWNAME;
  2159 this includes the file modes, along with ACL entries and SELinux
  2160 context if present.  Otherwise, if NEWNAME is created its file
  2161 permission bits are those of FILE, masked by the default file
  2162 permissions.  */)
  2163   (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists,
  2164    Lisp_Object keep_time, Lisp_Object preserve_uid_gid,
  2165    Lisp_Object preserve_permissions)
  2166 {
  2167   Lisp_Object handler;
  2168   specpdl_ref count = SPECPDL_INDEX ();
  2169   Lisp_Object encoded_file, encoded_newname;
  2170 #if HAVE_LIBSELINUX
  2171   char *con;
  2172   int conlength = 0;
  2173 #endif
  2174 #ifdef WINDOWSNT
  2175   int result;
  2176 #else
  2177   bool already_exists = false;
  2178   mode_t new_mask;
  2179   int ifd, ofd;
  2180   struct stat st;
  2181 #endif
  2182 
  2183   file = Fexpand_file_name (file, Qnil);
  2184   newname = expand_cp_target (file, newname);
  2185 
  2186   /* If the input file name has special constructs in it,
  2187      call the corresponding file name handler.  */
  2188   handler = Ffind_file_name_handler (file, Qcopy_file);
  2189   /* Likewise for output file name.  */
  2190   if (NILP (handler))
  2191     handler = Ffind_file_name_handler (newname, Qcopy_file);
  2192   if (!NILP (handler))
  2193     return call7 (handler, Qcopy_file, file, newname,
  2194                   ok_if_already_exists, keep_time, preserve_uid_gid,
  2195                   preserve_permissions);
  2196 
  2197   encoded_file = ENCODE_FILE (file);
  2198   encoded_newname = ENCODE_FILE (newname);
  2199 
  2200 #ifdef WINDOWSNT
  2201   if (NILP (ok_if_already_exists)
  2202       || FIXNUMP (ok_if_already_exists))
  2203     barf_or_query_if_file_exists (newname, false, "copy to it",
  2204                                   FIXNUMP (ok_if_already_exists), false);
  2205 
  2206   result = w32_copy_file (SSDATA (encoded_file), SSDATA (encoded_newname),
  2207                           !NILP (keep_time), !NILP (preserve_uid_gid),
  2208                           !NILP (preserve_permissions));
  2209   switch (result)
  2210     {
  2211     case -1:
  2212       report_file_error ("Copying file", list2 (file, newname));
  2213     case -2:
  2214       report_file_error ("Copying permissions from", file);
  2215     case -3:
  2216       xsignal2 (Qfile_date_error,
  2217                 build_string ("Cannot set file date"), newname);
  2218     case -4:
  2219       report_file_error ("Copying permissions to", newname);
  2220     }
  2221 #else /* not WINDOWSNT */
  2222   ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
  2223 
  2224   if (ifd < 0)
  2225     report_file_error ("Opening input file", file);
  2226 
  2227   record_unwind_protect_int (close_file_unwind, ifd);
  2228 
  2229   if (fstat (ifd, &st) != 0)
  2230     report_file_error ("Input file status", file);
  2231 
  2232   if (!NILP (preserve_permissions))
  2233     {
  2234 #if HAVE_LIBSELINUX
  2235       if (is_selinux_enabled ())
  2236         {
  2237           conlength = fgetfilecon (ifd, &con);
  2238           if (conlength == -1)
  2239             report_file_error ("Doing fgetfilecon", file);
  2240         }
  2241 #endif
  2242     }
  2243 
  2244   /* We can copy only regular files.  */
  2245   if (!S_ISREG (st.st_mode))
  2246     report_file_errno ("Non-regular file", file,
  2247                        S_ISDIR (st.st_mode) ? EISDIR : EINVAL);
  2248 
  2249 #ifndef MSDOS
  2250   new_mask = st.st_mode & (!NILP (preserve_uid_gid) ? 0700 : 0777);
  2251 #else
  2252   new_mask = S_IREAD | S_IWRITE;
  2253 #endif
  2254 
  2255   ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY | O_CREAT | O_EXCL,
  2256                     new_mask);
  2257   if (ofd < 0 && errno == EEXIST)
  2258     {
  2259       if (NILP (ok_if_already_exists) || FIXNUMP (ok_if_already_exists))
  2260         barf_or_query_if_file_exists (newname, true, "copy to it",
  2261                                       FIXNUMP (ok_if_already_exists), false);
  2262       already_exists = true;
  2263       ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY, 0);
  2264     }
  2265   if (ofd < 0)
  2266     report_file_error ("Opening output file", newname);
  2267 
  2268   record_unwind_protect_int (close_file_unwind, ofd);
  2269 
  2270   off_t oldsize = 0, newsize;
  2271 
  2272   if (already_exists)
  2273     {
  2274       struct stat out_st;
  2275       if (fstat (ofd, &out_st) != 0)
  2276         report_file_error ("Output file status", newname);
  2277       if (st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
  2278         report_file_errno ("Input and output files are the same",
  2279                            list2 (file, newname), 0);
  2280       if (S_ISREG (out_st.st_mode))
  2281         oldsize = out_st.st_size;
  2282     }
  2283 
  2284   maybe_quit ();
  2285 
  2286   if (clone_file (ofd, ifd))
  2287     newsize = st.st_size;
  2288   else
  2289     {
  2290       off_t insize = st.st_size;
  2291       ssize_t copied;
  2292 
  2293 #ifndef MSDOS
  2294       for (newsize = 0; newsize < insize; newsize += copied)
  2295         {
  2296           /* Copy at most COPY_MAX bytes at a time; this is min
  2297              (PTRDIFF_MAX, SIZE_MAX) truncated to a value that is
  2298              surely aligned well.  */
  2299           ssize_t ssize_max = TYPE_MAXIMUM (ssize_t);
  2300           ptrdiff_t copy_max = min (ssize_max, SIZE_MAX) >> 30 << 30;
  2301           off_t intail = insize - newsize;
  2302           ptrdiff_t len = min (intail, copy_max);
  2303           copied = copy_file_range (ifd, NULL, ofd, NULL, len, 0);
  2304           if (copied <= 0)
  2305             break;
  2306           maybe_quit ();
  2307         }
  2308 #endif /* MSDOS */
  2309 
  2310       /* Fall back on read+write if copy_file_range failed, or if the
  2311          input is empty and so could be a /proc file.  read+write will
  2312          either succeed, or report an error more precisely than
  2313          copy_file_range would.  */
  2314       if (newsize != insize || insize == 0)
  2315         {
  2316           char buf[MAX_ALLOCA];
  2317           for (; (copied = emacs_read_quit (ifd, buf, sizeof buf));
  2318                newsize += copied)
  2319             {
  2320               if (copied < 0)
  2321                 report_file_error ("Read error", file);
  2322               if (emacs_write_quit (ofd, buf, copied) != copied)
  2323                 report_file_error ("Write error", newname);
  2324             }
  2325         }
  2326     }
  2327 
  2328   /* Truncate any existing output file after writing the data.  This
  2329      is more likely to work than truncation before writing, if the
  2330      file system is out of space or the user is over disk quota.  */
  2331   if (newsize < oldsize && ftruncate (ofd, newsize) != 0)
  2332     report_file_error ("Truncating output file", newname);
  2333 
  2334 #ifndef MSDOS
  2335   /* Preserve the original file permissions, and if requested, also its
  2336      owner and group.  */
  2337   {
  2338     mode_t preserved_permissions = st.st_mode & 07777;
  2339     mode_t default_permissions = st.st_mode & 0777 & ~realmask;
  2340     if (!NILP (preserve_uid_gid))
  2341       {
  2342         /* Attempt to change owner and group.  If that doesn't work
  2343            attempt to change just the group, as that is sometimes allowed.
  2344            Adjust the mode mask to eliminate setuid or setgid bits
  2345            or group permissions bits that are inappropriate if the
  2346            owner or group are wrong.  */
  2347         if (fchown (ofd, st.st_uid, st.st_gid) != 0)
  2348           {
  2349             if (fchown (ofd, -1, st.st_gid) == 0)
  2350               preserved_permissions &= ~04000;
  2351             else
  2352               {
  2353                 preserved_permissions &= ~06000;
  2354 
  2355                 /* Copy the other bits to the group bits, since the
  2356                    group is wrong.  */
  2357                 preserved_permissions &= ~070;
  2358                 preserved_permissions |= (preserved_permissions & 7) << 3;
  2359                 default_permissions &= ~070;
  2360                 default_permissions |= (default_permissions & 7) << 3;
  2361               }
  2362           }
  2363       }
  2364 
  2365     switch (!NILP (preserve_permissions)
  2366             ? qcopy_acl (SSDATA (encoded_file), ifd,
  2367                          SSDATA (encoded_newname), ofd,
  2368                          preserved_permissions)
  2369             : (already_exists
  2370                || (new_mask & ~realmask) == default_permissions)
  2371             ? 0
  2372             : fchmod (ofd, default_permissions))
  2373       {
  2374       case -2: report_file_error ("Copying permissions from", file);
  2375       case -1: report_file_error ("Copying permissions to", newname);
  2376       }
  2377   }
  2378 #endif  /* not MSDOS */
  2379 
  2380 #if HAVE_LIBSELINUX
  2381   if (conlength > 0)
  2382     {
  2383       /* Set the modified context back to the file.  */
  2384       bool fail = fsetfilecon (ofd, con) != 0;
  2385       /* See https://debbugs.gnu.org/11245 for ENOTSUP.  */
  2386       if (fail && errno != ENOTSUP)
  2387         report_file_error ("Doing fsetfilecon", newname);
  2388 
  2389       freecon (con);
  2390     }
  2391 #endif
  2392 
  2393   if (!NILP (keep_time))
  2394     {
  2395       struct timespec ts[2];
  2396       ts[0] = get_stat_atime (&st);
  2397       ts[1] = get_stat_mtime (&st);
  2398       if (futimens (ofd, ts) != 0)
  2399         xsignal2 (Qfile_date_error,
  2400                   build_string ("Cannot set file date"), newname);
  2401     }
  2402 
  2403   if (emacs_close (ofd) < 0)
  2404     report_file_error ("Write error", newname);
  2405 
  2406   emacs_close (ifd);
  2407 
  2408 #ifdef MSDOS
  2409   /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
  2410      and if it can't, it tells so.  Otherwise, under MSDOS we usually
  2411      get only the READ bit, which will make the copied file read-only,
  2412      so it's better not to chmod at all.  */
  2413   if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
  2414     chmod (SDATA (encoded_newname), st.st_mode & 07777);
  2415 #endif /* MSDOS */
  2416 #endif /* not WINDOWSNT */
  2417 
  2418   /* Discard the unwind protects.  */
  2419   specpdl_ptr = specpdl_ref_to_ptr (count);
  2420 
  2421   return Qnil;
  2422 }
  2423 
  2424 DEFUN ("make-directory-internal", Fmake_directory_internal,
  2425        Smake_directory_internal, 1, 1, 0,
  2426        doc: /* Create a new directory named DIRECTORY.  */)
  2427   (Lisp_Object directory)
  2428 {
  2429   const char *dir;
  2430   Lisp_Object encoded_dir;
  2431 
  2432   CHECK_STRING (directory);
  2433   directory = Fexpand_file_name (directory, Qnil);
  2434 
  2435   encoded_dir = ENCODE_FILE (directory);
  2436 
  2437   dir = SSDATA (encoded_dir);
  2438 
  2439   if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
  2440     report_file_error ("Creating directory", directory);
  2441 
  2442   return Qnil;
  2443 }
  2444 
  2445 DEFUN ("delete-directory-internal", Fdelete_directory_internal,
  2446        Sdelete_directory_internal, 1, 1, 0,
  2447        doc: /* Delete the directory named DIRECTORY.  Does not follow symlinks.  */)
  2448   (Lisp_Object directory)
  2449 {
  2450   const char *dir;
  2451   Lisp_Object encoded_dir;
  2452 
  2453   CHECK_STRING (directory);
  2454   directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
  2455   encoded_dir = ENCODE_FILE (directory);
  2456   dir = SSDATA (encoded_dir);
  2457 
  2458   if (rmdir (dir) != 0)
  2459     report_file_error ("Removing directory", directory);
  2460 
  2461   return Qnil;
  2462 }
  2463 
  2464 DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 2,
  2465        "(list (read-file-name \
  2466                 (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
  2467                     \"Move file to trash: \" \"Delete file: \") \
  2468                 nil default-directory (confirm-nonexistent-file-or-buffer)) \
  2469               (null current-prefix-arg))",
  2470        doc: /* Delete file named FILENAME.  If it is a symlink, remove the symlink.
  2471 If file has multiple names, it continues to exist with the other names.
  2472 TRASH non-nil means to trash the file instead of deleting, provided
  2473 `delete-by-moving-to-trash' is non-nil.
  2474 
  2475 When called interactively, TRASH is t if no prefix argument is given.
  2476 With a prefix argument, TRASH is nil.  */)
  2477   (Lisp_Object filename, Lisp_Object trash)
  2478 {
  2479   Lisp_Object handler;
  2480   Lisp_Object encoded_file;
  2481 
  2482   if (!NILP (Ffile_directory_p (filename))
  2483       && NILP (Ffile_symlink_p (filename)))
  2484     xsignal2 (Qfile_error,
  2485               build_string ("Removing old name: is a directory"),
  2486               filename);
  2487   filename = Fexpand_file_name (filename, Qnil);
  2488 
  2489   handler = Ffind_file_name_handler (filename, Qdelete_file);
  2490   if (!NILP (handler))
  2491     return call3 (handler, Qdelete_file, filename, trash);
  2492 
  2493   if (delete_by_moving_to_trash && !NILP (trash))
  2494     return call1 (Qmove_file_to_trash, filename);
  2495 
  2496   encoded_file = ENCODE_FILE (filename);
  2497 
  2498   if (unlink (SSDATA (encoded_file)) != 0 && errno != ENOENT)
  2499     report_file_error ("Removing old name", filename);
  2500   return Qnil;
  2501 }
  2502 
  2503 #if defined HAVE_NATIVE_COMP && defined WINDOWSNT
  2504 
  2505 static Lisp_Object
  2506 internal_delete_file_1 (Lisp_Object ignore)
  2507 {
  2508   return Qt;
  2509 }
  2510 
  2511 /* Delete file FILENAME, returning true if successful.
  2512    This ignores `delete-by-moving-to-trash'.  */
  2513 
  2514 bool
  2515 internal_delete_file (Lisp_Object filename)
  2516 {
  2517   Lisp_Object tem;
  2518 
  2519   tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
  2520                                    Qt, internal_delete_file_1);
  2521   return NILP (tem);
  2522 }
  2523 
  2524 #endif
  2525 
  2526 /* Return -1 if FILE is a case-insensitive file name, 0 if not,
  2527    and a positive errno value if the result cannot be determined.  */
  2528 
  2529 static int
  2530 file_name_case_insensitive_err (Lisp_Object file)
  2531 {
  2532   /* Filesystems are case-sensitive on all supported systems except
  2533      MS-Windows, MS-DOS, Cygwin, and macOS.  They are always
  2534      case-insensitive on the first two, but they may or may not be
  2535      case-insensitive on Cygwin and macOS so do a runtime test on
  2536      those two systems.  If the test is not conclusive, assume
  2537      case-insensitivity on Cygwin and case-sensitivity on macOS.
  2538 
  2539      FIXME: Mounted filesystems on Posix hosts, like Samba shares or
  2540      NFS-mounted Windows volumes, might be case-insensitive.  Can we
  2541      detect this?
  2542 
  2543      Use pathconf with _PC_CASE_INSENSITIVE or _PC_CASE_SENSITIVE if
  2544      those flags are available.  As of this writing (2019-09-15),
  2545      Cygwin is the only platform known to support the former (starting
  2546      with Cygwin-2.6.1), and macOS is the only platform known to
  2547      support the latter.  */
  2548 
  2549 #if defined _PC_CASE_INSENSITIVE || defined _PC_CASE_SENSITIVE
  2550   char *filename = SSDATA (ENCODE_FILE (file));
  2551 # ifdef _PC_CASE_INSENSITIVE
  2552   long int res = pathconf (filename, _PC_CASE_INSENSITIVE);
  2553   if (res >= 0)
  2554     return - (res > 0);
  2555 # else
  2556   long int res = pathconf (filename, _PC_CASE_SENSITIVE);
  2557   if (res >= 0)
  2558     return - (res == 0);
  2559 # endif
  2560   if (errno != EINVAL)
  2561     return errno;
  2562 #endif
  2563 
  2564 #if defined CYGWIN || defined DOS_NT
  2565   return -1;
  2566 #else
  2567   return 0;
  2568 #endif
  2569 }
  2570 
  2571 DEFUN ("file-name-case-insensitive-p", Ffile_name_case_insensitive_p,
  2572        Sfile_name_case_insensitive_p, 1, 1, 0,
  2573        doc: /* Return t if file FILENAME is on a case-insensitive filesystem.
  2574 Return nil if FILENAME does not exist or is not on a case-insensitive
  2575 filesystem, or if there was trouble determining whether the filesystem
  2576 is case-insensitive.  */)
  2577   (Lisp_Object filename)
  2578 {
  2579   Lisp_Object handler;
  2580 
  2581   CHECK_STRING (filename);
  2582   filename = Fexpand_file_name (filename, Qnil);
  2583 
  2584   /* If the file name has special constructs in it,
  2585      call the corresponding file name handler.  */
  2586   handler = Ffind_file_name_handler (filename, Qfile_name_case_insensitive_p);
  2587   if (!NILP (handler))
  2588     return call2 (handler, Qfile_name_case_insensitive_p, filename);
  2589 
  2590   /* If the file doesn't exist or there is trouble checking its
  2591      filesystem, move up the filesystem tree until we reach an
  2592      existing, trouble-free directory or the root.  */
  2593   while (true)
  2594     {
  2595       int err = file_name_case_insensitive_err (filename);
  2596       if (err <= 0)
  2597         return err < 0 ? Qt : Qnil;
  2598       Lisp_Object parent = file_name_directory (filename);
  2599       /* Avoid infinite loop if the root has trouble (if that's even possible).
  2600          Without a parent, we just don't know and return nil as well.  */
  2601       if (!STRINGP (parent) || !NILP (Fstring_equal (parent, filename)))
  2602         return Qnil;
  2603       filename = parent;
  2604     }
  2605 }
  2606 
  2607 DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
  2608        "fRename file: \nGRename %s to file: \np",
  2609        doc: /* Rename FILE as NEWNAME.  Both args must be strings.
  2610 If file has names other than FILE, it continues to have those names.
  2611 If NEWNAME is a directory name, rename FILE to a like-named file under
  2612 NEWNAME.  For NEWNAME to be recognized as a directory name, it should
  2613 end in a slash.
  2614 
  2615 Signal a `file-already-exists' error if a file NEWNAME already exists
  2616 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
  2617 An integer third arg means request confirmation if NEWNAME already exists.
  2618 This is what happens in interactive use with M-x.  */)
  2619   (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
  2620 {
  2621   Lisp_Object handler;
  2622   Lisp_Object encoded_file, encoded_newname;
  2623 
  2624   file = Fexpand_file_name (file, Qnil);
  2625 
  2626   /* If the filesystem is case-insensitive and the file names are
  2627      identical but for case, treat it as a change-case request, and do
  2628      not worry whether NEWNAME exists or whether it is a directory, as
  2629      it is already another name for FILE.  */
  2630   bool case_only_rename = false;
  2631 #if defined CYGWIN || defined DOS_NT
  2632   if (!NILP (Ffile_name_case_insensitive_p (file)))
  2633     {
  2634       newname = Fexpand_file_name (newname, Qnil);
  2635       case_only_rename = !NILP (Fstring_equal (Fdowncase (file),
  2636                                                Fdowncase (newname)));
  2637     }
  2638 #endif
  2639 
  2640   if (!case_only_rename)
  2641     newname = expand_cp_target (Fdirectory_file_name (file), newname);
  2642 
  2643   /* If the file name has special constructs in it,
  2644      call the corresponding file name handler.  */
  2645   handler = Ffind_file_name_handler (file, Qrename_file);
  2646   if (NILP (handler))
  2647     handler = Ffind_file_name_handler (newname, Qrename_file);
  2648   if (!NILP (handler))
  2649     return call4 (handler, Qrename_file,
  2650                   file, newname, ok_if_already_exists);
  2651 
  2652   encoded_file = ENCODE_FILE (file);
  2653   encoded_newname = ENCODE_FILE (newname);
  2654 
  2655   bool plain_rename = (case_only_rename
  2656                        || (!NILP (ok_if_already_exists)
  2657                            && !FIXNUMP (ok_if_already_exists)));
  2658   int rename_errno UNINIT;
  2659   if (!plain_rename)
  2660     {
  2661       if (renameat_noreplace (AT_FDCWD, SSDATA (encoded_file),
  2662                               AT_FDCWD, SSDATA (encoded_newname))
  2663           == 0)
  2664         return Qnil;
  2665 
  2666       rename_errno = errno;
  2667       switch (rename_errno)
  2668         {
  2669         case EEXIST: case EINVAL: case ENOSYS:
  2670 #if ENOSYS != ENOTSUP
  2671         case ENOTSUP:
  2672 #endif
  2673           barf_or_query_if_file_exists (newname, rename_errno == EEXIST,
  2674                                         "rename to it",
  2675                                         FIXNUMP (ok_if_already_exists),
  2676                                         false);
  2677           plain_rename = true;
  2678           break;
  2679         }
  2680     }
  2681 
  2682   if (plain_rename)
  2683     {
  2684       if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
  2685         return Qnil;
  2686       rename_errno = errno;
  2687       /* Don't prompt again.  */
  2688       ok_if_already_exists = Qt;
  2689     }
  2690   else if (!NILP (ok_if_already_exists))
  2691     ok_if_already_exists = Qt;
  2692 
  2693   if (rename_errno != EXDEV)
  2694     report_file_errno ("Renaming", list2 (file, newname), rename_errno);
  2695 
  2696   struct stat file_st;
  2697   bool dirp = !NILP (Fdirectory_name_p (file));
  2698   if (!dirp)
  2699     {
  2700       if (emacs_fstatat (AT_FDCWD, SSDATA (encoded_file),
  2701                          &file_st, AT_SYMLINK_NOFOLLOW)
  2702           != 0)
  2703         report_file_error ("Renaming", list2 (file, newname));
  2704       dirp = S_ISDIR (file_st.st_mode) != 0;
  2705     }
  2706   if (dirp)
  2707     call4 (Qcopy_directory, file, newname, Qt, Qnil);
  2708   else
  2709     {
  2710       Lisp_Object symlink_target
  2711         = (S_ISLNK (file_st.st_mode)
  2712            ? check_emacs_readlinkat (AT_FDCWD, file, SSDATA (encoded_file))
  2713            : Qnil);
  2714       if (!NILP (symlink_target))
  2715         Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists);
  2716       else if (S_ISFIFO (file_st.st_mode))
  2717         {
  2718           /* If it's a FIFO, calling `copy-file' will hang if it's a
  2719              inter-file system move, so do it here.  (It will signal
  2720              an error in that case, but it won't hang in any case.)  */
  2721           if (!NILP (ok_if_already_exists))
  2722             barf_or_query_if_file_exists (newname, false,
  2723                                           "rename to it",
  2724                                           FIXNUMP (ok_if_already_exists),
  2725                                           false);
  2726           if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) != 0)
  2727             report_file_errno ("Renaming", list2 (file, newname), errno);
  2728           return Qnil;
  2729         }
  2730       else
  2731         Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt);
  2732     }
  2733 
  2734   specpdl_ref count = SPECPDL_INDEX ();
  2735   specbind (Qdelete_by_moving_to_trash, Qnil);
  2736   if (dirp)
  2737     call2 (Qdelete_directory, file, Qt);
  2738   else
  2739     Fdelete_file (file, Qnil);
  2740   return unbind_to (count, Qnil);
  2741 }
  2742 
  2743 DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
  2744        "fAdd name to file: \nGName to add to %s: \np",
  2745        doc: /* Give FILE additional name NEWNAME.  Both args must be strings.
  2746 If NEWNAME is a directory name, give FILE a like-named new name under
  2747 NEWNAME.
  2748 
  2749 Signal a `file-already-exists' error if a file NEWNAME already exists
  2750 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
  2751 An integer third arg means request confirmation if NEWNAME already exists.
  2752 This is what happens in interactive use with M-x.  */)
  2753   (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
  2754 {
  2755   Lisp_Object handler;
  2756   Lisp_Object encoded_file, encoded_newname;
  2757 
  2758   file = Fexpand_file_name (file, Qnil);
  2759   newname = expand_cp_target (file, newname);
  2760 
  2761   /* If the file name has special constructs in it,
  2762      call the corresponding file name handler.  */
  2763   handler = Ffind_file_name_handler (file, Qadd_name_to_file);
  2764   if (!NILP (handler))
  2765     return call4 (handler, Qadd_name_to_file, file,
  2766                   newname, ok_if_already_exists);
  2767 
  2768   /* If the new name has special constructs in it,
  2769      call the corresponding file name handler.  */
  2770   handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
  2771   if (!NILP (handler))
  2772     return call4 (handler, Qadd_name_to_file, file,
  2773                   newname, ok_if_already_exists);
  2774 
  2775   encoded_file = ENCODE_FILE (file);
  2776   encoded_newname = ENCODE_FILE (newname);
  2777 
  2778   if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
  2779     return Qnil;
  2780 
  2781   if (errno == EEXIST)
  2782     {
  2783       if (NILP (ok_if_already_exists)
  2784           || FIXNUMP (ok_if_already_exists))
  2785         barf_or_query_if_file_exists (newname, true, "make it a new name",
  2786                                       FIXNUMP (ok_if_already_exists), false);
  2787       unlink (SSDATA (newname));
  2788       if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
  2789         return Qnil;
  2790     }
  2791 
  2792   report_file_error ("Adding new name", list2 (file, newname));
  2793 }
  2794 
  2795 DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
  2796        "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
  2797        doc: /* Make a symbolic link to TARGET, named LINKNAME.
  2798 If LINKNAME is a directory name, make a like-named symbolic link under
  2799 LINKNAME.
  2800 
  2801 Signal a `file-already-exists' error if a file LINKNAME already exists
  2802 unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
  2803 An integer third arg means request confirmation if LINKNAME already
  2804 exists, and expand leading "~" or strip leading "/:" in TARGET.
  2805 This happens for interactive use with M-x.  */)
  2806   (Lisp_Object target, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
  2807 {
  2808   Lisp_Object handler;
  2809   Lisp_Object encoded_target, encoded_linkname;
  2810 
  2811   CHECK_STRING (target);
  2812   if (FIXNUMP (ok_if_already_exists))
  2813     {
  2814       if (SREF (target, 0) == '~')
  2815         target = Fexpand_file_name (target, Qnil);
  2816       else if (SREF (target, 0) == '/' && SREF (target, 1) == ':')
  2817         target = Fsubstring_no_properties (target, make_fixnum (2), Qnil);
  2818     }
  2819   linkname = expand_cp_target (target, linkname);
  2820 
  2821   /* If the new link name has special constructs in it,
  2822      call the corresponding file name handler.  */
  2823   handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
  2824   if (!NILP (handler))
  2825     return call4 (handler, Qmake_symbolic_link, target,
  2826                   linkname, ok_if_already_exists);
  2827 
  2828   encoded_target = ENCODE_FILE (target);
  2829   encoded_linkname = ENCODE_FILE (linkname);
  2830 
  2831   if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
  2832     return Qnil;
  2833 
  2834   if (errno == ENOSYS)
  2835     xsignal1 (Qfile_error,
  2836               build_string ("Symbolic links are not supported"));
  2837 
  2838   if (errno == EEXIST)
  2839     {
  2840       if (NILP (ok_if_already_exists)
  2841           || FIXNUMP (ok_if_already_exists))
  2842         barf_or_query_if_file_exists (linkname, true, "make it a link",
  2843                                       FIXNUMP (ok_if_already_exists), false);
  2844       unlink (SSDATA (encoded_linkname));
  2845       if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
  2846         return Qnil;
  2847     }
  2848 
  2849   report_file_error ("Making symbolic link", list2 (target, linkname));
  2850 }
  2851 
  2852 
  2853 DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
  2854        1, 1, 0,
  2855        doc: /* Return t if FILENAME is an absolute file name.
  2856 On Unix, absolute file names start with `/'.  In Emacs, an absolute
  2857 file name can also start with an initial `~' or `~USER' component,
  2858 where USER is a valid login name.  */)
  2859   (Lisp_Object filename)
  2860 {
  2861   CHECK_STRING (filename);
  2862   return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
  2863 }
  2864 
  2865 bool
  2866 file_name_absolute_p (char const *filename)
  2867 {
  2868   return (IS_ABSOLUTE_FILE_NAME (filename)
  2869           || (filename[0] == '~'
  2870               && (!filename[1] || IS_DIRECTORY_SEP (filename[1])
  2871                   || user_homedir (&filename[1]))));
  2872 }
  2873 
  2874 /* Return t if FILE exists and is accessible via OPERATION and AMODE,
  2875    nil (setting errno) if not.  */
  2876 
  2877 static Lisp_Object
  2878 check_file_access (Lisp_Object file, Lisp_Object operation, int amode)
  2879 {
  2880   file = Fexpand_file_name (file, Qnil);
  2881   Lisp_Object handler = Ffind_file_name_handler (file, operation);
  2882   if (!NILP (handler))
  2883     {
  2884       Lisp_Object ok = call2 (handler, operation, file);
  2885       /* This errno value is bogus.  Any caller that depends on errno
  2886          should be rethought anyway, to avoid a race between testing a
  2887          handled file's accessibility and using the file.  */
  2888       errno = 0;
  2889       return ok;
  2890     }
  2891 
  2892   char *encoded_file = SSDATA (ENCODE_FILE (file));
  2893   return file_access_p (encoded_file, amode) ? Qt : Qnil;
  2894 }
  2895 
  2896 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
  2897        doc: /* Return t if file FILENAME exists (whether or not you can read it).
  2898 Return nil if FILENAME does not exist, or if there was trouble
  2899 determining whether the file exists.
  2900 See also `file-readable-p' and `file-attributes'.
  2901 This returns nil for a symlink to a nonexistent file.
  2902 Use `file-symlink-p' to test for such links.  */)
  2903   (Lisp_Object filename)
  2904 {
  2905   return check_file_access (filename, Qfile_exists_p, F_OK);
  2906 }
  2907 
  2908 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
  2909        doc: /* Return t if FILENAME can be executed by you.
  2910 For a directory, this means you can access files in that directory.
  2911 \(It is generally better to use `file-accessible-directory-p' for that
  2912 purpose, though.)  */)
  2913   (Lisp_Object filename)
  2914 {
  2915   return check_file_access (filename, Qfile_executable_p, X_OK);
  2916 }
  2917 
  2918 DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
  2919        doc: /* Return t if file FILENAME exists and you can read it.
  2920 See also `file-exists-p' and `file-attributes'.  */)
  2921   (Lisp_Object filename)
  2922 {
  2923   return check_file_access (filename, Qfile_readable_p, R_OK);
  2924 }
  2925 
  2926 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
  2927        doc: /* Return t if file FILENAME can be written or created by you.  */)
  2928   (Lisp_Object filename)
  2929 {
  2930   Lisp_Object absname, dir, encoded;
  2931   Lisp_Object handler;
  2932 
  2933   absname = Fexpand_file_name (filename, Qnil);
  2934 
  2935   /* If the file name has special constructs in it,
  2936      call the corresponding file name handler.  */
  2937   handler = Ffind_file_name_handler (absname, Qfile_writable_p);
  2938   if (!NILP (handler))
  2939     return call2 (handler, Qfile_writable_p, absname);
  2940 
  2941   encoded = ENCODE_FILE (absname);
  2942   if (file_access_p (SSDATA (encoded), W_OK))
  2943     return Qt;
  2944   if (errno != ENOENT)
  2945     return Qnil;
  2946 
  2947   dir = file_name_directory (absname);
  2948   eassert (!NILP (dir));
  2949 #ifdef MSDOS
  2950   dir = Fdirectory_file_name (dir);
  2951 #endif /* MSDOS */
  2952 
  2953   encoded = ENCODE_FILE (dir);
  2954 #ifdef WINDOWSNT
  2955   /* The read-only attribute of the parent directory doesn't affect
  2956      whether a file or directory can be created within it.  Some day we
  2957      should check ACLs though, which do affect this.  */
  2958   return file_directory_p (encoded) ? Qt : Qnil;
  2959 #else
  2960   return file_access_p (SSDATA (encoded), W_OK | X_OK) ? Qt : Qnil;
  2961 #endif
  2962 }
  2963 
  2964 DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
  2965        doc: /* Access file FILENAME, and get an error if that does not work.
  2966 The second argument STRING is prepended to the error message.
  2967 If there is no error, returns nil.  */)
  2968   (Lisp_Object filename, Lisp_Object string)
  2969 {
  2970   Lisp_Object handler, encoded_filename, absname;
  2971 
  2972   CHECK_STRING (filename);
  2973   absname = Fexpand_file_name (filename, Qnil);
  2974 
  2975   CHECK_STRING (string);
  2976 
  2977   /* If the file name has special constructs in it,
  2978      call the corresponding file name handler.  */
  2979   handler = Ffind_file_name_handler (absname, Qaccess_file);
  2980   if (!NILP (handler))
  2981     return call3 (handler, Qaccess_file, absname, string);
  2982 
  2983   encoded_filename = ENCODE_FILE (absname);
  2984 
  2985   if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0)
  2986     report_file_error (SSDATA (string), filename);
  2987 
  2988   return Qnil;
  2989 }
  2990 
  2991 /* Relative to directory FD, return the symbolic link value of FILENAME.
  2992    On failure, return nil (setting errno).  */
  2993 static Lisp_Object
  2994 emacs_readlinkat (int fd, char const *filename)
  2995 {
  2996   static struct allocator const emacs_norealloc_allocator =
  2997     { xmalloc, NULL, xfree, memory_full };
  2998   Lisp_Object val;
  2999   char readlink_buf[1024];
  3000   char *buf = careadlinkat (fd, filename, readlink_buf, sizeof readlink_buf,
  3001                             &emacs_norealloc_allocator, readlinkat);
  3002   if (!buf)
  3003     return Qnil;
  3004 
  3005   val = build_unibyte_string (buf);
  3006   if (buf != readlink_buf)
  3007     xfree (buf);
  3008   val = DECODE_FILE (val);
  3009   return val;
  3010 }
  3011 
  3012 /* Relative to directory FD, return the symbolic link value of FILE.
  3013    If FILE is not a symbolic link, return nil (setting errno).
  3014    Signal an error if the result cannot be determined.  */
  3015 Lisp_Object
  3016 check_emacs_readlinkat (int fd, Lisp_Object file, char const *encoded_file)
  3017 {
  3018   Lisp_Object val = emacs_readlinkat (fd, encoded_file);
  3019   if (NILP (val))
  3020     {
  3021       if (errno == EINVAL)
  3022         return val;
  3023 #ifdef CYGWIN
  3024       /* Work around Cygwin bugs.  */
  3025       if (errno == EIO || errno == EACCES)
  3026         return val;
  3027 #endif
  3028       return file_metadata_errno ("Reading symbolic link", file, errno);
  3029     }
  3030   return val;
  3031 }
  3032 
  3033 DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
  3034        doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
  3035 The value is the link target, as a string.
  3036 Return nil if FILENAME does not exist or is not a symbolic link,
  3037 of there was trouble determining whether the file is a symbolic link.
  3038 
  3039 This function does not check whether the link target exists.  */)
  3040   (Lisp_Object filename)
  3041 {
  3042   Lisp_Object handler;
  3043 
  3044   CHECK_STRING (filename);
  3045   filename = Fexpand_file_name (filename, Qnil);
  3046 
  3047   /* If the file name has special constructs in it,
  3048      call the corresponding file name handler.  */
  3049   handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
  3050   if (!NILP (handler))
  3051     return call2 (handler, Qfile_symlink_p, filename);
  3052 
  3053   return emacs_readlinkat (AT_FDCWD, SSDATA (ENCODE_FILE (filename)));
  3054 }
  3055 
  3056 DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
  3057        doc: /* Return t if FILENAME names an existing directory.
  3058 Return nil if FILENAME does not name a directory, or if there
  3059 was trouble determining whether FILENAME is a directory.
  3060 
  3061 As a special case, this function will also return t if FILENAME is the
  3062 empty string (\"\").  This quirk is due to Emacs interpreting the
  3063 empty string (in some cases) as the current directory.
  3064 
  3065 Symbolic links to directories count as directories.
  3066 See `file-symlink-p' to distinguish symlinks.  */)
  3067   (Lisp_Object filename)
  3068 {
  3069   Lisp_Object absname = expand_and_dir_to_file (filename);
  3070 
  3071   /* If the file name has special constructs in it,
  3072      call the corresponding file name handler.  */
  3073   Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_directory_p);
  3074   if (!NILP (handler))
  3075     return call2 (handler, Qfile_directory_p, absname);
  3076 
  3077   return file_directory_p (ENCODE_FILE (absname)) ? Qt : Qnil;
  3078 }
  3079 
  3080 /* Return true if FILE is a directory or a symlink to a directory.
  3081    Otherwise return false and set errno.  */
  3082 bool
  3083 file_directory_p (Lisp_Object file)
  3084 {
  3085 #ifdef DOS_NT
  3086   /* This is cheaper than 'stat'.  */
  3087   bool retval = faccessat (AT_FDCWD, SSDATA (file), D_OK, AT_EACCESS) == 0;
  3088   if (!retval && errno == EACCES)
  3089     errno = ENOTDIR;    /* like the non-DOS_NT branch below does */
  3090   return retval;
  3091 #else
  3092 # ifdef O_PATH
  3093   /* Use O_PATH if available, as it avoids races and EOVERFLOW issues.  */
  3094   int fd = emacs_openat (AT_FDCWD, SSDATA (file),
  3095                          O_PATH | O_CLOEXEC | O_DIRECTORY, 0);
  3096   if (0 <= fd)
  3097     {
  3098       emacs_close (fd);
  3099       return true;
  3100     }
  3101   if (errno != EINVAL)
  3102     return false;
  3103   /* O_PATH is defined but evidently this Linux kernel predates 2.6.39.
  3104      Fall back on generic POSIX code.  */
  3105 # endif
  3106   /* Use file_accessible_directory_p, as it avoids fstatat EOVERFLOW
  3107      problems and could be cheaper.  However, if it fails because FILE
  3108      is inaccessible, fall back on fstatat; if the latter fails with
  3109      EOVERFLOW then FILE must have been a directory unless a race
  3110      condition occurred (a problem hard to work around portably).  */
  3111   if (file_accessible_directory_p (file))
  3112     return true;
  3113   if (errno != EACCES)
  3114     return false;
  3115   struct stat st;
  3116   if (emacs_fstatat (AT_FDCWD, SSDATA (file), &st, 0) != 0)
  3117     return errno == EOVERFLOW;
  3118   if (S_ISDIR (st.st_mode))
  3119     return true;
  3120   errno = ENOTDIR;
  3121   return false;
  3122 #endif
  3123 }
  3124 
  3125 DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p,
  3126        Sfile_accessible_directory_p, 1, 1, 0,
  3127        doc: /* Return t if FILENAME names a directory you can open.
  3128 This means that FILENAME must specify the name of a directory, and the
  3129 directory must allow you to open files in it.  If this isn't the case,
  3130 return nil.
  3131 
  3132 FILENAME can either be a directory name (eg. \"/tmp/foo/\") or the
  3133 file name of a file which is a directory (eg. \"/tmp/foo\", without
  3134 the final slash).
  3135 
  3136 In order to use a directory as a buffer's current directory, this
  3137 predicate must return true.  */)
  3138   (Lisp_Object filename)
  3139 {
  3140   Lisp_Object absname;
  3141   Lisp_Object handler;
  3142 
  3143   CHECK_STRING (filename);
  3144   absname = Fexpand_file_name (filename, Qnil);
  3145 
  3146   /* If the file name has special constructs in it,
  3147      call the corresponding file name handler.  */
  3148   handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p);
  3149   if (!NILP (handler))
  3150     {
  3151       Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
  3152 
  3153       /* Set errno in case the handler failed.  EACCES might be a lie
  3154          (e.g., the directory might not exist, or be a regular file),
  3155          but at least it does TRT in the "usual" case of an existing
  3156          directory that is not accessible by the current user, and
  3157          avoids reporting "Success" for a failed operation.  Perhaps
  3158          someday we can fix this in a better way, by improving
  3159          file-accessible-directory-p's API; see Bug#25419.  */
  3160       if (!EQ (r, Qt))
  3161         errno = EACCES;
  3162 
  3163       return r;
  3164     }
  3165 
  3166   Lisp_Object encoded_absname = ENCODE_FILE (absname);
  3167   return file_accessible_directory_p (encoded_absname) ? Qt : Qnil;
  3168 }
  3169 
  3170 /* If FILE is a searchable directory or a symlink to a
  3171    searchable directory, return true.  Otherwise return
  3172    false and set errno to an error number.  */
  3173 bool
  3174 file_accessible_directory_p (Lisp_Object file)
  3175 {
  3176 #ifdef DOS_NT
  3177 # ifdef WINDOWSNT
  3178   /* We need a special-purpose test because (a) NTFS security data is
  3179      not reflected in Posix-style mode bits, and (b) the trick with
  3180      accessing "DIR/.", used below on Posix hosts, doesn't work on
  3181      Windows, because "DIR/." is normalized to just "DIR" before
  3182      hitting the disk.  */
  3183   return (SBYTES (file) == 0
  3184           || w32_accessible_directory_p (SSDATA (file), SBYTES (file)));
  3185 # else  /* MSDOS */
  3186   return file_directory_p (file);
  3187 # endif  /* MSDOS */
  3188 #else    /* !DOS_NT */
  3189   /* On POSIXish platforms, use just one system call; this avoids a
  3190      race and is typically faster.  */
  3191   const char *data = SSDATA (file);
  3192   ptrdiff_t len = SBYTES (file);
  3193   char const *dir;
  3194   bool ok;
  3195   USE_SAFE_ALLOCA;
  3196 
  3197   /* Normally a file "FOO" is an accessible directory if "FOO/." exists.
  3198      There are three exceptions: "", "/", and "//".  Leave "" alone,
  3199      as it's invalid.  Append only "." to the other two exceptions as
  3200      "/" and "//" are distinct on some platforms, whereas "/", "///",
  3201      "////", etc. are all equivalent.  */
  3202   if (! len)
  3203     dir = data;
  3204   else
  3205     {
  3206       /* Just check for trailing '/' when deciding whether append '/'
  3207          before appending '.'.  That's simpler than testing the two
  3208          special cases "/" and "//", and it's a safe optimization
  3209          here.  After appending '.', append another '/' to work around
  3210          a macOS bug (Bug#30350).  */
  3211       static char const appended[] = "/./";
  3212       char *buf = SAFE_ALLOCA (len + sizeof appended);
  3213       memcpy (buf, data, len);
  3214       strcpy (buf + len, &appended[data[len - 1] == '/']);
  3215       dir = buf;
  3216     }
  3217 
  3218   ok = file_access_p (dir, F_OK);
  3219   SAFE_FREE ();
  3220   return ok;
  3221 #endif  /* !DOS_NT */
  3222 }
  3223 
  3224 DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
  3225        doc: /* Return t if FILENAME names a regular file.
  3226 This is the sort of file that holds an ordinary stream of data bytes.
  3227 Return nil if FILENAME does not exist or is not a regular file,
  3228 or there was trouble determining whether FILENAME is a regular file.
  3229 Symbolic links to regular files count as regular files.
  3230 See `file-symlink-p' to distinguish symlinks.  */)
  3231   (Lisp_Object filename)
  3232 {
  3233   struct stat st;
  3234   Lisp_Object absname = expand_and_dir_to_file (filename);
  3235 
  3236   /* If the file name has special constructs in it,
  3237      call the corresponding file name handler.  */
  3238   Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_regular_p);
  3239   if (!NILP (handler))
  3240     return call2 (handler, Qfile_regular_p, absname);
  3241 
  3242 #ifdef WINDOWSNT
  3243   /* Tell stat to use expensive method to get accurate info.  */
  3244   Lisp_Object true_attributes = Vw32_get_true_file_attributes;
  3245   Vw32_get_true_file_attributes = Qt;
  3246 #endif
  3247 
  3248   int stat_result = emacs_fstatat (AT_FDCWD, SSDATA (absname), &st, 0);
  3249 
  3250 #ifdef WINDOWSNT
  3251   Vw32_get_true_file_attributes = true_attributes;
  3252 #endif
  3253 
  3254   return stat_result == 0 && S_ISREG (st.st_mode) ? Qt : Qnil;
  3255 }
  3256 
  3257 DEFUN ("file-selinux-context", Ffile_selinux_context,
  3258        Sfile_selinux_context, 1, 1, 0,
  3259        doc: /* Return SELinux context of file named FILENAME.
  3260 The return value is a list (USER ROLE TYPE RANGE), where the list
  3261 elements are strings naming the user, role, type, and range of the
  3262 file's SELinux security context.
  3263 
  3264 Return (nil nil nil nil) if the file is nonexistent,
  3265 or if SELinux is disabled, or if Emacs lacks SELinux support.  */)
  3266   (Lisp_Object filename)
  3267 {
  3268   Lisp_Object user = Qnil, role = Qnil, type = Qnil, range = Qnil;
  3269   Lisp_Object absname = expand_and_dir_to_file (filename);
  3270 
  3271   /* If the file name has special constructs in it,
  3272      call the corresponding file name handler.  */
  3273   Lisp_Object handler = Ffind_file_name_handler (absname,
  3274                                                  Qfile_selinux_context);
  3275   if (!NILP (handler))
  3276     return call2 (handler, Qfile_selinux_context, absname);
  3277 
  3278 #if HAVE_LIBSELINUX
  3279   if (is_selinux_enabled ())
  3280     {
  3281       char *con;
  3282       int conlength = lgetfilecon (SSDATA (ENCODE_FILE (absname)), &con);
  3283       if (conlength > 0)
  3284         {
  3285           context_t context = context_new (con);
  3286           if (context_user_get (context))
  3287             user = build_string (context_user_get (context));
  3288           if (context_role_get (context))
  3289             role = build_string (context_role_get (context));
  3290           if (context_type_get (context))
  3291             type = build_string (context_type_get (context));
  3292           if (context_range_get (context))
  3293             range = build_string (context_range_get (context));
  3294           context_free (context);
  3295           freecon (con);
  3296         }
  3297       else if (! (errno == ENOENT || errno == ENOTDIR || errno == ENODATA
  3298                   || errno == ENOTSUP))
  3299         report_file_error ("getting SELinux context", absname);
  3300     }
  3301 #endif
  3302 
  3303   return list4 (user, role, type, range);
  3304 }
  3305 
  3306 DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
  3307        Sset_file_selinux_context, 2, 2, 0,
  3308        doc: /* Set SELinux context of file named FILENAME to CONTEXT.
  3309 CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
  3310 elements are strings naming the components of a SELinux context.
  3311 
  3312 Value is t if setting of SELinux context was successful, nil otherwise.
  3313 
  3314 This function does nothing and returns nil if SELinux is disabled,
  3315 or if Emacs was not compiled with SELinux support.  */)
  3316   (Lisp_Object filename, Lisp_Object context)
  3317 {
  3318   Lisp_Object absname;
  3319   Lisp_Object handler;
  3320 #if HAVE_LIBSELINUX
  3321   Lisp_Object encoded_absname;
  3322   Lisp_Object user = CAR_SAFE (context);
  3323   Lisp_Object role = CAR_SAFE (CDR_SAFE (context));
  3324   Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
  3325   Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
  3326   char *con;
  3327   bool fail;
  3328   int conlength;
  3329   context_t parsed_con;
  3330 #endif
  3331 
  3332   absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
  3333 
  3334   /* If the file name has special constructs in it,
  3335      call the corresponding file name handler.  */
  3336   handler = Ffind_file_name_handler (absname, Qset_file_selinux_context);
  3337   if (!NILP (handler))
  3338     return call3 (handler, Qset_file_selinux_context, absname, context);
  3339 
  3340 #if HAVE_LIBSELINUX
  3341   if (is_selinux_enabled ())
  3342     {
  3343       /* Get current file context. */
  3344       encoded_absname = ENCODE_FILE (absname);
  3345       conlength = lgetfilecon (SSDATA (encoded_absname), &con);
  3346       if (conlength > 0)
  3347         {
  3348           parsed_con = context_new (con);
  3349           /* Change the parts defined in the parameter.*/
  3350           if (STRINGP (user))
  3351             {
  3352               if (context_user_set (parsed_con, SSDATA (user)))
  3353                 error ("Doing context_user_set");
  3354             }
  3355           if (STRINGP (role))
  3356             {
  3357               if (context_role_set (parsed_con, SSDATA (role)))
  3358                 error ("Doing context_role_set");
  3359             }
  3360           if (STRINGP (type))
  3361             {
  3362               if (context_type_set (parsed_con, SSDATA (type)))
  3363                 error ("Doing context_type_set");
  3364             }
  3365           if (STRINGP (range))
  3366             {
  3367               if (context_range_set (parsed_con, SSDATA (range)))
  3368                 error ("Doing context_range_set");
  3369             }
  3370 
  3371           /* Set the modified context back to the file.  */
  3372           fail = (lsetfilecon (SSDATA (encoded_absname),
  3373                                context_str (parsed_con))
  3374                   != 0);
  3375           /* See https://debbugs.gnu.org/11245 for ENOTSUP.  */
  3376           if (fail && errno != ENOTSUP)
  3377             report_file_error ("Doing lsetfilecon", absname);
  3378 
  3379           context_free (parsed_con);
  3380           freecon (con);
  3381           return fail ? Qnil : Qt;
  3382         }
  3383       else
  3384         report_file_error ("Doing lgetfilecon", absname);
  3385     }
  3386 #endif
  3387 
  3388   return Qnil;
  3389 }
  3390 
  3391 DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0,
  3392        doc: /* Return ACL entries of file named FILENAME.
  3393 The entries are returned in a format suitable for use in `set-file-acl'
  3394 but is otherwise undocumented and subject to change.
  3395 Return nil if file does not exist.  */)
  3396   (Lisp_Object filename)
  3397 {
  3398   Lisp_Object acl_string = Qnil;
  3399 
  3400 #if USE_ACL
  3401   Lisp_Object absname = expand_and_dir_to_file (filename);
  3402 
  3403   /* If the file name has special constructs in it,
  3404      call the corresponding file name handler.  */
  3405   Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_acl);
  3406   if (!NILP (handler))
  3407     return call2 (handler, Qfile_acl, absname);
  3408 
  3409 # ifdef HAVE_ACL_SET_FILE
  3410 #  ifndef HAVE_ACL_TYPE_EXTENDED
  3411   acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS;
  3412 #  endif
  3413   acl_t acl = acl_get_file (SSDATA (ENCODE_FILE (absname)), ACL_TYPE_EXTENDED);
  3414   if (acl == NULL)
  3415     {
  3416       if (errno == ENOENT || errno == ENOTDIR || !acl_errno_valid (errno))
  3417         return Qnil;
  3418       report_file_error ("Getting ACLs", absname);
  3419     }
  3420   char *str = acl_to_text (acl, NULL);
  3421   if (str == NULL)
  3422     {
  3423       int err = errno;
  3424       acl_free (acl);
  3425       report_file_errno ("Getting ACLs", absname, err);
  3426     }
  3427 
  3428   acl_string = build_string (str);
  3429   acl_free (str);
  3430   acl_free (acl);
  3431 # endif
  3432 #endif
  3433 
  3434   return acl_string;
  3435 }
  3436 
  3437 DEFUN ("set-file-acl", Fset_file_acl, Sset_file_acl,
  3438        2, 2, 0,
  3439        doc: /* Set ACL of file named FILENAME to ACL-STRING.
  3440 ACL-STRING should contain the textual representation of the ACL
  3441 entries in a format suitable for the platform.
  3442 
  3443 Value is t if setting of ACL was successful, nil otherwise.
  3444 
  3445 Setting ACL for local files requires Emacs to be built with ACL
  3446 support.  */)
  3447   (Lisp_Object filename, Lisp_Object acl_string)
  3448 {
  3449 #if USE_ACL
  3450   Lisp_Object absname;
  3451   Lisp_Object handler;
  3452 # ifdef HAVE_ACL_SET_FILE
  3453   Lisp_Object encoded_absname;
  3454   acl_t acl;
  3455   bool fail;
  3456 # endif
  3457 
  3458   absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
  3459 
  3460   /* If the file name has special constructs in it,
  3461      call the corresponding file name handler.  */
  3462   handler = Ffind_file_name_handler (absname, Qset_file_acl);
  3463   if (!NILP (handler))
  3464     return call3 (handler, Qset_file_acl, absname, acl_string);
  3465 
  3466 # ifdef HAVE_ACL_SET_FILE
  3467   if (STRINGP (acl_string))
  3468     {
  3469       acl = acl_from_text (SSDATA (acl_string));
  3470       if (acl == NULL)
  3471         {
  3472           if (acl_errno_valid (errno))
  3473             report_file_error ("Converting ACL", absname);
  3474           return Qnil;
  3475         }
  3476 
  3477       encoded_absname = ENCODE_FILE (absname);
  3478 
  3479       fail = (acl_set_file (SSDATA (encoded_absname), ACL_TYPE_ACCESS,
  3480                             acl)
  3481               != 0);
  3482       if (fail && acl_errno_valid (errno))
  3483         report_file_error ("Setting ACL", absname);
  3484 
  3485       acl_free (acl);
  3486       return fail ? Qnil : Qt;
  3487     }
  3488 # endif
  3489 #endif
  3490 
  3491   return Qnil;
  3492 }
  3493 
  3494 static int
  3495 symlink_nofollow_flag (Lisp_Object flag)
  3496 {
  3497   /* For now, treat all non-nil FLAGs like 'nofollow'.  */
  3498   return !NILP (flag) ? AT_SYMLINK_NOFOLLOW : 0;
  3499 }
  3500 
  3501 DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 2, 0,
  3502        doc: /* Return mode bits of file named FILENAME, as an integer.
  3503 Return nil if FILENAME does not exist.  If optional FLAG is `nofollow',
  3504 do not follow FILENAME if it is a symbolic link.  */)
  3505   (Lisp_Object filename, Lisp_Object flag)
  3506 {
  3507   struct stat st;
  3508   int nofollow = symlink_nofollow_flag (flag);
  3509   Lisp_Object absname = expand_and_dir_to_file (filename);
  3510 
  3511   /* If the file name has special constructs in it,
  3512      call the corresponding file name handler.  */
  3513   Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_modes);
  3514   if (!NILP (handler))
  3515     return call3 (handler, Qfile_modes, absname, flag);
  3516 
  3517   char *fname = SSDATA (ENCODE_FILE (absname));
  3518   if (emacs_fstatat (AT_FDCWD, fname, &st, nofollow) != 0)
  3519     return file_attribute_errno (absname, errno);
  3520   return make_fixnum (st.st_mode & 07777);
  3521 }
  3522 
  3523 DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 3,
  3524        "(let ((file (read-file-name \"File: \")))                       \
  3525           (list file (read-file-modes nil file)))",
  3526        doc: /* Set mode bits of file named FILENAME to MODE (an integer).
  3527 Only the 12 low bits of MODE are used.  If optional FLAG is `nofollow',
  3528 do not follow FILENAME if it is a symbolic link.
  3529 
  3530 Interactively, prompt for FILENAME, and read MODE with
  3531 `read-file-modes', which accepts symbolic notation, like the `chmod'
  3532 command from GNU Coreutils.  */)
  3533   (Lisp_Object filename, Lisp_Object mode, Lisp_Object flag)
  3534 {
  3535   CHECK_FIXNUM (mode);
  3536   int nofollow = symlink_nofollow_flag (flag);
  3537   Lisp_Object absname = Fexpand_file_name (filename,
  3538                                            BVAR (current_buffer, directory));
  3539 
  3540   /* If the file name has special constructs in it,
  3541      call the corresponding file name handler.  */
  3542   Lisp_Object handler = Ffind_file_name_handler (absname, Qset_file_modes);
  3543   if (!NILP (handler))
  3544     return call4 (handler, Qset_file_modes, absname, mode, flag);
  3545 
  3546   char *fname = SSDATA (ENCODE_FILE (absname));
  3547   mode_t imode = XFIXNUM (mode) & 07777;
  3548   if (fchmodat (AT_FDCWD, fname, imode, nofollow) != 0)
  3549     report_file_error ("Doing chmod", absname);
  3550 
  3551   return Qnil;
  3552 }
  3553 
  3554 DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
  3555        doc: /* Set the file permission bits for newly created files.
  3556 The argument MODE should be an integer; only the low 9 bits are used.
  3557 On Posix hosts, this setting is inherited by subprocesses.
  3558 
  3559 This function works by setting the Emacs's file mode creation mask.
  3560 Each bit that is set in the mask means that the corresponding bit
  3561 in the permissions of newly created files will be disabled.
  3562 
  3563 Note that when `write-region' creates a file, it resets the
  3564 execute bit, even if the mask set by this function allows that bit
  3565 by having the corresponding bit in the mask reset.  */)
  3566   (Lisp_Object mode)
  3567 {
  3568   mode_t oldrealmask, oldumask, newumask;
  3569   CHECK_FIXNUM (mode);
  3570   oldrealmask = realmask;
  3571   newumask = ~ XFIXNUM (mode) & 0777;
  3572 
  3573   block_input ();
  3574   realmask = newumask;
  3575   oldumask = umask (newumask);
  3576   unblock_input ();
  3577 
  3578   eassert (oldumask == oldrealmask);
  3579   return Qnil;
  3580 }
  3581 
  3582 DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
  3583        doc: /* Return the default file protection for created files.
  3584 The value is an integer.  */)
  3585   (void)
  3586 {
  3587   Lisp_Object value;
  3588   XSETINT (value, (~ realmask) & 0777);
  3589   return value;
  3590 }
  3591 
  3592 
  3593 DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 3, 0,
  3594        doc: /* Set times of file FILENAME to TIMESTAMP.
  3595 If optional FLAG is `nofollow', do not follow FILENAME if it is a
  3596 symbolic link.  Set both access and modification times.  Return t on
  3597 success, else nil.  Use the current time if TIMESTAMP is nil.
  3598 TIMESTAMP is in the format of `current-time'. */)
  3599   (Lisp_Object filename, Lisp_Object timestamp, Lisp_Object flag)
  3600 {
  3601   int nofollow = symlink_nofollow_flag (flag);
  3602 
  3603   struct timespec ts[2];
  3604   if (!NILP (timestamp))
  3605     ts[0] = ts[1] = lisp_time_argument (timestamp);
  3606   else
  3607     ts[0].tv_nsec = ts[1].tv_nsec = UTIME_NOW;
  3608 
  3609   /* If the file name has special constructs in it,
  3610      call the corresponding file name handler.  */
  3611   Lisp_Object
  3612     absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)),
  3613     handler = Ffind_file_name_handler (absname, Qset_file_times);
  3614   if (!NILP (handler))
  3615     return call4 (handler, Qset_file_times, absname, timestamp, flag);
  3616 
  3617   Lisp_Object encoded_absname = ENCODE_FILE (absname);
  3618 
  3619   if (utimensat (AT_FDCWD, SSDATA (encoded_absname), ts, nofollow) != 0)
  3620     {
  3621 #ifdef MSDOS
  3622       /* Setting times on a directory always fails.  */
  3623       if (file_directory_p (encoded_absname))
  3624         return Qnil;
  3625 #endif
  3626       report_file_error ("Setting file times", absname);
  3627     }
  3628 
  3629   return Qt;
  3630 }
  3631 
  3632 #ifdef HAVE_SYNC
  3633 DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
  3634        doc: /* Tell Unix to finish all pending disk updates.  */)
  3635   (void)
  3636 {
  3637   sync ();
  3638   return Qnil;
  3639 }
  3640 
  3641 #endif /* HAVE_SYNC */
  3642 
  3643 DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
  3644        doc: /* Return t if file FILE1 is newer than file FILE2.
  3645 If FILE1 does not exist, the answer is nil;
  3646 otherwise, if FILE2 does not exist, the answer is t.  */)
  3647   (Lisp_Object file1, Lisp_Object file2)
  3648 {
  3649   struct stat st1, st2;
  3650 
  3651   CHECK_STRING (file1);
  3652   CHECK_STRING (file2);
  3653 
  3654   Lisp_Object absname1 = expand_and_dir_to_file (file1);
  3655   Lisp_Object absname2 = expand_and_dir_to_file (file2);
  3656 
  3657   /* If the file name has special constructs in it,
  3658      call the corresponding file name handler.  */
  3659   Lisp_Object handler = Ffind_file_name_handler (absname1,
  3660                                                  Qfile_newer_than_file_p);
  3661   if (NILP (handler))
  3662     handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p);
  3663   if (!NILP (handler))
  3664     return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
  3665 
  3666   int err1;
  3667   if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname1)), &st1, 0) == 0)
  3668     err1 = 0;
  3669   else
  3670     {
  3671       err1 = errno;
  3672       if (err1 != EOVERFLOW)
  3673         return file_attribute_errno (absname1, err1);
  3674     }
  3675   if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname2)), &st2, 0) != 0)
  3676     {
  3677       file_attribute_errno (absname2, errno);
  3678       return Qt;
  3679     }
  3680   if (err1)
  3681     file_attribute_errno (absname1, err1);
  3682 
  3683   return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0
  3684           ? Qt : Qnil);
  3685 }
  3686 
  3687 enum { READ_BUF_SIZE = MAX_ALLOCA };
  3688 
  3689 /* This function is called after Lisp functions to decide a coding
  3690    system are called, or when they cause an error.  Before they are
  3691    called, the current buffer is set unibyte and it contains only a
  3692    newly inserted text (thus the buffer was empty before the
  3693    insertion).
  3694 
  3695    The functions may set markers, overlays, text properties, or even
  3696    alter the buffer contents, change the current buffer.
  3697 
  3698    Here, we reset all those changes by:
  3699         o set back the current buffer.
  3700         o move all markers and overlays to BEG.
  3701         o remove all text properties.
  3702         o set back the buffer multibyteness.  */
  3703 
  3704 static void
  3705 decide_coding_unwind (Lisp_Object unwind_data)
  3706 {
  3707   Lisp_Object multibyte = XCAR (unwind_data);
  3708   Lisp_Object tmp = XCDR (unwind_data);
  3709   Lisp_Object undo_list = XCAR (tmp);
  3710   Lisp_Object buffer = XCDR (tmp);
  3711 
  3712   set_buffer_internal (XBUFFER (buffer));
  3713 
  3714   /* We're about to "delete" the text by moving it back into the gap.
  3715      So move markers that set-auto-coding might have created to BEG,
  3716      just in case.  */
  3717   adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
  3718   adjust_overlays_for_delete (BEG, Z - BEG);
  3719   set_buffer_intervals (current_buffer, NULL);
  3720   TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
  3721 
  3722   /* In case of a non-local exit from set_auto_coding_function, in order not
  3723      to end up with potentially invalid byte sequences in a multibyte buffer,
  3724      we have the following options:
  3725      1- decode the bytes in some arbitrary coding-system.
  3726      2- erase the buffer.
  3727      3- leave the buffer unibyte (which is actually the same as option (1)
  3728         where the coding-system is `raw-text-unix`).
  3729      Here we choose 2.  */
  3730 
  3731   /* Move the bytes back to (the beginning of) the gap.
  3732      In general this may have to move all the bytes, but here
  3733      this can't move more bytes than were moved during the execution
  3734      of Vset_auto_coding_function, which is normally 0 (because it
  3735      normally doesn't modify the buffer).  */
  3736   move_gap_both (Z, Z_BYTE);
  3737   ptrdiff_t inserted = Z_BYTE - BEG_BYTE;
  3738   GAP_SIZE += inserted;
  3739   ZV = Z = GPT = BEG;
  3740   ZV_BYTE = Z_BYTE = GPT_BYTE = BEG_BYTE;
  3741 
  3742   /* Pass the new `inserted` back.  */
  3743   XSETCAR (unwind_data, make_fixnum (inserted));
  3744 
  3745   /* Now we are safe to change the buffer's multibyteness directly.  */
  3746   bset_enable_multibyte_characters (current_buffer, multibyte);
  3747   bset_undo_list (current_buffer, undo_list);
  3748 }
  3749 
  3750 /* Read from a non-regular file.  Return the number of bytes read.  */
  3751 
  3752 union read_non_regular
  3753 {
  3754   struct
  3755   {
  3756     int fd;
  3757     ptrdiff_t inserted, trytry;
  3758   } s;
  3759   GCALIGNED_UNION_MEMBER
  3760 };
  3761 verify (GCALIGNED (union read_non_regular));
  3762 
  3763 static Lisp_Object
  3764 read_non_regular (Lisp_Object state)
  3765 {
  3766   union read_non_regular *data = XFIXNUMPTR (state);
  3767   int nbytes = emacs_read_quit (data->s.fd,
  3768                                 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
  3769                                  + data->s.inserted),
  3770                                 data->s.trytry);
  3771   return make_fixnum (nbytes);
  3772 }
  3773 
  3774 
  3775 /* Condition-case handler used when reading from non-regular files
  3776    in insert-file-contents.  */
  3777 
  3778 static Lisp_Object
  3779 read_non_regular_quit (Lisp_Object ignore)
  3780 {
  3781   return Qnil;
  3782 }
  3783 
  3784 /* Return the file offset that VAL represents, checking for type
  3785    errors and overflow.  */
  3786 static off_t
  3787 file_offset (Lisp_Object val)
  3788 {
  3789   if (INTEGERP (val))
  3790     {
  3791       intmax_t v;
  3792       if (integer_to_intmax (val, &v) && 0 <= v && v <= TYPE_MAXIMUM (off_t))
  3793         return v;
  3794     }
  3795   else if (FLOATP (val))
  3796     {
  3797       double v = XFLOAT_DATA (val);
  3798       if (0 <= v && v < 1.0 + TYPE_MAXIMUM (off_t))
  3799         {
  3800           off_t o = v;
  3801           if (o == v)
  3802             return o;
  3803         }
  3804     }
  3805 
  3806   wrong_type_argument (Qfile_offset, val);
  3807 }
  3808 
  3809 /* Return a special time value indicating the error number ERRNUM.  */
  3810 static struct timespec
  3811 time_error_value (int errnum)
  3812 {
  3813   int ns = (errnum == ENOENT || errnum == ENOTDIR
  3814             ? NONEXISTENT_MODTIME_NSECS
  3815             : UNKNOWN_MODTIME_NSECS);
  3816   return make_timespec (0, ns);
  3817 }
  3818 
  3819 static Lisp_Object
  3820 get_window_points_and_markers (void)
  3821 {
  3822   Lisp_Object pt_marker = Fpoint_marker ();
  3823   Lisp_Object windows
  3824     = call3 (Qget_buffer_window_list, Fcurrent_buffer (), Qnil, Qt);
  3825   Lisp_Object window_markers = windows;
  3826   /* Window markers (and point) are handled specially: rather than move to
  3827      just before or just after the modified text, we try to keep the
  3828      markers at the same distance (bug#19161).
  3829      In general, this is wrong, but for window-markers, this should be harmless
  3830      and is convenient for the end user when most of the file is unmodified,
  3831      except for a few minor details near the beginning and near the end.  */
  3832   for (; CONSP (windows); windows = XCDR (windows))
  3833     if (WINDOWP (XCAR (windows)))
  3834       {
  3835         Lisp_Object window_marker = XWINDOW (XCAR (windows))->pointm;
  3836         XSETCAR (windows,
  3837                  Fcons (window_marker, Fmarker_position (window_marker)));
  3838       }
  3839   return Fcons (Fcons (pt_marker, Fpoint ()), window_markers);
  3840 }
  3841 
  3842 static void
  3843 restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted,
  3844                        ptrdiff_t same_at_start, ptrdiff_t same_at_end)
  3845 {
  3846   for (; CONSP (window_markers); window_markers = XCDR (window_markers))
  3847     if (CONSP (XCAR (window_markers)))
  3848       {
  3849         Lisp_Object car = XCAR (window_markers);
  3850         Lisp_Object marker = XCAR (car);
  3851         Lisp_Object oldpos = XCDR (car);
  3852         if (MARKERP (marker) && FIXNUMP (oldpos)
  3853             && XFIXNUM (oldpos) > same_at_start
  3854             && XFIXNUM (oldpos) <= same_at_end)
  3855           {
  3856             ptrdiff_t oldsize = same_at_end - same_at_start;
  3857             ptrdiff_t newsize = inserted;
  3858             double growth = newsize / (double)oldsize;
  3859             ptrdiff_t newpos
  3860               = same_at_start + growth * (XFIXNUM (oldpos) - same_at_start);
  3861             Fset_marker (marker, make_fixnum (newpos), Qnil);
  3862           }
  3863       }
  3864 }
  3865 
  3866 /* Make sure the gap is at Z_BYTE.  This is required to treat buffer
  3867    text as a linear C char array.  */
  3868 static void
  3869 maybe_move_gap (struct buffer *b)
  3870 {
  3871   if (BUF_GPT_BYTE (b) != BUF_Z_BYTE (b))
  3872     {
  3873       struct buffer *cb = current_buffer;
  3874 
  3875       set_buffer_internal (b);
  3876       move_gap_both (Z, Z_BYTE);
  3877       set_buffer_internal (cb);
  3878     }
  3879 }
  3880 
  3881 /* FIXME: insert-file-contents should be split with the top-level moved to
  3882    Elisp and only the core kept in C.  */
  3883 
  3884 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
  3885        1, 5, 0,
  3886        doc: /* Insert contents of file FILENAME after point.
  3887 Returns list of absolute file name and number of characters inserted.
  3888 If second argument VISIT is non-nil, the buffer's visited filename and
  3889 last save file modtime are set, and it is marked unmodified.  If
  3890 visiting and the file does not exist, visiting is completed before the
  3891 error is signaled.
  3892 
  3893 The optional third and fourth arguments BEG and END specify what portion
  3894 of the file to insert.  These arguments count bytes in the file, not
  3895 characters in the buffer.  If VISIT is non-nil, BEG and END must be nil.
  3896 
  3897 When inserting data from a special file (e.g., /dev/urandom), you
  3898 can't specify VISIT or BEG, and END should be specified to avoid
  3899 inserting unlimited data into the buffer.
  3900 
  3901 If optional fifth argument REPLACE is non-nil, replace the current
  3902 buffer contents (in the accessible portion) with the file contents.
  3903 This is better than simply deleting and inserting the whole thing
  3904 because (1) it preserves some marker positions (in unchanged portions
  3905 at the start and end of the buffer) and (2) it puts less data in the
  3906 undo list.  When REPLACE is non-nil, the second return value is the
  3907 number of characters that replace previous buffer contents.
  3908 
  3909 This function does code conversion according to the value of
  3910 `coding-system-for-read' or `file-coding-system-alist', and sets the
  3911 variable `last-coding-system-used' to the coding system actually used.
  3912 
  3913 In addition, this function decodes the inserted text from known formats
  3914 by calling `format-decode', which see.  */)
  3915   (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
  3916 {
  3917   struct stat st;
  3918   struct timespec mtime;
  3919   int fd;
  3920   ptrdiff_t inserted = 0;
  3921   ptrdiff_t how_much;
  3922   off_t beg_offset, end_offset;
  3923   int unprocessed;
  3924   specpdl_ref count = SPECPDL_INDEX ();
  3925   Lisp_Object handler, val, insval, orig_filename, old_undo;
  3926   Lisp_Object p;
  3927   ptrdiff_t total = 0;
  3928   bool regular = true;
  3929   int save_errno = 0;
  3930   char read_buf[READ_BUF_SIZE];
  3931   struct coding_system coding;
  3932   bool replace_handled = false;
  3933   bool set_coding_system = false;
  3934   Lisp_Object coding_system;
  3935   bool read_quit = false;
  3936   /* If the undo log only contains the insertion, there's no point
  3937      keeping it.  It's typically when we first fill a file-buffer.  */
  3938   bool empty_undo_list_p
  3939     = (!NILP (visit) && NILP (BVAR (current_buffer, undo_list))
  3940        && BEG == Z);
  3941   Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
  3942   bool we_locked_file = false;
  3943   Lisp_Object window_markers = Qnil;
  3944   /* same_at_start and same_at_end count bytes, because file access counts
  3945      bytes and BEG and END count bytes.  */
  3946   ptrdiff_t same_at_start = BEGV_BYTE;
  3947   ptrdiff_t same_at_end = ZV_BYTE;
  3948   /* SAME_AT_END_CHARPOS counts characters, because
  3949      restore_window_points needs the old character count.  */
  3950   ptrdiff_t same_at_end_charpos = ZV;
  3951   bool seekable = true;
  3952 
  3953   if (current_buffer->base_buffer && ! NILP (visit))
  3954     error ("Cannot do file visiting in an indirect buffer");
  3955 
  3956   if (!NILP (BVAR (current_buffer, read_only)))
  3957     Fbarf_if_buffer_read_only (Qnil);
  3958 
  3959   val = Qnil;
  3960   p = Qnil;
  3961   orig_filename = Qnil;
  3962   old_undo = Qnil;
  3963 
  3964   CHECK_STRING (filename);
  3965   filename = Fexpand_file_name (filename, Qnil);
  3966 
  3967   /* The value Qnil means that the coding system is not yet
  3968      decided.  */
  3969   coding_system = Qnil;
  3970 
  3971   /* If the file name has special constructs in it,
  3972      call the corresponding file name handler.  */
  3973   handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
  3974   if (!NILP (handler))
  3975     {
  3976       val = call6 (handler, Qinsert_file_contents, filename,
  3977                    visit, beg, end, replace);
  3978       if (CONSP (val) && CONSP (XCDR (val))
  3979           && RANGED_FIXNUMP (0, XCAR (XCDR (val)), ZV - PT))
  3980         inserted = XFIXNUM (XCAR (XCDR (val)));
  3981       goto handled;
  3982     }
  3983 
  3984   orig_filename = filename;
  3985   filename = ENCODE_FILE (filename);
  3986 
  3987   fd = emacs_open (SSDATA (filename), O_RDONLY, 0);
  3988   if (fd < 0)
  3989     {
  3990       save_errno = errno;
  3991       if (NILP (visit))
  3992         report_file_error ("Opening input file", orig_filename);
  3993       mtime = time_error_value (save_errno);
  3994       st.st_size = -1;
  3995       if (!NILP (Vcoding_system_for_read))
  3996         {
  3997           /* Don't let invalid values into buffer-file-coding-system.  */
  3998           CHECK_CODING_SYSTEM (Vcoding_system_for_read);
  3999           Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
  4000         }
  4001       eassert (inserted == 0);
  4002       goto notfound;
  4003     }
  4004 
  4005   specpdl_ref fd_index = SPECPDL_INDEX ();
  4006   record_unwind_protect_int (close_file_unwind, fd);
  4007 
  4008   /* Replacement should preserve point as it preserves markers.  */
  4009   if (!NILP (replace))
  4010     {
  4011       window_markers = get_window_points_and_markers ();
  4012       record_unwind_protect (restore_point_unwind,
  4013                              XCAR (XCAR (window_markers)));
  4014     }
  4015 
  4016   if (fstat (fd, &st) != 0)
  4017     report_file_error ("Input file status", orig_filename);
  4018   mtime = get_stat_mtime (&st);
  4019 
  4020   /* This code will need to be changed in order to work on named
  4021      pipes, and it's probably just not worth it.  So we should at
  4022      least signal an error.  */
  4023   if (!S_ISREG (st.st_mode))
  4024     {
  4025       regular = false;
  4026       seekable = lseek (fd, 0, SEEK_CUR) != (off_t) -1;
  4027 
  4028       if (! NILP (visit))
  4029         {
  4030           eassert (inserted == 0);
  4031           goto notfound;
  4032         }
  4033 
  4034       if (!NILP (beg) && !seekable)
  4035         xsignal2 (Qfile_error,
  4036                   build_string ("cannot use a start position in a non-seekable file/device"),
  4037                   orig_filename);
  4038 
  4039       if (!NILP (replace))
  4040         xsignal2 (Qfile_error,
  4041                   build_string ("not a regular file"), orig_filename);
  4042     }
  4043 
  4044   if (!NILP (visit))
  4045     {
  4046       if (!NILP (beg) || !NILP (end))
  4047         error ("Attempt to visit less than an entire file");
  4048       if (BEG < Z && NILP (replace))
  4049         error ("Cannot do file visiting in a non-empty buffer");
  4050     }
  4051 
  4052   if (!NILP (beg))
  4053     beg_offset = file_offset (beg);
  4054   else
  4055     beg_offset = 0;
  4056 
  4057   if (!NILP (end))
  4058     end_offset = file_offset (end);
  4059   else
  4060     {
  4061       if (!regular)
  4062         end_offset = TYPE_MAXIMUM (off_t);
  4063       else
  4064         {
  4065           end_offset = st.st_size;
  4066 
  4067           /* A negative size can happen on a platform that allows file
  4068              sizes greater than the maximum off_t value.  */
  4069           if (end_offset < 0)
  4070             buffer_overflow ();
  4071 
  4072           /* The file size returned from fstat may be zero, but data
  4073              may be readable nonetheless, for example when this is a
  4074              file in the /proc filesystem.  */
  4075           if (end_offset == 0)
  4076             end_offset = READ_BUF_SIZE;
  4077         }
  4078     }
  4079 
  4080   /* Check now whether the buffer will become too large,
  4081      in the likely case where the file's length is not changing.
  4082      This saves a lot of needless work before a buffer overflow.  */
  4083   if (regular)
  4084     {
  4085       /* The likely offset where we will stop reading.  We could read
  4086          more (or less), if the file grows (or shrinks) as we read it.  */
  4087       off_t likely_end = min (end_offset, st.st_size);
  4088 
  4089       if (beg_offset < likely_end)
  4090         {
  4091           ptrdiff_t buf_bytes
  4092             = Z_BYTE - (!NILP (replace) ? ZV_BYTE - BEGV_BYTE  : 0);
  4093           ptrdiff_t buf_growth_max = BUF_BYTES_MAX - buf_bytes;
  4094           off_t likely_growth = likely_end - beg_offset;
  4095           if (buf_growth_max < likely_growth)
  4096             buffer_overflow ();
  4097         }
  4098     }
  4099 
  4100   /* Prevent redisplay optimizations.  */
  4101   current_buffer->clip_changed = true;
  4102 
  4103   if (EQ (Vcoding_system_for_read, Qauto_save_coding))
  4104     {
  4105       coding_system = coding_inherit_eol_type (Qutf_8_emacs, Qunix);
  4106       setup_coding_system (coding_system, &coding);
  4107       /* Ensure we set Vlast_coding_system_used.  */
  4108       set_coding_system = true;
  4109     }
  4110   else if (BEG < Z)
  4111     {
  4112       /* Decide the coding system to use for reading the file now
  4113          because we can't use an optimized method for handling
  4114          `coding:' tag if the current buffer is not empty.  */
  4115       if (!NILP (Vcoding_system_for_read))
  4116         coding_system = Vcoding_system_for_read;
  4117       else
  4118         {
  4119           /* Don't try looking inside a file for a coding system
  4120              specification if it is not seekable.  */
  4121           if (regular && !NILP (Vset_auto_coding_function))
  4122             {
  4123               /* Find a coding system specified in the heading two
  4124                  lines or in the tailing several lines of the file.
  4125                  We assume that the 1K-byte and 3K-byte for heading
  4126                  and tailing respectively are sufficient for this
  4127                  purpose.  */
  4128               int nread;
  4129 
  4130               if (st.st_size <= (1024 * 4))
  4131                 nread = emacs_read_quit (fd, read_buf, 1024 * 4);
  4132               else
  4133                 {
  4134                   nread = emacs_read_quit (fd, read_buf, 1024);
  4135                   if (nread == 1024)
  4136                     {
  4137                       int ntail;
  4138                       if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
  4139                         report_file_error ("Setting file position",
  4140                                            orig_filename);
  4141                       ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3);
  4142                       nread = ntail < 0 ? ntail : nread + ntail;
  4143                     }
  4144                 }
  4145 
  4146               if (nread < 0)
  4147                 report_file_error ("Read error", orig_filename);
  4148               else if (nread > 0)
  4149                 {
  4150                   AUTO_STRING (name, " *code-converting-work*");
  4151                   struct buffer *prev = current_buffer;
  4152                   Lisp_Object workbuf;
  4153                   struct buffer *buf;
  4154 
  4155                   record_unwind_current_buffer ();
  4156 
  4157                   workbuf = Fget_buffer_create (name, Qt);
  4158                   buf = XBUFFER (workbuf);
  4159 
  4160                   delete_all_overlays (buf);
  4161                   bset_directory (buf, BVAR (current_buffer, directory));
  4162                   bset_read_only (buf, Qnil);
  4163                   bset_filename (buf, Qnil);
  4164                   bset_undo_list (buf, Qt);
  4165                   eassert (buf->overlays == NULL);
  4166 
  4167                   set_buffer_internal (buf);
  4168                   Ferase_buffer ();
  4169                   bset_enable_multibyte_characters (buf, Qnil);
  4170 
  4171                   insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
  4172                   TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
  4173                   coding_system = call2 (Vset_auto_coding_function,
  4174                                          filename, make_fixnum (nread));
  4175                   set_buffer_internal (prev);
  4176 
  4177                   /* Discard the unwind protect for recovering the
  4178                      current buffer.  */
  4179                   specpdl_ptr--;
  4180 
  4181                   /* Rewind the file for the actual read done later.  */
  4182                   if (lseek (fd, 0, SEEK_SET) < 0)
  4183                     report_file_error ("Setting file position", orig_filename);
  4184                 }
  4185             }
  4186 
  4187           if (NILP (coding_system))
  4188             {
  4189               /* If we have not yet decided a coding system, check
  4190                  file-coding-system-alist.  */
  4191               coding_system = CALLN (Ffind_operation_coding_system,
  4192                                      Qinsert_file_contents, orig_filename,
  4193                                      visit, beg, end, replace);
  4194               if (CONSP (coding_system))
  4195                 coding_system = XCAR (coding_system);
  4196             }
  4197         }
  4198 
  4199       if (NILP (coding_system))
  4200         coding_system = Qundecided;
  4201       else
  4202         CHECK_CODING_SYSTEM (coding_system);
  4203 
  4204       if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
  4205         /* We must suppress all character code conversion except for
  4206            end-of-line conversion.  */
  4207         coding_system = raw_text_coding_system (coding_system);
  4208 
  4209       setup_coding_system (coding_system, &coding);
  4210       /* Ensure we set Vlast_coding_system_used.  */
  4211       set_coding_system = true;
  4212     }
  4213 
  4214   /* If requested, replace the accessible part of the buffer
  4215      with the file contents.  Avoid replacing text at the
  4216      beginning or end of the buffer that matches the file contents;
  4217      that preserves markers pointing to the unchanged parts.
  4218 
  4219      Here we implement this feature in an optimized way
  4220      for the case where code conversion is NOT needed.
  4221      The following if-statement handles the case of conversion
  4222      in a less optimal way.
  4223 
  4224      If the code conversion is "automatic" then we try using this
  4225      method and hope for the best.
  4226      But if we discover the need for conversion, we give up on this method
  4227      and let the following if-statement handle the replace job.  */
  4228   if (!NILP (replace)
  4229       && BEGV < ZV
  4230       && (NILP (coding_system)
  4231           || ! CODING_REQUIRE_DECODING (&coding)))
  4232     {
  4233       ptrdiff_t overlap;
  4234       /* There is still a possibility we will find the need to do code
  4235          conversion.  If that happens, set this variable to
  4236          give up on handling REPLACE in the optimized way.  */
  4237       bool giveup_match_end = false;
  4238 
  4239       if (beg_offset != 0)
  4240         {
  4241           if (lseek (fd, beg_offset, SEEK_SET) < 0)
  4242             report_file_error ("Setting file position", orig_filename);
  4243         }
  4244 
  4245       /* Count how many chars at the start of the file
  4246          match the text at the beginning of the buffer.  */
  4247       while (true)
  4248         {
  4249           int nread = emacs_read_quit (fd, read_buf, sizeof read_buf);
  4250           if (nread < 0)
  4251             report_file_error ("Read error", orig_filename);
  4252           else if (nread == 0)
  4253             break;
  4254 
  4255           if (CODING_REQUIRE_DETECTION (&coding))
  4256             {
  4257               coding_system = detect_coding_system ((unsigned char *) read_buf,
  4258                                                     nread, nread, 1, 0,
  4259                                                     coding_system);
  4260               setup_coding_system (coding_system, &coding);
  4261             }
  4262 
  4263           if (CODING_REQUIRE_DECODING (&coding))
  4264             /* We found that the file should be decoded somehow.
  4265                Let's give up here.  */
  4266             {
  4267               giveup_match_end = true;
  4268               break;
  4269             }
  4270 
  4271           int bufpos = 0;
  4272           while (bufpos < nread && same_at_start < ZV_BYTE
  4273                  && FETCH_BYTE (same_at_start) == read_buf[bufpos])
  4274             same_at_start++, bufpos++;
  4275           /* If we found a discrepancy, stop the scan.
  4276              Otherwise loop around and scan the next bufferful.  */
  4277           if (bufpos != nread)
  4278             break;
  4279         }
  4280       /* If the file matches the buffer completely,
  4281          there's no need to replace anything.  */
  4282       if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
  4283         {
  4284           emacs_close (fd);
  4285           clear_unwind_protect (fd_index);
  4286 
  4287           /* Truncate the buffer to the size of the file.  */
  4288           del_range_1 (same_at_start, same_at_end, 0, 0);
  4289           goto handled;
  4290         }
  4291 
  4292       /* Count how many chars at the end of the file
  4293          match the text at the end of the buffer.  But, if we have
  4294          already found that decoding is necessary, don't waste time.  */
  4295       while (!giveup_match_end)
  4296         {
  4297           int total_read, nread, bufpos, trial;
  4298           off_t curpos;
  4299 
  4300           /* At what file position are we now scanning?  */
  4301           curpos = end_offset - (ZV_BYTE - same_at_end);
  4302           /* If the entire file matches the buffer tail, stop the scan.  */
  4303           if (curpos == 0)
  4304             break;
  4305           /* How much can we scan in the next step?  */
  4306           trial = min (curpos, sizeof read_buf);
  4307           if (lseek (fd, curpos - trial, SEEK_SET) < 0)
  4308             report_file_error ("Setting file position", orig_filename);
  4309 
  4310           total_read = nread = 0;
  4311           while (total_read < trial)
  4312             {
  4313               nread = emacs_read_quit (fd, read_buf + total_read,
  4314                                        trial - total_read);
  4315               if (nread < 0)
  4316                 report_file_error ("Read error", orig_filename);
  4317               else if (nread == 0)
  4318                 break;
  4319               total_read += nread;
  4320             }
  4321 
  4322           /* Scan this bufferful from the end, comparing with
  4323              the Emacs buffer.  */
  4324           bufpos = total_read;
  4325 
  4326           /* Compare with same_at_start to avoid counting some buffer text
  4327              as matching both at the file's beginning and at the end.  */
  4328           while (bufpos > 0 && same_at_end > same_at_start
  4329                  && FETCH_BYTE (same_at_end - 1) == read_buf[bufpos - 1])
  4330             same_at_end--, bufpos--;
  4331 
  4332           /* If we found a discrepancy, stop the scan.
  4333              Otherwise loop around and scan the preceding bufferful.  */
  4334           if (bufpos != 0)
  4335             {
  4336               /* If this discrepancy is because of code conversion,
  4337                  we cannot use this method; giveup and try the other.  */
  4338               if (same_at_end > same_at_start
  4339                   && FETCH_BYTE (same_at_end - 1) >= 0200
  4340                   && ! NILP (BVAR (current_buffer, enable_multibyte_characters))
  4341                   && (CODING_MAY_REQUIRE_DECODING (&coding)))
  4342                 giveup_match_end = true;
  4343               break;
  4344             }
  4345 
  4346           if (nread == 0)
  4347             break;
  4348         }
  4349 
  4350       if (! giveup_match_end)
  4351         {
  4352           ptrdiff_t temp;
  4353           specpdl_ref this_count = SPECPDL_INDEX ();
  4354 
  4355           /* We win!  We can handle REPLACE the optimized way.  */
  4356 
  4357           /* Extend the start of non-matching text area to multibyte
  4358              character boundary.  */
  4359           if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
  4360             while (same_at_start > BEGV_BYTE
  4361                    && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
  4362               same_at_start--;
  4363 
  4364           /* Extend the end of non-matching text area to multibyte
  4365              character boundary.  */
  4366           if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
  4367             while (same_at_end < ZV_BYTE
  4368                    && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
  4369               same_at_end++;
  4370 
  4371           /* Don't try to reuse the same piece of text twice.  */
  4372           overlap = (same_at_start - BEGV_BYTE
  4373                      - (same_at_end
  4374                         + (! NILP (end) ? end_offset : st.st_size) - ZV_BYTE));
  4375           if (overlap > 0)
  4376             same_at_end += overlap;
  4377           same_at_end_charpos = BYTE_TO_CHAR (same_at_end);
  4378 
  4379           /* Arrange to read only the nonmatching middle part of the file.  */
  4380           beg_offset += same_at_start - BEGV_BYTE;
  4381           end_offset -= ZV_BYTE - same_at_end;
  4382 
  4383           /* This binding is to avoid ask-user-about-supersession-threat
  4384              being called in insert_from_buffer or del_range_bytes (via
  4385              prepare_to_modify_buffer).
  4386              AFAICT we could avoid ask-user-about-supersession-threat by setting
  4387              current_buffer->modtime earlier, but we could still end up calling
  4388              ask-user-about-supersession-threat if the file is modified while
  4389              we read it, so we bind buffer-file-name instead.  */
  4390           specbind (intern ("buffer-file-name"), Qnil);
  4391           del_range_byte (same_at_start, same_at_end);
  4392           /* Insert from the file at the proper position.  */
  4393           temp = BYTE_TO_CHAR (same_at_start);
  4394           SET_PT_BOTH (temp, same_at_start);
  4395           unbind_to (this_count, Qnil);
  4396 
  4397           /* If display currently starts at beginning of line,
  4398              keep it that way.  */
  4399           if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
  4400             XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
  4401 
  4402           replace_handled = true;
  4403         }
  4404     }
  4405 
  4406   /* If requested, replace the accessible part of the buffer
  4407      with the file contents.  Avoid replacing text at the
  4408      beginning or end of the buffer that matches the file contents;
  4409      that preserves markers pointing to the unchanged parts.
  4410 
  4411      Here we implement this feature for the case where code conversion
  4412      is needed, in a simple way that needs a lot of memory.
  4413      The preceding if-statement handles the case of no conversion
  4414      in a more optimized way.  */
  4415   if (!NILP (replace) && ! replace_handled && BEGV < ZV)
  4416     {
  4417       ptrdiff_t same_at_start_charpos;
  4418       ptrdiff_t inserted_chars;
  4419       ptrdiff_t overlap;
  4420       ptrdiff_t bufpos;
  4421       unsigned char *decoded;
  4422       ptrdiff_t temp;
  4423       ptrdiff_t this = 0;
  4424       specpdl_ref this_count = SPECPDL_INDEX ();
  4425       bool multibyte
  4426         = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
  4427       Lisp_Object conversion_buffer;
  4428 
  4429       conversion_buffer = code_conversion_save (1, multibyte);
  4430 
  4431       /* First read the whole file, performing code conversion into
  4432          CONVERSION_BUFFER.  */
  4433 
  4434       if (lseek (fd, beg_offset, SEEK_SET) < 0)
  4435         report_file_error ("Setting file position", orig_filename);
  4436 
  4437       inserted = 0;             /* Bytes put into CONVERSION_BUFFER so far.  */
  4438       unprocessed = 0;          /* Bytes not processed in previous loop.  */
  4439 
  4440       while (true)
  4441         {
  4442           /* Read at most READ_BUF_SIZE bytes at a time, to allow
  4443              quitting while reading a huge file.  */
  4444 
  4445           this = emacs_read_quit (fd, read_buf + unprocessed,
  4446                                   READ_BUF_SIZE - unprocessed);
  4447           if (this <= 0)
  4448             break;
  4449 
  4450           BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
  4451                            BUF_Z (XBUFFER (conversion_buffer)));
  4452           decode_coding_c_string (&coding, (unsigned char *) read_buf,
  4453                                   unprocessed + this, conversion_buffer);
  4454           unprocessed = coding.carryover_bytes;
  4455           if (coding.carryover_bytes > 0)
  4456             memcpy (read_buf, coding.carryover, unprocessed);
  4457         }
  4458 
  4459       if (this < 0)
  4460         report_file_error ("Read error", orig_filename);
  4461       emacs_close (fd);
  4462       clear_unwind_protect (fd_index);
  4463 
  4464       if (unprocessed > 0)
  4465         {
  4466           BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
  4467                            BUF_Z (XBUFFER (conversion_buffer)));
  4468           coding.mode |= CODING_MODE_LAST_BLOCK;
  4469           decode_coding_c_string (&coding, (unsigned char *) read_buf,
  4470                                   unprocessed, conversion_buffer);
  4471           coding.mode &= ~CODING_MODE_LAST_BLOCK;
  4472         }
  4473 
  4474       coding_system = CODING_ID_NAME (coding.id);
  4475       set_coding_system = true;
  4476       maybe_move_gap (XBUFFER (conversion_buffer));
  4477       decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer));
  4478       inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer))
  4479                   - BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
  4480 
  4481       /* Compare the beginning of the converted string with the buffer
  4482          text.  */
  4483 
  4484       bufpos = 0;
  4485       while (bufpos < inserted && same_at_start < same_at_end
  4486              && FETCH_BYTE (same_at_start) == decoded[bufpos])
  4487         same_at_start++, bufpos++;
  4488 
  4489       /* If the file matches the head of buffer completely,
  4490          there's no need to replace anything.  */
  4491 
  4492       if (bufpos == inserted)
  4493         {
  4494           /* Truncate the buffer to the size of the file.  */
  4495           if (same_at_start != same_at_end)
  4496             {
  4497               /* See previous specbind for the reason behind this.  */
  4498               specbind (intern ("buffer-file-name"), Qnil);
  4499               del_range_byte (same_at_start, same_at_end);
  4500             }
  4501           inserted = 0;
  4502 
  4503           unbind_to (this_count, Qnil);
  4504           goto handled;
  4505         }
  4506 
  4507       /* Extend the start of non-matching text area to the previous
  4508          multibyte character boundary.  */
  4509       if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
  4510         while (same_at_start > BEGV_BYTE
  4511                && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
  4512           same_at_start--;
  4513 
  4514       /* Scan this bufferful from the end, comparing with
  4515          the Emacs buffer.  */
  4516       bufpos = inserted;
  4517 
  4518       /* Compare with same_at_start to avoid counting some buffer text
  4519          as matching both at the file's beginning and at the end.  */
  4520       while (bufpos > 0 && same_at_end > same_at_start
  4521              && FETCH_BYTE (same_at_end - 1) == decoded[bufpos - 1])
  4522         same_at_end--, bufpos--;
  4523 
  4524       /* Extend the end of non-matching text area to the next
  4525          multibyte character boundary.  */
  4526       if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
  4527         while (same_at_end < ZV_BYTE
  4528                && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
  4529           same_at_end++;
  4530 
  4531       /* Don't try to reuse the same piece of text twice.  */
  4532       overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
  4533       if (overlap > 0)
  4534         same_at_end += overlap;
  4535       same_at_end_charpos = BYTE_TO_CHAR (same_at_end);
  4536 
  4537       /* If display currently starts at beginning of line,
  4538          keep it that way.  */
  4539       if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
  4540         XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
  4541 
  4542       /* Replace the chars that we need to replace,
  4543          and update INSERTED to equal the number of bytes
  4544          we are taking from the decoded string.  */
  4545       inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
  4546 
  4547       /* See previous specbind for the reason behind this.  */
  4548       specbind (intern ("buffer-file-name"), Qnil);
  4549       if (same_at_end != same_at_start)
  4550         {
  4551           del_range_byte (same_at_start, same_at_end);
  4552           temp = GPT;
  4553           eassert (same_at_start == GPT_BYTE);
  4554           same_at_start = GPT_BYTE;
  4555         }
  4556       else
  4557         {
  4558           temp = same_at_end_charpos;
  4559         }
  4560       /* Insert from the file at the proper position.  */
  4561       SET_PT_BOTH (temp, same_at_start);
  4562       same_at_start_charpos
  4563         = buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
  4564                                   same_at_start - BEGV_BYTE
  4565                                   + BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
  4566       eassert (same_at_start_charpos == temp - (BEGV - BEG));
  4567       inserted_chars
  4568         = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
  4569                                    same_at_start + inserted - BEGV_BYTE
  4570                                   + BUF_BEG_BYTE (XBUFFER (conversion_buffer)))
  4571            - same_at_start_charpos);
  4572       insert_from_buffer (XBUFFER (conversion_buffer),
  4573                           same_at_start_charpos, inserted_chars, 0);
  4574       /* Set `inserted' to the number of inserted characters.  */
  4575       inserted = PT - temp;
  4576       /* Set point before the inserted characters.  */
  4577       SET_PT_BOTH (temp, same_at_start);
  4578 
  4579       unbind_to (this_count, Qnil);
  4580 
  4581       goto handled;
  4582     }
  4583 
  4584   if (seekable || !NILP (end))
  4585     total = end_offset - beg_offset;
  4586   else
  4587     /* For a special file, all we can do is guess.  */
  4588     total = READ_BUF_SIZE;
  4589 
  4590   if (NILP (visit) && total > 0)
  4591     {
  4592       if (!NILP (BVAR (current_buffer, file_truename))
  4593           /* Make binding buffer-file-name to nil effective.  */
  4594           && !NILP (BVAR (current_buffer, filename))
  4595           && SAVE_MODIFF >= MODIFF)
  4596         we_locked_file = true;
  4597       prepare_to_modify_buffer (PT, PT, NULL);
  4598     }
  4599 
  4600   move_gap_both (PT, PT_BYTE);
  4601   if (GAP_SIZE < total)
  4602     make_gap (total - GAP_SIZE);
  4603 
  4604   if (beg_offset != 0 || !NILP (replace))
  4605     {
  4606       if (lseek (fd, beg_offset, SEEK_SET) < 0)
  4607         report_file_error ("Setting file position", orig_filename);
  4608     }
  4609 
  4610   /* In the following loop, HOW_MUCH contains the total bytes read so
  4611      far for a regular file, and not changed for a special file.  But,
  4612      before exiting the loop, it is set to a negative value if I/O
  4613      error occurs.  */
  4614   how_much = 0;
  4615 
  4616   /* Total bytes inserted.  */
  4617   inserted = 0;
  4618 
  4619   /* Here, we don't do code conversion in the loop.  It is done by
  4620      decode_coding_gap after all data are read into the buffer.  */
  4621   {
  4622     ptrdiff_t gap_size = GAP_SIZE;
  4623 
  4624     while (how_much < total)
  4625       {
  4626         /* `try' is reserved in some compilers (Microsoft C).  */
  4627         ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE);
  4628         ptrdiff_t this;
  4629 
  4630         if (!seekable && NILP (end))
  4631           {
  4632             Lisp_Object nbytes;
  4633 
  4634             /* Maybe make more room.  */
  4635             if (gap_size < trytry)
  4636               {
  4637                 make_gap (trytry - gap_size);
  4638                 gap_size = GAP_SIZE - inserted;
  4639               }
  4640 
  4641             /* Read from the file, capturing `quit'.  When an
  4642                error occurs, end the loop, and arrange for a quit
  4643                to be signaled after decoding the text we read.  */
  4644             union read_non_regular data = {{fd, inserted, trytry}};
  4645             nbytes = internal_condition_case_1
  4646               (read_non_regular, make_pointer_integer (&data),
  4647                Qerror, read_non_regular_quit);
  4648 
  4649             if (NILP (nbytes))
  4650               {
  4651                 read_quit = true;
  4652                 break;
  4653               }
  4654 
  4655             this = XFIXNUM (nbytes);
  4656           }
  4657         else
  4658           {
  4659             /* Allow quitting out of the actual I/O.  We don't make text
  4660                part of the buffer until all the reading is done, so a C-g
  4661                here doesn't do any harm.  */
  4662             this = emacs_read_quit (fd,
  4663                                     ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
  4664                                      + inserted),
  4665                                     trytry);
  4666           }
  4667 
  4668         if (this <= 0)
  4669           {
  4670             how_much = this;
  4671             break;
  4672           }
  4673 
  4674         gap_size -= this;
  4675 
  4676         /* For a regular file, where TOTAL is the real size,
  4677            count HOW_MUCH to compare with it.
  4678            For a special file, where TOTAL is just a buffer size,
  4679            so don't bother counting in HOW_MUCH.
  4680            (INSERTED is where we count the number of characters inserted.)  */
  4681         if (seekable || !NILP (end))
  4682           how_much += this;
  4683         inserted += this;
  4684       }
  4685   }
  4686 
  4687   /* Now we have either read all the file data into the gap,
  4688      or stop reading on I/O error or quit.  If nothing was
  4689      read, undo marking the buffer modified.  */
  4690 
  4691   if (inserted == 0)
  4692     {
  4693       if (we_locked_file)
  4694         Funlock_file (BVAR (current_buffer, file_truename));
  4695       Vdeactivate_mark = old_Vdeactivate_mark;
  4696     }
  4697   else
  4698     Fset (Qdeactivate_mark, Qt);
  4699 
  4700   emacs_close (fd);
  4701   clear_unwind_protect (fd_index);
  4702 
  4703   if (how_much < 0)
  4704     report_file_error ("Read error", orig_filename);
  4705 
  4706  notfound:
  4707 
  4708   if (NILP (coding_system))
  4709     {
  4710       /* The coding system is not yet decided.  Decide it by an
  4711          optimized method for handling `coding:' tag.
  4712 
  4713          Note that we can get here only if the buffer was empty
  4714          before the insertion.  */
  4715       eassert (Z == BEG);
  4716 
  4717       if (!NILP (Vcoding_system_for_read))
  4718         coding_system = Vcoding_system_for_read;
  4719       else
  4720         {
  4721           /* Since we are sure that the current buffer was empty
  4722              before the insertion, we can toggle
  4723              enable-multibyte-characters directly here without taking
  4724              care of marker adjustment.  By this way, we can run Lisp
  4725              program safely before decoding the inserted text.  */
  4726           Lisp_Object multibyte
  4727             = BVAR (current_buffer, enable_multibyte_characters);
  4728           Lisp_Object unwind_data
  4729             = Fcons (multibyte,
  4730                      Fcons (BVAR (current_buffer, undo_list),
  4731                             Fcurrent_buffer ()));
  4732           specpdl_ref count1 = SPECPDL_INDEX ();
  4733 
  4734           bset_enable_multibyte_characters (current_buffer, Qnil);
  4735           bset_undo_list (current_buffer, Qt);
  4736           record_unwind_protect (decide_coding_unwind, unwind_data);
  4737 
  4738           /* Make the text read part of the buffer.  */
  4739           insert_from_gap_1 (inserted, inserted, false);
  4740 
  4741           if (inserted > 0 && ! NILP (Vset_auto_coding_function))
  4742             {
  4743               coding_system = call2 (Vset_auto_coding_function,
  4744                                      filename, make_fixnum (inserted));
  4745             }
  4746 
  4747           if (NILP (coding_system))
  4748             {
  4749               /* If the coding system is not yet decided, check
  4750                  file-coding-system-alist.  */
  4751               coding_system = CALLN (Ffind_operation_coding_system,
  4752                                      Qinsert_file_contents, orig_filename,
  4753                                      visit, beg, end, Qnil);
  4754               if (CONSP (coding_system))
  4755                 coding_system = XCAR (coding_system);
  4756             }
  4757           /* Move the text back to the gap.  */
  4758           unbind_to (count1, Qnil);
  4759           inserted = XFIXNUM (XCAR (unwind_data));
  4760         }
  4761 
  4762       if (NILP (coding_system))
  4763         coding_system = Qundecided;
  4764       else
  4765         CHECK_CODING_SYSTEM (coding_system);
  4766 
  4767       if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
  4768         /* We must suppress all character code conversion except for
  4769            end-of-line conversion.  */
  4770         coding_system = raw_text_coding_system (coding_system);
  4771       setup_coding_system (coding_system, &coding);
  4772       /* Ensure we set Vlast_coding_system_used.  */
  4773       set_coding_system = true;
  4774     }
  4775 
  4776   if (!NILP (visit))
  4777     {
  4778       /* When we visit a file by raw-text, we change the buffer to
  4779          unibyte.  */
  4780       if (CODING_FOR_UNIBYTE (&coding)
  4781           /* Can't do this if part of the buffer might be preserved.  */
  4782           && NILP (replace))
  4783         {
  4784           /* Visiting a file with these coding system makes the buffer
  4785              unibyte.  */
  4786           if (inserted > 0)
  4787             bset_enable_multibyte_characters (current_buffer, Qnil);
  4788           else
  4789             Fset_buffer_multibyte (Qnil);
  4790         }
  4791     }
  4792 
  4793   eassert (PT == GPT);
  4794 
  4795   coding.dst_multibyte
  4796     = !NILP (BVAR (current_buffer, enable_multibyte_characters));
  4797   if (CODING_MAY_REQUIRE_DECODING (&coding)
  4798       && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding)))
  4799     {
  4800       /* Now we have all the new bytes at the beginning of the gap,
  4801          but `decode_coding_gap` can't have them at the beginning of the gap,
  4802          so we need to move them.  */
  4803       memmove (GAP_END_ADDR - inserted, GPT_ADDR, inserted);
  4804       decode_coding_gap (&coding, inserted);
  4805       inserted = coding.produced_char;
  4806       coding_system = CODING_ID_NAME (coding.id);
  4807     }
  4808   else if (inserted > 0)
  4809     {
  4810       /* Make the text read part of the buffer.  */
  4811       eassert (NILP (BVAR (current_buffer, enable_multibyte_characters)));
  4812       insert_from_gap_1 (inserted, inserted, false);
  4813 
  4814       invalidate_buffer_caches (current_buffer, PT, PT + inserted);
  4815       adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
  4816                            inserted);
  4817     }
  4818 
  4819   /* Call after-change hooks for the inserted text, aside from the case
  4820      of normal visiting (not with REPLACE), which is done in a new buffer
  4821      "before" the buffer is changed.  */
  4822   if (inserted > 0 && total > 0
  4823       && (NILP (visit) || !NILP (replace)))
  4824     {
  4825       signal_after_change (PT, 0, inserted);
  4826       update_compositions (PT, PT, CHECK_BORDER);
  4827     }
  4828 
  4829   /* Now INSERTED is measured in characters.  */
  4830 
  4831  handled:
  4832 
  4833   if (inserted > 0)
  4834     restore_window_points (window_markers, inserted,
  4835                            BYTE_TO_CHAR (same_at_start),
  4836                            same_at_end_charpos);
  4837 
  4838   if (!NILP (visit))
  4839     {
  4840       if (empty_undo_list_p)
  4841         bset_undo_list (current_buffer, Qnil);
  4842 
  4843       if (NILP (handler))
  4844         {
  4845           current_buffer->modtime = mtime;
  4846           current_buffer->modtime_size = st.st_size;
  4847           bset_filename (current_buffer, orig_filename);
  4848         }
  4849 
  4850       SAVE_MODIFF = MODIFF;
  4851       BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
  4852       XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
  4853       if (NILP (handler))
  4854         {
  4855           if (!NILP (BVAR (current_buffer, file_truename)))
  4856             Funlock_file (BVAR (current_buffer, file_truename));
  4857           Funlock_file (filename);
  4858         }
  4859       if (!regular)
  4860         xsignal2 (Qfile_error,
  4861                   build_string ("not a regular file"), orig_filename);
  4862     }
  4863 
  4864   if (set_coding_system)
  4865     Vlast_coding_system_used = coding_system;
  4866 
  4867   if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
  4868     {
  4869       insval = call2 (Qafter_insert_file_set_coding, make_fixnum (inserted),
  4870                       visit);
  4871       if (! NILP (insval))
  4872         {
  4873           if (! RANGED_FIXNUMP (0, insval, ZV - PT))
  4874             wrong_type_argument (Qinserted_chars, insval);
  4875           inserted = XFIXNAT (insval);
  4876         }
  4877     }
  4878 
  4879   /* Decode file format.  */
  4880   if (inserted > 0)
  4881     {
  4882       /* Don't run point motion or modification hooks when decoding.  */
  4883       specpdl_ref count1 = SPECPDL_INDEX ();
  4884       ptrdiff_t old_inserted = inserted;
  4885       specbind (Qinhibit_point_motion_hooks, Qt);
  4886       specbind (Qinhibit_modification_hooks, Qt);
  4887 
  4888       /* Save old undo list and don't record undo for decoding.  */
  4889       old_undo = BVAR (current_buffer, undo_list);
  4890       bset_undo_list (current_buffer, Qt);
  4891 
  4892       if (NILP (replace))
  4893         {
  4894           insval = call3 (Qformat_decode,
  4895                           Qnil, make_fixnum (inserted), visit);
  4896           if (! RANGED_FIXNUMP (0, insval, ZV - PT))
  4897             wrong_type_argument (Qinserted_chars, insval);
  4898           inserted = XFIXNAT (insval);
  4899         }
  4900       else
  4901         {
  4902           /* If REPLACE is non-nil and we succeeded in not replacing the
  4903              beginning or end of the buffer text with the file's contents,
  4904              call format-decode with `point' positioned at the beginning
  4905              of the buffer and `inserted' equaling the number of
  4906              characters in the buffer.  Otherwise, format-decode might
  4907              fail to correctly analyze the beginning or end of the buffer.
  4908              Hence we temporarily save `point' and `inserted' here and
  4909              restore `point' iff format-decode did not insert or delete
  4910              any text.  Otherwise we leave `point' at point-min.  */
  4911           ptrdiff_t opoint = PT;
  4912           ptrdiff_t opoint_byte = PT_BYTE;
  4913           ptrdiff_t oinserted = ZV - BEGV;
  4914           modiff_count ochars_modiff = CHARS_MODIFF;
  4915 
  4916           TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
  4917           insval = call3 (Qformat_decode,
  4918                           Qnil, make_fixnum (oinserted), visit);
  4919           if (! RANGED_FIXNUMP (0, insval, ZV - PT))
  4920             wrong_type_argument (Qinserted_chars, insval);
  4921           if (ochars_modiff == CHARS_MODIFF)
  4922             /* format_decode didn't modify buffer's characters => move
  4923                point back to position before inserted text and leave
  4924                value of inserted alone.  */
  4925             SET_PT_BOTH (opoint, opoint_byte);
  4926           else
  4927             /* format_decode modified buffer's characters => consider
  4928                entire buffer changed and leave point at point-min.  */
  4929             inserted = XFIXNAT (insval);
  4930         }
  4931 
  4932       /* For consistency with format-decode call these now iff inserted > 0
  4933          (martin 2007-06-28).  */
  4934       p = Vafter_insert_file_functions;
  4935       FOR_EACH_TAIL (p)
  4936         {
  4937           if (NILP (replace))
  4938             {
  4939               insval = call1 (XCAR (p), make_fixnum (inserted));
  4940               if (!NILP (insval))
  4941                 {
  4942                   if (! RANGED_FIXNUMP (0, insval, ZV - PT))
  4943                     wrong_type_argument (Qinserted_chars, insval);
  4944                   inserted = XFIXNAT (insval);
  4945                 }
  4946             }
  4947           else
  4948             {
  4949               /* For the rationale of this see the comment on
  4950                  format-decode above.  */
  4951               ptrdiff_t opoint = PT;
  4952               ptrdiff_t opoint_byte = PT_BYTE;
  4953               ptrdiff_t oinserted = ZV - BEGV;
  4954               modiff_count ochars_modiff = CHARS_MODIFF;
  4955 
  4956               TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
  4957               insval = call1 (XCAR (p), make_fixnum (oinserted));
  4958               if (!NILP (insval))
  4959                 {
  4960                   if (! RANGED_FIXNUMP (0, insval, ZV - PT))
  4961                     wrong_type_argument (Qinserted_chars, insval);
  4962                   if (ochars_modiff == CHARS_MODIFF)
  4963                     /* after_insert_file_functions didn't modify
  4964                        buffer's characters => move point back to
  4965                        position before inserted text and leave value of
  4966                        inserted alone.  */
  4967                     SET_PT_BOTH (opoint, opoint_byte);
  4968                   else
  4969                     /* after_insert_file_functions did modify buffer's
  4970                        characters => consider entire buffer changed and
  4971                        leave point at point-min.  */
  4972                     inserted = XFIXNAT (insval);
  4973                 }
  4974             }
  4975         }
  4976 
  4977       if (!empty_undo_list_p)
  4978         {
  4979           bset_undo_list (current_buffer, old_undo);
  4980           if (CONSP (old_undo) && inserted != old_inserted)
  4981             {
  4982               /* Adjust the last undo record for the size change during
  4983                  the format conversion.  */
  4984               Lisp_Object tem = XCAR (old_undo);
  4985               if (CONSP (tem) && FIXNUMP (XCAR (tem))
  4986                   && FIXNUMP (XCDR (tem))
  4987                   && XFIXNUM (XCDR (tem)) == PT + old_inserted)
  4988                 XSETCDR (tem, make_fixnum (PT + inserted));
  4989             }
  4990         }
  4991       else
  4992         /* If undo_list was Qt before, keep it that way.
  4993            Otherwise start with an empty undo_list.  */
  4994         bset_undo_list (current_buffer, EQ (old_undo, Qt) ? Qt : Qnil);
  4995 
  4996       unbind_to (count1, Qnil);
  4997     }
  4998 
  4999   if (save_errno != 0)
  5000     {
  5001       /* Signal an error if visiting a file that could not be opened.  */
  5002       eassert (!NILP (visit) && NILP (handler));
  5003       report_file_errno ("Opening input file", orig_filename, save_errno);
  5004     }
  5005 
  5006   /* We made a lot of deletions and insertions above, so invalidate
  5007      the newline cache for the entire region of the inserted
  5008      characters.  */
  5009   if (current_buffer->base_buffer && current_buffer->base_buffer->newline_cache)
  5010     invalidate_region_cache (current_buffer->base_buffer,
  5011                              current_buffer->base_buffer->newline_cache,
  5012                              PT - BEG, Z - PT - inserted);
  5013   else if (current_buffer->newline_cache)
  5014     invalidate_region_cache (current_buffer,
  5015                              current_buffer->newline_cache,
  5016                              PT - BEG, Z - PT - inserted);
  5017 
  5018   if (read_quit)
  5019     quit ();
  5020 
  5021   /* Retval needs to be dealt with in all cases consistently.  */
  5022   if (NILP (val))
  5023     val = list2 (orig_filename, make_fixnum (inserted));
  5024 
  5025   return unbind_to (count, val);
  5026 }
  5027 
  5028 static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
  5029 
  5030 static void
  5031 build_annotations_unwind (Lisp_Object arg)
  5032 {
  5033   Vwrite_region_annotation_buffers = arg;
  5034 }
  5035 
  5036 /* Decide the coding-system to encode the data with.  */
  5037 
  5038 static Lisp_Object
  5039 choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
  5040                             Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
  5041                             struct coding_system *coding)
  5042 {
  5043   Lisp_Object val;
  5044   Lisp_Object eol_parent = Qnil;
  5045 
  5046   if (auto_saving
  5047       && NILP (Fstring_equal (BVAR (current_buffer, filename),
  5048                               BVAR (current_buffer, auto_save_file_name))))
  5049     {
  5050       val = Qutf_8_emacs;
  5051       eol_parent = Qunix;
  5052     }
  5053   else if (!NILP (Vcoding_system_for_write))
  5054     {
  5055       val = Vcoding_system_for_write;
  5056       if (coding_system_require_warning
  5057           && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
  5058         /* Confirm that VAL can surely encode the current region.  */
  5059         val = call5 (Vselect_safe_coding_system_function,
  5060                      start, end, list2 (Qt, val),
  5061                      Qnil, filename);
  5062     }
  5063   else
  5064     {
  5065       /* If the variable `buffer-file-coding-system' is set locally,
  5066          it means that the file was read with some kind of code
  5067          conversion or the variable is explicitly set by users.  We
  5068          had better write it out with the same coding system even if
  5069          `enable-multibyte-characters' is nil.
  5070 
  5071          If it is not set locally, we anyway have to convert EOL
  5072          format if the default value of `buffer-file-coding-system'
  5073          tells that it is not Unix-like (LF only) format.  */
  5074       bool using_default_coding = 0;
  5075       bool force_raw_text = 0;
  5076 
  5077       val = BVAR (current_buffer, buffer_file_coding_system);
  5078       if (NILP (val)
  5079           || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
  5080         {
  5081           val = Qnil;
  5082           if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
  5083             force_raw_text = 1;
  5084         }
  5085 
  5086       if (NILP (val))
  5087         {
  5088           /* Check file-coding-system-alist.  */
  5089           Lisp_Object coding_systems
  5090             = CALLN (Ffind_operation_coding_system, Qwrite_region, start, end,
  5091                      filename, append, visit, lockname);
  5092           if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
  5093             val = XCDR (coding_systems);
  5094         }
  5095 
  5096       if (NILP (val))
  5097         {
  5098           /* If we still have not decided a coding system, use the
  5099              current buffer's value of buffer-file-coding-system.  */
  5100           val = BVAR (current_buffer, buffer_file_coding_system);
  5101           using_default_coding = 1;
  5102         }
  5103 
  5104       if (! NILP (val) && ! force_raw_text)
  5105         {
  5106           Lisp_Object spec, attrs;
  5107 
  5108           CHECK_CODING_SYSTEM (val);
  5109           CHECK_CODING_SYSTEM_GET_SPEC (val, spec);
  5110           attrs = AREF (spec, 0);
  5111           if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
  5112             force_raw_text = 1;
  5113         }
  5114 
  5115       if (!force_raw_text
  5116           && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
  5117         {
  5118           /* Confirm that VAL can surely encode the current region.  */
  5119           val = call5 (Vselect_safe_coding_system_function,
  5120                        start, end, val, Qnil, filename);
  5121           /* As the function specified by select-safe-coding-system-function
  5122              is out of our control, make sure we are not fed by bogus
  5123              values.  */
  5124           if (!NILP (val))
  5125             CHECK_CODING_SYSTEM (val);
  5126         }
  5127 
  5128       /* If the decided coding-system doesn't specify end-of-line
  5129          format, we use that of `buffer-file-coding-system'.  */
  5130       if (! using_default_coding)
  5131         {
  5132           Lisp_Object dflt = BVAR (&buffer_defaults, buffer_file_coding_system);
  5133 
  5134           if (! NILP (dflt))
  5135             val = coding_inherit_eol_type (val, dflt);
  5136         }
  5137 
  5138       /* If we decide not to encode text, use `raw-text' or one of its
  5139          subsidiaries.  */
  5140       if (force_raw_text)
  5141         val = raw_text_coding_system (val);
  5142     }
  5143 
  5144   val = coding_inherit_eol_type (val, eol_parent);
  5145   setup_coding_system (val, coding);
  5146 
  5147   if (!STRINGP (start) && EQ (Qt, BVAR (current_buffer, selective_display)))
  5148     coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
  5149   return val;
  5150 }
  5151 
  5152 DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
  5153        "r\nFWrite region to file: \ni\ni\ni\np",
  5154        doc: /* Write current region into specified file.
  5155 When called from a program, requires three arguments:
  5156 START, END and FILENAME.  START and END are normally buffer positions
  5157 specifying the part of the buffer to write.
  5158 If START is nil, that means to use the entire buffer contents; END is
  5159 ignored.
  5160 If START is a string, then output that string to the file
  5161 instead of any buffer contents; END is ignored.
  5162 
  5163 Optional fourth argument APPEND if non-nil means
  5164   append to existing file contents (if any).  If it is a number,
  5165   seek to that offset in the file before writing.
  5166 Optional fifth argument VISIT, if t or a string, means
  5167   set the last-save-file-modtime of buffer to this file's modtime
  5168   and mark buffer not modified.
  5169 If VISIT is t, the buffer is marked as visiting FILENAME.
  5170 If VISIT is a string, it is a second file name;
  5171   the output goes to FILENAME, but the buffer is marked as visiting VISIT.
  5172   VISIT is also the file name to lock and unlock for clash detection.
  5173 If VISIT is neither t nor nil nor a string, or if Emacs is in batch mode,
  5174   do not display the \"Wrote file\" message.
  5175 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
  5176   use for locking and unlocking, overriding FILENAME and VISIT.
  5177 The optional seventh arg MUSTBENEW, if non-nil, insists on a check
  5178   for an existing file with the same name.  If MUSTBENEW is `excl',
  5179   that means to get an error if the file already exists; never overwrite.
  5180   If MUSTBENEW is neither nil nor `excl', that means ask for
  5181   confirmation before overwriting, but do go ahead and overwrite the file
  5182   if the user confirms.
  5183 
  5184 This does code conversion according to the value of
  5185 `coding-system-for-write', `buffer-file-coding-system', or
  5186 `file-coding-system-alist', and sets the variable
  5187 `last-coding-system-used' to the coding system actually used.
  5188 
  5189 This calls `write-region-annotate-functions' at the start, and
  5190 `write-region-post-annotation-function' at the end.  */)
  5191   (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append,
  5192    Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
  5193 {
  5194   return write_region (start, end, filename, append, visit, lockname, mustbenew,
  5195                        -1);
  5196 }
  5197 
  5198 /* Like Fwrite_region, except that if DESC is nonnegative, it is a file
  5199    descriptor for FILENAME, so do not open or close FILENAME.  */
  5200 
  5201 Lisp_Object
  5202 write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
  5203               Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
  5204               Lisp_Object mustbenew, int desc)
  5205 {
  5206   int open_flags;
  5207   int mode;
  5208   off_t offset UNINIT;
  5209   bool open_and_close_file = desc < 0;
  5210   bool ok;
  5211   int save_errno = 0;
  5212   const char *fn;
  5213   struct stat st;
  5214   struct timespec modtime;
  5215   specpdl_ref count = SPECPDL_INDEX ();
  5216   specpdl_ref count1 UNINIT;
  5217   Lisp_Object handler;
  5218   Lisp_Object visit_file;
  5219   Lisp_Object annotations;
  5220   Lisp_Object encoded_filename;
  5221   bool visiting = (EQ (visit, Qt) || STRINGP (visit));
  5222   bool quietly = !NILP (visit);
  5223   bool file_locked = 0;
  5224   struct buffer *given_buffer;
  5225   struct coding_system coding;
  5226 
  5227   if (current_buffer->base_buffer && visiting)
  5228     error ("Cannot do file visiting in an indirect buffer");
  5229 
  5230   if (!NILP (start) && !STRINGP (start))
  5231     validate_region (&start, &end);
  5232 
  5233   visit_file = Qnil;
  5234 
  5235   filename = Fexpand_file_name (filename, Qnil);
  5236 
  5237   if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
  5238     barf_or_query_if_file_exists (filename, false, "overwrite", true, true);
  5239 
  5240   if (STRINGP (visit))
  5241     visit_file = Fexpand_file_name (visit, Qnil);
  5242   else
  5243     visit_file = filename;
  5244 
  5245   if (NILP (lockname))
  5246     lockname = visit_file;
  5247 
  5248   annotations = Qnil;
  5249 
  5250   /* If the file name has special constructs in it,
  5251      call the corresponding file name handler.  */
  5252   handler = Ffind_file_name_handler (filename, Qwrite_region);
  5253   /* If FILENAME has no handler, see if VISIT has one.  */
  5254   if (NILP (handler) && STRINGP (visit))
  5255     handler = Ffind_file_name_handler (visit, Qwrite_region);
  5256 
  5257   if (!NILP (handler))
  5258     {
  5259       Lisp_Object val;
  5260       val = call8 (handler, Qwrite_region, start, end,
  5261                    filename, append, visit, lockname, mustbenew);
  5262 
  5263       if (visiting)
  5264         {
  5265           SAVE_MODIFF = MODIFF;
  5266           XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
  5267           bset_filename (current_buffer, visit_file);
  5268         }
  5269 
  5270       return val;
  5271     }
  5272 
  5273   record_unwind_protect (save_restriction_restore, save_restriction_save ());
  5274   labeled_restrictions_remove_in_current_buffer ();
  5275 
  5276   /* Special kludge to simplify auto-saving.  */
  5277   if (NILP (start))
  5278     {
  5279       /* Do it later, so write-region-annotate-function can work differently
  5280          if we save "the buffer" vs "a region".
  5281          This is useful in tar-mode.  --Stef
  5282       XSETFASTINT (start, BEG);
  5283       XSETFASTINT (end, Z); */
  5284       Fwiden ();
  5285     }
  5286 
  5287   record_unwind_protect (build_annotations_unwind,
  5288                          Vwrite_region_annotation_buffers);
  5289   Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ());
  5290 
  5291   given_buffer = current_buffer;
  5292 
  5293   if (!STRINGP (start))
  5294     {
  5295       annotations = build_annotations (start, end);
  5296 
  5297       if (current_buffer != given_buffer)
  5298         {
  5299           XSETFASTINT (start, BEGV);
  5300           XSETFASTINT (end, ZV);
  5301         }
  5302     }
  5303 
  5304   if (NILP (start))
  5305     {
  5306       XSETFASTINT (start, BEGV);
  5307       XSETFASTINT (end, ZV);
  5308     }
  5309 
  5310   /* Decide the coding-system to encode the data with.
  5311      We used to make this choice before calling build_annotations, but that
  5312      leads to problems when a write-annotate-function takes care of
  5313      unsavable chars (as was the case with X-Symbol).  */
  5314   Vlast_coding_system_used
  5315     = choose_write_coding_system (start, end, filename,
  5316                                  append, visit, lockname, &coding);
  5317 
  5318   if (open_and_close_file && !auto_saving)
  5319     {
  5320       Flock_file (lockname);
  5321       file_locked = 1;
  5322     }
  5323 
  5324   encoded_filename = ENCODE_FILE (filename);
  5325   fn = SSDATA (encoded_filename);
  5326   open_flags = O_WRONLY | O_CREAT;
  5327   open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
  5328   if (NUMBERP (append))
  5329     offset = file_offset (append);
  5330   else if (!NILP (append))
  5331     open_flags |= O_APPEND;
  5332 #ifdef DOS_NT
  5333   mode = S_IREAD | S_IWRITE;
  5334 #else
  5335   mode = auto_saving ? auto_save_mode_bits : 0666;
  5336 #endif
  5337 
  5338   if (open_and_close_file)
  5339     {
  5340       desc = emacs_open (fn, open_flags, mode);
  5341       if (desc < 0)
  5342         {
  5343           int open_errno = errno;
  5344           if (file_locked)
  5345             Funlock_file (lockname);
  5346           report_file_errno ("Opening output file", filename, open_errno);
  5347         }
  5348 
  5349       count1 = SPECPDL_INDEX ();
  5350       record_unwind_protect_int (close_file_unwind, desc);
  5351     }
  5352 
  5353   if (NUMBERP (append))
  5354     {
  5355       off_t ret = lseek (desc, offset, SEEK_SET);
  5356       if (ret < 0)
  5357         {
  5358           int lseek_errno = errno;
  5359           if (file_locked)
  5360             Funlock_file (lockname);
  5361           report_file_errno ("Lseek error", filename, lseek_errno);
  5362         }
  5363     }
  5364 
  5365   if (STRINGP (start))
  5366     ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
  5367   else if (XFIXNUM (start) != XFIXNUM (end))
  5368     ok = a_write (desc, Qnil, XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
  5369                   &annotations, &coding);
  5370   else
  5371     {
  5372       /* If file was empty, still need to write the annotations.  */
  5373       coding.mode |= CODING_MODE_LAST_BLOCK;
  5374       ok = a_write (desc, Qnil, XFIXNUM (end), 0, &annotations, &coding);
  5375     }
  5376   save_errno = errno;
  5377 
  5378   if (ok && CODING_REQUIRE_FLUSHING (&coding)
  5379       && !(coding.mode & CODING_MODE_LAST_BLOCK))
  5380     {
  5381       /* We have to flush out a data. */
  5382       coding.mode |= CODING_MODE_LAST_BLOCK;
  5383       ok = e_write (desc, Qnil, 1, 1, &coding);
  5384       save_errno = errno;
  5385     }
  5386 
  5387   /* fsync is not crucial for temporary files.  Nor for auto-save
  5388      files, since they might lose some work anyway.  */
  5389   if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
  5390     {
  5391       /* Transfer data and metadata to disk, retrying if interrupted.
  5392          fsync can report a write failure here, e.g., due to disk full
  5393          under NFS.  But ignore EINVAL (and EBADF on Windows), which
  5394          means fsync is not supported on this file.  */
  5395       while (fsync (desc) != 0)
  5396         if (errno != EINTR)
  5397           {
  5398             if (errno != EINVAL
  5399 #ifdef WINDOWSNT
  5400                 && errno != EBADF
  5401 #endif
  5402                 )
  5403               ok = 0, save_errno = errno;
  5404             break;
  5405           }
  5406     }
  5407 
  5408   modtime = invalid_timespec ();
  5409   if (visiting)
  5410     {
  5411       if (fstat (desc, &st) == 0)
  5412         modtime = get_stat_mtime (&st);
  5413       else
  5414         ok = 0, save_errno = errno;
  5415     }
  5416 
  5417   if (open_and_close_file)
  5418     {
  5419       /* NFS can report a write failure now.  */
  5420       if (emacs_close (desc) < 0)
  5421         ok = 0, save_errno = errno;
  5422 
  5423       /* Discard the unwind protect for close_file_unwind.  */
  5424       specpdl_ptr = specpdl_ref_to_ptr (count1);
  5425     }
  5426 
  5427   /* Some file systems have a bug where st_mtime is not updated
  5428      properly after a write.  For example, CIFS might not see the
  5429      st_mtime change until after the file is opened again.
  5430 
  5431      Attempt to detect this file system bug, and update MODTIME to the
  5432      newer st_mtime if the bug appears to be present.  This introduces
  5433      a race condition, so to avoid most instances of the race condition
  5434      on non-buggy file systems, skip this check if the most recently
  5435      encountered non-buggy file system was the current file system.
  5436 
  5437      A race condition can occur if some other process modifies the
  5438      file between the fstat above and the fstat below, but the race is
  5439      unlikely and a similar race between the last write and the fstat
  5440      above cannot possibly be closed anyway.  */
  5441 
  5442   if (timespec_valid_p (modtime)
  5443       && ! (valid_timestamp_file_system && st.st_dev == timestamp_file_system))
  5444     {
  5445       int desc1 = emacs_open (fn, O_WRONLY, 0);
  5446       if (desc1 >= 0)
  5447         {
  5448           struct stat st1;
  5449           if (fstat (desc1, &st1) == 0
  5450               && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino)
  5451             {
  5452               /* Use the heuristic if it appears to be valid.  With neither
  5453                  O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
  5454                  file, the time stamp won't change.  Also, some non-POSIX
  5455                  systems don't update an empty file's time stamp when
  5456                  truncating it.  Finally, file systems with 100 ns or worse
  5457                  resolution sometimes seem to have bugs: on a system with ns
  5458                  resolution, checking ns % 100 incorrectly avoids the heuristic
  5459                  1% of the time, but the problem should be temporary as we will
  5460                  try again on the next time stamp.  */
  5461               bool use_heuristic
  5462                 = ((open_flags & (O_EXCL | O_TRUNC)) != 0
  5463                    && st.st_size != 0
  5464                    && modtime.tv_nsec % 100 != 0);
  5465 
  5466               struct timespec modtime1 = get_stat_mtime (&st1);
  5467               if (use_heuristic
  5468                   && timespec_cmp (modtime, modtime1) == 0
  5469                   && st.st_size == st1.st_size)
  5470                 {
  5471                   timestamp_file_system = st.st_dev;
  5472                   valid_timestamp_file_system = 1;
  5473                 }
  5474               else
  5475                 {
  5476                   st.st_size = st1.st_size;
  5477                   modtime = modtime1;
  5478                 }
  5479             }
  5480           emacs_close (desc1);
  5481         }
  5482     }
  5483 
  5484   /* Call write-region-post-annotation-function. */
  5485   while (CONSP (Vwrite_region_annotation_buffers))
  5486     {
  5487       Lisp_Object buf = XCAR (Vwrite_region_annotation_buffers);
  5488       if (!NILP (Fbuffer_live_p (buf)))
  5489         {
  5490           Fset_buffer (buf);
  5491           if (FUNCTIONP (Vwrite_region_post_annotation_function))
  5492             call0 (Vwrite_region_post_annotation_function);
  5493         }
  5494       Vwrite_region_annotation_buffers
  5495         = XCDR (Vwrite_region_annotation_buffers);
  5496     }
  5497 
  5498   unbind_to (count, Qnil);
  5499 
  5500   if (file_locked)
  5501     Funlock_file (lockname);
  5502 
  5503   /* Do this before reporting IO error
  5504      to avoid a "file has changed on disk" warning on
  5505      next attempt to save.  */
  5506   if (timespec_valid_p (modtime))
  5507     {
  5508       current_buffer->modtime = modtime;
  5509       current_buffer->modtime_size = st.st_size;
  5510     }
  5511 
  5512   if (! ok)
  5513     report_file_errno ("Write error", filename, save_errno);
  5514 
  5515   bool auto_saving_into_visited_file =
  5516     auto_saving
  5517     && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
  5518                               BVAR (current_buffer, auto_save_file_name)));
  5519   if (visiting)
  5520     {
  5521       SAVE_MODIFF = MODIFF;
  5522       XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
  5523       bset_filename (current_buffer, visit_file);
  5524       update_mode_lines = 14;
  5525       if (auto_saving_into_visited_file)
  5526         Funlock_file (lockname);
  5527     }
  5528   else if (quietly)
  5529     {
  5530       if (auto_saving_into_visited_file)
  5531         {
  5532           SAVE_MODIFF = MODIFF;
  5533           Funlock_file (lockname);
  5534         }
  5535 
  5536       return Qnil;
  5537     }
  5538 
  5539   if (!auto_saving && !noninteractive)
  5540     message_with_string ((NUMBERP (append)
  5541                           ? "Updated %s"
  5542                           : ! NILP (append)
  5543                           ? "Added to %s"
  5544                           : "Wrote %s"),
  5545                          visit_file, 1);
  5546 
  5547   return Qnil;
  5548 }
  5549 
  5550 DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
  5551        doc: /* Return t if (car A) is numerically less than (car B).  */)
  5552   (Lisp_Object a, Lisp_Object b)
  5553 {
  5554   Lisp_Object ca = Fcar (a), cb = Fcar (b);
  5555   if (FIXNUMP (ca) && FIXNUMP (cb))
  5556     return XFIXNUM (ca) < XFIXNUM (cb) ? Qt : Qnil;
  5557   return arithcompare (ca, cb, ARITH_LESS);
  5558 }
  5559 
  5560 /* Build the complete list of annotations appropriate for writing out
  5561    the text between START and END, by calling all the functions in
  5562    write-region-annotate-functions and merging the lists they return.
  5563    If one of these functions switches to a different buffer, we assume
  5564    that buffer contains altered text.  Therefore, the caller must
  5565    make sure to restore the current buffer in all cases,
  5566    as save-excursion would do.  */
  5567 
  5568 static Lisp_Object
  5569 build_annotations (Lisp_Object start, Lisp_Object end)
  5570 {
  5571   Lisp_Object annotations;
  5572   Lisp_Object p, res;
  5573   Lisp_Object original_buffer;
  5574   bool used_global = false;
  5575 
  5576   XSETBUFFER (original_buffer, current_buffer);
  5577 
  5578   annotations = Qnil;
  5579   p = Vwrite_region_annotate_functions;
  5580  loop_over_p:
  5581   FOR_EACH_TAIL (p)
  5582     {
  5583       struct buffer *given_buffer = current_buffer;
  5584       if (EQ (Qt, XCAR (p)) && !used_global)
  5585         { /* Use the global value of the hook.  */
  5586           used_global = true;
  5587           p = CALLN (Fappend,
  5588                      Fdefault_value (Qwrite_region_annotate_functions),
  5589                      XCDR (p));
  5590           goto loop_over_p;
  5591         }
  5592       Vwrite_region_annotations_so_far = annotations;
  5593       res = call2 (XCAR (p), start, end);
  5594       /* If the function makes a different buffer current,
  5595          assume that means this buffer contains altered text to be output.
  5596          Reset START and END from the buffer bounds
  5597          and discard all previous annotations because they should have
  5598          been dealt with by this function.  */
  5599       if (current_buffer != given_buffer)
  5600         {
  5601           Vwrite_region_annotation_buffers
  5602             = Fcons (Fcurrent_buffer (),
  5603                      Vwrite_region_annotation_buffers);
  5604           XSETFASTINT (start, BEGV);
  5605           XSETFASTINT (end, ZV);
  5606           annotations = Qnil;
  5607         }
  5608       Flength (res);   /* Check basic validity of return value */
  5609       annotations = merge (annotations, res, Qcar_less_than_car);
  5610     }
  5611 
  5612   /* Now do the same for annotation functions implied by the file-format */
  5613   if (auto_saving && (!EQ (BVAR (current_buffer, auto_save_file_format), Qt)))
  5614     p = BVAR (current_buffer, auto_save_file_format);
  5615   else
  5616     p = BVAR (current_buffer, file_format);
  5617   EMACS_INT i = 0;
  5618   FOR_EACH_TAIL (p)
  5619     {
  5620       struct buffer *given_buffer = current_buffer;
  5621 
  5622       Vwrite_region_annotations_so_far = annotations;
  5623 
  5624       /* Value is either a list of annotations or nil if the function
  5625          has written annotations to a temporary buffer, which is now
  5626          current.  */
  5627       res = call5 (Qformat_annotate_function, XCAR (p), start, end,
  5628                    original_buffer, make_fixnum (i++));
  5629       if (current_buffer != given_buffer)
  5630         {
  5631           XSETFASTINT (start, BEGV);
  5632           XSETFASTINT (end, ZV);
  5633           annotations = Qnil;
  5634         }
  5635 
  5636       if (CONSP (res))
  5637         annotations = merge (annotations, res, Qcar_less_than_car);
  5638     }
  5639 
  5640   return annotations;
  5641 }
  5642 
  5643 
  5644 /* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
  5645    If STRING is nil, POS is the character position in the current buffer.
  5646    Intersperse with them the annotations from *ANNOT
  5647    which fall within the range of POS to POS + NCHARS,
  5648    each at its appropriate position.
  5649 
  5650    We modify *ANNOT by discarding elements as we use them up.
  5651 
  5652    Return true if successful.  */
  5653 
  5654 static bool
  5655 a_write (int desc, Lisp_Object string, ptrdiff_t pos,
  5656          ptrdiff_t nchars, Lisp_Object *annot,
  5657          struct coding_system *coding)
  5658 {
  5659   Lisp_Object tem;
  5660   ptrdiff_t nextpos;
  5661   ptrdiff_t lastpos = pos + nchars;
  5662 
  5663   while (NILP (*annot) || CONSP (*annot))
  5664     {
  5665       tem = Fcar_safe (Fcar (*annot));
  5666       nextpos = pos - 1;
  5667       if (FIXNUMP (tem))
  5668         nextpos = XFIXNUM (tem);
  5669 
  5670       /* If there are no more annotations in this range,
  5671          output the rest of the range all at once.  */
  5672       if (! (nextpos >= pos && nextpos <= lastpos))
  5673         return e_write (desc, string, pos, lastpos, coding);
  5674 
  5675       /* Output buffer text up to the next annotation's position.  */
  5676       if (nextpos > pos)
  5677         {
  5678           if (!e_write (desc, string, pos, nextpos, coding))
  5679             return 0;
  5680           pos = nextpos;
  5681         }
  5682       /* Output the annotation.  */
  5683       tem = Fcdr (Fcar (*annot));
  5684       if (STRINGP (tem))
  5685         {
  5686           if (!e_write (desc, tem, 0, SCHARS (tem), coding))
  5687             return 0;
  5688         }
  5689       *annot = Fcdr (*annot);
  5690     }
  5691   return 1;
  5692 }
  5693 
  5694 /* Maximum number of characters that the next
  5695    function encodes per one loop iteration.  */
  5696 
  5697 enum { E_WRITE_MAX = 8 * 1024 * 1024 };
  5698 
  5699 /* Write text in the range START and END into descriptor DESC,
  5700    encoding them with coding system CODING.  If STRING is nil, START
  5701    and END are character positions of the current buffer, else they
  5702    are indexes to the string STRING.  Return true if successful.  */
  5703 
  5704 static bool
  5705 e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
  5706          struct coding_system *coding)
  5707 {
  5708   if (STRINGP (string))
  5709     {
  5710       start = 0;
  5711       end = SCHARS (string);
  5712     }
  5713 
  5714   /* We used to have a code for handling selective display here.  But,
  5715      now it is handled within encode_coding.  */
  5716 
  5717   while (start < end)
  5718     {
  5719       if (STRINGP (string))
  5720         {
  5721           coding->src_multibyte = SCHARS (string) < SBYTES (string);
  5722           if (CODING_REQUIRE_ENCODING (coding))
  5723             {
  5724               ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
  5725 
  5726               /* Avoid creating huge Lisp string in encode_coding_object.  */
  5727               if (nchars == E_WRITE_MAX)
  5728                 coding->raw_destination = 1;
  5729 
  5730               encode_coding_object
  5731                 (coding, string, start, string_char_to_byte (string, start),
  5732                  start + nchars, string_char_to_byte (string, start + nchars),
  5733                  Qt);
  5734             }
  5735           else
  5736             {
  5737               coding->dst_object = string;
  5738               coding->consumed_char = SCHARS (string);
  5739               coding->produced = SBYTES (string);
  5740             }
  5741         }
  5742       else
  5743         {
  5744           ptrdiff_t start_byte = CHAR_TO_BYTE (start);
  5745           ptrdiff_t end_byte = CHAR_TO_BYTE (end);
  5746 
  5747           coding->src_multibyte = (end - start) < (end_byte - start_byte);
  5748           if (CODING_REQUIRE_ENCODING (coding))
  5749             {
  5750               ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
  5751 
  5752               /* Likewise.  */
  5753               if (nchars == E_WRITE_MAX)
  5754                 coding->raw_destination = 1;
  5755 
  5756               encode_coding_object
  5757                 (coding, Fcurrent_buffer (), start, start_byte,
  5758                  start + nchars, CHAR_TO_BYTE (start + nchars), Qt);
  5759             }
  5760           else
  5761             {
  5762               coding->dst_object = Qnil;
  5763               coding->dst_pos_byte = start_byte;
  5764               if (start >= GPT || end <= GPT)
  5765                 {
  5766                   coding->consumed_char = end - start;
  5767                   coding->produced = end_byte - start_byte;
  5768                 }
  5769               else
  5770                 {
  5771                   coding->consumed_char = GPT - start;
  5772                   coding->produced = GPT_BYTE - start_byte;
  5773                 }
  5774             }
  5775         }
  5776 
  5777       if (coding->produced > 0)
  5778         {
  5779           char *buf = (coding->raw_destination ? (char *) coding->destination
  5780                        : (STRINGP (coding->dst_object)
  5781                           ? SSDATA (coding->dst_object)
  5782                           : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
  5783           coding->produced -= emacs_write_quit (desc, buf, coding->produced);
  5784 
  5785           if (coding->raw_destination)
  5786             {
  5787               /* We're responsible for freeing this, see
  5788                  encode_coding_object to check why.  */
  5789               xfree (coding->destination);
  5790               coding->raw_destination = 0;
  5791             }
  5792           if (coding->produced)
  5793             return 0;
  5794         }
  5795       start += coding->consumed_char;
  5796     }
  5797 
  5798   return 1;
  5799 }
  5800 
  5801 DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
  5802        Sverify_visited_file_modtime, 0, 1, 0,
  5803        doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
  5804 This means that the file has not been changed since it was visited or saved.
  5805 If BUF is omitted or nil, it defaults to the current buffer.
  5806 See Info node `(elisp)Modification Time' for more details.  */)
  5807   (Lisp_Object buf)
  5808 {
  5809   struct buffer *b = decode_buffer (buf);
  5810   struct stat st;
  5811   Lisp_Object handler;
  5812   Lisp_Object filename;
  5813   struct timespec mtime;
  5814 
  5815   if (!STRINGP (BVAR (b, filename))) return Qt;
  5816   if (b->modtime.tv_nsec == UNKNOWN_MODTIME_NSECS) return Qt;
  5817 
  5818   /* If the file name has special constructs in it,
  5819      call the corresponding file name handler.  */
  5820   handler = Ffind_file_name_handler (BVAR (b, filename),
  5821                                      Qverify_visited_file_modtime);
  5822   if (!NILP (handler))
  5823     return call2 (handler, Qverify_visited_file_modtime, buf);
  5824 
  5825   filename = ENCODE_FILE (BVAR (b, filename));
  5826 
  5827   mtime = (emacs_fstatat (AT_FDCWD, SSDATA (filename), &st, 0) == 0
  5828            ? get_stat_mtime (&st)
  5829            : time_error_value (errno));
  5830   if (timespec_cmp (mtime, b->modtime) == 0
  5831       && (b->modtime_size < 0
  5832           || st.st_size == b->modtime_size))
  5833     return Qt;
  5834   return Qnil;
  5835 }
  5836 
  5837 Lisp_Object
  5838 buffer_visited_file_modtime (struct buffer *buf)
  5839 {
  5840   int ns = buf->modtime.tv_nsec;
  5841   if (ns < 0)
  5842     return make_fixnum (UNKNOWN_MODTIME_NSECS - ns);
  5843   return make_lisp_time (buf->modtime);
  5844 }
  5845 
  5846 DEFUN ("visited-file-modtime", Fvisited_file_modtime,
  5847        Svisited_file_modtime, 0, 0, 0,
  5848        doc: /* Return the current buffer's recorded visited file modification time.
  5849 Return a Lisp timestamp (as in `current-time') if the current buffer
  5850 has a recorded file modification time, 0 if it doesn't, and -1 if the
  5851 visited file doesn't exist.
  5852 See Info node `(elisp)Modification Time' for more details.  */)
  5853   (void)
  5854 {
  5855   return buffer_visited_file_modtime (current_buffer);
  5856 }
  5857 
  5858 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
  5859        Sset_visited_file_modtime, 0, 1, 0,
  5860        doc: /* Update buffer's recorded modification time from the visited file's time.
  5861 Useful if the buffer was not read from the file normally
  5862 or if the file itself has been changed for some known benign reason.
  5863 An argument specifies the modification time value to use
  5864 \(instead of that of the visited file), in the form of a time value as
  5865 in `current-time' or an integer flag as returned by `visited-file-modtime'.  */)
  5866   (Lisp_Object time_flag)
  5867 {
  5868   if (!NILP (time_flag))
  5869     {
  5870       struct timespec mtime;
  5871       if (FIXNUMP (time_flag))
  5872         {
  5873           int flag = check_integer_range (time_flag, -1, 0);
  5874           mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - flag);
  5875         }
  5876       else
  5877         mtime = lisp_time_argument (time_flag);
  5878 
  5879       current_buffer->modtime = mtime;
  5880       current_buffer->modtime_size = -1;
  5881     }
  5882   else if (current_buffer->base_buffer)
  5883     error ("An indirect buffer does not have a visited file");
  5884   else
  5885     {
  5886       register Lisp_Object filename;
  5887       struct stat st;
  5888       Lisp_Object handler;
  5889 
  5890       filename = Fexpand_file_name (BVAR (current_buffer, filename), Qnil);
  5891 
  5892       /* If the file name has special constructs in it,
  5893          call the corresponding file name handler.  */
  5894       handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
  5895       if (!NILP (handler))
  5896         /* The handler can find the file name the same way we did.  */
  5897         return call2 (handler, Qset_visited_file_modtime, Qnil);
  5898 
  5899       if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (filename)), &st, 0)
  5900           == 0)
  5901         {
  5902           current_buffer->modtime = get_stat_mtime (&st);
  5903           current_buffer->modtime_size = st.st_size;
  5904         }
  5905       else
  5906         file_attribute_errno (filename, errno);
  5907     }
  5908 
  5909   return Qnil;
  5910 }
  5911 
  5912 static Lisp_Object
  5913 auto_save_error (Lisp_Object error_val)
  5914 {
  5915   auto_save_error_occurred = 1;
  5916 
  5917   ring_bell (XFRAME (selected_frame));
  5918 
  5919   AUTO_STRING (format, "Auto-saving %s: %s");
  5920   Lisp_Object msg = CALLN (Fformat, format, BVAR (current_buffer, name),
  5921                            Ferror_message_string (error_val));
  5922   call3 (intern ("display-warning"),
  5923          intern ("auto-save"), msg, intern (":error"));
  5924 
  5925   return Qnil;
  5926 }
  5927 
  5928 static Lisp_Object
  5929 auto_save_1 (void)
  5930 {
  5931   struct stat st;
  5932   Lisp_Object modes;
  5933 
  5934   auto_save_mode_bits = 0666;
  5935 
  5936   /* Get visited file's mode to become the auto save file's mode.  */
  5937   if (! NILP (BVAR (current_buffer, filename)))
  5938     {
  5939       if (emacs_fstatat (AT_FDCWD, SSDATA (BVAR (current_buffer, filename)),
  5940                          &st, 0)
  5941           == 0)
  5942         /* But make sure we can overwrite it later!  */
  5943         auto_save_mode_bits = (st.st_mode | 0600) & 0777;
  5944       else if (modes = Ffile_modes (BVAR (current_buffer, filename), Qnil),
  5945                FIXNUMP (modes))
  5946         /* Remote files don't cooperate with fstatat.  */
  5947         auto_save_mode_bits = (XFIXNUM (modes) | 0600) & 0777;
  5948     }
  5949 
  5950   return
  5951     Fwrite_region (Qnil, Qnil, BVAR (current_buffer, auto_save_file_name), Qnil,
  5952                    NILP (Vauto_save_visited_file_name) ? Qlambda : Qt,
  5953                    Qnil, Qnil);
  5954 }
  5955 
  5956 struct auto_save_unwind
  5957 {
  5958   FILE *stream;
  5959   bool auto_raise;
  5960 };
  5961 
  5962 static void
  5963 do_auto_save_unwind (void *arg)
  5964 {
  5965   struct auto_save_unwind *p = arg;
  5966   FILE *stream = p->stream;
  5967   minibuffer_auto_raise = p->auto_raise;
  5968   auto_saving = 0;
  5969   if (stream != NULL)
  5970     {
  5971       block_input ();
  5972       fclose (stream);
  5973       unblock_input ();
  5974     }
  5975 }
  5976 
  5977 static Lisp_Object
  5978 do_auto_save_make_dir (Lisp_Object dir)
  5979 {
  5980   Lisp_Object result;
  5981 
  5982   auto_saving_dir_umask = 077;
  5983   result = call2 (Qmake_directory, dir, Qt);
  5984   auto_saving_dir_umask = 0;
  5985   return result;
  5986 }
  5987 
  5988 static Lisp_Object
  5989 do_auto_save_eh (Lisp_Object ignore)
  5990 {
  5991   auto_saving_dir_umask = 0;
  5992   return Qnil;
  5993 }
  5994 
  5995 DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
  5996        doc: /* Auto-save all buffers that need it.
  5997 This auto-saves all buffers that have auto-saving enabled and
  5998 were changed since last auto-saved.
  5999 
  6000 Auto-saving writes the buffer into a file so that your edits are
  6001 not lost if the system crashes.
  6002 
  6003 The auto-save file is not the file you visited; that changes only
  6004 when you save.
  6005 
  6006 Normally, run the normal hook `auto-save-hook' before saving.
  6007 
  6008 A non-nil NO-MESSAGE argument means do not print any message if successful.
  6009 
  6010 A non-nil CURRENT-ONLY argument means save only current buffer.  */)
  6011   (Lisp_Object no_message, Lisp_Object current_only)
  6012 {
  6013   struct buffer *old = current_buffer, *b;
  6014   Lisp_Object tail, buf, hook;
  6015   bool auto_saved = 0;
  6016   int do_handled_files;
  6017   Lisp_Object oquit;
  6018   FILE *stream = NULL;
  6019   specpdl_ref count = SPECPDL_INDEX ();
  6020   bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
  6021   bool old_message_p = 0;
  6022   struct auto_save_unwind auto_save_unwind;
  6023 
  6024   if (minibuf_level)
  6025     no_message = Qt;
  6026 
  6027   if (NILP (no_message))
  6028     {
  6029       old_message_p = push_message ();
  6030       record_unwind_protect_void (pop_message_unwind);
  6031     }
  6032 
  6033   /* Ordinarily don't quit within this function,
  6034      but don't make it impossible to quit (in case we get hung in I/O).  */
  6035   oquit = Vquit_flag;
  6036   Vquit_flag = Qnil;
  6037 
  6038   hook = intern ("auto-save-hook");
  6039   safe_run_hooks (hook);
  6040 
  6041   if (STRINGP (Vauto_save_list_file_name))
  6042     {
  6043       Lisp_Object listfile;
  6044 
  6045       listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
  6046 
  6047       /* Don't try to create the directory when shutting down Emacs,
  6048          because creating the directory might signal an error, and
  6049          that would leave Emacs in a strange state.  */
  6050       if (!NILP (Vrun_hooks))
  6051         {
  6052           Lisp_Object dir;
  6053           dir = file_name_directory (listfile);
  6054           if (NILP (Ffile_directory_p (dir)))
  6055             internal_condition_case_1 (do_auto_save_make_dir,
  6056                                        dir, Qt,
  6057                                        do_auto_save_eh);
  6058         }
  6059 
  6060       stream = emacs_fopen (SSDATA (listfile), "w");
  6061     }
  6062 
  6063   auto_save_unwind.stream = stream;
  6064   auto_save_unwind.auto_raise = minibuffer_auto_raise;
  6065   record_unwind_protect_ptr (do_auto_save_unwind, &auto_save_unwind);
  6066   minibuffer_auto_raise = 0;
  6067   auto_saving = 1;
  6068   auto_save_error_occurred = 0;
  6069 
  6070   /* On first pass, save all files that don't have handlers.
  6071      On second pass, save all files that do have handlers.
  6072 
  6073      If Emacs is crashing, the handlers may tweak what is causing
  6074      Emacs to crash in the first place, and it would be a shame if
  6075      Emacs failed to autosave perfectly ordinary files because it
  6076      couldn't handle some ange-ftp'd file.  */
  6077 
  6078   for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
  6079     FOR_EACH_LIVE_BUFFER (tail, buf)
  6080       {
  6081         b = XBUFFER (buf);
  6082 
  6083         /* Record all the buffers that have auto save mode
  6084            in the special file that lists them.  For each of these buffers,
  6085            Record visited name (if any) and auto save name.  */
  6086         if (STRINGP (BVAR (b, auto_save_file_name))
  6087             && stream != NULL && do_handled_files == 0)
  6088           {
  6089             block_input ();
  6090             if (!NILP (BVAR (b, filename)))
  6091               fwrite (SDATA (BVAR (b, filename)), 1,
  6092                       SBYTES (BVAR (b, filename)), stream);
  6093             putc ('\n', stream);
  6094             fwrite (SDATA (BVAR (b, auto_save_file_name)), 1,
  6095                     SBYTES (BVAR (b, auto_save_file_name)), stream);
  6096             putc ('\n', stream);
  6097             unblock_input ();
  6098           }
  6099 
  6100         if (!NILP (current_only)
  6101             && b != current_buffer)
  6102           continue;
  6103 
  6104         /* Don't auto-save indirect buffers.
  6105            The base buffer takes care of it.  */
  6106         if (b->base_buffer)
  6107           continue;
  6108 
  6109         /* Check for auto save enabled
  6110            and file changed since last auto save
  6111            and file changed since last real save.  */
  6112         if (STRINGP (BVAR (b, auto_save_file_name))
  6113             && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
  6114             && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b)
  6115             /* -1 means we've turned off autosaving for a while--see below.  */
  6116             && FIXNUMP (BVAR (b, save_length))
  6117             && XFIXNUM (BVAR (b, save_length)) >= 0
  6118             && (do_handled_files
  6119                 || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
  6120                                                   Qwrite_region))))
  6121           {
  6122             struct timespec before_time = current_timespec ();
  6123             struct timespec after_time;
  6124 
  6125             /* If we had a failure, don't try again for 20 minutes.  */
  6126             if (b->auto_save_failure_time > 0
  6127                 && before_time.tv_sec - b->auto_save_failure_time < 1200)
  6128               continue;
  6129 
  6130             enum { growth_factor = 4 };
  6131             verify (BUF_BYTES_MAX <= EMACS_INT_MAX / growth_factor);
  6132 
  6133             set_buffer_internal (b);
  6134             if (NILP (Vauto_save_include_big_deletions)
  6135                 && FIXNUMP (BVAR (b, save_length))
  6136                 /* A short file is likely to change a large fraction;
  6137                    spare the user annoying messages.  */
  6138                 && XFIXNUM (BVAR (b, save_length)) > 5000
  6139                 && (growth_factor * (BUF_Z (b) - BUF_BEG (b))
  6140                     < (growth_factor - 1) * XFIXNUM (BVAR (b, save_length)))
  6141                 /* These messages are frequent and annoying for `*mail*'.  */
  6142                 && !NILP (BVAR (b, filename))
  6143                 && NILP (no_message))
  6144               {
  6145                 /* It has shrunk too much; turn off auto-saving here.  */
  6146                 minibuffer_auto_raise = orig_minibuffer_auto_raise;
  6147                 message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
  6148                                      BVAR (b, name), 1);
  6149                 minibuffer_auto_raise = 0;
  6150                 /* Turn off auto-saving until there's a real save,
  6151                    and prevent any more warnings.  */
  6152                 XSETINT (BVAR (b, save_length), -1);
  6153                 Fsleep_for (make_fixnum (1), Qnil);
  6154                 continue;
  6155               }
  6156             if (!auto_saved && NILP (no_message))
  6157               message1 ("Auto-saving...");
  6158             internal_condition_case (auto_save_1, Qt, auto_save_error);
  6159             auto_saved = 1;
  6160             BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
  6161             XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
  6162             set_buffer_internal (old);
  6163 
  6164             after_time = current_timespec ();
  6165 
  6166             /* If auto-save took more than 60 seconds,
  6167                assume it was an NFS failure that got a timeout.  */
  6168             if (after_time.tv_sec - before_time.tv_sec > 60)
  6169               b->auto_save_failure_time = after_time.tv_sec;
  6170           }
  6171       }
  6172 
  6173   /* Prevent another auto save till enough input events come in.  */
  6174   record_auto_save ();
  6175 
  6176   if (auto_saved && NILP (no_message))
  6177     {
  6178       if (old_message_p)
  6179         {
  6180           /* If we are going to restore an old message,
  6181              give time to read ours.  */
  6182           sit_for (make_fixnum (1), 0, 0);
  6183           restore_message ();
  6184         }
  6185       else if (!auto_save_error_occurred)
  6186         /* Don't overwrite the error message if an error occurred.
  6187            If we displayed a message and then restored a state
  6188            with no message, leave a "done" message on the screen.  */
  6189         message1 ("Auto-saving...done");
  6190     }
  6191 
  6192   Vquit_flag = oquit;
  6193 
  6194   /* This restores the message-stack status.  */
  6195   return unbind_to (count, Qnil);
  6196 }
  6197 
  6198 DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
  6199        Sset_buffer_auto_saved, 0, 0, 0,
  6200        doc: /* Mark current buffer as auto-saved with its current text.
  6201 No auto-save file will be written until the buffer changes again.  */)
  6202   (void)
  6203 {
  6204   /* FIXME: This should not be called in indirect buffers, since
  6205      they're not autosaved.  */
  6206   BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
  6207   XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
  6208   current_buffer->auto_save_failure_time = 0;
  6209   return Qnil;
  6210 }
  6211 
  6212 DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
  6213        Sclear_buffer_auto_save_failure, 0, 0, 0,
  6214        doc: /* Clear any record of a recent auto-save failure in the current buffer.  */)
  6215   (void)
  6216 {
  6217   current_buffer->auto_save_failure_time = 0;
  6218   return Qnil;
  6219 }
  6220 
  6221 DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
  6222        0, 0, 0,
  6223        doc: /* Return t if current buffer has been auto-saved recently.
  6224 More precisely, if it has been auto-saved since last read from or saved
  6225 in the visited file.  If the buffer has no visited file,
  6226 then any auto-save counts as "recent".  */)
  6227   (void)
  6228 {
  6229   /* FIXME: maybe we should return nil for indirect buffers since
  6230      they're never autosaved.  */
  6231   return (SAVE_MODIFF < BUF_AUTOSAVE_MODIFF (current_buffer) ? Qt : Qnil);
  6232 }
  6233 
  6234 /* Reading and completing file names.  */
  6235 
  6236 DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
  6237        Snext_read_file_uses_dialog_p, 0, 0, 0,
  6238        doc: /* Return t if a call to `read-file-name' will use a dialog.
  6239 The return value is only relevant for a call to `read-file-name' that happens
  6240 before any other event (mouse or keypress) is handled.  */)
  6241   (void)
  6242 {
  6243 #if (defined USE_GTK || defined USE_MOTIF \
  6244      || defined HAVE_NS || defined HAVE_NTGUI || defined HAVE_HAIKU)
  6245   if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
  6246       && use_dialog_box
  6247       && use_file_dialog
  6248       && window_system_available (SELECTED_FRAME ()))
  6249     return Qt;
  6250 #endif
  6251   return Qnil;
  6252 }
  6253 
  6254 
  6255 DEFUN ("set-binary-mode", Fset_binary_mode, Sset_binary_mode, 2, 2, 0,
  6256        doc: /* Switch STREAM to binary I/O mode or text I/O mode.
  6257 STREAM can be one of the symbols `stdin', `stdout', or `stderr'.
  6258 If MODE is non-nil, switch STREAM to binary mode, otherwise switch
  6259 it to text mode.
  6260 
  6261 As a side effect, this function flushes any pending STREAM's data.
  6262 
  6263 Value is the previous value of STREAM's I/O mode, nil for text mode,
  6264 non-nil for binary mode.
  6265 
  6266 On MS-Windows and MS-DOS, binary mode is needed to read or write
  6267 arbitrary binary data, and for disabling translation between CR-LF
  6268 pairs and a single newline character.  Examples include generation
  6269 of text files with Unix-style end-of-line format using `princ' in
  6270 batch mode, with standard output redirected to a file.
  6271 
  6272 On Posix systems, this function always returns non-nil, and has no
  6273 effect except for flushing STREAM's data.  */)
  6274   (Lisp_Object stream, Lisp_Object mode)
  6275 {
  6276   FILE *fp = NULL;
  6277   int binmode;
  6278 
  6279   CHECK_SYMBOL (stream);
  6280   if (EQ (stream, Qstdin))
  6281     fp = stdin;
  6282   else if (EQ (stream, Qstdout))
  6283     fp = stdout;
  6284   else if (EQ (stream, Qstderr))
  6285     fp = stderr;
  6286   else
  6287     xsignal2 (Qerror, build_string ("unsupported stream"), stream);
  6288 
  6289   binmode = NILP (mode) ? O_TEXT : O_BINARY;
  6290   if (fp != stdin)
  6291     fflush (fp);
  6292 
  6293   return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil;
  6294 }
  6295 
  6296 #ifndef DOS_NT
  6297 
  6298 /* Yield a Lisp number equal to BLOCKSIZE * BLOCKS, with the result
  6299    negated if NEGATE.  */
  6300 static Lisp_Object
  6301 blocks_to_bytes (uintmax_t blocksize, uintmax_t blocks, bool negate)
  6302 {
  6303   intmax_t n;
  6304   if (!INT_MULTIPLY_WRAPV (blocksize, blocks, &n))
  6305     return make_int (negate ? -n : n);
  6306   Lisp_Object bs = make_uint (blocksize);
  6307   if (negate)
  6308     bs = CALLN (Fminus, bs);
  6309   return CALLN (Ftimes, bs, make_uint (blocks));
  6310 }
  6311 
  6312 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
  6313        doc: /* Return storage information about the file system FILENAME is on.
  6314 Value is a list of numbers (TOTAL FREE AVAIL), where TOTAL is the total
  6315 storage of the file system, FREE is the free storage, and AVAIL is the
  6316 storage available to a non-superuser.  All 3 numbers are in bytes.
  6317 If the underlying system call fails, value is nil.  */)
  6318   (Lisp_Object filename)
  6319 {
  6320   filename = Fexpand_file_name (filename, Qnil);
  6321 
  6322   /* If the file name has special constructs in it,
  6323      call the corresponding file name handler.  */
  6324   Lisp_Object handler = Ffind_file_name_handler (filename, Qfile_system_info);
  6325   if (!NILP (handler))
  6326     {
  6327       Lisp_Object result = call2 (handler, Qfile_system_info, filename);
  6328       if (CONSP (result) || NILP (result))
  6329         return result;
  6330       error ("Invalid handler in `file-name-handler-alist'");
  6331     }
  6332 
  6333   struct fs_usage u;
  6334   if (get_fs_usage (SSDATA (ENCODE_FILE (filename)), NULL, &u) != 0)
  6335     return errno == ENOSYS ? Qnil : file_attribute_errno (filename, errno);
  6336   return list3 (blocks_to_bytes (u.fsu_blocksize, u.fsu_blocks, false),
  6337                 blocks_to_bytes (u.fsu_blocksize, u.fsu_bfree, false),
  6338                 blocks_to_bytes (u.fsu_blocksize, u.fsu_bavail,
  6339                                  u.fsu_bavail_top_bit_set));
  6340 }
  6341 
  6342 #endif /* !DOS_NT */
  6343 
  6344 void
  6345 init_fileio (void)
  6346 {
  6347   realmask = umask (0);
  6348   umask (realmask);
  6349 
  6350   valid_timestamp_file_system = 0;
  6351 
  6352   /* fsync can be a significant performance hit.  Often it doesn't
  6353      suffice to make the file-save operation survive a crash.  For
  6354      batch scripts, which are typically part of larger shell commands
  6355      that don't fsync other files, its effect on performance can be
  6356      significant so its utility is particularly questionable.
  6357      Hence, for now by default fsync is used only when interactive.
  6358 
  6359      For more on why fsync often fails to work on today's hardware, see:
  6360      Zheng M et al. Understanding the robustness of SSDs under power fault.
  6361      11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
  6362      https://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
  6363 
  6364      For more on why fsync does not suffice even if it works properly, see:
  6365      Roche X. Necessary step(s) to synchronize filename operations on disk.
  6366      Austin Group Defect 672, 2013-03-19
  6367      https://austingroupbugs.net/view.php?id=672  */
  6368   write_region_inhibit_fsync = noninteractive;
  6369 }
  6370 
  6371 void
  6372 syms_of_fileio (void)
  6373 {
  6374   /* Property name of a file name handler,
  6375      which gives a list of operations it handles.  */
  6376   DEFSYM (Qoperations, "operations");
  6377 
  6378   DEFSYM (Qexpand_file_name, "expand-file-name");
  6379   DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name");
  6380   DEFSYM (Qdirectory_file_name, "directory-file-name");
  6381   DEFSYM (Qfile_name_directory, "file-name-directory");
  6382   DEFSYM (Qfile_name_nondirectory, "file-name-nondirectory");
  6383   DEFSYM (Qunhandled_file_name_directory, "unhandled-file-name-directory");
  6384   DEFSYM (Qfile_name_as_directory, "file-name-as-directory");
  6385   DEFSYM (Qcopy_file, "copy-file");
  6386   DEFSYM (Qmake_directory_internal, "make-directory-internal");
  6387   DEFSYM (Qmake_directory, "make-directory");
  6388   DEFSYM (Qdelete_file, "delete-file");
  6389   DEFSYM (Qfile_name_case_insensitive_p, "file-name-case-insensitive-p");
  6390   DEFSYM (Qrename_file, "rename-file");
  6391   DEFSYM (Qadd_name_to_file, "add-name-to-file");
  6392   DEFSYM (Qmake_symbolic_link, "make-symbolic-link");
  6393   DEFSYM (Qfile_exists_p, "file-exists-p");
  6394   DEFSYM (Qfile_executable_p, "file-executable-p");
  6395   DEFSYM (Qfile_readable_p, "file-readable-p");
  6396   DEFSYM (Qfile_writable_p, "file-writable-p");
  6397   DEFSYM (Qfile_symlink_p, "file-symlink-p");
  6398   DEFSYM (Qaccess_file, "access-file");
  6399   DEFSYM (Qfile_directory_p, "file-directory-p");
  6400   DEFSYM (Qfile_regular_p, "file-regular-p");
  6401   DEFSYM (Qfile_accessible_directory_p, "file-accessible-directory-p");
  6402   DEFSYM (Qfile_modes, "file-modes");
  6403   DEFSYM (Qset_file_modes, "set-file-modes");
  6404   DEFSYM (Qset_file_times, "set-file-times");
  6405   DEFSYM (Qfile_selinux_context, "file-selinux-context");
  6406   DEFSYM (Qset_file_selinux_context, "set-file-selinux-context");
  6407   DEFSYM (Qfile_acl, "file-acl");
  6408   DEFSYM (Qset_file_acl, "set-file-acl");
  6409   DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
  6410   DEFSYM (Qinsert_file_contents, "insert-file-contents");
  6411   DEFSYM (Qwrite_region, "write-region");
  6412   DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
  6413   DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
  6414   DEFSYM (Qfile_system_info, "file-system-info");
  6415 
  6416   /* The symbol bound to coding-system-for-read when
  6417      insert-file-contents is called for recovering a file.  This is not
  6418      an actual coding system name, but just an indicator to tell
  6419      insert-file-contents to use `emacs-mule' with a special flag for
  6420      auto saving and recovering a file.  */
  6421   DEFSYM (Qauto_save_coding, "auto-save-coding");
  6422 
  6423   DEFSYM (Qfile_name_history, "file-name-history");
  6424   Fset (Qfile_name_history, Qnil);
  6425 
  6426   DEFSYM (Qfile_error, "file-error");
  6427   DEFSYM (Qfile_already_exists, "file-already-exists");
  6428   DEFSYM (Qfile_date_error, "file-date-error");
  6429   DEFSYM (Qfile_missing, "file-missing");
  6430   DEFSYM (Qpermission_denied, "permission-denied");
  6431   DEFSYM (Qfile_offset, "file-offset");
  6432   DEFSYM (Qfile_notify_error, "file-notify-error");
  6433   DEFSYM (Qremote_file_error, "remote-file-error");
  6434   DEFSYM (Qexcl, "excl");
  6435   DEFSYM (Qinserted_chars, "inserted-chars");
  6436 
  6437   DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
  6438                doc: /* Coding system for encoding file names.
  6439 If it is nil, `default-file-name-coding-system' (which see) is used.
  6440 
  6441 On MS-Windows, the value of this variable is largely ignored if
  6442 `w32-unicode-filenames' (which see) is non-nil.  Emacs on Windows
  6443 behaves as if file names were encoded in `utf-8'.  */);
  6444   Vfile_name_coding_system = Qnil;
  6445 
  6446   DEFVAR_LISP ("default-file-name-coding-system",
  6447                Vdefault_file_name_coding_system,
  6448                doc: /* Default coding system for encoding file names.
  6449 This variable is used only when `file-name-coding-system' is nil.
  6450 
  6451 This variable is set/changed by the command `set-language-environment'.
  6452 User should not set this variable manually,
  6453 instead use `file-name-coding-system' to get a constant encoding
  6454 of file names regardless of the current language environment.
  6455 
  6456 On MS-Windows, the value of this variable is largely ignored if
  6457 `w32-unicode-filenames' (which see) is non-nil.  Emacs on Windows
  6458 behaves as if file names were encoded in `utf-8'.  */);
  6459   Vdefault_file_name_coding_system = Qnil;
  6460 
  6461   /* Lisp functions for translating file formats.  */
  6462   DEFSYM (Qformat_decode, "format-decode");
  6463   DEFSYM (Qformat_annotate_function, "format-annotate-function");
  6464 
  6465   /* Lisp function for setting buffer-file-coding-system and the
  6466      multibyteness of the current buffer after inserting a file.  */
  6467   DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding");
  6468 
  6469   DEFSYM (Qcar_less_than_car, "car-less-than-car");
  6470 
  6471   Fput (Qfile_error, Qerror_conditions,
  6472         Fpurecopy (list2 (Qfile_error, Qerror)));
  6473   Fput (Qfile_error, Qerror_message,
  6474         build_pure_c_string ("File error"));
  6475 
  6476   Fput (Qfile_already_exists, Qerror_conditions,
  6477         Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
  6478   Fput (Qfile_already_exists, Qerror_message,
  6479         build_pure_c_string ("File already exists"));
  6480 
  6481   Fput (Qfile_date_error, Qerror_conditions,
  6482         Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
  6483   Fput (Qfile_date_error, Qerror_message,
  6484         build_pure_c_string ("Cannot set file date"));
  6485 
  6486   Fput (Qfile_missing, Qerror_conditions,
  6487         Fpurecopy (list3 (Qfile_missing, Qfile_error, Qerror)));
  6488   Fput (Qfile_missing, Qerror_message,
  6489         build_pure_c_string ("File is missing"));
  6490 
  6491   Fput (Qpermission_denied, Qerror_conditions,
  6492         Fpurecopy (list3 (Qpermission_denied, Qfile_error, Qerror)));
  6493   Fput (Qpermission_denied, Qerror_message,
  6494         build_pure_c_string ("Cannot access file or directory"));
  6495 
  6496   Fput (Qfile_notify_error, Qerror_conditions,
  6497         Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
  6498   Fput (Qfile_notify_error, Qerror_message,
  6499         build_pure_c_string ("File notification error"));
  6500 
  6501   Fput (Qremote_file_error, Qerror_conditions,
  6502         Fpurecopy (list3 (Qremote_file_error, Qfile_error, Qerror)));
  6503   Fput (Qremote_file_error, Qerror_message,
  6504         build_pure_c_string ("Remote file error"));
  6505 
  6506   DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
  6507                doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
  6508 If a file name matches REGEXP, all I/O on that file is done by calling
  6509 HANDLER.  If a file name matches more than one handler, the handler
  6510 whose match starts last in the file name gets precedence.  The
  6511 function `find-file-name-handler' checks this list for a handler for
  6512 its argument.
  6513 
  6514 HANDLER should be a function.  The first argument given to it is the
  6515 name of the I/O primitive to be handled; the remaining arguments are
  6516 the arguments that were passed to that primitive.  For example, if you
  6517 do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
  6518 HANDLER is called like this:
  6519 
  6520   (funcall HANDLER \\='file-exists-p FILENAME)
  6521 
  6522 Note that HANDLER must be able to handle all I/O primitives; if it has
  6523 nothing special to do for a primitive, it should reinvoke the
  6524 primitive to handle the operation \"the usual way\".
  6525 See Info node `(elisp)Magic File Names' for more details.  */);
  6526   Vfile_name_handler_alist = Qnil;
  6527 
  6528   DEFVAR_LISP ("set-auto-coding-function",
  6529                Vset_auto_coding_function,
  6530                doc: /* If non-nil, a function to call to decide a coding system of file.
  6531 Two arguments are passed to this function: the file name
  6532 and the length of a file contents following the point.
  6533 This function should return a coding system to decode the file contents.
  6534 It should check the file name against `auto-coding-alist'.
  6535 If no coding system is decided, it should check a coding system
  6536 specified in the heading lines with the format:
  6537         -*- ... coding: CODING-SYSTEM; ... -*-
  6538 or local variable spec of the tailing lines with `coding:' tag.  */);
  6539   Vset_auto_coding_function = Qnil;
  6540 
  6541   DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions,
  6542                doc: /* A list of functions to be called at the end of `insert-file-contents'.
  6543 Each is passed one argument, the number of characters inserted,
  6544 with point at the start of the inserted text.  Each function
  6545 should leave point the same, and return the new character count.
  6546 If `insert-file-contents' is intercepted by a handler from
  6547 `file-name-handler-alist', that handler is responsible for calling the
  6548 functions in `after-insert-file-functions' if appropriate.  */);
  6549   Vafter_insert_file_functions = Qnil;
  6550 
  6551   DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions,
  6552                doc: /* A list of functions to be called at the start of `write-region'.
  6553 Each is passed two arguments, START and END as for `write-region'.
  6554 These are usually two numbers but not always; see the documentation
  6555 for `write-region'.  The function should return a list of pairs
  6556 of the form (POSITION . STRING), consisting of strings to be effectively
  6557 inserted at the specified positions of the file being written (1 means to
  6558 insert before the first byte written).  The POSITIONs must be sorted into
  6559 increasing order.
  6560 
  6561 If there are several annotation functions, the lists returned by these
  6562 functions are merged destructively.  As each annotation function runs,
  6563 the variable `write-region-annotations-so-far' contains a list of all
  6564 annotations returned by previous annotation functions.
  6565 
  6566 An annotation function can return with a different buffer current.
  6567 Doing so removes the annotations returned by previous functions, and
  6568 resets START and END to `point-min' and `point-max' of the new buffer.
  6569 
  6570 After `write-region' completes, Emacs calls the function stored in
  6571 `write-region-post-annotation-function', once for each buffer that was
  6572 current when building the annotations (i.e., at least once), with that
  6573 buffer current.  */);
  6574   Vwrite_region_annotate_functions = Qnil;
  6575   DEFSYM (Qwrite_region_annotate_functions, "write-region-annotate-functions");
  6576 
  6577   DEFVAR_LISP ("write-region-post-annotation-function",
  6578                Vwrite_region_post_annotation_function,
  6579                doc: /* Function to call after `write-region' completes.
  6580 The function is called with no arguments.  If one or more of the
  6581 annotation functions in `write-region-annotate-functions' changed the
  6582 current buffer, the function stored in this variable is called for
  6583 each of those additional buffers as well, in addition to the original
  6584 buffer.  The relevant buffer is current during each function call.  */);
  6585   Vwrite_region_post_annotation_function = Qnil;
  6586   staticpro (&Vwrite_region_annotation_buffers);
  6587 
  6588   DEFVAR_LISP ("write-region-annotations-so-far",
  6589                Vwrite_region_annotations_so_far,
  6590                doc: /* When an annotation function is called, this holds the previous annotations.
  6591 These are the annotations made by other annotation functions
  6592 that were already called.  See also `write-region-annotate-functions'.  */);
  6593   Vwrite_region_annotations_so_far = Qnil;
  6594 
  6595   DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers,
  6596                doc: /* A list of file name handlers that temporarily should not be used.
  6597 This applies only to the operation `inhibit-file-name-operation'.  */);
  6598   Vinhibit_file_name_handlers = Qnil;
  6599 
  6600   DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation,
  6601                doc: /* The operation for which `inhibit-file-name-handlers' is applicable.  */);
  6602   Vinhibit_file_name_operation = Qnil;
  6603 
  6604   DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name,
  6605                doc: /* File name in which to write a list of all auto save file names.
  6606 This variable is initialized automatically from `auto-save-list-file-prefix'
  6607 shortly after Emacs reads your init file, if you have not yet given it
  6608 a non-nil value.  */);
  6609   Vauto_save_list_file_name = Qnil;
  6610 
  6611   DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name,
  6612                doc: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
  6613 Normally auto-save files are written under other names.  */);
  6614   Vauto_save_visited_file_name = Qnil;
  6615 
  6616   DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions,
  6617                doc: /* If non-nil, auto-save even if a large part of the text is deleted.
  6618 If nil, deleting a substantial portion of the text disables auto-save
  6619 in the buffer; this is the default behavior, because the auto-save
  6620 file is usually more useful if it contains the deleted text.  */);
  6621   Vauto_save_include_big_deletions = Qnil;
  6622 
  6623   DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync,
  6624                doc: /* Non-nil means don't call fsync in `write-region'.
  6625 This variable affects calls to `write-region' as well as save commands.
  6626 Setting this to nil may avoid data loss if the system loses power or
  6627 the operating system crashes.  By default, it is non-nil in batch mode.  */);
  6628   write_region_inhibit_fsync = 0; /* See also `init_fileio' above.  */
  6629 
  6630   DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash,
  6631                doc: /* Specifies whether to use the system's trash can.
  6632 When non-nil, certain file deletion commands use the function
  6633 `move-file-to-trash' instead of deleting files outright.
  6634 This includes interactive calls to `delete-file' and
  6635 `delete-directory' and the Dired deletion commands.  */);
  6636   delete_by_moving_to_trash = 0;
  6637   DEFSYM (Qdelete_by_moving_to_trash, "delete-by-moving-to-trash");
  6638 
  6639   /* Lisp function for moving files to trash.  */
  6640   DEFSYM (Qmove_file_to_trash, "move-file-to-trash");
  6641 
  6642   /* Lisp function for recursively copying directories.  */
  6643   DEFSYM (Qcopy_directory, "copy-directory");
  6644 
  6645   /* Lisp function for recursively deleting directories.  */
  6646   DEFSYM (Qdelete_directory, "delete-directory");
  6647 
  6648   DEFSYM (Qsubstitute_env_in_file_name, "substitute-env-in-file-name");
  6649   DEFSYM (Qget_buffer_window_list, "get-buffer-window-list");
  6650 
  6651   DEFSYM (Qstdin, "stdin");
  6652   DEFSYM (Qstdout, "stdout");
  6653   DEFSYM (Qstderr, "stderr");
  6654 
  6655   defsubr (&Sfind_file_name_handler);
  6656   defsubr (&Sfile_name_directory);
  6657   defsubr (&Sfile_name_nondirectory);
  6658   defsubr (&Sunhandled_file_name_directory);
  6659   defsubr (&Sfile_name_as_directory);
  6660   defsubr (&Sdirectory_name_p);
  6661   defsubr (&Sdirectory_file_name);
  6662   defsubr (&Smake_temp_file_internal);
  6663   defsubr (&Smake_temp_name);
  6664   defsubr (&Sfile_name_concat);
  6665   defsubr (&Sexpand_file_name);
  6666   defsubr (&Ssubstitute_in_file_name);
  6667   defsubr (&Scopy_file);
  6668   defsubr (&Smake_directory_internal);
  6669   defsubr (&Sdelete_directory_internal);
  6670   defsubr (&Sdelete_file);
  6671   defsubr (&Sfile_name_case_insensitive_p);
  6672   defsubr (&Srename_file);
  6673   defsubr (&Sadd_name_to_file);
  6674   defsubr (&Smake_symbolic_link);
  6675   defsubr (&Sfile_name_absolute_p);
  6676   defsubr (&Sfile_exists_p);
  6677   defsubr (&Sfile_executable_p);
  6678   defsubr (&Sfile_readable_p);
  6679   defsubr (&Sfile_writable_p);
  6680   defsubr (&Saccess_file);
  6681   defsubr (&Sfile_symlink_p);
  6682   defsubr (&Sfile_directory_p);
  6683   defsubr (&Sfile_accessible_directory_p);
  6684   defsubr (&Sfile_regular_p);
  6685   defsubr (&Sfile_modes);
  6686   defsubr (&Sset_file_modes);
  6687   defsubr (&Sset_file_times);
  6688   defsubr (&Sfile_selinux_context);
  6689   defsubr (&Sfile_acl);
  6690   defsubr (&Sset_file_acl);
  6691   defsubr (&Sset_file_selinux_context);
  6692   defsubr (&Sset_default_file_modes);
  6693   defsubr (&Sdefault_file_modes);
  6694   defsubr (&Sfile_newer_than_file_p);
  6695   defsubr (&Sinsert_file_contents);
  6696   defsubr (&Swrite_region);
  6697   defsubr (&Scar_less_than_car);
  6698   defsubr (&Sverify_visited_file_modtime);
  6699   defsubr (&Svisited_file_modtime);
  6700   defsubr (&Sset_visited_file_modtime);
  6701   defsubr (&Sdo_auto_save);
  6702   defsubr (&Sset_buffer_auto_saved);
  6703   defsubr (&Sclear_buffer_auto_save_failure);
  6704   defsubr (&Srecent_auto_save_p);
  6705 
  6706   defsubr (&Snext_read_file_uses_dialog_p);
  6707 
  6708   defsubr (&Sset_binary_mode);
  6709 
  6710 #ifndef DOS_NT
  6711   defsubr (&Sfile_system_info);
  6712 #endif
  6713 
  6714 #ifdef HAVE_SYNC
  6715   defsubr (&Sunix_sync);
  6716 #endif
  6717 }