root/src/fileio.c

DEFINITIONS

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