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