root/src/fileio.c

DEFINITIONS

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