aboutsummaryrefslogtreecommitdiffstats
path: root/src/fileio.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/fileio.c')
-rw-r--r--src/fileio.c934
1 files changed, 598 insertions, 336 deletions
diff --git a/src/fileio.c b/src/fileio.c
index 442c66550d3..d7c476172cb 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1,6 +1,6 @@
1/* File IO for GNU Emacs. 1/* File IO for GNU Emacs.
2 2
3Copyright (C) 1985-1988, 1993-2012 Free Software Foundation, Inc. 3Copyright (C) 1985-1988, 1993-2013 Free Software Foundation, Inc.
4 4
5This file is part of GNU Emacs. 5This file is part of GNU Emacs.
6 6
@@ -36,6 +36,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
36#include <selinux/context.h> 36#include <selinux/context.h>
37#endif 37#endif
38 38
39#ifdef HAVE_POSIX_ACL
40#include <sys/acl.h>
41#endif
42
39#include <c-ctype.h> 43#include <c-ctype.h>
40 44
41#include "lisp.h" 45#include "lisp.h"
@@ -78,6 +82,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
78#endif 82#endif
79 83
80#include "systime.h" 84#include "systime.h"
85#include <allocator.h>
86#include <careadlinkat.h>
81#include <stat-time.h> 87#include <stat-time.h>
82 88
83#ifdef HPUX 89#ifdef HPUX
@@ -99,6 +105,11 @@ static mode_t auto_save_mode_bits;
99/* Set by auto_save_1 if an error occurred during the last auto-save. */ 105/* Set by auto_save_1 if an error occurred during the last auto-save. */
100static bool auto_save_error_occurred; 106static bool auto_save_error_occurred;
101 107
108/* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
109 number of a file system where time stamps were observed to to work. */
110static bool valid_timestamp_file_system;
111static dev_t timestamp_file_system;
112
102/* The symbol bound to coding-system-for-read when 113/* The symbol bound to coding-system-for-read when
103 insert-file-contents is called for recovering a file. This is not 114 insert-file-contents is called for recovering a file. This is not
104 an actual coding system name, but just an indicator to tell 115 an actual coding system name, but just an indicator to tell
@@ -122,9 +133,6 @@ static Lisp_Object Qwrite_region_annotate_functions;
122 is added here. */ 133 is added here. */
123static Lisp_Object Vwrite_region_annotation_buffers; 134static Lisp_Object Vwrite_region_annotation_buffers;
124 135
125#ifdef HAVE_FSYNC
126#endif
127
128static Lisp_Object Qdelete_by_moving_to_trash; 136static Lisp_Object Qdelete_by_moving_to_trash;
129 137
130/* Lisp function for moving files to trash. */ 138/* Lisp function for moving files to trash. */
@@ -236,8 +244,11 @@ static Lisp_Object Qset_file_modes;
236static Lisp_Object Qset_file_times; 244static Lisp_Object Qset_file_times;
237static Lisp_Object Qfile_selinux_context; 245static Lisp_Object Qfile_selinux_context;
238static Lisp_Object Qset_file_selinux_context; 246static Lisp_Object Qset_file_selinux_context;
247static Lisp_Object Qfile_acl;
248static Lisp_Object Qset_file_acl;
239static Lisp_Object Qfile_newer_than_file_p; 249static Lisp_Object Qfile_newer_than_file_p;
240Lisp_Object Qinsert_file_contents; 250Lisp_Object Qinsert_file_contents;
251static Lisp_Object Qchoose_write_coding_system;
241Lisp_Object Qwrite_region; 252Lisp_Object Qwrite_region;
242static Lisp_Object Qverify_visited_file_modtime; 253static Lisp_Object Qverify_visited_file_modtime;
243static Lisp_Object Qset_visited_file_modtime; 254static Lisp_Object Qset_visited_file_modtime;
@@ -369,16 +380,35 @@ Given a Unix syntax file name, returns a string ending in slash. */)
369 380
370 if (getdefdir (c_toupper (*beg) - 'A' + 1, r)) 381 if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
371 { 382 {
372 if (!IS_DIRECTORY_SEP (res[strlen (res) - 1])) 383 size_t l = strlen (res);
384
385 if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
373 strcat (res, "/"); 386 strcat (res, "/");
374 beg = res; 387 beg = res;
375 p = beg + strlen (beg); 388 p = beg + strlen (beg);
389 dostounix_filename (beg, 0);
390 tem_fn = make_specified_string (beg, -1, p - beg,
391 STRING_MULTIBYTE (filename));
376 } 392 }
393 else
394 tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
395 STRING_MULTIBYTE (filename));
396 }
397 else if (STRING_MULTIBYTE (filename))
398 {
399 tem_fn = make_specified_string (beg, -1, p - beg, 1);
400 dostounix_filename (SSDATA (tem_fn), 1);
401#ifdef WINDOWSNT
402 if (!NILP (Vw32_downcase_file_names))
403 tem_fn = Fdowncase (tem_fn);
404#endif
377 } 405 }
378 tem_fn = ENCODE_FILE (make_specified_string (beg, -1, p - beg, 406 else
379 STRING_MULTIBYTE (filename))); 407 {
380 dostounix_filename (SSDATA (tem_fn)); 408 dostounix_filename (beg, 0);
381 return DECODE_FILE (tem_fn); 409 tem_fn = make_specified_string (beg, -1, p - beg, 0);
410 }
411 return tem_fn;
382#else /* DOS_NT */ 412#else /* DOS_NT */
383 return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename)); 413 return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
384#endif /* DOS_NT */ 414#endif /* DOS_NT */
@@ -453,12 +483,14 @@ get a current directory to run processes in. */)
453 return Ffile_name_directory (filename); 483 return Ffile_name_directory (filename);
454} 484}
455 485
456/* Convert from file name SRC of length SRCLEN to directory name 486/* Convert from file name SRC of length SRCLEN to directory name in
457 in DST. On UNIX, just make sure there is a terminating /. 487 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
458 Return the length of DST. */ 488 string. On UNIX, just make sure there is a terminating /. Return
489 the length of DST in bytes. */
459 490
460static ptrdiff_t 491static ptrdiff_t
461file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen) 492file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
493 bool multibyte)
462{ 494{
463 if (srclen == 0) 495 if (srclen == 0)
464 { 496 {
@@ -477,7 +509,7 @@ file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen)
477 srclen++; 509 srclen++;
478 } 510 }
479#ifdef DOS_NT 511#ifdef DOS_NT
480 dostounix_filename (dst); 512 dostounix_filename (dst, multibyte);
481#endif 513#endif
482 return srclen; 514 return srclen;
483} 515}
@@ -512,17 +544,23 @@ For a Unix-syntax file name, just appends a slash. */)
512 error ("Invalid handler in `file-name-handler-alist'"); 544 error ("Invalid handler in `file-name-handler-alist'");
513 } 545 }
514 546
547#ifdef WINDOWSNT
548 if (!NILP (Vw32_downcase_file_names))
549 file = Fdowncase (file);
550#endif
515 buf = alloca (SBYTES (file) + 10); 551 buf = alloca (SBYTES (file) + 10);
516 length = file_name_as_directory (buf, SSDATA (file), SBYTES (file)); 552 length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
553 STRING_MULTIBYTE (file));
517 return make_specified_string (buf, -1, length, STRING_MULTIBYTE (file)); 554 return make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
518} 555}
519 556
520/* Convert from directory name SRC of length SRCLEN to 557/* Convert from directory name SRC of length SRCLEN to file name in
521 file name in DST. On UNIX, just make sure there isn't 558 DST. MULTIBYTE non-zero means the file name in SRC is a multibyte
522 a terminating /. Return the length of DST. */ 559 string. On UNIX, just make sure there isn't a terminating /.
560 Return the length of DST in bytes. */
523 561
524static ptrdiff_t 562static ptrdiff_t
525directory_file_name (char *dst, char *src, ptrdiff_t srclen) 563directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
526{ 564{
527 /* Process as Unix format: just remove any final slash. 565 /* Process as Unix format: just remove any final slash.
528 But leave "/" unchanged; do not change it to "". */ 566 But leave "/" unchanged; do not change it to "". */
@@ -538,7 +576,7 @@ directory_file_name (char *dst, char *src, ptrdiff_t srclen)
538 srclen--; 576 srclen--;
539 } 577 }
540#ifdef DOS_NT 578#ifdef DOS_NT
541 dostounix_filename (dst); 579 dostounix_filename (dst, multibyte);
542#endif 580#endif
543 return srclen; 581 return srclen;
544} 582}
@@ -573,8 +611,13 @@ In Unix-syntax, this function just removes the final slash. */)
573 error ("Invalid handler in `file-name-handler-alist'"); 611 error ("Invalid handler in `file-name-handler-alist'");
574 } 612 }
575 613
614#ifdef WINDOWSNT
615 if (!NILP (Vw32_downcase_file_names))
616 directory = Fdowncase (directory);
617#endif
576 buf = alloca (SBYTES (directory) + 20); 618 buf = alloca (SBYTES (directory) + 20);
577 length = directory_file_name (buf, SSDATA (directory), SBYTES (directory)); 619 length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
620 STRING_MULTIBYTE (directory));
578 return make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory)); 621 return make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
579} 622}
580 623
@@ -872,6 +915,11 @@ filesystem tree, not (expand-file-name ".." dirname). */)
872 } 915 }
873 } 916 }
874 917
918#ifdef WINDOWSNT
919 if (!NILP (Vw32_downcase_file_names))
920 default_directory = Fdowncase (default_directory);
921#endif
922
875 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */ 923 /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
876 nm = alloca (SBYTES (name) + 1); 924 nm = alloca (SBYTES (name) + 1);
877 memcpy (nm, SSDATA (name), SBYTES (name) + 1); 925 memcpy (nm, SSDATA (name), SBYTES (name) + 1);
@@ -955,18 +1003,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
955#ifdef DOS_NT 1003#ifdef DOS_NT
956 /* Make sure directories are all separated with /, but 1004 /* Make sure directories are all separated with /, but
957 avoid allocation of a new string when not required. */ 1005 avoid allocation of a new string when not required. */
958 if (multibyte) 1006 dostounix_filename (nm, multibyte);
959 {
960 Lisp_Object tem_name = make_specified_string (nm, -1, strlen (nm),
961 multibyte);
962
963 tem_name = ENCODE_FILE (tem_name);
964 dostounix_filename (SSDATA (tem_name));
965 tem_name = DECODE_FILE (tem_name);
966 memcpy (nm, SSDATA (tem_name), SBYTES (tem_name) + 1);
967 }
968 else
969 dostounix_filename (nm);
970#ifdef WINDOWSNT 1007#ifdef WINDOWSNT
971 if (IS_DIRECTORY_SEP (nm[1])) 1008 if (IS_DIRECTORY_SEP (nm[1]))
972 { 1009 {
@@ -984,6 +1021,10 @@ filesystem tree, not (expand-file-name ".." dirname). */)
984 temp[0] = DRIVE_LETTER (drive); 1021 temp[0] = DRIVE_LETTER (drive);
985 name = concat2 (build_string (temp), name); 1022 name = concat2 (build_string (temp), name);
986 } 1023 }
1024#ifdef WINDOWSNT
1025 if (!NILP (Vw32_downcase_file_names))
1026 name = Fdowncase (name);
1027#endif
987 return name; 1028 return name;
988#else /* not DOS_NT */ 1029#else /* not DOS_NT */
989 if (strcmp (nm, SSDATA (name)) == 0) 1030 if (strcmp (nm, SSDATA (name)) == 0)
@@ -1024,7 +1065,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
1024 /* `egetenv' may return a unibyte string, which will bite us since 1065 /* `egetenv' may return a unibyte string, which will bite us since
1025 we expect the directory to be multibyte. */ 1066 we expect the directory to be multibyte. */
1026 tem = build_string (newdir); 1067 tem = build_string (newdir);
1027 if (!STRING_MULTIBYTE (tem)) 1068 if (multibyte && !STRING_MULTIBYTE (tem))
1028 { 1069 {
1029 hdir = DECODE_FILE (tem); 1070 hdir = DECODE_FILE (tem);
1030 newdir = SSDATA (hdir); 1071 newdir = SSDATA (hdir);
@@ -1042,11 +1083,22 @@ filesystem tree, not (expand-file-name ".." dirname). */)
1042 o [p - nm] = 0; 1083 o [p - nm] = 0;
1043 1084
1044 block_input (); 1085 block_input ();
1045 pw = (struct passwd *) getpwnam (o + 1); 1086 pw = getpwnam (o + 1);
1046 unblock_input (); 1087 unblock_input ();
1047 if (pw) 1088 if (pw)
1048 { 1089 {
1090 Lisp_Object tem;
1091
1049 newdir = pw->pw_dir; 1092 newdir = pw->pw_dir;
1093 /* `getpwnam' may return a unibyte string, which will
1094 bite us since we expect the directory to be
1095 multibyte. */
1096 tem = build_string (newdir);
1097 if (multibyte && !STRING_MULTIBYTE (tem))
1098 {
1099 hdir = DECODE_FILE (tem);
1100 newdir = SSDATA (hdir);
1101 }
1050 nm = p; 1102 nm = p;
1051#ifdef DOS_NT 1103#ifdef DOS_NT
1052 collapse_newdir = 0; 1104 collapse_newdir = 0;
@@ -1070,6 +1122,13 @@ filesystem tree, not (expand-file-name ".." dirname). */)
1070 adir = alloca (MAXPATHLEN + 1); 1122 adir = alloca (MAXPATHLEN + 1);
1071 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir)) 1123 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1072 adir = NULL; 1124 adir = NULL;
1125 else if (multibyte)
1126 {
1127 Lisp_Object tem = build_string (adir);
1128
1129 tem = DECODE_FILE (tem);
1130 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1131 }
1073 } 1132 }
1074 if (!adir) 1133 if (!adir)
1075 { 1134 {
@@ -1128,6 +1187,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
1128 indirectly by prepending newdir to nm if necessary, and using 1187 indirectly by prepending newdir to nm if necessary, and using
1129 cwd (or the wd of newdir's drive) as the new newdir. */ 1188 cwd (or the wd of newdir's drive) as the new newdir. */
1130 char *adir; 1189 char *adir;
1190
1131 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1])) 1191 if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
1132 { 1192 {
1133 drive = (unsigned char) newdir[0]; 1193 drive = (unsigned char) newdir[0];
@@ -1137,7 +1197,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
1137 { 1197 {
1138 ptrdiff_t newlen = strlen (newdir); 1198 ptrdiff_t newlen = strlen (newdir);
1139 char *tmp = alloca (newlen + strlen (nm) + 2); 1199 char *tmp = alloca (newlen + strlen (nm) + 2);
1140 file_name_as_directory (tmp, newdir, newlen); 1200 file_name_as_directory (tmp, newdir, newlen, multibyte);
1141 strcat (tmp, nm); 1201 strcat (tmp, nm);
1142 nm = tmp; 1202 nm = tmp;
1143 } 1203 }
@@ -1145,10 +1205,17 @@ filesystem tree, not (expand-file-name ".." dirname). */)
1145 if (drive) 1205 if (drive)
1146 { 1206 {
1147 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir)) 1207 if (!getdefdir (c_toupper (drive) - 'A' + 1, adir))
1148 newdir = "/"; 1208 strcpy (adir, "/");
1149 } 1209 }
1150 else 1210 else
1151 getcwd (adir, MAXPATHLEN + 1); 1211 getcwd (adir, MAXPATHLEN + 1);
1212 if (multibyte)
1213 {
1214 Lisp_Object tem = build_string (adir);
1215
1216 tem = DECODE_FILE (tem);
1217 memcpy (adir, SSDATA (tem), SBYTES (tem) + 1);
1218 }
1152 newdir = adir; 1219 newdir = adir;
1153 } 1220 }
1154 1221
@@ -1235,7 +1302,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
1235 strcpy (target, newdir); 1302 strcpy (target, newdir);
1236 } 1303 }
1237 else 1304 else
1238 file_name_as_directory (target, newdir, length); 1305 file_name_as_directory (target, newdir, length, multibyte);
1239 } 1306 }
1240 1307
1241 strcat (target, nm); 1308 strcat (target, nm);
@@ -1278,8 +1345,8 @@ filesystem tree, not (expand-file-name ".." dirname). */)
1278#ifdef WINDOWSNT 1345#ifdef WINDOWSNT
1279 char *prev_o = o; 1346 char *prev_o = o;
1280#endif 1347#endif
1281 while (o != target && (--o) && !IS_DIRECTORY_SEP (*o)) 1348 while (o != target && (--o, !IS_DIRECTORY_SEP (*o)))
1282 ; 1349 continue;
1283#ifdef WINDOWSNT 1350#ifdef WINDOWSNT
1284 /* Don't go below server level in UNC filenames. */ 1351 /* Don't go below server level in UNC filenames. */
1285 if (o == target + 1 && IS_DIRECTORY_SEP (*o) 1352 if (o == target + 1 && IS_DIRECTORY_SEP (*o)
@@ -1321,9 +1388,11 @@ filesystem tree, not (expand-file-name ".." dirname). */)
1321 target[1] = ':'; 1388 target[1] = ':';
1322 } 1389 }
1323 result = make_specified_string (target, -1, o - target, multibyte); 1390 result = make_specified_string (target, -1, o - target, multibyte);
1324 result = ENCODE_FILE (result); 1391 dostounix_filename (SSDATA (result), multibyte);
1325 dostounix_filename (SSDATA (result)); 1392#ifdef WINDOWSNT
1326 result = DECODE_FILE (result); 1393 if (!NILP (Vw32_downcase_file_names))
1394 result = Fdowncase (result);
1395#endif
1327#else /* !DOS_NT */ 1396#else /* !DOS_NT */
1328 result = make_specified_string (target, -1, o - target, multibyte); 1397 result = make_specified_string (target, -1, o - target, multibyte);
1329#endif /* !DOS_NT */ 1398#endif /* !DOS_NT */
@@ -1576,7 +1645,7 @@ those `/' is discarded. */)
1576{ 1645{
1577 char *nm, *s, *p, *o, *x, *endp; 1646 char *nm, *s, *p, *o, *x, *endp;
1578 char *target = NULL; 1647 char *target = NULL;
1579 int total = 0; 1648 ptrdiff_t total = 0;
1580 bool substituted = 0; 1649 bool substituted = 0;
1581 bool multibyte; 1650 bool multibyte;
1582 char *xnm; 1651 char *xnm;
@@ -1605,18 +1674,8 @@ those `/' is discarded. */)
1605 memcpy (nm, SDATA (filename), SBYTES (filename) + 1); 1674 memcpy (nm, SDATA (filename), SBYTES (filename) + 1);
1606 1675
1607#ifdef DOS_NT 1676#ifdef DOS_NT
1608 { 1677 dostounix_filename (nm, multibyte);
1609 Lisp_Object encoded_filename = ENCODE_FILE (filename); 1678 substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
1610 Lisp_Object tem_fn;
1611
1612 dostounix_filename (SDATA (encoded_filename));
1613 tem_fn = DECODE_FILE (encoded_filename);
1614 nm = alloca (SBYTES (tem_fn) + 1);
1615 memcpy (nm, SDATA (tem_fn), SBYTES (tem_fn) + 1);
1616 substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
1617 if (substituted)
1618 filename = tem_fn;
1619 }
1620#endif 1679#endif
1621 endp = nm + SBYTES (filename); 1680 endp = nm + SBYTES (filename);
1622 1681
@@ -1651,8 +1710,9 @@ those `/' is discarded. */)
1651 else if (*p == '{') 1710 else if (*p == '{')
1652 { 1711 {
1653 o = ++p; 1712 o = ++p;
1654 while (p != endp && *p != '}') p++; 1713 p = memchr (p, '}', endp - p);
1655 if (*p != '}') goto missingclose; 1714 if (! p)
1715 goto missingclose;
1656 s = p; 1716 s = p;
1657 } 1717 }
1658 else 1718 else
@@ -1690,7 +1750,13 @@ those `/' is discarded. */)
1690 } 1750 }
1691 1751
1692 if (!substituted) 1752 if (!substituted)
1693 return filename; 1753 {
1754#ifdef WINDOWSNT
1755 if (!NILP (Vw32_downcase_file_names))
1756 filename = Fdowncase (filename);
1757#endif
1758 return filename;
1759 }
1694 1760
1695 /* If substitution required, recopy the string and do it. */ 1761 /* If substitution required, recopy the string and do it. */
1696 /* Make space in stack frame for the new copy. */ 1762 /* Make space in stack frame for the new copy. */
@@ -1714,8 +1780,9 @@ those `/' is discarded. */)
1714 else if (*p == '{') 1780 else if (*p == '{')
1715 { 1781 {
1716 o = ++p; 1782 o = ++p;
1717 while (p != endp && *p != '}') p++; 1783 p = memchr (p, '}', endp - p);
1718 if (*p != '}') goto missingclose; 1784 if (! p)
1785 goto missingclose;
1719 s = p++; 1786 s = p++;
1720 } 1787 }
1721 else 1788 else
@@ -1729,9 +1796,6 @@ those `/' is discarded. */)
1729 target = alloca (s - o + 1); 1796 target = alloca (s - o + 1);
1730 memcpy (target, o, s - o); 1797 memcpy (target, o, s - o);
1731 target[s - o] = 0; 1798 target[s - o] = 0;
1732#ifdef DOS_NT
1733 strupr (target); /* $home == $HOME etc. */
1734#endif /* DOS_NT */
1735 1799
1736 /* Get variable value. */ 1800 /* Get variable value. */
1737 o = egetenv (target); 1801 o = egetenv (target);
@@ -1768,6 +1832,16 @@ those `/' is discarded. */)
1768 need to quote some $ to $$ first. */ 1832 need to quote some $ to $$ first. */
1769 xnm = p; 1833 xnm = p;
1770 1834
1835#ifdef WINDOWSNT
1836 if (!NILP (Vw32_downcase_file_names))
1837 {
1838 Lisp_Object xname = make_specified_string (xnm, -1, x - xnm, multibyte);
1839
1840 xname = Fdowncase (xname);
1841 return xname;
1842 }
1843 else
1844#endif
1771 return make_specified_string (xnm, -1, x - xnm, multibyte); 1845 return make_specified_string (xnm, -1, x - xnm, multibyte);
1772 1846
1773 badsubst: 1847 badsubst:
@@ -1776,9 +1850,6 @@ those `/' is discarded. */)
1776 error ("Missing \"}\" in environment-variable substitution"); 1850 error ("Missing \"}\" in environment-variable substitution");
1777 badvar: 1851 badvar:
1778 error ("Substituting nonexistent environment variable \"%s\"", target); 1852 error ("Substituting nonexistent environment variable \"%s\"", target);
1779
1780 /* NOTREACHED */
1781 return Qnil;
1782} 1853}
1783 1854
1784/* A slightly faster and more convenient way to get 1855/* A slightly faster and more convenient way to get
@@ -1881,9 +1952,10 @@ A prefix arg makes KEEP-TIME non-nil.
1881If PRESERVE-UID-GID is non-nil, we try to transfer the 1952If PRESERVE-UID-GID is non-nil, we try to transfer the
1882uid and gid of FILE to NEWNAME. 1953uid and gid of FILE to NEWNAME.
1883 1954
1884If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled 1955If PRESERVE-EXTENDED-ATTRIBUTES is non-nil, we try to copy additional
1885on the system, we copy the SELinux context of FILE to NEWNAME. */) 1956attributes of FILE to NEWNAME, such as its SELinux context and ACL
1886 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists, Lisp_Object keep_time, Lisp_Object preserve_uid_gid, Lisp_Object preserve_selinux_context) 1957entries (depending on how Emacs was built). */)
1958 (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists, Lisp_Object keep_time, Lisp_Object preserve_uid_gid, Lisp_Object preserve_extended_attributes)
1887{ 1959{
1888 int ifd, ofd; 1960 int ifd, ofd;
1889 int n; 1961 int n;
@@ -1892,12 +1964,14 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
1892 Lisp_Object handler; 1964 Lisp_Object handler;
1893 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 1965 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1894 ptrdiff_t count = SPECPDL_INDEX (); 1966 ptrdiff_t count = SPECPDL_INDEX ();
1895 bool input_file_statable_p;
1896 Lisp_Object encoded_file, encoded_newname; 1967 Lisp_Object encoded_file, encoded_newname;
1897#if HAVE_LIBSELINUX 1968#if HAVE_LIBSELINUX
1898 security_context_t con; 1969 security_context_t con;
1899 int conlength = 0; 1970 int conlength = 0;
1900#endif 1971#endif
1972#ifdef HAVE_POSIX_ACL
1973 acl_t acl = NULL;
1974#endif
1901 1975
1902 encoded_file = encoded_newname = Qnil; 1976 encoded_file = encoded_newname = Qnil;
1903 GCPRO4 (file, newname, encoded_file, encoded_newname); 1977 GCPRO4 (file, newname, encoded_file, encoded_newname);
@@ -1920,7 +1994,7 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
1920 if (!NILP (handler)) 1994 if (!NILP (handler))
1921 RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname, 1995 RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname,
1922 ok_if_already_exists, keep_time, preserve_uid_gid, 1996 ok_if_already_exists, keep_time, preserve_uid_gid,
1923 preserve_selinux_context)); 1997 preserve_extended_attributes));
1924 1998
1925 encoded_file = ENCODE_FILE (file); 1999 encoded_file = ENCODE_FILE (file);
1926 encoded_newname = ENCODE_FILE (newname); 2000 encoded_newname = ENCODE_FILE (newname);
@@ -1933,10 +2007,26 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
1933 out_st.st_mode = 0; 2007 out_st.st_mode = 0;
1934 2008
1935#ifdef WINDOWSNT 2009#ifdef WINDOWSNT
2010 if (!NILP (preserve_extended_attributes))
2011 {
2012#ifdef HAVE_POSIX_ACL
2013 acl = acl_get_file (SDATA (encoded_file), ACL_TYPE_ACCESS);
2014 if (acl == NULL && errno != ENOTSUP)
2015 report_file_error ("Getting ACL", Fcons (file, Qnil));
2016#endif
2017 }
1936 if (!CopyFile (SDATA (encoded_file), 2018 if (!CopyFile (SDATA (encoded_file),
1937 SDATA (encoded_newname), 2019 SDATA (encoded_newname),
1938 FALSE)) 2020 FALSE))
1939 report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil))); 2021 {
2022 /* CopyFile doesn't set errno when it fails. By far the most
2023 "popular" reason is that the target is read-only. */
2024 if (GetLastError () == 5)
2025 errno = EACCES;
2026 else
2027 errno = EPERM;
2028 report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));
2029 }
1940 /* CopyFile retains the timestamp by default. */ 2030 /* CopyFile retains the timestamp by default. */
1941 else if (NILP (keep_time)) 2031 else if (NILP (keep_time))
1942 { 2032 {
@@ -1960,6 +2050,17 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
1960 /* Restore original attributes. */ 2050 /* Restore original attributes. */
1961 SetFileAttributes (filename, attributes); 2051 SetFileAttributes (filename, attributes);
1962 } 2052 }
2053#ifdef HAVE_POSIX_ACL
2054 if (acl != NULL)
2055 {
2056 bool fail =
2057 acl_set_file (SDATA (encoded_newname), ACL_TYPE_ACCESS, acl) != 0;
2058 if (fail && errno != ENOTSUP)
2059 report_file_error ("Setting ACL", Fcons (newname, Qnil));
2060
2061 acl_free (acl);
2062 }
2063#endif
1963#else /* not WINDOWSNT */ 2064#else /* not WINDOWSNT */
1964 immediate_quit = 1; 2065 immediate_quit = 1;
1965 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); 2066 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
@@ -1970,19 +2071,27 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
1970 2071
1971 record_unwind_protect (close_file_unwind, make_number (ifd)); 2072 record_unwind_protect (close_file_unwind, make_number (ifd));
1972 2073
1973 /* We can only copy regular files and symbolic links. Other files are not 2074 if (fstat (ifd, &st) != 0)
1974 copyable by us. */ 2075 report_file_error ("Input file status", Fcons (file, Qnil));
1975 input_file_statable_p = (fstat (ifd, &st) >= 0);
1976 2076
1977#if HAVE_LIBSELINUX 2077 if (!NILP (preserve_extended_attributes))
1978 if (!NILP (preserve_selinux_context) && is_selinux_enabled ())
1979 { 2078 {
1980 conlength = fgetfilecon (ifd, &con); 2079#if HAVE_LIBSELINUX
1981 if (conlength == -1) 2080 if (is_selinux_enabled ())
1982 report_file_error ("Doing fgetfilecon", Fcons (file, Qnil)); 2081 {
1983 } 2082 conlength = fgetfilecon (ifd, &con);
2083 if (conlength == -1)
2084 report_file_error ("Doing fgetfilecon", Fcons (file, Qnil));
2085 }
1984#endif 2086#endif
1985 2087
2088#ifdef HAVE_POSIX_ACL
2089 acl = acl_get_fd (ifd);
2090 if (acl == NULL && errno != ENOTSUP)
2091 report_file_error ("Getting ACL", Fcons (file, Qnil));
2092#endif
2093 }
2094
1986 if (out_st.st_mode != 0 2095 if (out_st.st_mode != 0
1987 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) 2096 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
1988 { 2097 {
@@ -1991,16 +2100,12 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
1991 Fcons (file, Fcons (newname, Qnil))); 2100 Fcons (file, Fcons (newname, Qnil)));
1992 } 2101 }
1993 2102
1994 if (input_file_statable_p) 2103 /* We can copy only regular files. */
2104 if (!S_ISREG (st.st_mode))
1995 { 2105 {
1996 if (!(S_ISREG (st.st_mode)) && !(S_ISLNK (st.st_mode))) 2106 /* Get a better looking error message. */
1997 { 2107 errno = S_ISDIR (st.st_mode) ? EISDIR : EINVAL;
1998#if defined (EISDIR) 2108 report_file_error ("Non-regular file", Fcons (file, Qnil));
1999 /* Get a better looking error message. */
2000 errno = EISDIR;
2001#endif /* EISDIR */
2002 report_file_error ("Non-regular file", Fcons (file, Qnil));
2003 }
2004 } 2109 }
2005 2110
2006#ifdef MSDOS 2111#ifdef MSDOS
@@ -2011,13 +2116,8 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
2011 S_IREAD | S_IWRITE); 2116 S_IREAD | S_IWRITE);
2012#else /* not MSDOS */ 2117#else /* not MSDOS */
2013 { 2118 {
2014 mode_t new_mask = 0666; 2119 mode_t new_mask = !NILP (preserve_uid_gid) ? 0600 : 0666;
2015 if (input_file_statable_p) 2120 new_mask &= st.st_mode;
2016 {
2017 if (!NILP (preserve_uid_gid))
2018 new_mask = 0600;
2019 new_mask &= st.st_mode;
2020 }
2021 ofd = emacs_open (SSDATA (encoded_newname), 2121 ofd = emacs_open (SSDATA (encoded_newname),
2022 (O_WRONLY | O_TRUNC | O_CREAT 2122 (O_WRONLY | O_TRUNC | O_CREAT
2023 | (NILP (ok_if_already_exists) ? O_EXCL : 0)), 2123 | (NILP (ok_if_already_exists) ? O_EXCL : 0)),
@@ -2039,25 +2139,24 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
2039#ifndef MSDOS 2139#ifndef MSDOS
2040 /* Preserve the original file modes, and if requested, also its 2140 /* Preserve the original file modes, and if requested, also its
2041 owner and group. */ 2141 owner and group. */
2042 if (input_file_statable_p) 2142 {
2043 { 2143 mode_t mode_mask = 07777;
2044 mode_t mode_mask = 07777; 2144 if (!NILP (preserve_uid_gid))
2045 if (!NILP (preserve_uid_gid)) 2145 {
2046 { 2146 /* Attempt to change owner and group. If that doesn't work
2047 /* Attempt to change owner and group. If that doesn't work 2147 attempt to change just the group, as that is sometimes allowed.
2048 attempt to change just the group, as that is sometimes allowed. 2148 Adjust the mode mask to eliminate setuid or setgid bits
2049 Adjust the mode mask to eliminate setuid or setgid bits 2149 that are inappropriate if the owner and group are wrong. */
2050 that are inappropriate if the owner and group are wrong. */ 2150 if (fchown (ofd, st.st_uid, st.st_gid) != 0)
2051 if (fchown (ofd, st.st_uid, st.st_gid) != 0) 2151 {
2052 { 2152 mode_mask &= ~06000;
2053 mode_mask &= ~06000; 2153 if (fchown (ofd, -1, st.st_gid) == 0)
2054 if (fchown (ofd, -1, st.st_gid) == 0) 2154 mode_mask |= 02000;
2055 mode_mask |= 02000; 2155 }
2056 } 2156 }
2057 } 2157 if (fchmod (ofd, st.st_mode & mode_mask) != 0)
2058 if (fchmod (ofd, st.st_mode & mode_mask) != 0) 2158 report_file_error ("Doing chmod", Fcons (newname, Qnil));
2059 report_file_error ("Doing chmod", Fcons (newname, Qnil)); 2159 }
2060 }
2061#endif /* not MSDOS */ 2160#endif /* not MSDOS */
2062 2161
2063#if HAVE_LIBSELINUX 2162#if HAVE_LIBSELINUX
@@ -2073,16 +2172,24 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
2073 } 2172 }
2074#endif 2173#endif
2075 2174
2076 if (input_file_statable_p) 2175#ifdef HAVE_POSIX_ACL
2176 if (acl != NULL)
2077 { 2177 {
2078 if (!NILP (keep_time)) 2178 bool fail = acl_set_fd (ofd, acl) != 0;
2079 { 2179 if (fail && errno != ENOTSUP)
2080 EMACS_TIME atime = get_stat_atime (&st); 2180 report_file_error ("Setting ACL", Fcons (newname, Qnil));
2081 EMACS_TIME mtime = get_stat_mtime (&st); 2181
2082 if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime)) 2182 acl_free (acl);
2083 xsignal2 (Qfile_date_error, 2183 }
2084 build_string ("Cannot set file date"), newname); 2184#endif
2085 } 2185
2186 if (!NILP (keep_time))
2187 {
2188 EMACS_TIME atime = get_stat_atime (&st);
2189 EMACS_TIME mtime = get_stat_mtime (&st);
2190 if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime))
2191 xsignal2 (Qfile_date_error,
2192 build_string ("Cannot set file date"), newname);
2086 } 2193 }
2087 2194
2088 if (emacs_close (ofd) < 0) 2195 if (emacs_close (ofd) < 0)
@@ -2091,15 +2198,12 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */)
2091 emacs_close (ifd); 2198 emacs_close (ifd);
2092 2199
2093#ifdef MSDOS 2200#ifdef MSDOS
2094 if (input_file_statable_p) 2201 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
2095 { 2202 and if it can't, it tells so. Otherwise, under MSDOS we usually
2096 /* In DJGPP v2.0 and later, fstat usually returns true file mode bits, 2203 get only the READ bit, which will make the copied file read-only,
2097 and if it can't, it tells so. Otherwise, under MSDOS we usually 2204 so it's better not to chmod at all. */
2098 get only the READ bit, which will make the copied file read-only, 2205 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
2099 so it's better not to chmod at all. */ 2206 chmod (SDATA (encoded_newname), st.st_mode & 07777);
2100 if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
2101 chmod (SDATA (encoded_newname), st.st_mode & 07777);
2102 }
2103#endif /* MSDOS */ 2207#endif /* MSDOS */
2104#endif /* not WINDOWSNT */ 2208#endif /* not WINDOWSNT */
2105 2209
@@ -2207,14 +2311,17 @@ internal_delete_file_1 (Lisp_Object ignore)
2207 return Qt; 2311 return Qt;
2208} 2312}
2209 2313
2210/* Delete file FILENAME. 2314/* Delete file FILENAME, returning true if successful.
2211 This ignores `delete-by-moving-to-trash'. */ 2315 This ignores `delete-by-moving-to-trash'. */
2212 2316
2213void 2317bool
2214internal_delete_file (Lisp_Object filename) 2318internal_delete_file (Lisp_Object filename)
2215{ 2319{
2216 internal_condition_case_2 (Fdelete_file, filename, Qnil, 2320 Lisp_Object tem;
2217 Qt, internal_delete_file_1); 2321
2322 tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
2323 Qt, internal_delete_file_1);
2324 return NILP (tem);
2218} 2325}
2219 2326
2220DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, 2327DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
@@ -2635,6 +2742,29 @@ If there is no error, returns nil. */)
2635 return Qnil; 2742 return Qnil;
2636} 2743}
2637 2744
2745/* Relative to directory FD, return the symbolic link value of FILENAME.
2746 On failure, return nil. */
2747Lisp_Object
2748emacs_readlinkat (int fd, char const *filename)
2749{
2750 static struct allocator const emacs_norealloc_allocator =
2751 { xmalloc, NULL, xfree, memory_full };
2752 Lisp_Object val;
2753 char readlink_buf[1024];
2754 char *buf = careadlinkat (fd, filename, readlink_buf, sizeof readlink_buf,
2755 &emacs_norealloc_allocator, readlinkat);
2756 if (!buf)
2757 return Qnil;
2758
2759 val = build_string (buf);
2760 if (buf[0] == '/' && strchr (buf, ':'))
2761 val = concat2 (build_string ("/:"), val);
2762 if (buf != readlink_buf)
2763 xfree (buf);
2764 val = DECODE_FILE (val);
2765 return val;
2766}
2767
2638DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, 2768DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
2639 doc: /* Return non-nil if file FILENAME is the name of a symbolic link. 2769 doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
2640The value is the link target, as a string. 2770The value is the link target, as a string.
@@ -2645,9 +2775,6 @@ points to a nonexistent file. */)
2645 (Lisp_Object filename) 2775 (Lisp_Object filename)
2646{ 2776{
2647 Lisp_Object handler; 2777 Lisp_Object handler;
2648 char *buf;
2649 Lisp_Object val;
2650 char readlink_buf[READLINK_BUFSIZE];
2651 2778
2652 CHECK_STRING (filename); 2779 CHECK_STRING (filename);
2653 filename = Fexpand_file_name (filename, Qnil); 2780 filename = Fexpand_file_name (filename, Qnil);
@@ -2660,17 +2787,7 @@ points to a nonexistent file. */)
2660 2787
2661 filename = ENCODE_FILE (filename); 2788 filename = ENCODE_FILE (filename);
2662 2789
2663 buf = emacs_readlink (SSDATA (filename), readlink_buf); 2790 return emacs_readlinkat (AT_FDCWD, SSDATA (filename));
2664 if (! buf)
2665 return Qnil;
2666
2667 val = build_string (buf);
2668 if (buf[0] == '/' && strchr (buf, ':'))
2669 val = concat2 (build_string ("/:"), val);
2670 if (buf != readlink_buf)
2671 xfree (buf);
2672 val = DECODE_FILE (val);
2673 return val;
2674} 2791}
2675 2792
2676DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0, 2793DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
@@ -2886,8 +3003,10 @@ DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
2886CONTEXT should be a list (USER ROLE TYPE RANGE), where the list 3003CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
2887elements are strings naming the components of a SELinux context. 3004elements are strings naming the components of a SELinux context.
2888 3005
2889This function does nothing if SELinux is disabled, or if Emacs was not 3006Value is t if setting of SELinux context was successful, nil otherwise.
2890compiled with SELinux support. */) 3007
3008This function does nothing and returns nil if SELinux is disabled,
3009or if Emacs was not compiled with SELinux support. */)
2891 (Lisp_Object filename, Lisp_Object context) 3010 (Lisp_Object filename, Lisp_Object context)
2892{ 3011{
2893 Lisp_Object absname; 3012 Lisp_Object absname;
@@ -2953,6 +3072,7 @@ compiled with SELinux support. */)
2953 3072
2954 context_free (parsed_con); 3073 context_free (parsed_con);
2955 freecon (con); 3074 freecon (con);
3075 return fail ? Qnil : Qt;
2956 } 3076 }
2957 else 3077 else
2958 report_file_error ("Doing lgetfilecon", Fcons (absname, Qnil)); 3078 report_file_error ("Doing lgetfilecon", Fcons (absname, Qnil));
@@ -2962,6 +3082,109 @@ compiled with SELinux support. */)
2962 return Qnil; 3082 return Qnil;
2963} 3083}
2964 3084
3085DEFUN ("file-acl", Ffile_acl, Sfile_acl, 1, 1, 0,
3086 doc: /* Return ACL entries of file named FILENAME.
3087The entries are returned in a format suitable for use in `set-file-acl'
3088but is otherwise undocumented and subject to change.
3089Return nil if file does not exist or is not accessible, or if Emacs
3090was unable to determine the ACL entries. */)
3091 (Lisp_Object filename)
3092{
3093 Lisp_Object absname;
3094 Lisp_Object handler;
3095#ifdef HAVE_POSIX_ACL
3096 acl_t acl;
3097 Lisp_Object acl_string;
3098 char *str;
3099#endif
3100
3101 absname = expand_and_dir_to_file (filename,
3102 BVAR (current_buffer, directory));
3103
3104 /* If the file name has special constructs in it,
3105 call the corresponding file handler. */
3106 handler = Ffind_file_name_handler (absname, Qfile_acl);
3107 if (!NILP (handler))
3108 return call2 (handler, Qfile_acl, absname);
3109
3110#ifdef HAVE_POSIX_ACL
3111 absname = ENCODE_FILE (absname);
3112
3113 acl = acl_get_file (SSDATA (absname), ACL_TYPE_ACCESS);
3114 if (acl == NULL)
3115 return Qnil;
3116
3117 str = acl_to_text (acl, NULL);
3118 if (str == NULL)
3119 {
3120 acl_free (acl);
3121 return Qnil;
3122 }
3123
3124 acl_string = build_string (str);
3125 acl_free (str);
3126 acl_free (acl);
3127
3128 return acl_string;
3129#endif
3130
3131 return Qnil;
3132}
3133
3134DEFUN ("set-file-acl", Fset_file_acl, Sset_file_acl,
3135 2, 2, 0,
3136 doc: /* Set ACL of file named FILENAME to ACL-STRING.
3137ACL-STRING should contain the textual representation of the ACL
3138entries in a format suitable for the platform.
3139
3140Value is t if setting of ACL was successful, nil otherwise.
3141
3142Setting ACL for local files requires Emacs to be built with ACL
3143support. */)
3144 (Lisp_Object filename, Lisp_Object acl_string)
3145{
3146 Lisp_Object absname;
3147 Lisp_Object handler;
3148#ifdef HAVE_POSIX_ACL
3149 Lisp_Object encoded_absname;
3150 acl_t acl;
3151 bool fail;
3152#endif
3153
3154 absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
3155
3156 /* If the file name has special constructs in it,
3157 call the corresponding file handler. */
3158 handler = Ffind_file_name_handler (absname, Qset_file_acl);
3159 if (!NILP (handler))
3160 return call3 (handler, Qset_file_acl, absname, acl_string);
3161
3162#ifdef HAVE_POSIX_ACL
3163 if (STRINGP (acl_string))
3164 {
3165 acl = acl_from_text (SSDATA (acl_string));
3166 if (acl == NULL)
3167 {
3168 report_file_error ("Converting ACL", Fcons (absname, Qnil));
3169 return Qnil;
3170 }
3171
3172 encoded_absname = ENCODE_FILE (absname);
3173
3174 fail = (acl_set_file (SSDATA (encoded_absname), ACL_TYPE_ACCESS,
3175 acl)
3176 != 0);
3177 if (fail && errno != ENOTSUP)
3178 report_file_error ("Setting ACL", Fcons (absname, Qnil));
3179
3180 acl_free (acl);
3181 return fail ? Qnil : Qt;
3182 }
3183#endif
3184
3185 return Qnil;
3186}
3187
2965DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, 3188DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
2966 doc: /* Return mode bits of file named FILENAME, as an integer. 3189 doc: /* Return mode bits of file named FILENAME, as an integer.
2967Return nil, if file does not exist or is not accessible. */) 3190Return nil, if file does not exist or is not accessible. */)
@@ -3079,7 +3302,6 @@ Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
3079 return Qnil; 3302 return Qnil;
3080#endif 3303#endif
3081 report_file_error ("Setting file times", Fcons (absname, Qnil)); 3304 report_file_error ("Setting file times", Fcons (absname, Qnil));
3082 return Qnil;
3083 } 3305 }
3084 } 3306 }
3085 3307
@@ -3184,31 +3406,25 @@ decide_coding_unwind (Lisp_Object unwind_data)
3184 return Qnil; 3406 return Qnil;
3185} 3407}
3186 3408
3187 3409/* Read from a non-regular file. STATE is a Lisp_Save_Value
3188/* Used to pass values from insert-file-contents to read_non_regular. */ 3410 object where slot 0 is the file descriptor, slot 1 specifies
3189 3411 an offset to put the read bytes, and slot 2 is the maximum
3190static int non_regular_fd; 3412 amount of bytes to read. Value is the number of bytes read. */
3191static ptrdiff_t non_regular_inserted;
3192static int non_regular_nbytes;
3193
3194
3195/* Read from a non-regular file.
3196 Read non_regular_nbytes bytes max from non_regular_fd.
3197 Non_regular_inserted specifies where to put the read bytes.
3198 Value is the number of bytes read. */
3199 3413
3200static Lisp_Object 3414static Lisp_Object
3201read_non_regular (Lisp_Object ignore) 3415read_non_regular (Lisp_Object state)
3202{ 3416{
3203 int nbytes; 3417 int nbytes;
3204 3418
3205 immediate_quit = 1; 3419 immediate_quit = 1;
3206 QUIT; 3420 QUIT;
3207 nbytes = emacs_read (non_regular_fd, 3421 nbytes = emacs_read (XSAVE_INTEGER (state, 0),
3208 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE 3422 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3209 + non_regular_inserted), 3423 + XSAVE_INTEGER (state, 1)),
3210 non_regular_nbytes); 3424 XSAVE_INTEGER (state, 2));
3211 immediate_quit = 0; 3425 immediate_quit = 0;
3426 /* Fast recycle this object for the likely next call. */
3427 free_misc (state);
3212 return make_number (nbytes); 3428 return make_number (nbytes);
3213} 3429}
3214 3430
@@ -3222,19 +3438,25 @@ read_non_regular_quit (Lisp_Object ignore)
3222 return Qnil; 3438 return Qnil;
3223} 3439}
3224 3440
3225/* Reposition FD to OFFSET, based on WHENCE. This acts like lseek 3441/* Return the file offset that VAL represents, checking for type
3226 except that it also tests for OFFSET being out of lseek's range. */ 3442 errors and overflow. */
3227static off_t 3443static off_t
3228emacs_lseek (int fd, EMACS_INT offset, int whence) 3444file_offset (Lisp_Object val)
3229{ 3445{
3230 /* Use "&" rather than "&&" to suppress a bogus GCC warning; see 3446 if (RANGED_INTEGERP (0, val, TYPE_MAXIMUM (off_t)))
3231 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43772>. */ 3447 return XINT (val);
3232 if (! ((offset >= TYPE_MINIMUM (off_t)) & (offset <= TYPE_MAXIMUM (off_t)))) 3448
3449 if (FLOATP (val))
3233 { 3450 {
3234 errno = EINVAL; 3451 double v = XFLOAT_DATA (val);
3235 return -1; 3452 if (v >= 0
3453 && (sizeof (off_t) < sizeof v
3454 ? v <= TYPE_MAXIMUM (off_t)
3455 : v < TYPE_MAXIMUM (off_t)))
3456 return v;
3236 } 3457 }
3237 return lseek (fd, offset, whence); 3458
3459 wrong_type_argument (intern ("file-offset"), val);
3238} 3460}
3239 3461
3240/* Return a special time value indicating the error number ERRNUM. */ 3462/* Return a special time value indicating the error number ERRNUM. */
@@ -3269,11 +3491,13 @@ the number of characters that replace previous buffer contents.
3269 3491
3270This function does code conversion according to the value of 3492This function does code conversion according to the value of
3271`coding-system-for-read' or `file-coding-system-alist', and sets the 3493`coding-system-for-read' or `file-coding-system-alist', and sets the
3272variable `last-coding-system-used' to the coding system actually used. */) 3494variable `last-coding-system-used' to the coding system actually used.
3495
3496In addition, this function decodes the inserted text from known formats
3497by calling `format-decode', which see. */)
3273 (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace) 3498 (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
3274{ 3499{
3275 struct stat st; 3500 struct stat st;
3276 int file_status;
3277 EMACS_TIME mtime; 3501 EMACS_TIME mtime;
3278 int fd; 3502 int fd;
3279 ptrdiff_t inserted = 0; 3503 ptrdiff_t inserted = 0;
@@ -3290,7 +3514,6 @@ variable `last-coding-system-used' to the coding system actually used. */)
3290 int save_errno = 0; 3514 int save_errno = 0;
3291 char read_buf[READ_BUF_SIZE]; 3515 char read_buf[READ_BUF_SIZE];
3292 struct coding_system coding; 3516 struct coding_system coding;
3293 char buffer[1 << 14];
3294 bool replace_handled = 0; 3517 bool replace_handled = 0;
3295 bool set_coding_system = 0; 3518 bool set_coding_system = 0;
3296 Lisp_Object coding_system; 3519 Lisp_Object coding_system;
@@ -3335,37 +3558,29 @@ variable `last-coding-system-used' to the coding system actually used. */)
3335 orig_filename = filename; 3558 orig_filename = filename;
3336 filename = ENCODE_FILE (filename); 3559 filename = ENCODE_FILE (filename);
3337 3560
3338 fd = -1; 3561 fd = emacs_open (SSDATA (filename), O_RDONLY, 0);
3339 3562 if (fd < 0)
3340#ifdef WINDOWSNT
3341 {
3342 Lisp_Object tem = Vw32_get_true_file_attributes;
3343
3344 /* Tell stat to use expensive method to get accurate info. */
3345 Vw32_get_true_file_attributes = Qt;
3346 file_status = stat (SSDATA (filename), &st);
3347 Vw32_get_true_file_attributes = tem;
3348 }
3349#else
3350 file_status = stat (SSDATA (filename), &st);
3351#endif /* WINDOWSNT */
3352
3353 if (file_status == 0)
3354 mtime = get_stat_mtime (&st);
3355 else
3356 { 3563 {
3357 badopen:
3358 save_errno = errno; 3564 save_errno = errno;
3359 if (NILP (visit)) 3565 if (NILP (visit))
3360 report_file_error ("Opening input file", Fcons (orig_filename, Qnil)); 3566 report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
3361 mtime = time_error_value (save_errno); 3567 mtime = time_error_value (save_errno);
3362 st.st_size = -1; 3568 st.st_size = -1;
3363 how_much = 0;
3364 if (!NILP (Vcoding_system_for_read)) 3569 if (!NILP (Vcoding_system_for_read))
3365 Fset (Qbuffer_file_coding_system, Vcoding_system_for_read); 3570 Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
3366 goto notfound; 3571 goto notfound;
3367 } 3572 }
3368 3573
3574 /* Replacement should preserve point as it preserves markers. */
3575 if (!NILP (replace))
3576 record_unwind_protect (restore_point_unwind, Fpoint_marker ());
3577
3578 record_unwind_protect (close_file_unwind, make_number (fd));
3579
3580 if (fstat (fd, &st) != 0)
3581 report_file_error ("Input file status", Fcons (orig_filename, Qnil));
3582 mtime = get_stat_mtime (&st);
3583
3369 /* This code will need to be changed in order to work on named 3584 /* This code will need to be changed in order to work on named
3370 pipes, and it's probably just not worth it. So we should at 3585 pipes, and it's probably just not worth it. So we should at
3371 least signal an error. */ 3586 least signal an error. */
@@ -3381,17 +3596,6 @@ variable `last-coding-system-used' to the coding system actually used. */)
3381 build_string ("not a regular file"), orig_filename); 3596 build_string ("not a regular file"), orig_filename);
3382 } 3597 }
3383 3598
3384 if (fd < 0)
3385 if ((fd = emacs_open (SSDATA (filename), O_RDONLY, 0)) < 0)
3386 goto badopen;
3387
3388 /* Replacement should preserve point as it preserves markers. */
3389 if (!NILP (replace))
3390 record_unwind_protect (restore_point_unwind, Fpoint_marker ());
3391
3392 record_unwind_protect (close_file_unwind, make_number (fd));
3393
3394
3395 if (!NILP (visit)) 3599 if (!NILP (visit))
3396 { 3600 {
3397 if (!NILP (beg) || !NILP (end)) 3601 if (!NILP (beg) || !NILP (end))
@@ -3401,20 +3605,12 @@ variable `last-coding-system-used' to the coding system actually used. */)
3401 } 3605 }
3402 3606
3403 if (!NILP (beg)) 3607 if (!NILP (beg))
3404 { 3608 beg_offset = file_offset (beg);
3405 if (! RANGED_INTEGERP (0, beg, TYPE_MAXIMUM (off_t)))
3406 wrong_type_argument (intern ("file-offset"), beg);
3407 beg_offset = XFASTINT (beg);
3408 }
3409 else 3609 else
3410 beg_offset = 0; 3610 beg_offset = 0;
3411 3611
3412 if (!NILP (end)) 3612 if (!NILP (end))
3413 { 3613 end_offset = file_offset (end);
3414 if (! RANGED_INTEGERP (0, end, TYPE_MAXIMUM (off_t)))
3415 wrong_type_argument (intern ("file-offset"), end);
3416 end_offset = XFASTINT (end);
3417 }
3418 else 3614 else
3419 { 3615 {
3420 if (not_regular) 3616 if (not_regular)
@@ -3491,12 +3687,14 @@ variable `last-coding-system-used' to the coding system actually used. */)
3491 else 3687 else
3492 { 3688 {
3493 nread = emacs_read (fd, read_buf, 1024); 3689 nread = emacs_read (fd, read_buf, 1024);
3494 if (nread >= 0) 3690 if (nread == 1024)
3495 { 3691 {
3496 if (lseek (fd, st.st_size - (1024 * 3), SEEK_SET) < 0) 3692 int ntail;
3693 if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
3497 report_file_error ("Setting file position", 3694 report_file_error ("Setting file position",
3498 Fcons (orig_filename, Qnil)); 3695 Fcons (orig_filename, Qnil));
3499 nread += emacs_read (fd, read_buf + nread, 1024 * 3); 3696 ntail = emacs_read (fd, read_buf + nread, 1024 * 3);
3697 nread = ntail < 0 ? ntail : nread + ntail;
3500 } 3698 }
3501 } 3699 }
3502 3700
@@ -3617,7 +3815,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
3617 { 3815 {
3618 int nread, bufpos; 3816 int nread, bufpos;
3619 3817
3620 nread = emacs_read (fd, buffer, sizeof buffer); 3818 nread = emacs_read (fd, read_buf, sizeof read_buf);
3621 if (nread < 0) 3819 if (nread < 0)
3622 error ("IO error reading %s: %s", 3820 error ("IO error reading %s: %s",
3623 SSDATA (orig_filename), emacs_strerror (errno)); 3821 SSDATA (orig_filename), emacs_strerror (errno));
@@ -3626,7 +3824,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
3626 3824
3627 if (CODING_REQUIRE_DETECTION (&coding)) 3825 if (CODING_REQUIRE_DETECTION (&coding))
3628 { 3826 {
3629 coding_system = detect_coding_system ((unsigned char *) buffer, 3827 coding_system = detect_coding_system ((unsigned char *) read_buf,
3630 nread, nread, 1, 0, 3828 nread, nread, 1, 0,
3631 coding_system); 3829 coding_system);
3632 setup_coding_system (coding_system, &coding); 3830 setup_coding_system (coding_system, &coding);
@@ -3642,7 +3840,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
3642 3840
3643 bufpos = 0; 3841 bufpos = 0;
3644 while (bufpos < nread && same_at_start < ZV_BYTE 3842 while (bufpos < nread && same_at_start < ZV_BYTE
3645 && FETCH_BYTE (same_at_start) == buffer[bufpos]) 3843 && FETCH_BYTE (same_at_start) == read_buf[bufpos])
3646 same_at_start++, bufpos++; 3844 same_at_start++, bufpos++;
3647 /* If we found a discrepancy, stop the scan. 3845 /* If we found a discrepancy, stop the scan.
3648 Otherwise loop around and scan the next bufferful. */ 3846 Otherwise loop around and scan the next bufferful. */
@@ -3676,7 +3874,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
3676 if (curpos == 0) 3874 if (curpos == 0)
3677 break; 3875 break;
3678 /* How much can we scan in the next step? */ 3876 /* How much can we scan in the next step? */
3679 trial = min (curpos, sizeof buffer); 3877 trial = min (curpos, sizeof read_buf);
3680 if (lseek (fd, curpos - trial, SEEK_SET) < 0) 3878 if (lseek (fd, curpos - trial, SEEK_SET) < 0)
3681 report_file_error ("Setting file position", 3879 report_file_error ("Setting file position",
3682 Fcons (orig_filename, Qnil)); 3880 Fcons (orig_filename, Qnil));
@@ -3684,7 +3882,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
3684 total_read = nread = 0; 3882 total_read = nread = 0;
3685 while (total_read < trial) 3883 while (total_read < trial)
3686 { 3884 {
3687 nread = emacs_read (fd, buffer + total_read, trial - total_read); 3885 nread = emacs_read (fd, read_buf + total_read, trial - total_read);
3688 if (nread < 0) 3886 if (nread < 0)
3689 error ("IO error reading %s: %s", 3887 error ("IO error reading %s: %s",
3690 SDATA (orig_filename), emacs_strerror (errno)); 3888 SDATA (orig_filename), emacs_strerror (errno));
@@ -3700,7 +3898,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
3700 /* Compare with same_at_start to avoid counting some buffer text 3898 /* Compare with same_at_start to avoid counting some buffer text
3701 as matching both at the file's beginning and at the end. */ 3899 as matching both at the file's beginning and at the end. */
3702 while (bufpos > 0 && same_at_end > same_at_start 3900 while (bufpos > 0 && same_at_end > same_at_start
3703 && FETCH_BYTE (same_at_end - 1) == buffer[bufpos - 1]) 3901 && FETCH_BYTE (same_at_end - 1) == read_buf[bufpos - 1])
3704 same_at_end--, bufpos--; 3902 same_at_end--, bufpos--;
3705 3903
3706 /* If we found a discrepancy, stop the scan. 3904 /* If we found a discrepancy, stop the scan.
@@ -3760,7 +3958,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
3760 3958
3761 /* If display currently starts at beginning of line, 3959 /* If display currently starts at beginning of line,
3762 keep it that way. */ 3960 keep it that way. */
3763 if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) 3961 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
3764 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ()); 3962 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
3765 3963
3766 replace_handled = 1; 3964 replace_handled = 1;
@@ -3802,30 +4000,25 @@ variable `last-coding-system-used' to the coding system actually used. */)
3802 report_file_error ("Setting file position", 4000 report_file_error ("Setting file position",
3803 Fcons (orig_filename, Qnil)); 4001 Fcons (orig_filename, Qnil));
3804 4002
3805 total = st.st_size; /* Total bytes in the file. */
3806 how_much = 0; /* Bytes read from file so far. */
3807 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ 4003 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
3808 unprocessed = 0; /* Bytes not processed in previous loop. */ 4004 unprocessed = 0; /* Bytes not processed in previous loop. */
3809 4005
3810 GCPRO1 (conversion_buffer); 4006 GCPRO1 (conversion_buffer);
3811 while (how_much < total) 4007 while (1)
3812 { 4008 {
3813 /* We read one bunch by one (READ_BUF_SIZE bytes) to allow 4009 /* Read at most READ_BUF_SIZE bytes at a time, to allow
3814 quitting while reading a huge while. */ 4010 quitting while reading a huge file. */
3815 /* `try'' is reserved in some compilers (Microsoft C). */
3816 int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
3817 4011
3818 /* Allow quitting out of the actual I/O. */ 4012 /* Allow quitting out of the actual I/O. */
3819 immediate_quit = 1; 4013 immediate_quit = 1;
3820 QUIT; 4014 QUIT;
3821 this = emacs_read (fd, read_buf + unprocessed, trytry); 4015 this = emacs_read (fd, read_buf + unprocessed,
4016 READ_BUF_SIZE - unprocessed);
3822 immediate_quit = 0; 4017 immediate_quit = 0;
3823 4018
3824 if (this <= 0) 4019 if (this <= 0)
3825 break; 4020 break;
3826 4021
3827 how_much += this;
3828
3829 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer), 4022 BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
3830 BUF_Z (XBUFFER (conversion_buffer))); 4023 BUF_Z (XBUFFER (conversion_buffer)));
3831 decode_coding_c_string (&coding, (unsigned char *) read_buf, 4024 decode_coding_c_string (&coding, (unsigned char *) read_buf,
@@ -3842,9 +4035,6 @@ variable `last-coding-system-used' to the coding system actually used. */)
3842 so defer the removal till we reach the `handled' label. */ 4035 so defer the removal till we reach the `handled' label. */
3843 deferred_remove_unwind_protect = 1; 4036 deferred_remove_unwind_protect = 1;
3844 4037
3845 /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
3846 if we couldn't read the file. */
3847
3848 if (this < 0) 4038 if (this < 0)
3849 error ("IO error reading %s: %s", 4039 error ("IO error reading %s: %s",
3850 SDATA (orig_filename), emacs_strerror (errno)); 4040 SDATA (orig_filename), emacs_strerror (errno));
@@ -3918,7 +4108,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
3918 4108
3919 /* If display currently starts at beginning of line, 4109 /* If display currently starts at beginning of line,
3920 keep it that way. */ 4110 keep it that way. */
3921 if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) 4111 if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
3922 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ()); 4112 XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
3923 4113
3924 /* Replace the chars that we need to replace, 4114 /* Replace the chars that we need to replace,
@@ -3981,7 +4171,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
3981 prepare_to_modify_buffer (GPT, GPT, NULL); 4171 prepare_to_modify_buffer (GPT, GPT, NULL);
3982 } 4172 }
3983 4173
3984 move_gap (PT); 4174 move_gap_both (PT, PT_BYTE);
3985 if (GAP_SIZE < total) 4175 if (GAP_SIZE < total)
3986 make_gap (total - GAP_SIZE); 4176 make_gap (total - GAP_SIZE);
3987 4177
@@ -4009,7 +4199,7 @@ variable `last-coding-system-used' to the coding system actually used. */)
4009 while (how_much < total) 4199 while (how_much < total)
4010 { 4200 {
4011 /* try is reserved in some compilers (Microsoft C) */ 4201 /* try is reserved in some compilers (Microsoft C) */
4012 int trytry = min (total - how_much, READ_BUF_SIZE); 4202 ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE);
4013 ptrdiff_t this; 4203 ptrdiff_t this;
4014 4204
4015 if (not_regular) 4205 if (not_regular)
@@ -4019,19 +4209,19 @@ variable `last-coding-system-used' to the coding system actually used. */)
4019 /* Maybe make more room. */ 4209 /* Maybe make more room. */
4020 if (gap_size < trytry) 4210 if (gap_size < trytry)
4021 { 4211 {
4022 make_gap (total - gap_size); 4212 make_gap (trytry - gap_size);
4023 gap_size = GAP_SIZE; 4213 gap_size = GAP_SIZE - inserted;
4024 } 4214 }
4025 4215
4026 /* Read from the file, capturing `quit'. When an 4216 /* Read from the file, capturing `quit'. When an
4027 error occurs, end the loop, and arrange for a quit 4217 error occurs, end the loop, and arrange for a quit
4028 to be signaled after decoding the text we read. */ 4218 to be signaled after decoding the text we read. */
4029 non_regular_fd = fd; 4219 nbytes = internal_condition_case_1
4030 non_regular_inserted = inserted; 4220 (read_non_regular,
4031 non_regular_nbytes = trytry; 4221 make_save_value (SAVE_TYPE_INT_INT_INT, (ptrdiff_t) fd,
4032 nbytes = internal_condition_case_1 (read_non_regular, 4222 inserted, trytry),
4033 Qnil, Qerror, 4223 Qerror, read_non_regular_quit);
4034 read_non_regular_quit); 4224
4035 if (NILP (nbytes)) 4225 if (NILP (nbytes))
4036 { 4226 {
4037 read_quit = 1; 4227 read_quit = 1;
@@ -4073,8 +4263,9 @@ variable `last-coding-system-used' to the coding system actually used. */)
4073 } 4263 }
4074 } 4264 }
4075 4265
4076 /* Now we have read all the file data into the gap. 4266 /* Now we have either read all the file data into the gap,
4077 If it was empty, undo marking the buffer modified. */ 4267 or stop reading on I/O error or quit. If nothing was
4268 read, undo marking the buffer modified. */
4078 4269
4079 if (inserted == 0) 4270 if (inserted == 0)
4080 { 4271 {
@@ -4087,6 +4278,15 @@ variable `last-coding-system-used' to the coding system actually used. */)
4087 else 4278 else
4088 Vdeactivate_mark = Qt; 4279 Vdeactivate_mark = Qt;
4089 4280
4281 emacs_close (fd);
4282
4283 /* Discard the unwind protect for closing the file. */
4284 specpdl_ptr--;
4285
4286 if (how_much < 0)
4287 error ("IO error reading %s: %s",
4288 SDATA (orig_filename), emacs_strerror (errno));
4289
4090 /* Make the text read part of the buffer. */ 4290 /* Make the text read part of the buffer. */
4091 GAP_SIZE -= inserted; 4291 GAP_SIZE -= inserted;
4092 GPT += inserted; 4292 GPT += inserted;
@@ -4100,15 +4300,6 @@ variable `last-coding-system-used' to the coding system actually used. */)
4100 /* Put an anchor to ensure multi-byte form ends at gap. */ 4300 /* Put an anchor to ensure multi-byte form ends at gap. */
4101 *GPT_ADDR = 0; 4301 *GPT_ADDR = 0;
4102 4302
4103 emacs_close (fd);
4104
4105 /* Discard the unwind protect for closing the file. */
4106 specpdl_ptr--;
4107
4108 if (how_much < 0)
4109 error ("IO error reading %s: %s",
4110 SDATA (orig_filename), emacs_strerror (errno));
4111
4112 notfound: 4303 notfound:
4113 4304
4114 if (NILP (coding_system)) 4305 if (NILP (coding_system))
@@ -4400,11 +4591,9 @@ variable `last-coding-system-used' to the coding system actually used. */)
4400 if (read_quit) 4591 if (read_quit)
4401 Fsignal (Qquit, Qnil); 4592 Fsignal (Qquit, Qnil);
4402 4593
4403 /* ??? Retval needs to be dealt with in all cases consistently. */ 4594 /* Retval needs to be dealt with in all cases consistently. */
4404 if (NILP (val)) 4595 if (NILP (val))
4405 val = Fcons (orig_filename, 4596 val = list2 (orig_filename, make_number (inserted));
4406 Fcons (make_number (inserted),
4407 Qnil));
4408 4597
4409 RETURN_UNGCPRO (unbind_to (count, val)); 4598 RETURN_UNGCPRO (unbind_to (count, val));
4410} 4599}
@@ -4420,14 +4609,24 @@ build_annotations_unwind (Lisp_Object arg)
4420 4609
4421/* Decide the coding-system to encode the data with. */ 4610/* Decide the coding-system to encode the data with. */
4422 4611
4423static Lisp_Object 4612DEFUN ("choose-write-coding-system", Fchoose_write_coding_system,
4424choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object filename, 4613 Schoose_write_coding_system, 3, 6, 0,
4425 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, 4614 doc: /* Choose the coding system for writing a file.
4426 struct coding_system *coding) 4615Arguments are as for `write-region'.
4616This function is for internal use only. It may prompt the user. */ )
4617 (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
4618 Lisp_Object append, Lisp_Object visit, Lisp_Object lockname)
4427{ 4619{
4428 Lisp_Object val; 4620 Lisp_Object val;
4429 Lisp_Object eol_parent = Qnil; 4621 Lisp_Object eol_parent = Qnil;
4430 4622
4623 /* Mimic write-region behavior. */
4624 if (NILP (start))
4625 {
4626 XSETFASTINT (start, BEGV);
4627 XSETFASTINT (end, ZV);
4628 }
4629
4431 if (auto_saving 4630 if (auto_saving
4432 && NILP (Fstring_equal (BVAR (current_buffer, filename), 4631 && NILP (Fstring_equal (BVAR (current_buffer, filename),
4433 BVAR (current_buffer, auto_save_file_name)))) 4632 BVAR (current_buffer, auto_save_file_name))))
@@ -4520,10 +4719,6 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file
4520 } 4719 }
4521 4720
4522 val = coding_inherit_eol_type (val, eol_parent); 4721 val = coding_inherit_eol_type (val, eol_parent);
4523 setup_coding_system (val, coding);
4524
4525 if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display)))
4526 coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
4527 return val; 4722 return val;
4528} 4723}
4529 4724
@@ -4538,7 +4733,7 @@ If START is a string, then output that string to the file
4538instead of any buffer contents; END is ignored. 4733instead of any buffer contents; END is ignored.
4539 4734
4540Optional fourth argument APPEND if non-nil means 4735Optional fourth argument APPEND if non-nil means
4541 append to existing file contents (if any). If it is an integer, 4736 append to existing file contents (if any). If it is a number,
4542 seek to that offset in the file before writing. 4737 seek to that offset in the file before writing.
4543Optional fifth argument VISIT, if t or a string, means 4738Optional fifth argument VISIT, if t or a string, means
4544 set the last-save-file-modtime of buffer to this file's modtime 4739 set the last-save-file-modtime of buffer to this file's modtime
@@ -4567,6 +4762,9 @@ This calls `write-region-annotate-functions' at the start, and
4567 (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew) 4762 (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
4568{ 4763{
4569 int desc; 4764 int desc;
4765 int open_flags;
4766 int mode;
4767 off_t offset IF_LINT (= 0);
4570 bool ok; 4768 bool ok;
4571 int save_errno = 0; 4769 int save_errno = 0;
4572 const char *fn; 4770 const char *fn;
@@ -4676,9 +4874,14 @@ This calls `write-region-annotate-functions' at the start, and
4676 We used to make this choice before calling build_annotations, but that 4874 We used to make this choice before calling build_annotations, but that
4677 leads to problems when a write-annotate-function takes care of 4875 leads to problems when a write-annotate-function takes care of
4678 unsavable chars (as was the case with X-Symbol). */ 4876 unsavable chars (as was the case with X-Symbol). */
4679 Vlast_coding_system_used 4877 Vlast_coding_system_used =
4680 = choose_write_coding_system (start, end, filename, 4878 Fchoose_write_coding_system (start, end, filename,
4681 append, visit, lockname, &coding); 4879 append, visit, lockname);
4880
4881 setup_coding_system (Vlast_coding_system_used, &coding);
4882
4883 if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display)))
4884 coding.mode |= CODING_MODE_SELECTIVE_DISPLAY;
4682 4885
4683#ifdef CLASH_DETECTION 4886#ifdef CLASH_DETECTION
4684 if (!auto_saving) 4887 if (!auto_saving)
@@ -4686,27 +4889,20 @@ This calls `write-region-annotate-functions' at the start, and
4686#endif /* CLASH_DETECTION */ 4889#endif /* CLASH_DETECTION */
4687 4890
4688 encoded_filename = ENCODE_FILE (filename); 4891 encoded_filename = ENCODE_FILE (filename);
4689
4690 fn = SSDATA (encoded_filename); 4892 fn = SSDATA (encoded_filename);
4691 desc = -1; 4893 open_flags = O_WRONLY | O_BINARY | O_CREAT;
4692 if (!NILP (append)) 4894 open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
4895 if (NUMBERP (append))
4896 offset = file_offset (append);
4897 else if (!NILP (append))
4898 open_flags |= O_APPEND;
4693#ifdef DOS_NT 4899#ifdef DOS_NT
4694 desc = emacs_open (fn, O_WRONLY | O_BINARY, 0); 4900 mode = S_IREAD | S_IWRITE;
4695#else /* not DOS_NT */ 4901#else
4696 desc = emacs_open (fn, O_WRONLY, 0); 4902 mode = auto_saving ? auto_save_mode_bits : 0666;
4697#endif /* not DOS_NT */ 4903#endif
4698 4904
4699 if (desc < 0 && (NILP (append) || errno == ENOENT)) 4905 desc = emacs_open (fn, open_flags, mode);
4700#ifdef DOS_NT
4701 desc = emacs_open (fn,
4702 O_WRONLY | O_CREAT | O_BINARY
4703 | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC),
4704 S_IREAD | S_IWRITE);
4705#else /* not DOS_NT */
4706 desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT
4707 | (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
4708 auto_saving ? auto_save_mode_bits : 0666);
4709#endif /* not DOS_NT */
4710 4906
4711 if (desc < 0) 4907 if (desc < 0)
4712 { 4908 {
@@ -4721,14 +4917,9 @@ This calls `write-region-annotate-functions' at the start, and
4721 4917
4722 record_unwind_protect (close_file_unwind, make_number (desc)); 4918 record_unwind_protect (close_file_unwind, make_number (desc));
4723 4919
4724 if (!NILP (append) && !NILP (Ffile_regular_p (filename))) 4920 if (NUMBERP (append))
4725 { 4921 {
4726 off_t ret; 4922 off_t ret = lseek (desc, offset, SEEK_SET);
4727
4728 if (NUMBERP (append))
4729 ret = emacs_lseek (desc, XINT (append), SEEK_CUR);
4730 else
4731 ret = lseek (desc, 0, SEEK_END);
4732 if (ret < 0) 4923 if (ret < 0)
4733 { 4924 {
4734#ifdef CLASH_DETECTION 4925#ifdef CLASH_DETECTION
@@ -4769,20 +4960,23 @@ This calls `write-region-annotate-functions' at the start, and
4769 4960
4770 immediate_quit = 0; 4961 immediate_quit = 0;
4771 4962
4772#ifdef HAVE_FSYNC 4963 /* fsync appears to change the modtime on BSD4.2.
4773 /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
4774 Disk full in NFS may be reported here. */ 4964 Disk full in NFS may be reported here. */
4775 /* mib says that closing the file will try to write as fast as NFS can do 4965 /* mib says that closing the file will try to write as fast as NFS can do
4776 it, and that means the fsync here is not crucial for autosave files. */ 4966 it, and that means the fsync here is not crucial for autosave files. */
4777 if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0) 4967 if (!auto_saving && !write_region_inhibit_fsync)
4778 { 4968 {
4779 /* If fsync fails with EINTR, don't treat that as serious. Also 4969 /* Transfer data and metadata to disk, retrying if interrupted. Also,
4780 ignore EINVAL which happens when fsync is not supported on this 4970 ignore EINVAL which happens when fsync is not supported on this
4781 file. */ 4971 file. */
4782 if (errno != EINTR && errno != EINVAL) 4972 while (fsync (desc) != 0)
4783 ok = 0, save_errno = errno; 4973 if (errno != EINTR)
4974 {
4975 if (errno != EINVAL)
4976 ok = 0, save_errno = errno;
4977 break;
4978 }
4784 } 4979 }
4785#endif
4786 4980
4787 modtime = invalid_emacs_time (); 4981 modtime = invalid_emacs_time ();
4788 if (visiting) 4982 if (visiting)
@@ -4800,6 +4994,63 @@ This calls `write-region-annotate-functions' at the start, and
4800 /* Discard the unwind protect for close_file_unwind. */ 4994 /* Discard the unwind protect for close_file_unwind. */
4801 specpdl_ptr = specpdl + count1; 4995 specpdl_ptr = specpdl + count1;
4802 4996
4997 /* Some file systems have a bug where st_mtime is not updated
4998 properly after a write. For example, CIFS might not see the
4999 st_mtime change until after the file is opened again.
5000
5001 Attempt to detect this file system bug, and update MODTIME to the
5002 newer st_mtime if the bug appears to be present. This introduces
5003 a race condition, so to avoid most instances of the race condition
5004 on non-buggy file systems, skip this check if the most recently
5005 encountered non-buggy file system was the current file system.
5006
5007 A race condition can occur if some other process modifies the
5008 file between the fstat above and the fstat below, but the race is
5009 unlikely and a similar race between the last write and the fstat
5010 above cannot possibly be closed anyway. */
5011
5012 if (EMACS_TIME_VALID_P (modtime)
5013 && ! (valid_timestamp_file_system && st.st_dev == timestamp_file_system))
5014 {
5015 int desc1 = emacs_open (fn, O_WRONLY | O_BINARY, 0);
5016 if (desc1 >= 0)
5017 {
5018 struct stat st1;
5019 if (fstat (desc1, &st1) == 0
5020 && st.st_dev == st1.st_dev && st.st_ino == st1.st_ino)
5021 {
5022 /* Use the heuristic if it appears to be valid. With neither
5023 O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
5024 file, the time stamp won't change. Also, some non-POSIX
5025 systems don't update an empty file's time stamp when
5026 truncating it. Finally, file systems with 100 ns or worse
5027 resolution sometimes seem to have bugs: on a system with ns
5028 resolution, checking ns % 100 incorrectly avoids the heuristic
5029 1% of the time, but the problem should be temporary as we will
5030 try again on the next time stamp. */
5031 bool use_heuristic
5032 = ((open_flags & (O_EXCL | O_TRUNC)) != 0
5033 && st.st_size != 0
5034 && EMACS_NSECS (modtime) % 100 != 0);
5035
5036 EMACS_TIME modtime1 = get_stat_mtime (&st1);
5037 if (use_heuristic
5038 && EMACS_TIME_EQ (modtime, modtime1)
5039 && st.st_size == st1.st_size)
5040 {
5041 timestamp_file_system = st.st_dev;
5042 valid_timestamp_file_system = 1;
5043 }
5044 else
5045 {
5046 st.st_size = st1.st_size;
5047 modtime = modtime1;
5048 }
5049 }
5050 emacs_close (desc1);
5051 }
5052 }
5053
4803 /* Call write-region-post-annotation-function. */ 5054 /* Call write-region-post-annotation-function. */
4804 while (CONSP (Vwrite_region_annotation_buffers)) 5055 while (CONSP (Vwrite_region_annotation_buffers))
4805 { 5056 {
@@ -4852,7 +5103,7 @@ This calls `write-region-annotate-functions' at the start, and
4852 } 5103 }
4853 5104
4854 if (!auto_saving) 5105 if (!auto_saving)
4855 message_with_string ((INTEGERP (append) 5106 message_with_string ((NUMBERP (append)
4856 ? "Updated %s" 5107 ? "Updated %s"
4857 : ! NILP (append) 5108 : ! NILP (append)
4858 ? "Added to %s" 5109 ? "Added to %s"
@@ -5130,8 +5381,8 @@ See Info node `(elisp)Modification Time' for more details. */)
5130 ? get_stat_mtime (&st) 5381 ? get_stat_mtime (&st)
5131 : time_error_value (errno)); 5382 : time_error_value (errno));
5132 if (EMACS_TIME_EQ (mtime, b->modtime) 5383 if (EMACS_TIME_EQ (mtime, b->modtime)
5133 && (st.st_size == b->modtime_size 5384 && (b->modtime_size < 0
5134 || b->modtime_size < 0)) 5385 || st.st_size == b->modtime_size))
5135 return Qt; 5386 return Qt;
5136 return Qnil; 5387 return Qnil;
5137} 5388}
@@ -5158,7 +5409,14 @@ See Info node `(elisp)Modification Time' for more details. */)
5158 (void) 5409 (void)
5159{ 5410{
5160 if (EMACS_NSECS (current_buffer->modtime) < 0) 5411 if (EMACS_NSECS (current_buffer->modtime) < 0)
5161 return make_number (0); 5412 {
5413 if (EMACS_NSECS (current_buffer->modtime) == NONEXISTENT_MODTIME_NSECS)
5414 {
5415 /* make_lisp_time won't work here if time_t is unsigned. */
5416 return list4i (-1, 65535, 0, 0);
5417 }
5418 return make_number (0);
5419 }
5162 return make_lisp_time (current_buffer->modtime); 5420 return make_lisp_time (current_buffer->modtime);
5163} 5421}
5164 5422
@@ -5208,10 +5466,8 @@ static Lisp_Object
5208auto_save_error (Lisp_Object error_val) 5466auto_save_error (Lisp_Object error_val)
5209{ 5467{
5210 Lisp_Object args[3], msg; 5468 Lisp_Object args[3], msg;
5211 int i, nbytes; 5469 int i;
5212 struct gcpro gcpro1; 5470 struct gcpro gcpro1;
5213 char *msgbuf;
5214 USE_SAFE_ALLOCA;
5215 5471
5216 auto_save_error_occurred = 1; 5472 auto_save_error_occurred = 1;
5217 5473
@@ -5222,20 +5478,16 @@ auto_save_error (Lisp_Object error_val)
5222 args[2] = Ferror_message_string (error_val); 5478 args[2] = Ferror_message_string (error_val);
5223 msg = Fformat (3, args); 5479 msg = Fformat (3, args);
5224 GCPRO1 (msg); 5480 GCPRO1 (msg);
5225 nbytes = SBYTES (msg);
5226 msgbuf = SAFE_ALLOCA (nbytes);
5227 memcpy (msgbuf, SDATA (msg), nbytes);
5228 5481
5229 for (i = 0; i < 3; ++i) 5482 for (i = 0; i < 3; ++i)
5230 { 5483 {
5231 if (i == 0) 5484 if (i == 0)
5232 message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg)); 5485 message3 (msg);
5233 else 5486 else
5234 message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg)); 5487 message3_nolog (msg);
5235 Fsleep_for (make_number (1), Qnil); 5488 Fsleep_for (make_number (1), Qnil);
5236 } 5489 }
5237 5490
5238 SAFE_FREE ();
5239 UNGCPRO; 5491 UNGCPRO;
5240 return Qnil; 5492 return Qnil;
5241} 5493}
@@ -5270,7 +5522,7 @@ static Lisp_Object
5270do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */ 5522do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */
5271 5523
5272{ 5524{
5273 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; 5525 FILE *stream = XSAVE_POINTER (arg, 0);
5274 auto_saving = 0; 5526 auto_saving = 0;
5275 if (stream != NULL) 5527 if (stream != NULL)
5276 { 5528 {
@@ -5380,7 +5632,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
5380 } 5632 }
5381 5633
5382 record_unwind_protect (do_auto_save_unwind, 5634 record_unwind_protect (do_auto_save_unwind,
5383 make_save_value (stream, 0)); 5635 make_save_pointer (stream));
5384 record_unwind_protect (do_auto_save_unwind_1, 5636 record_unwind_protect (do_auto_save_unwind_1,
5385 make_number (minibuffer_auto_raise)); 5637 make_number (minibuffer_auto_raise));
5386 minibuffer_auto_raise = 0; 5638 minibuffer_auto_raise = 0;
@@ -5589,6 +5841,12 @@ Fread_file_name (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filena
5589 5841
5590 5842
5591void 5843void
5844init_fileio (void)
5845{
5846 valid_timestamp_file_system = 0;
5847}
5848
5849void
5592syms_of_fileio (void) 5850syms_of_fileio (void)
5593{ 5851{
5594 DEFSYM (Qoperations, "operations"); 5852 DEFSYM (Qoperations, "operations");
@@ -5621,8 +5879,11 @@ syms_of_fileio (void)
5621 DEFSYM (Qset_file_times, "set-file-times"); 5879 DEFSYM (Qset_file_times, "set-file-times");
5622 DEFSYM (Qfile_selinux_context, "file-selinux-context"); 5880 DEFSYM (Qfile_selinux_context, "file-selinux-context");
5623 DEFSYM (Qset_file_selinux_context, "set-file-selinux-context"); 5881 DEFSYM (Qset_file_selinux_context, "set-file-selinux-context");
5882 DEFSYM (Qfile_acl, "file-acl");
5883 DEFSYM (Qset_file_acl, "set-file-acl");
5624 DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p"); 5884 DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
5625 DEFSYM (Qinsert_file_contents, "insert-file-contents"); 5885 DEFSYM (Qinsert_file_contents, "insert-file-contents");
5886 DEFSYM (Qchoose_write_coding_system, "choose-write-coding-system");
5626 DEFSYM (Qwrite_region, "write-region"); 5887 DEFSYM (Qwrite_region, "write-region");
5627 DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime"); 5888 DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
5628 DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime"); 5889 DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
@@ -5773,7 +6034,7 @@ This applies only to the operation `inhibit-file-name-operation'. */);
5773 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name, 6034 DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name,
5774 doc: /* File name in which we write a list of all auto save file names. 6035 doc: /* File name in which we write a list of all auto save file names.
5775This variable is initialized automatically from `auto-save-list-file-prefix' 6036This variable is initialized automatically from `auto-save-list-file-prefix'
5776shortly after Emacs reads your `.emacs' file, if you have not yet given it 6037shortly after Emacs reads your init file, if you have not yet given it
5777a non-nil value. */); 6038a non-nil value. */);
5778 Vauto_save_list_file_name = Qnil; 6039 Vauto_save_list_file_name = Qnil;
5779 6040
@@ -5789,13 +6050,11 @@ in the buffer; this is the default behavior, because the auto-save
5789file is usually more useful if it contains the deleted text. */); 6050file is usually more useful if it contains the deleted text. */);
5790 Vauto_save_include_big_deletions = Qnil; 6051 Vauto_save_include_big_deletions = Qnil;
5791 6052
5792#ifdef HAVE_FSYNC
5793 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync, 6053 DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync,
5794 doc: /* Non-nil means don't call fsync in `write-region'. 6054 doc: /* Non-nil means don't call fsync in `write-region'.
5795This variable affects calls to `write-region' as well as save commands. 6055This variable affects calls to `write-region' as well as save commands.
5796A non-nil value may result in data loss! */); 6056A non-nil value may result in data loss! */);
5797 write_region_inhibit_fsync = 0; 6057 write_region_inhibit_fsync = 0;
5798#endif
5799 6058
5800 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash, 6059 DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash,
5801 doc: /* Specifies whether to use the system's trash can. 6060 doc: /* Specifies whether to use the system's trash can.
@@ -5840,11 +6099,14 @@ This includes interactive calls to `delete-file' and
5840 defsubr (&Sset_file_modes); 6099 defsubr (&Sset_file_modes);
5841 defsubr (&Sset_file_times); 6100 defsubr (&Sset_file_times);
5842 defsubr (&Sfile_selinux_context); 6101 defsubr (&Sfile_selinux_context);
6102 defsubr (&Sfile_acl);
6103 defsubr (&Sset_file_acl);
5843 defsubr (&Sset_file_selinux_context); 6104 defsubr (&Sset_file_selinux_context);
5844 defsubr (&Sset_default_file_modes); 6105 defsubr (&Sset_default_file_modes);
5845 defsubr (&Sdefault_file_modes); 6106 defsubr (&Sdefault_file_modes);
5846 defsubr (&Sfile_newer_than_file_p); 6107 defsubr (&Sfile_newer_than_file_p);
5847 defsubr (&Sinsert_file_contents); 6108 defsubr (&Sinsert_file_contents);
6109 defsubr (&Schoose_write_coding_system);
5848 defsubr (&Swrite_region); 6110 defsubr (&Swrite_region);
5849 defsubr (&Scar_less_than_car); 6111 defsubr (&Scar_less_than_car);
5850 defsubr (&Sverify_visited_file_modtime); 6112 defsubr (&Sverify_visited_file_modtime);
generated by cgit v1.2.1 (git 2.18.0) at 2026-04-13 01:09:41 +0000