aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorRichard Stallman2020-02-06 18:30:47 -0500
committerRichard Stallman2020-02-06 18:30:47 -0500
commitc4be80112556e06bd7e92138e44051cc8c62e709 (patch)
tree2392fb385569e10ad9d4d0ab2a48a1771131bf4e /src
parent53f0de5d7719b43f184ce1a910f14882aedc50bc (diff)
parent15814d0ccd95848a2a0513d93ab718a49b289598 (diff)
downloademacs-c4be80112556e06bd7e92138e44051cc8c62e709.tar.gz
emacs-c4be80112556e06bd7e92138e44051cc8c62e709.zip
Merge
Diffstat (limited to 'src')
-rw-r--r--src/Makefile.in6
-rw-r--r--src/alloc.c319
-rw-r--r--src/bytecode.c8
-rw-r--r--src/callproc.c37
-rw-r--r--src/coding.c2
-rw-r--r--src/data.c66
-rw-r--r--src/deps.mk3
-rw-r--r--src/dired.c4
-rw-r--r--src/dispnew.c21
-rw-r--r--src/editfns.c2
-rw-r--r--src/emacs-module.c66
-rw-r--r--src/emacs-module.h.in14
-rw-r--r--src/emacs.c82
-rw-r--r--src/fileio.c40
-rw-r--r--src/filelock.c3
-rw-r--r--src/fns.c124
-rw-r--r--src/font.c1
-rw-r--r--src/font.h6
-rw-r--r--src/frame.c2
-rw-r--r--src/frame.h5
-rw-r--r--src/ftxfont.c371
-rw-r--r--src/gtkutil.c1
-rw-r--r--src/image.c16
-rw-r--r--src/json.c1
-rw-r--r--src/lisp.h17
-rw-r--r--src/lread.c6
-rw-r--r--src/mini-gmp.c218
-rw-r--r--src/mini-gmp.h8
-rw-r--r--src/minibuf.c8
-rw-r--r--src/module-env-28.h8
-rw-r--r--src/nsfns.m55
-rw-r--r--src/nsterm.h29
-rw-r--r--src/nsterm.m922
-rw-r--r--src/pdumper.c2
-rw-r--r--src/print.c40
-rw-r--r--src/sysdep.c36
-rw-r--r--src/systhread.c62
-rw-r--r--src/systhread.h5
-rw-r--r--src/term.c8
-rw-r--r--src/thread.c10
-rw-r--r--src/thread.h3
-rw-r--r--src/w32.c21
-rw-r--r--src/w32.h1
-rw-r--r--src/w32fns.c3
-rw-r--r--src/w32heap.c10
-rw-r--r--src/w32term.c6
-rw-r--r--src/w32term.h4
-rw-r--r--src/window.c21
-rw-r--r--src/window.h1
-rw-r--r--src/xdisp.c115
-rw-r--r--src/xfns.c8
-rw-r--r--src/xterm.c4
52 files changed, 1453 insertions, 1378 deletions
diff --git a/src/Makefile.in b/src/Makefile.in
index ab63b926272..552dd2e50ae 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -295,8 +295,8 @@ EMACSRES = @EMACSRES@
295W32_RES_LINK=@W32_RES_LINK@ 295W32_RES_LINK=@W32_RES_LINK@
296 296
297## Empty if !HAVE_X_WINDOWS 297## Empty if !HAVE_X_WINDOWS
298## xfont.o ftfont.o xftfont.o ftxfont.o if HAVE_XFT 298## xfont.o ftfont.o xftfont.o if HAVE_XFT
299## xfont.o ftfont.o ftxfont.o if HAVE_FREETYPE 299## xfont.o ftfont.o if HAVE_FREETYPE
300## xfont.o ftfont.o ftcrfont.o if USE_CAIRO 300## xfont.o ftfont.o ftcrfont.o if USE_CAIRO
301## else xfont.o 301## else xfont.o
302## if HAVE_HARFBUZZ, hbfont.o is added regardless of the rest 302## if HAVE_HARFBUZZ, hbfont.o is added regardless of the rest
@@ -436,7 +436,7 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \
436 nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o macfont.o \ 436 nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o macfont.o \
437 w32.o w32console.o w32cygwinx.o w32fns.o w32heap.o w32inevt.o w32notify.o \ 437 w32.o w32console.o w32cygwinx.o w32fns.o w32heap.o w32inevt.o w32notify.o \
438 w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \ 438 w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \
439 w16select.o widget.o xfont.o ftfont.o xftfont.o ftxfont.o gtkutil.o \ 439 w16select.o widget.o xfont.o ftfont.o xftfont.o gtkutil.o \
440 xsettings.o xgselect.o termcap.o hbfont.o 440 xsettings.o xgselect.o termcap.o hbfont.o
441 441
442## gmalloc.o if !SYSTEM_MALLOC && !DOUG_LEA_MALLOC, else empty. 442## gmalloc.o if !SYSTEM_MALLOC && !DOUG_LEA_MALLOC, else empty.
diff --git a/src/alloc.c b/src/alloc.c
index 1c6b664b220..a35b48cfb22 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -104,6 +104,26 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
104#include "w32heap.h" /* for sbrk */ 104#include "w32heap.h" /* for sbrk */
105#endif 105#endif
106 106
107/* MALLOC_SIZE_NEAR (N) is a good number to pass to malloc when
108 allocating a block of memory with size close to N bytes.
109 For best results N should be a power of 2.
110
111 When calculating how much memory to allocate, GNU malloc (SIZE)
112 adds sizeof (size_t) to SIZE for internal overhead, and then rounds
113 up to a multiple of MALLOC_ALIGNMENT. Emacs can improve
114 performance a bit on GNU platforms by arranging for the resulting
115 size to be a power of two. This heuristic is good for glibc 2.0
116 (1997) through at least glibc 2.31 (2020), and does not affect
117 correctness on other platforms. */
118
119#define MALLOC_SIZE_NEAR(n) \
120 (ROUNDUP (max (n, sizeof (size_t)), MALLOC_ALIGNMENT) - sizeof (size_t))
121#ifdef __i386
122enum { MALLOC_ALIGNMENT = 16 };
123#else
124enum { MALLOC_ALIGNMENT = max (2 * sizeof (size_t), alignof (long double)) };
125#endif
126
107#ifdef DOUG_LEA_MALLOC 127#ifdef DOUG_LEA_MALLOC
108 128
109/* Specify maximum number of areas to mmap. It would be nice to use a 129/* Specify maximum number of areas to mmap. It would be nice to use a
@@ -694,7 +714,7 @@ malloc_unblock_input (void)
694 malloc_probe (size); \ 714 malloc_probe (size); \
695 } while (0) 715 } while (0)
696 716
697static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); 717static void *lmalloc (size_t, bool) ATTRIBUTE_MALLOC_SIZE ((1));
698static void *lrealloc (void *, size_t); 718static void *lrealloc (void *, size_t);
699 719
700/* Like malloc but check for no memory and block interrupt input. */ 720/* Like malloc but check for no memory and block interrupt input. */
@@ -705,7 +725,7 @@ xmalloc (size_t size)
705 void *val; 725 void *val;
706 726
707 MALLOC_BLOCK_INPUT; 727 MALLOC_BLOCK_INPUT;
708 val = lmalloc (size); 728 val = lmalloc (size, false);
709 MALLOC_UNBLOCK_INPUT; 729 MALLOC_UNBLOCK_INPUT;
710 730
711 if (!val && size) 731 if (!val && size)
@@ -722,12 +742,11 @@ xzalloc (size_t size)
722 void *val; 742 void *val;
723 743
724 MALLOC_BLOCK_INPUT; 744 MALLOC_BLOCK_INPUT;
725 val = lmalloc (size); 745 val = lmalloc (size, true);
726 MALLOC_UNBLOCK_INPUT; 746 MALLOC_UNBLOCK_INPUT;
727 747
728 if (!val && size) 748 if (!val && size)
729 memory_full (size); 749 memory_full (size);
730 memset (val, 0, size);
731 MALLOC_PROBE (size); 750 MALLOC_PROBE (size);
732 return val; 751 return val;
733} 752}
@@ -743,7 +762,7 @@ xrealloc (void *block, size_t size)
743 /* We must call malloc explicitly when BLOCK is 0, since some 762 /* We must call malloc explicitly when BLOCK is 0, since some
744 reallocs don't do this. */ 763 reallocs don't do this. */
745 if (! block) 764 if (! block)
746 val = lmalloc (size); 765 val = lmalloc (size, false);
747 else 766 else
748 val = lrealloc (block, size); 767 val = lrealloc (block, size);
749 MALLOC_UNBLOCK_INPUT; 768 MALLOC_UNBLOCK_INPUT;
@@ -939,7 +958,7 @@ void *lisp_malloc_loser EXTERNALLY_VISIBLE;
939#endif 958#endif
940 959
941static void * 960static void *
942lisp_malloc (size_t nbytes, enum mem_type type) 961lisp_malloc (size_t nbytes, bool clearit, enum mem_type type)
943{ 962{
944 register void *val; 963 register void *val;
945 964
@@ -949,7 +968,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
949 allocated_mem_type = type; 968 allocated_mem_type = type;
950#endif 969#endif
951 970
952 val = lmalloc (nbytes); 971 val = lmalloc (nbytes, clearit);
953 972
954#if ! USE_LSB_TAG 973#if ! USE_LSB_TAG
955 /* If the memory just allocated cannot be addressed thru a Lisp 974 /* If the memory just allocated cannot be addressed thru a Lisp
@@ -1290,16 +1309,21 @@ laligned (void *p, size_t size)
1290 that's never really exercised) for little benefit. */ 1309 that's never really exercised) for little benefit. */
1291 1310
1292static void * 1311static void *
1293lmalloc (size_t size) 1312lmalloc (size_t size, bool clearit)
1294{ 1313{
1295#ifdef USE_ALIGNED_ALLOC 1314#ifdef USE_ALIGNED_ALLOC
1296 if (! MALLOC_IS_LISP_ALIGNED && size % LISP_ALIGNMENT == 0) 1315 if (! MALLOC_IS_LISP_ALIGNED && size % LISP_ALIGNMENT == 0)
1297 return aligned_alloc (LISP_ALIGNMENT, size); 1316 {
1317 void *p = aligned_alloc (LISP_ALIGNMENT, size);
1318 if (clearit && p)
1319 memclear (p, size);
1320 return p;
1321 }
1298#endif 1322#endif
1299 1323
1300 while (true) 1324 while (true)
1301 { 1325 {
1302 void *p = malloc (size); 1326 void *p = clearit ? calloc (1, size) : malloc (size);
1303 if (laligned (p, size)) 1327 if (laligned (p, size))
1304 return p; 1328 return p;
1305 free (p); 1329 free (p);
@@ -1328,11 +1352,11 @@ lrealloc (void *p, size_t size)
1328 Interval Allocation 1352 Interval Allocation
1329 ***********************************************************************/ 1353 ***********************************************************************/
1330 1354
1331/* Number of intervals allocated in an interval_block structure. 1355/* Number of intervals allocated in an interval_block structure. */
1332 The 1020 is 1024 minus malloc overhead. */
1333 1356
1334#define INTERVAL_BLOCK_SIZE \ 1357enum { INTERVAL_BLOCK_SIZE
1335 ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval)) 1358 = ((MALLOC_SIZE_NEAR (1024) - sizeof (struct interval_block *))
1359 / sizeof (struct interval)) };
1336 1360
1337/* Intervals are allocated in chunks in the form of an interval_block 1361/* Intervals are allocated in chunks in the form of an interval_block
1338 structure. */ 1362 structure. */
@@ -1377,7 +1401,7 @@ make_interval (void)
1377 if (interval_block_index == INTERVAL_BLOCK_SIZE) 1401 if (interval_block_index == INTERVAL_BLOCK_SIZE)
1378 { 1402 {
1379 struct interval_block *newi 1403 struct interval_block *newi
1380 = lisp_malloc (sizeof *newi, MEM_TYPE_NON_LISP); 1404 = lisp_malloc (sizeof *newi, false, MEM_TYPE_NON_LISP);
1381 1405
1382 newi->next = interval_block; 1406 newi->next = interval_block;
1383 interval_block = newi; 1407 interval_block = newi;
@@ -1444,10 +1468,9 @@ mark_interval_tree (INTERVAL i)
1444 longer used, can be easily recognized, and it's easy to compact the 1468 longer used, can be easily recognized, and it's easy to compact the
1445 sblocks of small strings which we do in compact_small_strings. */ 1469 sblocks of small strings which we do in compact_small_strings. */
1446 1470
1447/* Size in bytes of an sblock structure used for small strings. This 1471/* Size in bytes of an sblock structure used for small strings. */
1448 is 8192 minus malloc overhead. */
1449 1472
1450#define SBLOCK_SIZE 8188 1473enum { SBLOCK_SIZE = MALLOC_SIZE_NEAR (8192) };
1451 1474
1452/* Strings larger than this are considered large strings. String data 1475/* Strings larger than this are considered large strings. String data
1453 for large strings is allocated from individual sblocks. */ 1476 for large strings is allocated from individual sblocks. */
@@ -1522,11 +1545,11 @@ struct sblock
1522 sdata data[FLEXIBLE_ARRAY_MEMBER]; 1545 sdata data[FLEXIBLE_ARRAY_MEMBER];
1523}; 1546};
1524 1547
1525/* Number of Lisp strings in a string_block structure. The 1020 is 1548/* Number of Lisp strings in a string_block structure. */
1526 1024 minus malloc overhead. */
1527 1549
1528#define STRING_BLOCK_SIZE \ 1550enum { STRING_BLOCK_SIZE
1529 ((1020 - sizeof (struct string_block *)) / sizeof (struct Lisp_String)) 1551 = ((MALLOC_SIZE_NEAR (1024) - sizeof (struct string_block *))
1552 / sizeof (struct Lisp_String)) };
1530 1553
1531/* Structure describing a block from which Lisp_String structures 1554/* Structure describing a block from which Lisp_String structures
1532 are allocated. */ 1555 are allocated. */
@@ -1730,7 +1753,7 @@ allocate_string (void)
1730 add all the Lisp_Strings in it to the free-list. */ 1753 add all the Lisp_Strings in it to the free-list. */
1731 if (string_free_list == NULL) 1754 if (string_free_list == NULL)
1732 { 1755 {
1733 struct string_block *b = lisp_malloc (sizeof *b, MEM_TYPE_STRING); 1756 struct string_block *b = lisp_malloc (sizeof *b, false, MEM_TYPE_STRING);
1734 int i; 1757 int i;
1735 1758
1736 b->next = string_blocks; 1759 b->next = string_blocks;
@@ -1778,15 +1801,16 @@ allocate_string (void)
1778 plus a NUL byte at the end. Allocate an sdata structure DATA for 1801 plus a NUL byte at the end. Allocate an sdata structure DATA for
1779 S, and set S->u.s.data to SDATA->u.data. Store a NUL byte at the 1802 S, and set S->u.s.data to SDATA->u.data. Store a NUL byte at the
1780 end of S->u.s.data. Set S->u.s.size to NCHARS and S->u.s.size_byte 1803 end of S->u.s.data. Set S->u.s.size to NCHARS and S->u.s.size_byte
1781 to NBYTES. Free S->u.s.data if it was initially non-null. */ 1804 to NBYTES. Free S->u.s.data if it was initially non-null.
1782 1805
1783void 1806 If CLEARIT, also clear the other bytes of S->u.s.data. */
1807
1808static void
1784allocate_string_data (struct Lisp_String *s, 1809allocate_string_data (struct Lisp_String *s,
1785 EMACS_INT nchars, EMACS_INT nbytes) 1810 EMACS_INT nchars, EMACS_INT nbytes, bool clearit)
1786{ 1811{
1787 sdata *data, *old_data; 1812 sdata *data;
1788 struct sblock *b; 1813 struct sblock *b;
1789 ptrdiff_t old_nbytes;
1790 1814
1791 if (STRING_BYTES_MAX < nbytes) 1815 if (STRING_BYTES_MAX < nbytes)
1792 string_overflow (); 1816 string_overflow ();
@@ -1794,13 +1818,6 @@ allocate_string_data (struct Lisp_String *s,
1794 /* Determine the number of bytes needed to store NBYTES bytes 1818 /* Determine the number of bytes needed to store NBYTES bytes
1795 of string data. */ 1819 of string data. */
1796 ptrdiff_t needed = sdata_size (nbytes); 1820 ptrdiff_t needed = sdata_size (nbytes);
1797 if (s->u.s.data)
1798 {
1799 old_data = SDATA_OF_STRING (s);
1800 old_nbytes = STRING_BYTES (s);
1801 }
1802 else
1803 old_data = NULL;
1804 1821
1805 MALLOC_BLOCK_INPUT; 1822 MALLOC_BLOCK_INPUT;
1806 1823
@@ -1813,7 +1830,7 @@ allocate_string_data (struct Lisp_String *s,
1813 mallopt (M_MMAP_MAX, 0); 1830 mallopt (M_MMAP_MAX, 0);
1814#endif 1831#endif
1815 1832
1816 b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP); 1833 b = lisp_malloc (size + GC_STRING_EXTRA, clearit, MEM_TYPE_NON_LISP);
1817 1834
1818#ifdef DOUG_LEA_MALLOC 1835#ifdef DOUG_LEA_MALLOC
1819 if (!mmap_lisp_allowed_p ()) 1836 if (!mmap_lisp_allowed_p ())
@@ -1825,27 +1842,30 @@ allocate_string_data (struct Lisp_String *s,
1825 b->next_free = data; 1842 b->next_free = data;
1826 large_sblocks = b; 1843 large_sblocks = b;
1827 } 1844 }
1828 else if (current_sblock == NULL
1829 || (((char *) current_sblock + SBLOCK_SIZE
1830 - (char *) current_sblock->next_free)
1831 < (needed + GC_STRING_EXTRA)))
1832 {
1833 /* Not enough room in the current sblock. */
1834 b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
1835 data = b->data;
1836 b->next = NULL;
1837 b->next_free = data;
1838
1839 if (current_sblock)
1840 current_sblock->next = b;
1841 else
1842 oldest_sblock = b;
1843 current_sblock = b;
1844 }
1845 else 1845 else
1846 { 1846 {
1847 b = current_sblock; 1847 b = current_sblock;
1848
1849 if (b == NULL
1850 || (SBLOCK_SIZE - GC_STRING_EXTRA
1851 < (char *) b->next_free - (char *) b + needed))
1852 {
1853 /* Not enough room in the current sblock. */
1854 b = lisp_malloc (SBLOCK_SIZE, false, MEM_TYPE_NON_LISP);
1855 data = b->data;
1856 b->next = NULL;
1857 b->next_free = data;
1858
1859 if (current_sblock)
1860 current_sblock->next = b;
1861 else
1862 oldest_sblock = b;
1863 current_sblock = b;
1864 }
1865
1848 data = b->next_free; 1866 data = b->next_free;
1867 if (clearit)
1868 memset (SDATA_DATA (data), 0, nbytes);
1849 } 1869 }
1850 1870
1851 data->string = s; 1871 data->string = s;
@@ -1866,16 +1886,55 @@ allocate_string_data (struct Lisp_String *s,
1866 GC_STRING_OVERRUN_COOKIE_SIZE); 1886 GC_STRING_OVERRUN_COOKIE_SIZE);
1867#endif 1887#endif
1868 1888
1869 /* Note that Faset may call to this function when S has already data 1889 tally_consing (needed);
1870 assigned. In this case, mark data as free by setting it's string 1890}
1871 back-pointer to null, and record the size of the data in it. */ 1891
1872 if (old_data) 1892/* Reallocate multibyte STRING data when a single character is replaced.
1893 The character is at byte offset CIDX_BYTE in the string.
1894 The character being replaced is CLEN bytes long,
1895 and the character that will replace it is NEW_CLEN bytes long.
1896 Return the address of where the caller should store the
1897 the new character. */
1898
1899unsigned char *
1900resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte,
1901 int clen, int new_clen)
1902{
1903 eassume (STRING_MULTIBYTE (string));
1904 sdata *old_sdata = SDATA_OF_STRING (XSTRING (string));
1905 ptrdiff_t nchars = SCHARS (string);
1906 ptrdiff_t nbytes = SBYTES (string);
1907 ptrdiff_t new_nbytes = nbytes + (new_clen - clen);
1908 unsigned char *data = SDATA (string);
1909 unsigned char *new_charaddr;
1910
1911 if (sdata_size (nbytes) == sdata_size (new_nbytes))
1873 { 1912 {
1874 SDATA_NBYTES (old_data) = old_nbytes; 1913 /* No need to reallocate, as the size change falls within the
1875 old_data->string = NULL; 1914 alignment slop. */
1915 XSTRING (string)->u.s.size_byte = new_nbytes;
1916 new_charaddr = data + cidx_byte;
1917 memmove (new_charaddr + new_clen, new_charaddr + clen,
1918 nbytes - (cidx_byte + (clen - 1)));
1919 }
1920 else
1921 {
1922 allocate_string_data (XSTRING (string), nchars, new_nbytes, false);
1923 unsigned char *new_data = SDATA (string);
1924 new_charaddr = new_data + cidx_byte;
1925 memcpy (new_charaddr + new_clen, data + cidx_byte + clen,
1926 nbytes - (cidx_byte + clen));
1927 memcpy (new_data, data, cidx_byte);
1928
1929 /* Mark old string data as free by setting its string back-pointer
1930 to null, and record the size of the data in it. */
1931 SDATA_NBYTES (old_sdata) = nbytes;
1932 old_sdata->string = NULL;
1876 } 1933 }
1877 1934
1878 tally_consing (needed); 1935 clear_string_char_byte_cache ();
1936
1937 return new_charaddr;
1879} 1938}
1880 1939
1881 1940
@@ -2110,6 +2169,9 @@ string_overflow (void)
2110 error ("Maximum string size exceeded"); 2169 error ("Maximum string size exceeded");
2111} 2170}
2112 2171
2172static Lisp_Object make_clear_string (EMACS_INT, bool);
2173static Lisp_Object make_clear_multibyte_string (EMACS_INT, EMACS_INT, bool);
2174
2113DEFUN ("make-string", Fmake_string, Smake_string, 2, 3, 0, 2175DEFUN ("make-string", Fmake_string, Smake_string, 2, 3, 0,
2114 doc: /* Return a newly created string of length LENGTH, with INIT in each element. 2176 doc: /* Return a newly created string of length LENGTH, with INIT in each element.
2115LENGTH must be an integer. 2177LENGTH must be an integer.
@@ -2118,19 +2180,20 @@ If optional argument MULTIBYTE is non-nil, the result will be
2118a multibyte string even if INIT is an ASCII character. */) 2180a multibyte string even if INIT is an ASCII character. */)
2119 (Lisp_Object length, Lisp_Object init, Lisp_Object multibyte) 2181 (Lisp_Object length, Lisp_Object init, Lisp_Object multibyte)
2120{ 2182{
2121 register Lisp_Object val; 2183 Lisp_Object val;
2122 int c;
2123 EMACS_INT nbytes; 2184 EMACS_INT nbytes;
2124 2185
2125 CHECK_FIXNAT (length); 2186 CHECK_FIXNAT (length);
2126 CHECK_CHARACTER (init); 2187 CHECK_CHARACTER (init);
2127 2188
2128 c = XFIXNAT (init); 2189 int c = XFIXNAT (init);
2190 bool clearit = !c;
2191
2129 if (ASCII_CHAR_P (c) && NILP (multibyte)) 2192 if (ASCII_CHAR_P (c) && NILP (multibyte))
2130 { 2193 {
2131 nbytes = XFIXNUM (length); 2194 nbytes = XFIXNUM (length);
2132 val = make_uninit_string (nbytes); 2195 val = make_clear_string (nbytes, clearit);
2133 if (nbytes) 2196 if (nbytes && !clearit)
2134 { 2197 {
2135 memset (SDATA (val), c, nbytes); 2198 memset (SDATA (val), c, nbytes);
2136 SDATA (val)[nbytes] = 0; 2199 SDATA (val)[nbytes] = 0;
@@ -2141,26 +2204,27 @@ a multibyte string even if INIT is an ASCII character. */)
2141 unsigned char str[MAX_MULTIBYTE_LENGTH]; 2204 unsigned char str[MAX_MULTIBYTE_LENGTH];
2142 ptrdiff_t len = CHAR_STRING (c, str); 2205 ptrdiff_t len = CHAR_STRING (c, str);
2143 EMACS_INT string_len = XFIXNUM (length); 2206 EMACS_INT string_len = XFIXNUM (length);
2144 unsigned char *p, *beg, *end;
2145 2207
2146 if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes)) 2208 if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes))
2147 string_overflow (); 2209 string_overflow ();
2148 val = make_uninit_multibyte_string (string_len, nbytes); 2210 val = make_clear_multibyte_string (string_len, nbytes, clearit);
2149 for (beg = SDATA (val), p = beg, end = beg + nbytes; p < end; p += len) 2211 if (!clearit)
2150 { 2212 {
2151 /* First time we just copy `str' to the data of `val'. */ 2213 unsigned char *beg = SDATA (val), *end = beg + nbytes;
2152 if (p == beg) 2214 for (unsigned char *p = beg; p < end; p += len)
2153 memcpy (p, str, len);
2154 else
2155 { 2215 {
2156 /* Next time we copy largest possible chunk from 2216 /* First time we just copy STR to the data of VAL. */
2157 initialized to uninitialized part of `val'. */ 2217 if (p == beg)
2158 len = min (p - beg, end - p); 2218 memcpy (p, str, len);
2159 memcpy (p, beg, len); 2219 else
2220 {
2221 /* Next time we copy largest possible chunk from
2222 initialized to uninitialized part of VAL. */
2223 len = min (p - beg, end - p);
2224 memcpy (p, beg, len);
2225 }
2160 } 2226 }
2161 } 2227 }
2162 if (nbytes)
2163 *p = 0;
2164 } 2228 }
2165 2229
2166 return val; 2230 return val;
@@ -2330,26 +2394,37 @@ make_specified_string (const char *contents,
2330 2394
2331 2395
2332/* Return a unibyte Lisp_String set up to hold LENGTH characters 2396/* Return a unibyte Lisp_String set up to hold LENGTH characters
2333 occupying LENGTH bytes. */ 2397 occupying LENGTH bytes. If CLEARIT, clear its contents to null
2398 bytes; otherwise, the contents are uninitialized. */
2334 2399
2335Lisp_Object 2400static Lisp_Object
2336make_uninit_string (EMACS_INT length) 2401make_clear_string (EMACS_INT length, bool clearit)
2337{ 2402{
2338 Lisp_Object val; 2403 Lisp_Object val;
2339 2404
2340 if (!length) 2405 if (!length)
2341 return empty_unibyte_string; 2406 return empty_unibyte_string;
2342 val = make_uninit_multibyte_string (length, length); 2407 val = make_clear_multibyte_string (length, length, clearit);
2343 STRING_SET_UNIBYTE (val); 2408 STRING_SET_UNIBYTE (val);
2344 return val; 2409 return val;
2345} 2410}
2346 2411
2412/* Return a unibyte Lisp_String set up to hold LENGTH characters
2413 occupying LENGTH bytes. */
2414
2415Lisp_Object
2416make_uninit_string (EMACS_INT length)
2417{
2418 return make_clear_string (length, false);
2419}
2420
2347 2421
2348/* Return a multibyte Lisp_String set up to hold NCHARS characters 2422/* Return a multibyte Lisp_String set up to hold NCHARS characters
2349 which occupy NBYTES bytes. */ 2423 which occupy NBYTES bytes. If CLEARIT, clear its contents to null
2424 bytes; otherwise, the contents are uninitialized. */
2350 2425
2351Lisp_Object 2426static Lisp_Object
2352make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) 2427make_clear_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes, bool clearit)
2353{ 2428{
2354 Lisp_Object string; 2429 Lisp_Object string;
2355 struct Lisp_String *s; 2430 struct Lisp_String *s;
@@ -2361,12 +2436,21 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
2361 2436
2362 s = allocate_string (); 2437 s = allocate_string ();
2363 s->u.s.intervals = NULL; 2438 s->u.s.intervals = NULL;
2364 allocate_string_data (s, nchars, nbytes); 2439 allocate_string_data (s, nchars, nbytes, clearit);
2365 XSETSTRING (string, s); 2440 XSETSTRING (string, s);
2366 string_chars_consed += nbytes; 2441 string_chars_consed += nbytes;
2367 return string; 2442 return string;
2368} 2443}
2369 2444
2445/* Return a multibyte Lisp_String set up to hold NCHARS characters
2446 which occupy NBYTES bytes. */
2447
2448Lisp_Object
2449make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
2450{
2451 return make_clear_multibyte_string (nchars, nbytes, false);
2452}
2453
2370/* Print arguments to BUF according to a FORMAT, then return 2454/* Print arguments to BUF according to a FORMAT, then return
2371 a Lisp_String initialized with the data from BUF. */ 2455 a Lisp_String initialized with the data from BUF. */
2372 2456
@@ -3023,6 +3107,14 @@ cleanup_vector (struct Lisp_Vector *vector)
3023 if (uptr->finalizer) 3107 if (uptr->finalizer)
3024 uptr->finalizer (uptr->p); 3108 uptr->finalizer (uptr->p);
3025 } 3109 }
3110#ifdef HAVE_MODULES
3111 else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MODULE_FUNCTION))
3112 {
3113 ATTRIBUTE_MAY_ALIAS struct Lisp_Module_Function *function
3114 = (struct Lisp_Module_Function *) vector;
3115 module_finalize_function (function);
3116 }
3117#endif
3026} 3118}
3027 3119
3028/* Reclaim space used by unmarked vectors. */ 3120/* Reclaim space used by unmarked vectors. */
@@ -3137,7 +3229,7 @@ sweep_vectors (void)
3137 at most VECTOR_ELTS_MAX. */ 3229 at most VECTOR_ELTS_MAX. */
3138 3230
3139static struct Lisp_Vector * 3231static struct Lisp_Vector *
3140allocate_vectorlike (ptrdiff_t len) 3232allocate_vectorlike (ptrdiff_t len, bool clearit)
3141{ 3233{
3142 eassert (0 < len && len <= VECTOR_ELTS_MAX); 3234 eassert (0 < len && len <= VECTOR_ELTS_MAX);
3143 ptrdiff_t nbytes = header_size + len * word_size; 3235 ptrdiff_t nbytes = header_size + len * word_size;
@@ -3151,11 +3243,15 @@ allocate_vectorlike (ptrdiff_t len)
3151#endif 3243#endif
3152 3244
3153 if (nbytes <= VBLOCK_BYTES_MAX) 3245 if (nbytes <= VBLOCK_BYTES_MAX)
3154 p = allocate_vector_from_block (vroundup (nbytes)); 3246 {
3247 p = allocate_vector_from_block (vroundup (nbytes));
3248 if (clearit)
3249 memclear (p, nbytes);
3250 }
3155 else 3251 else
3156 { 3252 {
3157 struct large_vector *lv = lisp_malloc (large_vector_offset + nbytes, 3253 struct large_vector *lv = lisp_malloc (large_vector_offset + nbytes,
3158 MEM_TYPE_VECTORLIKE); 3254 clearit, MEM_TYPE_VECTORLIKE);
3159 lv->next = large_vectors; 3255 lv->next = large_vectors;
3160 large_vectors = lv; 3256 large_vectors = lv;
3161 p = large_vector_vec (lv); 3257 p = large_vector_vec (lv);
@@ -3178,20 +3274,37 @@ allocate_vectorlike (ptrdiff_t len)
3178} 3274}
3179 3275
3180 3276
3181/* Allocate a vector with LEN slots. */ 3277/* Allocate a vector with LEN slots. If CLEARIT, clear its slots;
3278 otherwise the vector's slots are uninitialized. */
3182 3279
3183struct Lisp_Vector * 3280static struct Lisp_Vector *
3184allocate_vector (ptrdiff_t len) 3281allocate_clear_vector (ptrdiff_t len, bool clearit)
3185{ 3282{
3186 if (len == 0) 3283 if (len == 0)
3187 return XVECTOR (zero_vector); 3284 return XVECTOR (zero_vector);
3188 if (VECTOR_ELTS_MAX < len) 3285 if (VECTOR_ELTS_MAX < len)
3189 memory_full (SIZE_MAX); 3286 memory_full (SIZE_MAX);
3190 struct Lisp_Vector *v = allocate_vectorlike (len); 3287 struct Lisp_Vector *v = allocate_vectorlike (len, clearit);
3191 v->header.size = len; 3288 v->header.size = len;
3192 return v; 3289 return v;
3193} 3290}
3194 3291
3292/* Allocate a vector with LEN uninitialized slots. */
3293
3294struct Lisp_Vector *
3295allocate_vector (ptrdiff_t len)
3296{
3297 return allocate_clear_vector (len, false);
3298}
3299
3300/* Allocate a vector with LEN nil slots. */
3301
3302struct Lisp_Vector *
3303allocate_nil_vector (ptrdiff_t len)
3304{
3305 return allocate_clear_vector (len, true);
3306}
3307
3195 3308
3196/* Allocate other vector-like structures. */ 3309/* Allocate other vector-like structures. */
3197 3310
@@ -3208,7 +3321,7 @@ allocate_pseudovector (int memlen, int lisplen,
3208 eassert (lisplen <= size_max); 3321 eassert (lisplen <= size_max);
3209 eassert (memlen <= size_max + rest_max); 3322 eassert (memlen <= size_max + rest_max);
3210 3323
3211 struct Lisp_Vector *v = allocate_vectorlike (memlen); 3324 struct Lisp_Vector *v = allocate_vectorlike (memlen, false);
3212 /* Only the first LISPLEN slots will be traced normally by the GC. */ 3325 /* Only the first LISPLEN slots will be traced normally by the GC. */
3213 memclear (v->contents, zerolen * word_size); 3326 memclear (v->contents, zerolen * word_size);
3214 XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen); 3327 XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
@@ -3218,7 +3331,7 @@ allocate_pseudovector (int memlen, int lisplen,
3218struct buffer * 3331struct buffer *
3219allocate_buffer (void) 3332allocate_buffer (void)
3220{ 3333{
3221 struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER); 3334 struct buffer *b = lisp_malloc (sizeof *b, false, MEM_TYPE_BUFFER);
3222 3335
3223 BUFFER_PVEC_INIT (b); 3336 BUFFER_PVEC_INIT (b);
3224 /* Put B on the chain of all buffers including killed ones. */ 3337 /* Put B on the chain of all buffers including killed ones. */
@@ -3238,7 +3351,7 @@ allocate_record (EMACS_INT count)
3238 if (count > PSEUDOVECTOR_SIZE_MASK) 3351 if (count > PSEUDOVECTOR_SIZE_MASK)
3239 error ("Attempt to allocate a record of %"pI"d slots; max is %d", 3352 error ("Attempt to allocate a record of %"pI"d slots; max is %d",
3240 count, PSEUDOVECTOR_SIZE_MASK); 3353 count, PSEUDOVECTOR_SIZE_MASK);
3241 struct Lisp_Vector *p = allocate_vectorlike (count); 3354 struct Lisp_Vector *p = allocate_vectorlike (count, false);
3242 p->header.size = count; 3355 p->header.size = count;
3243 XSETPVECTYPE (p, PVEC_RECORD); 3356 XSETPVECTYPE (p, PVEC_RECORD);
3244 return p; 3357 return p;
@@ -3291,9 +3404,11 @@ See also the function `vector'. */)
3291Lisp_Object 3404Lisp_Object
3292make_vector (ptrdiff_t length, Lisp_Object init) 3405make_vector (ptrdiff_t length, Lisp_Object init)
3293{ 3406{
3294 struct Lisp_Vector *p = allocate_vector (length); 3407 bool clearit = NIL_IS_ZERO && NILP (init);
3295 for (ptrdiff_t i = 0; i < length; i++) 3408 struct Lisp_Vector *p = allocate_clear_vector (length, clearit);
3296 p->contents[i] = init; 3409 if (!clearit)
3410 for (ptrdiff_t i = 0; i < length; i++)
3411 p->contents[i] = init;
3297 return make_lisp_ptr (p, Lisp_Vectorlike); 3412 return make_lisp_ptr (p, Lisp_Vectorlike);
3298} 3413}
3299 3414
@@ -3442,7 +3557,7 @@ Its value is void, and its function definition and property list are nil. */)
3442 if (symbol_block_index == SYMBOL_BLOCK_SIZE) 3557 if (symbol_block_index == SYMBOL_BLOCK_SIZE)
3443 { 3558 {
3444 struct symbol_block *new 3559 struct symbol_block *new
3445 = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL); 3560 = lisp_malloc (sizeof *new, false, MEM_TYPE_SYMBOL);
3446 new->next = symbol_block; 3561 new->next = symbol_block;
3447 symbol_block = new; 3562 symbol_block = new;
3448 symbol_block_index = 0; 3563 symbol_block_index = 0;
@@ -3904,10 +4019,10 @@ refill_memory_reserve (void)
3904 MEM_TYPE_SPARE); 4019 MEM_TYPE_SPARE);
3905 if (spare_memory[5] == 0) 4020 if (spare_memory[5] == 0)
3906 spare_memory[5] = lisp_malloc (sizeof (struct string_block), 4021 spare_memory[5] = lisp_malloc (sizeof (struct string_block),
3907 MEM_TYPE_SPARE); 4022 false, MEM_TYPE_SPARE);
3908 if (spare_memory[6] == 0) 4023 if (spare_memory[6] == 0)
3909 spare_memory[6] = lisp_malloc (sizeof (struct string_block), 4024 spare_memory[6] = lisp_malloc (sizeof (struct string_block),
3910 MEM_TYPE_SPARE); 4025 false, MEM_TYPE_SPARE);
3911 if (spare_memory[0] && spare_memory[1] && spare_memory[5]) 4026 if (spare_memory[0] && spare_memory[1] && spare_memory[5])
3912 Vmemory_full = Qnil; 4027 Vmemory_full = Qnil;
3913#endif 4028#endif
diff --git a/src/bytecode.c b/src/bytecode.c
index 9e75c9012e0..4624379756d 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -220,10 +220,10 @@ DEFINE (Bdup, 0211) \
220DEFINE (Bsave_excursion, 0212) \ 220DEFINE (Bsave_excursion, 0212) \
221DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \ 221DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \
222DEFINE (Bsave_restriction, 0214) \ 222DEFINE (Bsave_restriction, 0214) \
223DEFINE (Bcatch, 0215) \ 223DEFINE (Bcatch, 0215) /* Obsolete since Emacs-25. */ \
224 \ 224 \
225DEFINE (Bunwind_protect, 0216) \ 225DEFINE (Bunwind_protect, 0216) \
226DEFINE (Bcondition_case, 0217) \ 226DEFINE (Bcondition_case, 0217) /* Obsolete since Emacs-25. */ \
227DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \ 227DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \
228DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \ 228DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \
229 \ 229 \
@@ -763,7 +763,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
763 save_restriction_save ()); 763 save_restriction_save ());
764 NEXT; 764 NEXT;
765 765
766 CASE (Bcatch): /* Obsolete since 24.4. */ 766 CASE (Bcatch): /* Obsolete since 25. */
767 { 767 {
768 Lisp_Object v1 = POP; 768 Lisp_Object v1 = POP;
769 TOP = internal_catch (TOP, eval_sub, v1); 769 TOP = internal_catch (TOP, eval_sub, v1);
@@ -807,7 +807,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
807 NEXT; 807 NEXT;
808 } 808 }
809 809
810 CASE (Bcondition_case): /* Obsolete since 24.4. */ 810 CASE (Bcondition_case): /* Obsolete since 25. */
811 { 811 {
812 Lisp_Object handlers = POP, body = POP; 812 Lisp_Object handlers = POP, body = POP;
813 TOP = internal_lisp_condition_case (TOP, body, handlers); 813 TOP = internal_lisp_condition_case (TOP, body, handlers);
diff --git a/src/callproc.c b/src/callproc.c
index 52b89504205..07dcc4c3ae4 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -746,6 +746,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
746 int carryover = 0; 746 int carryover = 0;
747 bool display_on_the_fly = display_p; 747 bool display_on_the_fly = display_p;
748 struct coding_system saved_coding = process_coding; 748 struct coding_system saved_coding = process_coding;
749 ptrdiff_t prepared_pos = 0; /* prepare_to_modify_buffer was last
750 called here. */
749 751
750 while (1) 752 while (1)
751 { 753 {
@@ -773,6 +775,33 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
773 if (display_on_the_fly) 775 if (display_on_the_fly)
774 break; 776 break;
775 } 777 }
778 /* CHANGE FUNCTIONS
779 For each iteration of the enclosing while (1) loop which
780 yields data (i.e. nread > 0), before- and
781 after-change-functions are each invoked exactly once.
782 This is done directly from the current function only, by
783 calling prepare_to_modify_buffer and signal_after_change.
784 It is not done here by directing another function such as
785 insert_1_both to call them. The call to
786 prepare_to_modify_buffer follows this comment, and there
787 is one call to signal_after_change in each of the
788 branches of the next `else if'.
789
790 Exceptionally, the insertion into the buffer is aborted
791 at the call to del_range_2 ~45 lines further down, this
792 function removing the newly inserted data. At this stage
793 prepare_to_modify_buffer has been called, but
794 signal_after_change hasn't. A continue statement
795 restarts the enclosing while (1) loop. A second,
796 unwanted, call to `prepare_to_modify_buffer' is inhibited
797 by the test prepared_pos < PT. The data are inserted
798 again, and this time signal_after_change gets called,
799 balancing the previous call to prepare_to_modify_buffer. */
800 if ((prepared_pos < PT) && nread)
801 {
802 prepare_to_modify_buffer (PT, PT, NULL);
803 prepared_pos = PT;
804 }
776 805
777 /* Now NREAD is the total amount of data in the buffer. */ 806 /* Now NREAD is the total amount of data in the buffer. */
778 807
@@ -780,15 +809,16 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
780 ; 809 ;
781 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)) 810 else if (NILP (BVAR (current_buffer, enable_multibyte_characters))
782 && ! CODING_MAY_REQUIRE_DECODING (&process_coding)) 811 && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
783 insert_1_both (buf, nread, nread, 0, 1, 0); 812 {
813 insert_1_both (buf, nread, nread, 0, 0, 0);
814 signal_after_change (PT, 0, nread);
815 }
784 else 816 else
785 { /* We have to decode the input. */ 817 { /* We have to decode the input. */
786 Lisp_Object curbuf; 818 Lisp_Object curbuf;
787 ptrdiff_t count1 = SPECPDL_INDEX (); 819 ptrdiff_t count1 = SPECPDL_INDEX ();
788 820
789 XSETBUFFER (curbuf, current_buffer); 821 XSETBUFFER (curbuf, current_buffer);
790 /* FIXME: Call signal_after_change! */
791 prepare_to_modify_buffer (PT, PT, NULL);
792 /* We cannot allow after-change-functions be run 822 /* We cannot allow after-change-functions be run
793 during decoding, because that might modify the 823 during decoding, because that might modify the
794 buffer, while we rely on process_coding.produced to 824 buffer, while we rely on process_coding.produced to
@@ -824,6 +854,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
824 854
825 TEMP_SET_PT_BOTH (PT + process_coding.produced_char, 855 TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
826 PT_BYTE + process_coding.produced); 856 PT_BYTE + process_coding.produced);
857 signal_after_change (PT, 0, process_coding.produced_char);
827 carryover = process_coding.carryover_bytes; 858 carryover = process_coding.carryover_bytes;
828 if (carryover > 0) 859 if (carryover > 0)
829 memcpy (buf, process_coding.carryover, 860 memcpy (buf, process_coding.carryover,
diff --git a/src/coding.c b/src/coding.c
index ed755b1afcf..8b54281c0bf 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -11745,6 +11745,8 @@ syms_of_coding (void)
11745 11745
11746 DEFSYM (Qignored, "ignored"); 11746 DEFSYM (Qignored, "ignored");
11747 11747
11748 DEFSYM (Qutf_8_string_p, "utf-8-string-p");
11749
11748 defsubr (&Scoding_system_p); 11750 defsubr (&Scoding_system_p);
11749 defsubr (&Sread_coding_system); 11751 defsubr (&Sread_coding_system);
11750 defsubr (&Sread_non_nil_coding_system); 11752 defsubr (&Sread_non_nil_coding_system);
diff --git a/src/data.c b/src/data.c
index 56e363f16b6..fae9cee7db1 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2293,61 +2293,45 @@ bool-vector. IDX starts at 0. */)
2293 } 2293 }
2294 else /* STRINGP */ 2294 else /* STRINGP */
2295 { 2295 {
2296 int c;
2297
2298 CHECK_IMPURE (array, XSTRING (array)); 2296 CHECK_IMPURE (array, XSTRING (array));
2299 if (idxval < 0 || idxval >= SCHARS (array)) 2297 if (idxval < 0 || idxval >= SCHARS (array))
2300 args_out_of_range (array, idx); 2298 args_out_of_range (array, idx);
2301 CHECK_CHARACTER (newelt); 2299 CHECK_CHARACTER (newelt);
2302 c = XFIXNAT (newelt); 2300 int c = XFIXNAT (newelt);
2301 ptrdiff_t idxval_byte;
2302 int prev_bytes;
2303 unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
2303 2304
2304 if (STRING_MULTIBYTE (array)) 2305 if (STRING_MULTIBYTE (array))
2305 { 2306 {
2306 ptrdiff_t idxval_byte, nbytes;
2307 int prev_bytes, new_bytes;
2308 unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
2309
2310 nbytes = SBYTES (array);
2311 idxval_byte = string_char_to_byte (array, idxval); 2307 idxval_byte = string_char_to_byte (array, idxval);
2312 p1 = SDATA (array) + idxval_byte; 2308 p1 = SDATA (array) + idxval_byte;
2313 prev_bytes = BYTES_BY_CHAR_HEAD (*p1); 2309 prev_bytes = BYTES_BY_CHAR_HEAD (*p1);
2314 new_bytes = CHAR_STRING (c, p0);
2315 if (prev_bytes != new_bytes)
2316 {
2317 /* We must relocate the string data. */
2318 ptrdiff_t nchars = SCHARS (array);
2319 USE_SAFE_ALLOCA;
2320 unsigned char *str = SAFE_ALLOCA (nbytes);
2321
2322 memcpy (str, SDATA (array), nbytes);
2323 allocate_string_data (XSTRING (array), nchars,
2324 nbytes + new_bytes - prev_bytes);
2325 memcpy (SDATA (array), str, idxval_byte);
2326 p1 = SDATA (array) + idxval_byte;
2327 memcpy (p1 + new_bytes, str + idxval_byte + prev_bytes,
2328 nbytes - (idxval_byte + prev_bytes));
2329 SAFE_FREE ();
2330 clear_string_char_byte_cache ();
2331 }
2332 while (new_bytes--)
2333 *p1++ = *p0++;
2334 } 2310 }
2335 else 2311 else if (SINGLE_BYTE_CHAR_P (c))
2336 { 2312 {
2337 if (! SINGLE_BYTE_CHAR_P (c))
2338 {
2339 ptrdiff_t i;
2340
2341 for (i = SBYTES (array) - 1; i >= 0; i--)
2342 if (SREF (array, i) >= 0x80)
2343 args_out_of_range (array, newelt);
2344 /* ARRAY is an ASCII string. Convert it to a multibyte
2345 string, and try `aset' again. */
2346 STRING_SET_MULTIBYTE (array);
2347 return Faset (array, idx, newelt);
2348 }
2349 SSET (array, idxval, c); 2313 SSET (array, idxval, c);
2314 return newelt;
2350 } 2315 }
2316 else
2317 {
2318 for (ptrdiff_t i = SBYTES (array) - 1; i >= 0; i--)
2319 if (!ASCII_CHAR_P (SREF (array, i)))
2320 args_out_of_range (array, newelt);
2321 /* ARRAY is an ASCII string. Convert it to a multibyte string. */
2322 STRING_SET_MULTIBYTE (array);
2323 idxval_byte = idxval;
2324 p1 = SDATA (array) + idxval_byte;
2325 prev_bytes = 1;
2326 }
2327
2328 int new_bytes = CHAR_STRING (c, p0);
2329 if (prev_bytes != new_bytes)
2330 p1 = resize_string_data (array, idxval_byte, prev_bytes, new_bytes);
2331
2332 do
2333 *p1++ = *p0++;
2334 while (--new_bytes != 0);
2351 } 2335 }
2352 2336
2353 return newelt; 2337 return newelt;
diff --git a/src/deps.mk b/src/deps.mk
index a7e1b559173..4d162eeb0f2 100644
--- a/src/deps.mk
+++ b/src/deps.mk
@@ -239,9 +239,6 @@ xfont.o: dispextern.h xterm.h frame.h blockinput.h character.h charset.h \
239xftfont.o: xftfont.c dispextern.h xterm.h frame.h blockinput.h character.h \ 239xftfont.o: xftfont.c dispextern.h xterm.h frame.h blockinput.h character.h \
240 charset.h font.h lisp.h globals.h $(config_h) atimer.h systime.h \ 240 charset.h font.h lisp.h globals.h $(config_h) atimer.h systime.h \
241 fontset.h ccl.h ftfont.h composite.h 241 fontset.h ccl.h ftfont.h composite.h
242ftxfont.o: ftxfont.c dispextern.h xterm.h frame.h blockinput.h character.h \
243 charset.h font.h lisp.h globals.h $(config_h) atimer.h systime.h \
244 fontset.h ccl.h
245menu.o: menu.c lisp.h keyboard.h keymap.h frame.h termhooks.h blockinput.h \ 242menu.o: menu.c lisp.h keyboard.h keymap.h frame.h termhooks.h blockinput.h \
246 dispextern.h $(srcdir)/../lwlib/lwlib.h xterm.h gtkutil.h menu.h \ 243 dispextern.h $(srcdir)/../lwlib/lwlib.h xterm.h gtkutil.h menu.h \
247 lisp.h globals.h $(config_h) systime.h coding.h composite.h window.h \ 244 lisp.h globals.h $(config_h) systime.h coding.h composite.h window.h \
diff --git a/src/dired.c b/src/dired.c
index 611477aa4ef..f013a4cea03 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -937,7 +937,7 @@ file_attributes (int fd, char const *name,
937 int err = EINVAL; 937 int err = EINVAL;
938 938
939#if defined O_PATH && !defined HAVE_CYGWIN_O_PATH_BUG 939#if defined O_PATH && !defined HAVE_CYGWIN_O_PATH_BUG
940 int namefd = openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW); 940 int namefd = emacs_openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW, 0);
941 if (namefd < 0) 941 if (namefd < 0)
942 err = errno; 942 err = errno;
943 else 943 else
@@ -970,7 +970,7 @@ file_attributes (int fd, char const *name,
970 information to be accurate. */ 970 information to be accurate. */
971 w32_stat_get_owner_group = 1; 971 w32_stat_get_owner_group = 1;
972#endif 972#endif
973 err = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno; 973 err = emacs_fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno;
974#ifdef WINDOWSNT 974#ifdef WINDOWSNT
975 w32_stat_get_owner_group = 0; 975 w32_stat_get_owner_group = 0;
976#endif 976#endif
diff --git a/src/dispnew.c b/src/dispnew.c
index b2a257090cc..d79ae836c56 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -534,6 +534,14 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
534 eassert (left >= 0 && right >= 0); 534 eassert (left >= 0 && right >= 0);
535 matrix->left_margin_glyphs = left; 535 matrix->left_margin_glyphs = left;
536 matrix->right_margin_glyphs = right; 536 matrix->right_margin_glyphs = right;
537
538 /* If we are resizing a window, make sure the previous mode-line
539 row of the window's current matrix is no longer marked as such. */
540 if (w && matrix == w->current_matrix
541 && matrix->nrows > 0
542 && dim.height != matrix->nrows
543 && matrix->nrows <= matrix->rows_allocated)
544 MATRIX_MODE_LINE_ROW (matrix)->mode_line_p = false;
537 } 545 }
538 546
539 /* Number of rows to be used by MATRIX. */ 547 /* Number of rows to be used by MATRIX. */
@@ -3735,11 +3743,10 @@ gui_update_window_end (struct window *w, bool cursor_on_p,
3735{ 3743{
3736 struct frame *f = XFRAME (WINDOW_FRAME (w)); 3744 struct frame *f = XFRAME (WINDOW_FRAME (w));
3737 3745
3738 block_input ();
3739
3740 /* Pseudo windows don't have cursors, so don't display them here. */ 3746 /* Pseudo windows don't have cursors, so don't display them here. */
3741 if (!w->pseudo_window_p) 3747 if (!w->pseudo_window_p)
3742 { 3748 {
3749 block_input ();
3743 3750
3744 if (cursor_on_p) 3751 if (cursor_on_p)
3745 display_and_set_cursor (w, true, 3752 display_and_set_cursor (w, true,
@@ -3753,6 +3760,7 @@ gui_update_window_end (struct window *w, bool cursor_on_p,
3753 else 3760 else
3754 gui_draw_vertical_border (w); 3761 gui_draw_vertical_border (w);
3755 } 3762 }
3763 unblock_input ();
3756 } 3764 }
3757 3765
3758 /* If a row with mouse-face was overwritten, arrange for 3766 /* If a row with mouse-face was overwritten, arrange for
@@ -3770,7 +3778,6 @@ gui_update_window_end (struct window *w, bool cursor_on_p,
3770 FRAME_RIF (f)->update_window_end_hook (w, 3778 FRAME_RIF (f)->update_window_end_hook (w,
3771 cursor_on_p, 3779 cursor_on_p,
3772 mouse_face_overwritten_p); 3780 mouse_face_overwritten_p);
3773 unblock_input ();
3774} 3781}
3775 3782
3776#endif /* HAVE_WINDOW_SYSTEM */ 3783#endif /* HAVE_WINDOW_SYSTEM */
@@ -4352,6 +4359,14 @@ scrolling_window (struct window *w, int tab_line_p)
4352 return 0; 4359 return 0;
4353#endif 4360#endif
4354 4361
4362 /* Can't scroll the display of w32 GUI frames when position of point
4363 is indicated by the system caret, because scrolling the display
4364 will then "copy" the pixels used by the caret. */
4365#ifdef HAVE_NTGUI
4366 if (w32_use_visible_system_caret)
4367 return 0;
4368#endif
4369
4355 /* Give up if some rows in the desired matrix are not enabled. */ 4370 /* Give up if some rows in the desired matrix are not enabled. */
4356 if (! MATRIX_ROW_ENABLED_P (desired_matrix, i)) 4371 if (! MATRIX_ROW_ENABLED_P (desired_matrix, i))
4357 return -1; 4372 return -1;
diff --git a/src/editfns.c b/src/editfns.c
index 4e35784e554..3f1b3aa4b75 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3031,7 +3031,7 @@ width, and precision specifiers, as follows:
3031 %<field><flags><width><precision>character 3031 %<field><flags><width><precision>character
3032 3032
3033where field is [0-9]+ followed by a literal dollar "$", flags is 3033where field is [0-9]+ followed by a literal dollar "$", flags is
3034[+ #-0]+, width is [0-9]+, and precision is a literal period "." 3034[+ #0-]+, width is [0-9]+, and precision is a literal period "."
3035followed by [0-9]+. 3035followed by [0-9]+.
3036 3036
3037If a %-sequence is numbered with a field with positive value N, the 3037If a %-sequence is numbered with a field with positive value N, the
diff --git a/src/emacs-module.c b/src/emacs-module.c
index bbb0e3dadd9..60f16418efa 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -213,6 +213,25 @@ static bool value_storage_contains_p (const struct emacs_value_storage *,
213 213
214static bool module_assertions = false; 214static bool module_assertions = false;
215 215
216
217/* Small helper functions. */
218
219/* Interprets the string at STR with length LEN as UTF-8 string.
220 Signals an error if it's not a valid UTF-8 string. */
221
222static Lisp_Object
223module_decode_utf_8 (const char *str, ptrdiff_t len)
224{
225 /* We set HANDLE-8-BIT and HANDLE-OVER-UNI to nil to signal an error
226 if the argument is not a valid UTF-8 string. While it isn't
227 documented how make_string and make_function behave in this case,
228 signaling an error is the most defensive and obvious reaction. */
229 Lisp_Object s = decode_string_utf_8 (Qnil, str, len, Qnil, false, Qnil, Qnil);
230 CHECK_TYPE (!NILP (s), Qutf_8_string_p, make_string_from_utf8 (str, len));
231 return s;
232}
233
234
216/* Convenience macros for non-local exit handling. */ 235/* Convenience macros for non-local exit handling. */
217 236
218/* FIXME: The following implementation for non-local exit handling 237/* FIXME: The following implementation for non-local exit handling
@@ -327,6 +346,12 @@ static bool module_assertions = false;
327 MODULE_HANDLE_NONLOCAL_EXIT (error_retval) 346 MODULE_HANDLE_NONLOCAL_EXIT (error_retval)
328 347
329static void 348static void
349CHECK_MODULE_FUNCTION (Lisp_Object obj)
350{
351 CHECK_TYPE (MODULE_FUNCTIONP (obj), Qmodule_function_p, obj);
352}
353
354static void
330CHECK_USER_PTR (Lisp_Object obj) 355CHECK_USER_PTR (Lisp_Object obj)
331{ 356{
332 CHECK_TYPE (USER_PTRP (obj), Quser_ptrp, obj); 357 CHECK_TYPE (USER_PTRP (obj), Quser_ptrp, obj);
@@ -478,6 +503,7 @@ struct Lisp_Module_Function
478 ptrdiff_t min_arity, max_arity; 503 ptrdiff_t min_arity, max_arity;
479 emacs_function subr; 504 emacs_function subr;
480 void *data; 505 void *data;
506 emacs_finalizer finalizer;
481} GCALIGNED_STRUCT; 507} GCALIGNED_STRUCT;
482 508
483static struct Lisp_Module_Function * 509static struct Lisp_Module_Function *
@@ -511,9 +537,11 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
511 function->max_arity = max_arity; 537 function->max_arity = max_arity;
512 function->subr = func; 538 function->subr = func;
513 function->data = data; 539 function->data = data;
540 function->finalizer = NULL;
514 541
515 if (docstring) 542 if (docstring)
516 function->documentation = build_string_from_utf8 (docstring); 543 function->documentation
544 = module_decode_utf_8 (docstring, strlen (docstring));
517 545
518 Lisp_Object result; 546 Lisp_Object result;
519 XSET_MODULE_FUNCTION (result, function); 547 XSET_MODULE_FUNCTION (result, function);
@@ -522,6 +550,32 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
522 return lisp_to_value (env, result); 550 return lisp_to_value (env, result);
523} 551}
524 552
553static emacs_finalizer
554module_get_function_finalizer (emacs_env *env, emacs_value arg)
555{
556 MODULE_FUNCTION_BEGIN (NULL);
557 Lisp_Object lisp = value_to_lisp (arg);
558 CHECK_MODULE_FUNCTION (lisp);
559 return XMODULE_FUNCTION (lisp)->finalizer;
560}
561
562static void
563module_set_function_finalizer (emacs_env *env, emacs_value arg,
564 emacs_finalizer fin)
565{
566 MODULE_FUNCTION_BEGIN ();
567 Lisp_Object lisp = value_to_lisp (arg);
568 CHECK_MODULE_FUNCTION (lisp);
569 XMODULE_FUNCTION (lisp)->finalizer = fin;
570}
571
572void
573module_finalize_function (const struct Lisp_Module_Function *func)
574{
575 if (func->finalizer != NULL)
576 func->finalizer (func->data);
577}
578
525static emacs_value 579static emacs_value
526module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs, 580module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
527 emacs_value *args) 581 emacs_value *args)
@@ -660,7 +714,7 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t len)
660 MODULE_FUNCTION_BEGIN (NULL); 714 MODULE_FUNCTION_BEGIN (NULL);
661 if (! (0 <= len && len <= STRING_BYTES_BOUND)) 715 if (! (0 <= len && len <= STRING_BYTES_BOUND))
662 overflow_error (); 716 overflow_error ();
663 Lisp_Object lstr = make_string_from_utf8 (str, len); 717 Lisp_Object lstr = module_decode_utf_8 (str, len);
664 return lisp_to_value (env, lstr); 718 return lisp_to_value (env, lstr);
665} 719}
666 720
@@ -1064,6 +1118,12 @@ module_function_address (const struct Lisp_Module_Function *function)
1064 return (module_funcptr) function->subr; 1118 return (module_funcptr) function->subr;
1065} 1119}
1066 1120
1121void *
1122module_function_data (const struct Lisp_Module_Function *function)
1123{
1124 return function->data;
1125}
1126
1067 1127
1068/* Helper functions. */ 1128/* Helper functions. */
1069 1129
@@ -1329,6 +1389,8 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
1329 env->make_time = module_make_time; 1389 env->make_time = module_make_time;
1330 env->extract_big_integer = module_extract_big_integer; 1390 env->extract_big_integer = module_extract_big_integer;
1331 env->make_big_integer = module_make_big_integer; 1391 env->make_big_integer = module_make_big_integer;
1392 env->get_function_finalizer = module_get_function_finalizer;
1393 env->set_function_finalizer = module_set_function_finalizer;
1332 Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); 1394 Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
1333 return env; 1395 return env;
1334} 1396}
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index 7065f13f2b1..cd75c0907e4 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -42,6 +42,12 @@ information how to write modules and use this header file.
42# define EMACS_NOEXCEPT 42# define EMACS_NOEXCEPT
43#endif 43#endif
44 44
45#if defined __cplusplus && __cplusplus >= 201703L
46# define EMACS_NOEXCEPT_TYPEDEF noexcept
47#else
48# define EMACS_NOEXCEPT_TYPEDEF
49#endif
50
45#ifdef __has_attribute 51#ifdef __has_attribute
46#if __has_attribute(__nonnull__) 52#if __has_attribute(__nonnull__)
47# define EMACS_ATTRIBUTE_NONNULL(...) __attribute__((__nonnull__(__VA_ARGS__))) 53# define EMACS_ATTRIBUTE_NONNULL(...) __attribute__((__nonnull__(__VA_ARGS__)))
@@ -88,11 +94,11 @@ struct emacs_runtime
88typedef emacs_value (*emacs_function) (emacs_env *env, ptrdiff_t nargs, 94typedef emacs_value (*emacs_function) (emacs_env *env, ptrdiff_t nargs,
89 emacs_value *args, 95 emacs_value *args,
90 void *data) 96 void *data)
91 EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL (1); 97 EMACS_NOEXCEPT_TYPEDEF EMACS_ATTRIBUTE_NONNULL (1);
92 98
93/* Function prototype for module user-pointer finalizers. These must 99/* Function prototype for module user-pointer and function finalizers.
94 not throw C++ exceptions. */ 100 These must not throw C++ exceptions. */
95typedef void (*emacs_finalizer) (void *data) EMACS_NOEXCEPT; 101typedef void (*emacs_finalizer) (void *data) EMACS_NOEXCEPT_TYPEDEF;
96 102
97/* Possible Emacs function call outcomes. */ 103/* Possible Emacs function call outcomes. */
98enum emacs_funcall_exit 104enum emacs_funcall_exit
diff --git a/src/emacs.c b/src/emacs.c
index c5a760d29f6..c170333e603 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -930,7 +930,6 @@ main (int argc, char **argv)
930 for pointers. */ 930 for pointers. */
931 void *stack_bottom_variable; 931 void *stack_bottom_variable;
932 932
933 bool do_initial_setlocale;
934 bool no_loadup = false; 933 bool no_loadup = false;
935 char *junk = 0; 934 char *junk = 0;
936 char *dname_arg = 0; 935 char *dname_arg = 0;
@@ -1235,19 +1234,20 @@ main (int argc, char **argv)
1235 set_binary_mode (STDOUT_FILENO, O_BINARY); 1234 set_binary_mode (STDOUT_FILENO, O_BINARY);
1236#endif /* MSDOS */ 1235#endif /* MSDOS */
1237 1236
1238 /* Skip initial setlocale if LC_ALL is "C", as it's not needed in that case. 1237 /* Set locale, so that initial error messages are localized properly.
1239 The build procedure uses this while dumping, to ensure that the 1238 However, skip this if LC_ALL is "C", as it's not needed in that case.
1240 dumped Emacs does not have its system locale tables initialized, 1239 Skipping helps if dumping with unexec, to ensure that the dumped
1241 as that might cause screwups when the dumped Emacs starts up. */ 1240 Emacs does not have its system locale tables initialized, as that
1242 { 1241 might cause screwups when the dumped Emacs starts up. */
1243 char *lc_all = getenv ("LC_ALL"); 1242 char *lc_all = getenv ("LC_ALL");
1244 do_initial_setlocale = ! lc_all || strcmp (lc_all, "C"); 1243 if (! (lc_all && strcmp (lc_all, "C") == 0))
1245 } 1244 {
1246 1245 #ifdef HAVE_NS
1247 /* Set locale now, so that initial error messages are localized properly. 1246 ns_init_locale ();
1248 fixup_locale must wait until later, since it builds strings. */ 1247 #endif
1249 if (do_initial_setlocale) 1248 setlocale (LC_ALL, "");
1250 setlocale (LC_ALL, ""); 1249 fixup_locale ();
1250 }
1251 text_quoting_flag = using_utf8 (); 1251 text_quoting_flag = using_utf8 ();
1252 1252
1253 inhibit_window_system = 0; 1253 inhibit_window_system = 0;
@@ -1576,14 +1576,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
1576 init_alloc (); 1576 init_alloc ();
1577 init_bignum (); 1577 init_bignum ();
1578 init_threads (); 1578 init_threads ();
1579
1580 if (do_initial_setlocale)
1581 {
1582 fixup_locale ();
1583 Vsystem_messages_locale = Vprevious_system_messages_locale;
1584 Vsystem_time_locale = Vprevious_system_time_locale;
1585 }
1586
1587 init_eval (); 1579 init_eval ();
1588 init_atimer (); 1580 init_atimer ();
1589 running_asynch_code = 0; 1581 running_asynch_code = 0;
@@ -1621,10 +1613,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
1621 1613
1622#ifdef HAVE_NS 1614#ifdef HAVE_NS
1623 ns_pool = ns_alloc_autorelease_pool (); 1615 ns_pool = ns_alloc_autorelease_pool ();
1624#ifdef NS_IMPL_GNUSTEP
1625 /* GNUstep stupidly resets our locale settings after we made them. */
1626 fixup_locale ();
1627#endif
1628 1616
1629 if (!noninteractive) 1617 if (!noninteractive)
1630 { 1618 {
@@ -1735,11 +1723,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
1735 globals_of_gfilenotify (); 1723 globals_of_gfilenotify ();
1736#endif 1724#endif
1737 1725
1738#ifdef HAVE_NS
1739 /* Initialize the locale from user defaults. */
1740 ns_init_locale ();
1741#endif
1742
1743 /* Initialize and GC-protect Vinitial_environment and 1726 /* Initialize and GC-protect Vinitial_environment and
1744 Vprocess_environment before set_initial_environment fills them 1727 Vprocess_environment before set_initial_environment fills them
1745 in. */ 1728 in. */
@@ -2617,25 +2600,25 @@ synchronize_locale (int category, Lisp_Object *plocale, Lisp_Object desired_loca
2617 if (! EQ (*plocale, desired_locale)) 2600 if (! EQ (*plocale, desired_locale))
2618 { 2601 {
2619 *plocale = desired_locale; 2602 *plocale = desired_locale;
2620#ifdef WINDOWSNT 2603 char const *locale_string
2604 = STRINGP (desired_locale) ? SSDATA (desired_locale) : "";
2605# ifdef WINDOWSNT
2621 /* Changing categories like LC_TIME usually requires specifying 2606 /* Changing categories like LC_TIME usually requires specifying
2622 an encoding suitable for the new locale, but MS-Windows's 2607 an encoding suitable for the new locale, but MS-Windows's
2623 'setlocale' will only switch the encoding when LC_ALL is 2608 'setlocale' will only switch the encoding when LC_ALL is
2624 specified. So we ignore CATEGORY, use LC_ALL instead, and 2609 specified. So we ignore CATEGORY, use LC_ALL instead, and
2625 then restore LC_NUMERIC to "C", so reading and printing 2610 then restore LC_NUMERIC to "C", so reading and printing
2626 numbers is unaffected. */ 2611 numbers is unaffected. */
2627 setlocale (LC_ALL, (STRINGP (desired_locale) 2612 setlocale (LC_ALL, locale_string);
2628 ? SSDATA (desired_locale)
2629 : ""));
2630 fixup_locale (); 2613 fixup_locale ();
2631#else /* !WINDOWSNT */ 2614# else /* !WINDOWSNT */
2632 setlocale (category, (STRINGP (desired_locale) 2615 setlocale (category, locale_string);
2633 ? SSDATA (desired_locale) 2616# endif /* !WINDOWSNT */
2634 : ""));
2635#endif /* !WINDOWSNT */
2636 } 2617 }
2637} 2618}
2638 2619
2620static Lisp_Object Vprevious_system_time_locale;
2621
2639/* Set system time locale to match Vsystem_time_locale, if possible. */ 2622/* Set system time locale to match Vsystem_time_locale, if possible. */
2640void 2623void
2641synchronize_system_time_locale (void) 2624synchronize_system_time_locale (void)
@@ -2644,15 +2627,19 @@ synchronize_system_time_locale (void)
2644 Vsystem_time_locale); 2627 Vsystem_time_locale);
2645} 2628}
2646 2629
2630# ifdef LC_MESSAGES
2631static Lisp_Object Vprevious_system_messages_locale;
2632# endif
2633
2647/* Set system messages locale to match Vsystem_messages_locale, if 2634/* Set system messages locale to match Vsystem_messages_locale, if
2648 possible. */ 2635 possible. */
2649void 2636void
2650synchronize_system_messages_locale (void) 2637synchronize_system_messages_locale (void)
2651{ 2638{
2652#ifdef LC_MESSAGES 2639# ifdef LC_MESSAGES
2653 synchronize_locale (LC_MESSAGES, &Vprevious_system_messages_locale, 2640 synchronize_locale (LC_MESSAGES, &Vprevious_system_messages_locale,
2654 Vsystem_messages_locale); 2641 Vsystem_messages_locale);
2655#endif 2642# endif
2656} 2643}
2657#endif /* HAVE_SETLOCALE */ 2644#endif /* HAVE_SETLOCALE */
2658 2645
@@ -2974,19 +2961,16 @@ build directory. */);
2974 DEFVAR_LISP ("system-messages-locale", Vsystem_messages_locale, 2961 DEFVAR_LISP ("system-messages-locale", Vsystem_messages_locale,
2975 doc: /* System locale for messages. */); 2962 doc: /* System locale for messages. */);
2976 Vsystem_messages_locale = Qnil; 2963 Vsystem_messages_locale = Qnil;
2977 2964#ifdef LC_MESSAGES
2978 DEFVAR_LISP ("previous-system-messages-locale",
2979 Vprevious_system_messages_locale,
2980 doc: /* Most recently used system locale for messages. */);
2981 Vprevious_system_messages_locale = Qnil; 2965 Vprevious_system_messages_locale = Qnil;
2966 staticpro (&Vprevious_system_messages_locale);
2967#endif
2982 2968
2983 DEFVAR_LISP ("system-time-locale", Vsystem_time_locale, 2969 DEFVAR_LISP ("system-time-locale", Vsystem_time_locale,
2984 doc: /* System locale for time. */); 2970 doc: /* System locale for time. */);
2985 Vsystem_time_locale = Qnil; 2971 Vsystem_time_locale = Qnil;
2986
2987 DEFVAR_LISP ("previous-system-time-locale", Vprevious_system_time_locale,
2988 doc: /* Most recently used system locale for time. */);
2989 Vprevious_system_time_locale = Qnil; 2972 Vprevious_system_time_locale = Qnil;
2973 staticpro (&Vprevious_system_time_locale);
2990 2974
2991 DEFVAR_LISP ("before-init-time", Vbefore_init_time, 2975 DEFVAR_LISP ("before-init-time", Vbefore_init_time,
2992 doc: /* Value of `current-time' before Emacs begins initialization. */); 2976 doc: /* Value of `current-time' before Emacs begins initialization. */);
diff --git a/src/fileio.c b/src/fileio.c
index 6e2fe2f0b82..87a17eab425 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1952,7 +1952,10 @@ barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist,
1952 1952
1953 encoded_filename = ENCODE_FILE (absname); 1953 encoded_filename = ENCODE_FILE (absname);
1954 1954
1955 if (! known_to_exist && lstat (SSDATA (encoded_filename), &statbuf) == 0) 1955 if (! known_to_exist
1956 && (emacs_fstatat (AT_FDCWD, SSDATA (encoded_filename),
1957 &statbuf, AT_SYMLINK_NOFOLLOW)
1958 == 0))
1956 { 1959 {
1957 if (S_ISDIR (statbuf.st_mode)) 1960 if (S_ISDIR (statbuf.st_mode))
1958 xsignal2 (Qfile_error, 1961 xsignal2 (Qfile_error,
@@ -2555,7 +2558,9 @@ This is what happens in interactive use with M-x. */)
2555 bool dirp = !NILP (Fdirectory_name_p (file)); 2558 bool dirp = !NILP (Fdirectory_name_p (file));
2556 if (!dirp) 2559 if (!dirp)
2557 { 2560 {
2558 if (lstat (SSDATA (encoded_file), &file_st) != 0) 2561 if (emacs_fstatat (AT_FDCWD, SSDATA (encoded_file),
2562 &file_st, AT_SYMLINK_NOFOLLOW)
2563 != 0)
2559 report_file_error ("Renaming", list2 (file, newname)); 2564 report_file_error ("Renaming", list2 (file, newname));
2560 dirp = S_ISDIR (file_st.st_mode) != 0; 2565 dirp = S_ISDIR (file_st.st_mode) != 0;
2561 } 2566 }
@@ -2928,7 +2933,8 @@ file_directory_p (Lisp_Object file)
2928#else 2933#else
2929# ifdef O_PATH 2934# ifdef O_PATH
2930 /* Use O_PATH if available, as it avoids races and EOVERFLOW issues. */ 2935 /* Use O_PATH if available, as it avoids races and EOVERFLOW issues. */
2931 int fd = openat (AT_FDCWD, SSDATA (file), O_PATH | O_CLOEXEC | O_DIRECTORY); 2936 int fd = emacs_openat (AT_FDCWD, SSDATA (file),
2937 O_PATH | O_CLOEXEC | O_DIRECTORY, 0);
2932 if (0 <= fd) 2938 if (0 <= fd)
2933 { 2939 {
2934 emacs_close (fd); 2940 emacs_close (fd);
@@ -2939,9 +2945,9 @@ file_directory_p (Lisp_Object file)
2939 /* O_PATH is defined but evidently this Linux kernel predates 2.6.39. 2945 /* O_PATH is defined but evidently this Linux kernel predates 2.6.39.
2940 Fall back on generic POSIX code. */ 2946 Fall back on generic POSIX code. */
2941# endif 2947# endif
2942 /* Use file_accessible_directory_p, as it avoids stat EOVERFLOW 2948 /* Use file_accessible_directory_p, as it avoids fstatat EOVERFLOW
2943 problems and could be cheaper. However, if it fails because FILE 2949 problems and could be cheaper. However, if it fails because FILE
2944 is inaccessible, fall back on stat; if the latter fails with 2950 is inaccessible, fall back on fstatat; if the latter fails with
2945 EOVERFLOW then FILE must have been a directory unless a race 2951 EOVERFLOW then FILE must have been a directory unless a race
2946 condition occurred (a problem hard to work around portably). */ 2952 condition occurred (a problem hard to work around portably). */
2947 if (file_accessible_directory_p (file)) 2953 if (file_accessible_directory_p (file))
@@ -2949,7 +2955,7 @@ file_directory_p (Lisp_Object file)
2949 if (errno != EACCES) 2955 if (errno != EACCES)
2950 return false; 2956 return false;
2951 struct stat st; 2957 struct stat st;
2952 if (stat (SSDATA (file), &st) != 0) 2958 if (emacs_fstatat (AT_FDCWD, SSDATA (file), &st, 0) != 0)
2953 return errno == EOVERFLOW; 2959 return errno == EOVERFLOW;
2954 if (S_ISDIR (st.st_mode)) 2960 if (S_ISDIR (st.st_mode))
2955 return true; 2961 return true;
@@ -3080,7 +3086,7 @@ See `file-symlink-p' to distinguish symlinks. */)
3080 Vw32_get_true_file_attributes = Qt; 3086 Vw32_get_true_file_attributes = Qt;
3081#endif 3087#endif
3082 3088
3083 int stat_result = stat (SSDATA (absname), &st); 3089 int stat_result = emacs_fstatat (AT_FDCWD, SSDATA (absname), &st, 0);
3084 3090
3085#ifdef WINDOWSNT 3091#ifdef WINDOWSNT
3086 Vw32_get_true_file_attributes = true_attributes; 3092 Vw32_get_true_file_attributes = true_attributes;
@@ -3340,7 +3346,7 @@ Return nil if FILENAME does not exist. */)
3340 if (!NILP (handler)) 3346 if (!NILP (handler))
3341 return call2 (handler, Qfile_modes, absname); 3347 return call2 (handler, Qfile_modes, absname);
3342 3348
3343 if (stat (SSDATA (ENCODE_FILE (absname)), &st) != 0) 3349 if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname)), &st, 0) != 0)
3344 return file_attribute_errno (absname, errno); 3350 return file_attribute_errno (absname, errno);
3345 return make_fixnum (st.st_mode & 07777); 3351 return make_fixnum (st.st_mode & 07777);
3346} 3352}
@@ -3486,7 +3492,7 @@ otherwise, if FILE2 does not exist, the answer is t. */)
3486 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2); 3492 return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
3487 3493
3488 int err1; 3494 int err1;
3489 if (stat (SSDATA (ENCODE_FILE (absname1)), &st1) == 0) 3495 if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname1)), &st1, 0) == 0)
3490 err1 = 0; 3496 err1 = 0;
3491 else 3497 else
3492 { 3498 {
@@ -3494,7 +3500,7 @@ otherwise, if FILE2 does not exist, the answer is t. */)
3494 if (err1 != EOVERFLOW) 3500 if (err1 != EOVERFLOW)
3495 return file_attribute_errno (absname1, err1); 3501 return file_attribute_errno (absname1, err1);
3496 } 3502 }
3497 if (stat (SSDATA (ENCODE_FILE (absname2)), &st2) != 0) 3503 if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname2)), &st2, 0) != 0)
3498 { 3504 {
3499 file_attribute_errno (absname2, errno); 3505 file_attribute_errno (absname2, errno);
3500 return Qt; 3506 return Qt;
@@ -3880,7 +3886,7 @@ by calling `format-decode', which see. */)
3880 if (end_offset < 0) 3886 if (end_offset < 0)
3881 buffer_overflow (); 3887 buffer_overflow ();
3882 3888
3883 /* The file size returned from stat may be zero, but data 3889 /* The file size returned from fstat may be zero, but data
3884 may be readable nonetheless, for example when this is a 3890 may be readable nonetheless, for example when this is a
3885 file in the /proc filesystem. */ 3891 file in the /proc filesystem. */
3886 if (end_offset == 0) 3892 if (end_offset == 0)
@@ -4975,6 +4981,7 @@ Optional fourth argument APPEND if non-nil means
4975Optional fifth argument VISIT, if t or a string, means 4981Optional fifth argument VISIT, if t or a string, means
4976 set the last-save-file-modtime of buffer to this file's modtime 4982 set the last-save-file-modtime of buffer to this file's modtime
4977 and mark buffer not modified. 4983 and mark buffer not modified.
4984If VISIT is t, the buffer is marked as visiting FILENAME.
4978If VISIT is a string, it is a second file name; 4985If VISIT is a string, it is a second file name;
4979 the output goes to FILENAME, but the buffer is marked as visiting VISIT. 4986 the output goes to FILENAME, but the buffer is marked as visiting VISIT.
4980 VISIT is also the file name to lock and unlock for clash detection. 4987 VISIT is also the file name to lock and unlock for clash detection.
@@ -5624,7 +5631,7 @@ See Info node `(elisp)Modification Time' for more details. */)
5624 5631
5625 filename = ENCODE_FILE (BVAR (b, filename)); 5632 filename = ENCODE_FILE (BVAR (b, filename));
5626 5633
5627 mtime = (stat (SSDATA (filename), &st) == 0 5634 mtime = (emacs_fstatat (AT_FDCWD, SSDATA (filename), &st, 0) == 0
5628 ? get_stat_mtime (&st) 5635 ? get_stat_mtime (&st)
5629 : time_error_value (errno)); 5636 : time_error_value (errno));
5630 if (timespec_cmp (mtime, b->modtime) == 0 5637 if (timespec_cmp (mtime, b->modtime) == 0
@@ -5688,7 +5695,8 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */)
5688 /* The handler can find the file name the same way we did. */ 5695 /* The handler can find the file name the same way we did. */
5689 return call2 (handler, Qset_visited_file_modtime, Qnil); 5696 return call2 (handler, Qset_visited_file_modtime, Qnil);
5690 5697
5691 if (stat (SSDATA (ENCODE_FILE (filename)), &st) == 0) 5698 if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (filename)), &st, 0)
5699 == 0)
5692 { 5700 {
5693 current_buffer->modtime = get_stat_mtime (&st); 5701 current_buffer->modtime = get_stat_mtime (&st);
5694 current_buffer->modtime_size = st.st_size; 5702 current_buffer->modtime_size = st.st_size;
@@ -5727,12 +5735,14 @@ auto_save_1 (void)
5727 /* Get visited file's mode to become the auto save file's mode. */ 5735 /* Get visited file's mode to become the auto save file's mode. */
5728 if (! NILP (BVAR (current_buffer, filename))) 5736 if (! NILP (BVAR (current_buffer, filename)))
5729 { 5737 {
5730 if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0) 5738 if (emacs_fstatat (AT_FDCWD, SSDATA (BVAR (current_buffer, filename)),
5739 &st, 0)
5740 == 0)
5731 /* But make sure we can overwrite it later! */ 5741 /* But make sure we can overwrite it later! */
5732 auto_save_mode_bits = (st.st_mode | 0600) & 0777; 5742 auto_save_mode_bits = (st.st_mode | 0600) & 0777;
5733 else if (modes = Ffile_modes (BVAR (current_buffer, filename)), 5743 else if (modes = Ffile_modes (BVAR (current_buffer, filename)),
5734 FIXNUMP (modes)) 5744 FIXNUMP (modes))
5735 /* Remote files don't cooperate with stat. */ 5745 /* Remote files don't cooperate with fstatat. */
5736 auto_save_mode_bits = (XFIXNUM (modes) | 0600) & 0777; 5746 auto_save_mode_bits = (XFIXNUM (modes) | 0600) & 0777;
5737 } 5747 }
5738 5748
diff --git a/src/filelock.c b/src/filelock.c
index b28f16e9b5a..73202f0b2c4 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -347,7 +347,8 @@ rename_lock_file (char const *old, char const *new, bool force)
347 potential race condition since some other process may create 347 potential race condition since some other process may create
348 NEW immediately after the existence check, but it's the best 348 NEW immediately after the existence check, but it's the best
349 we can portably do here. */ 349 we can portably do here. */
350 if (lstat (new, &st) == 0 || errno == EOVERFLOW) 350 if (emacs_fstatat (AT_FDCWD, new, &st, AT_SYMLINK_NOFOLLOW) == 0
351 || errno == EOVERFLOW)
351 { 352 {
352 errno = EEXIST; 353 errno = EEXIST;
353 return -1; 354 return -1;
diff --git a/src/fns.c b/src/fns.c
index 3b5feace521..436ef1c7b74 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -47,6 +47,7 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t,
47enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; 47enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
48static bool internal_equal (Lisp_Object, Lisp_Object, 48static bool internal_equal (Lisp_Object, Lisp_Object,
49 enum equal_kind, int, Lisp_Object); 49 enum equal_kind, int, Lisp_Object);
50static EMACS_UINT sxhash_obj (Lisp_Object, int);
50 51
51DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, 52DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
52 doc: /* Return the ARGUMENT unchanged. */ 53 doc: /* Return the ARGUMENT unchanged. */
@@ -2433,6 +2434,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
2433 same size. */ 2434 same size. */
2434 if (ASIZE (o2) != size) 2435 if (ASIZE (o2) != size)
2435 return false; 2436 return false;
2437
2438 /* Compare bignums, overlays, markers, and boolvectors
2439 specially, by comparing their values. */
2436 if (BIGNUMP (o1)) 2440 if (BIGNUMP (o1))
2437 return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0; 2441 return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0;
2438 if (OVERLAYP (o1)) 2442 if (OVERLAYP (o1))
@@ -2453,21 +2457,12 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
2453 && (XMARKER (o1)->buffer == 0 2457 && (XMARKER (o1)->buffer == 0
2454 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); 2458 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
2455 } 2459 }
2456 /* Boolvectors are compared much like strings. */
2457 if (BOOL_VECTOR_P (o1)) 2460 if (BOOL_VECTOR_P (o1))
2458 { 2461 {
2459 EMACS_INT size = bool_vector_size (o1); 2462 EMACS_INT size = bool_vector_size (o1);
2460 if (size != bool_vector_size (o2)) 2463 return (size == bool_vector_size (o2)
2461 return false; 2464 && !memcmp (bool_vector_data (o1), bool_vector_data (o2),
2462 if (memcmp (bool_vector_data (o1), bool_vector_data (o2), 2465 bool_vector_bytes (size)));
2463 bool_vector_bytes (size)))
2464 return false;
2465 return true;
2466 }
2467 if (WINDOW_CONFIGURATIONP (o1))
2468 {
2469 eassert (equal_kind != EQUAL_NO_QUIT);
2470 return compare_window_configurations (o1, o2, false);
2471 } 2466 }
2472 2467
2473 /* Aside from them, only true vectors, char-tables, compiled 2468 /* Aside from them, only true vectors, char-tables, compiled
@@ -2493,16 +2488,11 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
2493 break; 2488 break;
2494 2489
2495 case Lisp_String: 2490 case Lisp_String:
2496 if (SCHARS (o1) != SCHARS (o2)) 2491 return (SCHARS (o1) == SCHARS (o2)
2497 return false; 2492 && SBYTES (o1) == SBYTES (o2)
2498 if (SBYTES (o1) != SBYTES (o2)) 2493 && !memcmp (SDATA (o1), SDATA (o2), SBYTES (o1))
2499 return false; 2494 && (equal_kind != EQUAL_INCLUDING_PROPERTIES
2500 if (memcmp (SDATA (o1), SDATA (o2), SBYTES (o1))) 2495 || compare_string_intervals (o1, o2)));
2501 return false;
2502 if (equal_kind == EQUAL_INCLUDING_PROPERTIES
2503 && !compare_string_intervals (o1, o2))
2504 return false;
2505 return true;
2506 2496
2507 default: 2497 default:
2508 break; 2498 break;
@@ -4022,7 +4012,7 @@ hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h)
4022Lisp_Object 4012Lisp_Object
4023hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) 4013hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h)
4024{ 4014{
4025 return make_ufixnum (sxhash (key, 0)); 4015 return make_ufixnum (sxhash (key));
4026} 4016}
4027 4017
4028/* Ignore HT and return a hash code for KEY which uses 'eql' to compare keys. 4018/* Ignore HT and return a hash code for KEY which uses 'eql' to compare keys.
@@ -4042,7 +4032,7 @@ hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h)
4042{ 4032{
4043 Lisp_Object args[] = { h->test.user_hash_function, key }; 4033 Lisp_Object args[] = { h->test.user_hash_function, key };
4044 Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h); 4034 Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h);
4045 return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash, 0)); 4035 return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash));
4046} 4036}
4047 4037
4048struct hash_table_test const 4038struct hash_table_test const
@@ -4606,13 +4596,13 @@ sxhash_list (Lisp_Object list, int depth)
4606 CONSP (list) && i < SXHASH_MAX_LEN; 4596 CONSP (list) && i < SXHASH_MAX_LEN;
4607 list = XCDR (list), ++i) 4597 list = XCDR (list), ++i)
4608 { 4598 {
4609 EMACS_UINT hash2 = sxhash (XCAR (list), depth + 1); 4599 EMACS_UINT hash2 = sxhash_obj (XCAR (list), depth + 1);
4610 hash = sxhash_combine (hash, hash2); 4600 hash = sxhash_combine (hash, hash2);
4611 } 4601 }
4612 4602
4613 if (!NILP (list)) 4603 if (!NILP (list))
4614 { 4604 {
4615 EMACS_UINT hash2 = sxhash (list, depth + 1); 4605 EMACS_UINT hash2 = sxhash_obj (list, depth + 1);
4616 hash = sxhash_combine (hash, hash2); 4606 hash = sxhash_combine (hash, hash2);
4617 } 4607 }
4618 4608
@@ -4632,7 +4622,7 @@ sxhash_vector (Lisp_Object vec, int depth)
4632 n = min (SXHASH_MAX_LEN, hash & PSEUDOVECTOR_FLAG ? PVSIZE (vec) : hash); 4622 n = min (SXHASH_MAX_LEN, hash & PSEUDOVECTOR_FLAG ? PVSIZE (vec) : hash);
4633 for (i = 0; i < n; ++i) 4623 for (i = 0; i < n; ++i)
4634 { 4624 {
4635 EMACS_UINT hash2 = sxhash (AREF (vec, i), depth + 1); 4625 EMACS_UINT hash2 = sxhash_obj (AREF (vec, i), depth + 1);
4636 hash = sxhash_combine (hash, hash2); 4626 hash = sxhash_combine (hash, hash2);
4637 } 4627 }
4638 4628
@@ -4675,58 +4665,78 @@ sxhash_bignum (Lisp_Object bignum)
4675 structure. Value is an unsigned integer clipped to INTMASK. */ 4665 structure. Value is an unsigned integer clipped to INTMASK. */
4676 4666
4677EMACS_UINT 4667EMACS_UINT
4678sxhash (Lisp_Object obj, int depth) 4668sxhash (Lisp_Object obj)
4679{ 4669{
4680 EMACS_UINT hash; 4670 return sxhash_obj (obj, 0);
4671}
4681 4672
4673static EMACS_UINT
4674sxhash_obj (Lisp_Object obj, int depth)
4675{
4682 if (depth > SXHASH_MAX_DEPTH) 4676 if (depth > SXHASH_MAX_DEPTH)
4683 return 0; 4677 return 0;
4684 4678
4685 switch (XTYPE (obj)) 4679 switch (XTYPE (obj))
4686 { 4680 {
4687 case_Lisp_Int: 4681 case_Lisp_Int:
4688 hash = XUFIXNUM (obj); 4682 return XUFIXNUM (obj);
4689 break;
4690 4683
4691 case Lisp_Symbol: 4684 case Lisp_Symbol:
4692 hash = XHASH (obj); 4685 return XHASH (obj);
4693 break;
4694 4686
4695 case Lisp_String: 4687 case Lisp_String:
4696 hash = sxhash_string (SSDATA (obj), SBYTES (obj)); 4688 return sxhash_string (SSDATA (obj), SBYTES (obj));
4697 break;
4698 4689
4699 /* This can be everything from a vector to an overlay. */
4700 case Lisp_Vectorlike: 4690 case Lisp_Vectorlike:
4701 if (BIGNUMP (obj)) 4691 {
4702 hash = sxhash_bignum (obj); 4692 enum pvec_type pvec_type = PSEUDOVECTOR_TYPE (XVECTOR (obj));
4703 else if (VECTORP (obj) || RECORDP (obj)) 4693 if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_COMPILED))
4704 /* According to the CL HyperSpec, two arrays are equal only if 4694 {
4705 they are `eq', except for strings and bit-vectors. In 4695 /* According to the CL HyperSpec, two arrays are equal only if
4706 Emacs, this works differently. We have to compare element 4696 they are 'eq', except for strings and bit-vectors. In
4707 by element. Same for records. */ 4697 Emacs, this works differently. We have to compare element
4708 hash = sxhash_vector (obj, depth); 4698 by element. Same for pseudovectors that internal_equal
4709 else if (BOOL_VECTOR_P (obj)) 4699 examines the Lisp contents of. */
4710 hash = sxhash_bool_vector (obj); 4700 return (SUB_CHAR_TABLE_P (obj)
4711 else 4701 /* 'sxhash_vector' can't be applies to a sub-char-table and
4712 /* Others are `equal' if they are `eq', so let's take their 4702 it's probably not worth looking into them anyway! */
4713 address as hash. */ 4703 ? 42
4714 hash = XHASH (obj); 4704 : sxhash_vector (obj, depth));
4715 break; 4705 }
4706 else if (pvec_type == PVEC_BIGNUM)
4707 return sxhash_bignum (obj);
4708 else if (pvec_type == PVEC_MARKER)
4709 {
4710 ptrdiff_t bytepos
4711 = XMARKER (obj)->buffer ? XMARKER (obj)->bytepos : 0;
4712 EMACS_UINT hash
4713 = sxhash_combine ((intptr_t) XMARKER (obj)->buffer, bytepos);
4714 return SXHASH_REDUCE (hash);
4715 }
4716 else if (pvec_type == PVEC_BOOL_VECTOR)
4717 return sxhash_bool_vector (obj);
4718 else if (pvec_type == PVEC_OVERLAY)
4719 {
4720 EMACS_UINT hash = sxhash_obj (OVERLAY_START (obj), depth);
4721 hash = sxhash_combine (hash, sxhash_obj (OVERLAY_END (obj), depth));
4722 hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth));
4723 return SXHASH_REDUCE (hash);
4724 }
4725 else
4726 /* Others are 'equal' if they are 'eq', so take their
4727 address as hash. */
4728 return XHASH (obj);
4729 }
4716 4730
4717 case Lisp_Cons: 4731 case Lisp_Cons:
4718 hash = sxhash_list (obj, depth); 4732 return sxhash_list (obj, depth);
4719 break;
4720 4733
4721 case Lisp_Float: 4734 case Lisp_Float:
4722 hash = sxhash_float (XFLOAT_DATA (obj)); 4735 return sxhash_float (XFLOAT_DATA (obj));
4723 break;
4724 4736
4725 default: 4737 default:
4726 emacs_abort (); 4738 emacs_abort ();
4727 } 4739 }
4728
4729 return hash;
4730} 4740}
4731 4741
4732 4742
diff --git a/src/font.c b/src/font.c
index 2b90903c909..bb39aef92d5 100644
--- a/src/font.c
+++ b/src/font.c
@@ -5545,7 +5545,6 @@ cause Xft crashes. Only has an effect in Xft builds. */);
5545#ifdef USE_CAIRO 5545#ifdef USE_CAIRO
5546 syms_of_ftcrfont (); 5546 syms_of_ftcrfont ();
5547#else 5547#else
5548 syms_of_ftxfont ();
5549#ifdef HAVE_XFT 5548#ifdef HAVE_XFT
5550 syms_of_xftfont (); 5549 syms_of_xftfont ();
5551#endif /* HAVE_XFT */ 5550#endif /* HAVE_XFT */
diff --git a/src/font.h b/src/font.h
index 633d92709c5..0561e3c83f5 100644
--- a/src/font.h
+++ b/src/font.h
@@ -69,8 +69,8 @@ INLINE_HEADER_BEGIN
69 69
70enum font_property_index 70enum font_property_index
71 { 71 {
72 /* FONT-TYPE is a symbol indicating a font backend; currently `x', 72 /* FONT-TYPE is a symbol indicating a font backend; currently `x'
73 `xft', and `ftx' are available on X, `uniscribe' and `gdi' on 73 and `xft' are available on X, `uniscribe' and `gdi' on
74 Windows, and `ns' under Cocoa / GNUstep. */ 74 Windows, and `ns' under Cocoa / GNUstep. */
75 FONT_TYPE_INDEX, 75 FONT_TYPE_INDEX,
76 76
@@ -938,7 +938,6 @@ extern void syms_of_ftfont (void);
938extern struct font_driver const xfont_driver; 938extern struct font_driver const xfont_driver;
939extern Lisp_Object xfont_get_cache (struct frame *); 939extern Lisp_Object xfont_get_cache (struct frame *);
940extern void syms_of_xfont (void); 940extern void syms_of_xfont (void);
941extern void syms_of_ftxfont (void);
942#ifdef HAVE_XFT 941#ifdef HAVE_XFT
943extern struct font_driver const xftfont_driver; 942extern struct font_driver const xftfont_driver;
944#ifdef HAVE_HARFBUZZ 943#ifdef HAVE_HARFBUZZ
@@ -946,7 +945,6 @@ extern struct font_driver xfthbfont_driver;
946#endif /* HAVE_HARFBUZZ */ 945#endif /* HAVE_HARFBUZZ */
947#endif 946#endif
948#if defined HAVE_FREETYPE || defined HAVE_XFT 947#if defined HAVE_FREETYPE || defined HAVE_XFT
949extern struct font_driver const ftxfont_driver;
950extern void syms_of_xftfont (void); 948extern void syms_of_xftfont (void);
951#endif 949#endif
952#ifdef HAVE_BDFFONT 950#ifdef HAVE_BDFFONT
diff --git a/src/frame.c b/src/frame.c
index 88d6f22fc0a..51fc78ab703 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -904,7 +904,7 @@ make_frame (bool mini_p)
904 f->last_tool_bar_item = -1; 904 f->last_tool_bar_item = -1;
905#endif 905#endif
906#ifdef NS_IMPL_COCOA 906#ifdef NS_IMPL_COCOA
907 f->ns_appearance = ns_appearance_aqua; 907 f->ns_appearance = ns_appearance_system_default;
908 f->ns_transparent_titlebar = false; 908 f->ns_transparent_titlebar = false;
909#endif 909#endif
910#endif 910#endif
diff --git a/src/frame.h b/src/frame.h
index 6ab690c0ff5..68dc0ce3649 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -69,8 +69,9 @@ enum internal_border_part
69#ifdef NS_IMPL_COCOA 69#ifdef NS_IMPL_COCOA
70enum ns_appearance_type 70enum ns_appearance_type
71 { 71 {
72 ns_appearance_aqua, 72 ns_appearance_system_default,
73 ns_appearance_vibrant_dark 73 ns_appearance_aqua,
74 ns_appearance_vibrant_dark
74 }; 75 };
75#endif 76#endif
76#endif /* HAVE_WINDOW_SYSTEM */ 77#endif /* HAVE_WINDOW_SYSTEM */
diff --git a/src/ftxfont.c b/src/ftxfont.c
deleted file mode 100644
index 9bbb2c064c2..00000000000
--- a/src/ftxfont.c
+++ /dev/null
@@ -1,371 +0,0 @@
1/* ftxfont.c -- FreeType font driver on X (without using XFT).
2 Copyright (C) 2006-2020 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
6
7This file is part of GNU Emacs.
8
9GNU Emacs is free software: you can redistribute it and/or modify
10it under the terms of the GNU General Public License as published by
11the Free Software Foundation, either version 3 of the License, or (at
12your option) any later version.
13
14GNU Emacs is distributed in the hope that it will be useful,
15but WITHOUT ANY WARRANTY; without even the implied warranty of
16MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17GNU General Public License for more details.
18
19You should have received a copy of the GNU General Public License
20along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
21
22#include <config.h>
23#include <X11/Xlib.h>
24
25#include "lisp.h"
26#include "xterm.h"
27#include "frame.h"
28#include "blockinput.h"
29#include "font.h"
30#include "pdumper.h"
31
32/* FTX font driver. */
33
34struct ftxfont_frame_data
35{
36 /* Background and foreground colors. */
37 XColor colors[2];
38 /* GCs interpolating the above colors. gcs[0] is for a color
39 closest to BACKGROUND, and gcs[5] is for a color closest to
40 FOREGROUND. */
41 GC gcs[6];
42 struct ftxfont_frame_data *next;
43};
44
45
46/* Return an array of 6 GCs for antialiasing. */
47
48static GC *
49ftxfont_get_gcs (struct frame *f, unsigned long foreground, unsigned long background)
50{
51 XColor color;
52 XGCValues xgcv;
53 int i;
54 struct ftxfont_frame_data *data = font_get_frame_data (f, Qftx);
55 struct ftxfont_frame_data *prev = NULL, *this = NULL, *new;
56
57 if (data)
58 {
59 for (this = data; this; prev = this, this = this->next)
60 {
61 if (this->colors[0].pixel < background)
62 continue;
63 if (this->colors[0].pixel > background)
64 break;
65 if (this->colors[1].pixel < foreground)
66 continue;
67 if (this->colors[1].pixel > foreground)
68 break;
69 return this->gcs;
70 }
71 }
72
73 new = xmalloc (sizeof *new);
74 new->next = this;
75 if (prev)
76 prev->next = new;
77 font_put_frame_data (f, Qftx, new);
78
79 new->colors[0].pixel = background;
80 new->colors[1].pixel = foreground;
81
82 block_input ();
83 XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), new->colors, 2);
84 for (i = 1; i < 7; i++)
85 {
86 /* Interpolate colors linearly. Any better algorithm? */
87 color.red
88 = (new->colors[1].red * i + new->colors[0].red * (8 - i)) / 8;
89 color.green
90 = (new->colors[1].green * i + new->colors[0].green * (8 - i)) / 8;
91 color.blue
92 = (new->colors[1].blue * i + new->colors[0].blue * (8 - i)) / 8;
93 if (! x_alloc_nearest_color (f, FRAME_X_COLORMAP (f), &color))
94 break;
95 xgcv.foreground = color.pixel;
96 new->gcs[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
97 GCForeground, &xgcv);
98 }
99 unblock_input ();
100
101 if (i < 7)
102 {
103 block_input ();
104 for (i--; i >= 0; i--)
105 XFreeGC (FRAME_X_DISPLAY (f), new->gcs[i]);
106 unblock_input ();
107 if (prev)
108 prev->next = new->next;
109 else if (data)
110 font_put_frame_data (f, Qftx, new->next);
111 xfree (new);
112 return NULL;
113 }
114 return new->gcs;
115}
116
117static int
118ftxfont_draw_bitmap (struct frame *f, GC gc_fore, GC *gcs, struct font *font,
119 unsigned int code, int x, int y, XPoint *p, int size,
120 int *n, bool flush)
121{
122 struct font_bitmap bitmap;
123 unsigned char *b;
124 int i, j;
125
126 if (ftfont_get_bitmap (font, code, &bitmap, size > 0x100 ? 1 : 8) < 0)
127 return 0;
128 if (size > 0x100)
129 {
130 for (i = 0, b = bitmap.buffer; i < bitmap.rows;
131 i++, b += bitmap.pitch)
132 {
133 for (j = 0; j < bitmap.width; j++)
134 if (b[j / 8] & (1 << (7 - (j % 8))))
135 {
136 p[n[0]].x = x + bitmap.left + j;
137 p[n[0]].y = y - bitmap.top + i;
138 if (++n[0] == size)
139 {
140 XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
141 gc_fore, p, size, CoordModeOrigin);
142 n[0] = 0;
143 }
144 }
145 }
146 if (flush && n[0] > 0)
147 XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
148 gc_fore, p, n[0], CoordModeOrigin);
149 }
150 else
151 {
152 for (i = 0, b = bitmap.buffer; i < bitmap.rows;
153 i++, b += bitmap.pitch)
154 {
155 for (j = 0; j < bitmap.width; j++)
156 {
157 int idx = (bitmap.bits_per_pixel == 1
158 ? ((b[j / 8] & (1 << (7 - (j % 8)))) ? 6 : -1)
159 : (b[j] >> 5) - 1);
160
161 if (idx >= 0)
162 {
163 XPoint *pp = p + size * idx;
164
165 pp[n[idx]].x = x + bitmap.left + j;
166 pp[n[idx]].y = y - bitmap.top + i;
167 if (++(n[idx]) == size)
168 {
169 XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
170 idx == 6 ? gc_fore : gcs[idx], pp, size,
171 CoordModeOrigin);
172 n[idx] = 0;
173 }
174 }
175 }
176 }
177 if (flush)
178 {
179 for (i = 0; i < 6; i++)
180 if (n[i] > 0)
181 XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
182 gcs[i], p + 0x100 * i, n[i], CoordModeOrigin);
183 if (n[6] > 0)
184 XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f),
185 gc_fore, p + 0x600, n[6], CoordModeOrigin);
186 }
187 }
188
189 /* There is no ftfont_free_bitmap, so do not try to free BITMAP. */
190
191 return bitmap.advance;
192}
193
194static void
195ftxfont_draw_background (struct frame *f, struct font *font, GC gc, int x, int y,
196 int width)
197{
198 XGCValues xgcv;
199
200 XGetGCValues (FRAME_X_DISPLAY (f), gc,
201 GCForeground | GCBackground, &xgcv);
202 XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.background);
203 XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), gc,
204 x, y - FONT_BASE (font), width, FONT_HEIGHT (font));
205 XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.foreground);
206}
207
208static Lisp_Object
209ftxfont_list (struct frame *f, Lisp_Object spec)
210{
211 return ftfont_list2 (f, spec, Qftx);
212}
213
214static Lisp_Object
215ftxfont_match (struct frame *f, Lisp_Object spec)
216{
217 return ftfont_match2 (f, spec, Qftx);
218}
219
220static Lisp_Object
221ftxfont_open (struct frame *f, Lisp_Object entity, int pixel_size)
222{
223 Lisp_Object font_object = ftfont_open (f, entity, pixel_size);
224 if (NILP (font_object))
225 return Qnil;
226 struct font *font = XFONT_OBJECT (font_object);
227 font->driver = &ftxfont_driver;
228 return font_object;
229}
230
231static void
232ftxfont_close (struct font *font)
233{
234 ftfont_close (font);
235}
236
237static int
238ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y,
239 bool with_background)
240{
241 struct frame *f = s->f;
242 struct face *face = s->face;
243 struct font *font = s->font;
244 XPoint p[0x700];
245 int n[7];
246 unsigned *code = s->char2b + from;
247 int len = to - from;
248 int i;
249 GC *gcs;
250 int xadvance;
251
252 n[0] = n[1] = n[2] = n[3] = n[4] = n[5] = n[6] = 0;
253
254 block_input ();
255 if (with_background)
256 ftxfont_draw_background (f, font, s->gc, x, y, s->width);
257
258 if (face->gc == s->gc)
259 {
260 gcs = ftxfont_get_gcs (f, face->foreground, face->background);
261 }
262 else
263 {
264 XGCValues xgcv;
265 unsigned long mask = GCForeground | GCBackground;
266
267 XGetGCValues (FRAME_X_DISPLAY (f), s->gc, mask, &xgcv);
268 gcs = ftxfont_get_gcs (f, xgcv.foreground, xgcv.background);
269 }
270
271 if (gcs)
272 {
273 if (s->num_clips)
274 for (i = 0; i < 6; i++)
275 XSetClipRectangles (FRAME_X_DISPLAY (f), gcs[i], 0, 0,
276 s->clip, s->num_clips, Unsorted);
277
278 for (i = 0; i < len; i++)
279 {
280 xadvance = ftxfont_draw_bitmap (f, s->gc, gcs, font, code[i], x, y,
281 p, 0x100, n, i + 1 == len);
282 x += (s->padding_p ? 1 : xadvance);
283 }
284 if (s->num_clips)
285 for (i = 0; i < 6; i++)
286 XSetClipMask (FRAME_X_DISPLAY (f), gcs[i], None);
287 }
288 else
289 {
290 /* We can't draw with antialiasing.
291 s->gc should already have a proper clipping setting. */
292 for (i = 0; i < len; i++)
293 {
294 xadvance = ftxfont_draw_bitmap (f, s->gc, NULL, font, code[i], x, y,
295 p, 0x700, n, i + 1 == len);
296 x += (s->padding_p ? 1 : xadvance);
297 }
298 }
299
300 unblock_input ();
301
302 return len;
303}
304
305static int
306ftxfont_end_for_frame (struct frame *f)
307{
308 struct ftxfont_frame_data *data = font_get_frame_data (f, Qftx);
309
310 block_input ();
311 while (data)
312 {
313 struct ftxfont_frame_data *next = data->next;
314 int i;
315
316 for (i = 0; i < 6; i++)
317 XFreeGC (FRAME_X_DISPLAY (f), data->gcs[i]);
318 xfree (data);
319 data = next;
320 }
321 unblock_input ();
322 font_put_frame_data (f, Qftx, NULL);
323 return 0;
324}
325
326
327
328static void syms_of_ftxfont_for_pdumper (void);
329
330struct font_driver const ftxfont_driver =
331 {
332 /* We can't draw a text without device dependent functions. */
333 .type = LISPSYM_INITIALLY (Qftx),
334 .get_cache = ftfont_get_cache,
335 .list = ftxfont_list,
336 .match = ftxfont_match,
337 .list_family = ftfont_list_family,
338 .open_font = ftxfont_open,
339 .close_font = ftxfont_close,
340 .has_char = ftfont_has_char,
341 .encode_char = ftfont_encode_char,
342 .text_extents = ftfont_text_extents,
343 .draw = ftxfont_draw,
344 .get_bitmap = ftfont_get_bitmap,
345 .anchor_point = ftfont_anchor_point,
346#ifdef HAVE_LIBOTF
347 .otf_capability = ftfont_otf_capability,
348#endif
349 .end_for_frame = ftxfont_end_for_frame,
350#if defined HAVE_M17N_FLT && defined HAVE_LIBOTF
351 .shape = ftfont_shape,
352#endif
353#if defined HAVE_OTF_GET_VARIATION_GLYPHS || defined HAVE_FT_FACE_GETCHARVARIANTINDEX
354 .get_variation_glyphs = ftfont_variation_glyphs,
355#endif
356 .filter_properties = ftfont_filter_properties,
357 .combining_capability = ftfont_combining_capability,
358 };
359
360void
361syms_of_ftxfont (void)
362{
363 DEFSYM (Qftx, "ftx");
364 pdumper_do_now_and_after_load (syms_of_ftxfont_for_pdumper);
365}
366
367static void
368syms_of_ftxfont_for_pdumper (void)
369{
370 register_font_driver (&ftxfont_driver, NULL);
371}
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 6308c38f164..5e7cf3d2114 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -22,6 +22,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
22#ifdef USE_GTK 22#ifdef USE_GTK
23#include <float.h> 23#include <float.h>
24#include <stdio.h> 24#include <stdio.h>
25#include <stdlib.h>
25 26
26#include <c-ctype.h> 27#include <c-ctype.h>
27 28
diff --git a/src/image.c b/src/image.c
index 5fe0d713e1b..65d59254f02 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1242,6 +1242,10 @@ prepare_image_for_display (struct frame *f, struct image *img)
1242 if (img->cr_data == NULL || (cairo_pattern_get_type (img->cr_data) 1242 if (img->cr_data == NULL || (cairo_pattern_get_type (img->cr_data)
1243 != CAIRO_PATTERN_TYPE_SURFACE)) 1243 != CAIRO_PATTERN_TYPE_SURFACE))
1244 { 1244 {
1245 /* Fill in the background/background_transparent field while
1246 we have img->pixmap->data/img->mask->data. */
1247 IMAGE_BACKGROUND (img, f, img->pixmap);
1248 IMAGE_BACKGROUND_TRANSPARENT (img, f, img->mask);
1245 cr_put_image_to_cr_data (img); 1249 cr_put_image_to_cr_data (img);
1246 if (img->cr_data == NULL) 1250 if (img->cr_data == NULL)
1247 { 1251 {
@@ -1616,7 +1620,7 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash)
1616static void 1620static void
1617uncache_image (struct frame *f, Lisp_Object spec) 1621uncache_image (struct frame *f, Lisp_Object spec)
1618{ 1622{
1619 struct image *img = search_image_cache (f, spec, sxhash (spec, 0)); 1623 struct image *img = search_image_cache (f, spec, sxhash (spec));
1620 if (img) 1624 if (img)
1621 { 1625 {
1622 free_image (f, img); 1626 free_image (f, img);
@@ -2281,7 +2285,7 @@ lookup_image (struct frame *f, Lisp_Object spec)
2281 eassert (valid_image_p (spec)); 2285 eassert (valid_image_p (spec));
2282 2286
2283 /* Look up SPEC in the hash table of the image cache. */ 2287 /* Look up SPEC in the hash table of the image cache. */
2284 hash = sxhash (spec, 0); 2288 hash = sxhash (spec);
2285 img = search_image_cache (f, spec, hash); 2289 img = search_image_cache (f, spec, hash);
2286 if (img && img->load_failed_p) 2290 if (img && img->load_failed_p)
2287 { 2291 {
@@ -6231,7 +6235,7 @@ pbm_load (struct frame *f, struct image *img)
6231 PNG 6235 PNG
6232 ***********************************************************************/ 6236 ***********************************************************************/
6233 6237
6234#if defined (HAVE_PNG) || defined (HAVE_NS) || defined (USE_CAIRO) 6238#if defined (HAVE_PNG) || defined (HAVE_NS)
6235 6239
6236/* Indices of image specification fields in png_format, below. */ 6240/* Indices of image specification fields in png_format, below. */
6237 6241
@@ -6282,10 +6286,10 @@ png_image_p (Lisp_Object object)
6282 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1; 6286 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
6283} 6287}
6284 6288
6285#endif /* HAVE_PNG || HAVE_NS || USE_CAIRO */ 6289#endif /* HAVE_PNG || HAVE_NS */
6286 6290
6287 6291
6288#if (defined HAVE_PNG && !defined HAVE_NS) || defined USE_CAIRO 6292#if defined HAVE_PNG && !defined HAVE_NS
6289 6293
6290# ifdef WINDOWSNT 6294# ifdef WINDOWSNT
6291/* PNG library details. */ 6295/* PNG library details. */
@@ -10160,7 +10164,7 @@ static struct image_type const image_types[] =
10160 { SYMBOL_INDEX (Qsvg), svg_image_p, svg_load, image_clear_image, 10164 { SYMBOL_INDEX (Qsvg), svg_image_p, svg_load, image_clear_image,
10161 IMAGE_TYPE_INIT (init_svg_functions) }, 10165 IMAGE_TYPE_INIT (init_svg_functions) },
10162#endif 10166#endif
10163#if defined HAVE_PNG || defined HAVE_NS || defined USE_CAIRO 10167#if defined HAVE_PNG || defined HAVE_NS
10164 { SYMBOL_INDEX (Qpng), png_image_p, png_load, image_clear_image, 10168 { SYMBOL_INDEX (Qpng), png_image_p, png_load, image_clear_image,
10165 IMAGE_TYPE_INIT (init_png_functions) }, 10169 IMAGE_TYPE_INIT (init_png_functions) },
10166#endif 10170#endif
diff --git a/src/json.c b/src/json.c
index 2e50ce514fd..30027675580 100644
--- a/src/json.c
+++ b/src/json.c
@@ -1121,7 +1121,6 @@ syms_of_json (void)
1121 1121
1122 DEFSYM (Qstring_without_embedded_nulls_p, "string-without-embedded-nulls-p"); 1122 DEFSYM (Qstring_without_embedded_nulls_p, "string-without-embedded-nulls-p");
1123 DEFSYM (Qjson_value_p, "json-value-p"); 1123 DEFSYM (Qjson_value_p, "json-value-p");
1124 DEFSYM (Qutf_8_string_p, "utf-8-string-p");
1125 1124
1126 DEFSYM (Qjson_error, "json-error"); 1125 DEFSYM (Qjson_error, "json-error");
1127 DEFSYM (Qjson_out_of_memory, "json-out-of-memory"); 1126 DEFSYM (Qjson_out_of_memory, "json-out-of-memory");
diff --git a/src/lisp.h b/src/lisp.h
index 8674fe11a64..0bd375658e2 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1069,7 +1069,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
1069 with PVEC_TYPE_MASK to indicate the actual type. */ 1069 with PVEC_TYPE_MASK to indicate the actual type. */
1070enum pvec_type 1070enum pvec_type
1071{ 1071{
1072 PVEC_NORMAL_VECTOR, 1072 PVEC_NORMAL_VECTOR, /* Should be first, for sxhash_obj. */
1073 PVEC_FREE, 1073 PVEC_FREE,
1074 PVEC_BIGNUM, 1074 PVEC_BIGNUM,
1075 PVEC_MARKER, 1075 PVEC_MARKER,
@@ -1094,7 +1094,7 @@ enum pvec_type
1094 PVEC_CONDVAR, 1094 PVEC_CONDVAR,
1095 PVEC_MODULE_FUNCTION, 1095 PVEC_MODULE_FUNCTION,
1096 1096
1097 /* These should be last, check internal_equal to see why. */ 1097 /* These should be last, for internal_equal and sxhash_obj. */
1098 PVEC_COMPILED, 1098 PVEC_COMPILED,
1099 PVEC_CHAR_TABLE, 1099 PVEC_CHAR_TABLE,
1100 PVEC_SUB_CHAR_TABLE, 1100 PVEC_SUB_CHAR_TABLE,
@@ -3652,7 +3652,7 @@ extern bool sweep_weak_table (struct Lisp_Hash_Table *, bool);
3652extern void hexbuf_digest (char *, void const *, int); 3652extern void hexbuf_digest (char *, void const *, int);
3653extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); 3653extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *);
3654EMACS_UINT hash_string (char const *, ptrdiff_t); 3654EMACS_UINT hash_string (char const *, ptrdiff_t);
3655EMACS_UINT sxhash (Lisp_Object, int); 3655EMACS_UINT sxhash (Lisp_Object);
3656Lisp_Object hashfn_eql (Lisp_Object, struct Lisp_Hash_Table *); 3656Lisp_Object hashfn_eql (Lisp_Object, struct Lisp_Hash_Table *);
3657Lisp_Object hashfn_equal (Lisp_Object, struct Lisp_Hash_Table *); 3657Lisp_Object hashfn_equal (Lisp_Object, struct Lisp_Hash_Table *);
3658Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *); 3658Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *);
@@ -3812,7 +3812,7 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t,
3812/* Defined in alloc.c. */ 3812/* Defined in alloc.c. */
3813extern void *my_heap_start (void); 3813extern void *my_heap_start (void);
3814extern void check_pure_size (void); 3814extern void check_pure_size (void);
3815extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); 3815unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int);
3816extern void malloc_warning (const char *); 3816extern void malloc_warning (const char *);
3817extern AVOID memory_full (size_t); 3817extern AVOID memory_full (size_t);
3818extern AVOID buffer_memory_full (ptrdiff_t); 3818extern AVOID buffer_memory_full (ptrdiff_t);
@@ -3942,6 +3942,7 @@ extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
3942extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); 3942extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object);
3943extern void make_byte_code (struct Lisp_Vector *); 3943extern void make_byte_code (struct Lisp_Vector *);
3944extern struct Lisp_Vector *allocate_vector (ptrdiff_t); 3944extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
3945extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t);
3945 3946
3946/* Make an uninitialized vector for SIZE objects. NOTE: you must 3947/* Make an uninitialized vector for SIZE objects. NOTE: you must
3947 be sure that GC cannot happen until the vector is completely 3948 be sure that GC cannot happen until the vector is completely
@@ -3977,9 +3978,7 @@ make_uninit_sub_char_table (int depth, int min_char)
3977INLINE Lisp_Object 3978INLINE Lisp_Object
3978make_nil_vector (ptrdiff_t size) 3979make_nil_vector (ptrdiff_t size)
3979{ 3980{
3980 Lisp_Object vec = make_uninit_vector (size); 3981 return make_lisp_ptr (allocate_nil_vector (size), Lisp_Vectorlike);
3981 memclear (XVECTOR (vec)->contents, size * word_size);
3982 return vec;
3983} 3982}
3984 3983
3985extern struct Lisp_Vector *allocate_pseudovector (int, int, int, 3984extern struct Lisp_Vector *allocate_pseudovector (int, int, int,
@@ -4245,6 +4244,8 @@ extern Lisp_Object module_function_documentation
4245 (struct Lisp_Module_Function const *); 4244 (struct Lisp_Module_Function const *);
4246extern module_funcptr module_function_address 4245extern module_funcptr module_function_address
4247 (struct Lisp_Module_Function const *); 4246 (struct Lisp_Module_Function const *);
4247extern void *module_function_data (const struct Lisp_Module_Function *);
4248extern void module_finalize_function (const struct Lisp_Module_Function *);
4248extern void mark_modules (void); 4249extern void mark_modules (void);
4249extern void init_module_assertions (bool); 4250extern void init_module_assertions (bool);
4250extern void syms_of_module (void); 4251extern void syms_of_module (void);
@@ -4604,6 +4605,8 @@ extern void seed_random (void *, ptrdiff_t);
4604extern void init_random (void); 4605extern void init_random (void);
4605extern void emacs_backtrace (int); 4606extern void emacs_backtrace (int);
4606extern AVOID emacs_abort (void) NO_INLINE; 4607extern AVOID emacs_abort (void) NO_INLINE;
4608extern int emacs_fstatat (int, char const *, void *, int);
4609extern int emacs_openat (int, char const *, int, int);
4607extern int emacs_open (const char *, int, int); 4610extern int emacs_open (const char *, int, int);
4608extern int emacs_pipe (int[2]); 4611extern int emacs_pipe (int[2]);
4609extern int emacs_close (int); 4612extern int emacs_close (int);
diff --git a/src/lread.c b/src/lread.c
index 290b3d3d64e..69dd73912bc 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1353,11 +1353,11 @@ Return t if the file exists and loads successfully. */)
1353 ignores suffix order due to load_prefer_newer. */ 1353 ignores suffix order due to load_prefer_newer. */
1354 if (!load_prefer_newer && is_elc) 1354 if (!load_prefer_newer && is_elc)
1355 { 1355 {
1356 result = stat (SSDATA (efound), &s1); 1356 result = emacs_fstatat (AT_FDCWD, SSDATA (efound), &s1, 0);
1357 if (result == 0) 1357 if (result == 0)
1358 { 1358 {
1359 SSET (efound, SBYTES (efound) - 1, 0); 1359 SSET (efound, SBYTES (efound) - 1, 0);
1360 result = stat (SSDATA (efound), &s2); 1360 result = emacs_fstatat (AT_FDCWD, SSDATA (efound), &s2, 0);
1361 SSET (efound, SBYTES (efound) - 1, 'c'); 1361 SSET (efound, SBYTES (efound) - 1, 'c');
1362 } 1362 }
1363 1363
@@ -5070,7 +5070,7 @@ that are loaded before your customizations are read! */);
5070If nil, `load' and `read' raise errors when encountering some 5070If nil, `load' and `read' raise errors when encountering some
5071old-style variants of backquote and comma. If non-nil, these 5071old-style variants of backquote and comma. If non-nil, these
5072constructs are always interpreted as described in the Info node 5072constructs are always interpreted as described in the Info node
5073`(elisp)Backquotes', even if that interpretation is incompatible with 5073`(elisp)Backquote', even if that interpretation is incompatible with
5074previous versions of Emacs. Setting this variable to non-nil makes 5074previous versions of Emacs. Setting this variable to non-nil makes
5075Emacs compatible with the behavior planned for Emacs 28. In Emacs 28, 5075Emacs compatible with the behavior planned for Emacs 28. In Emacs 28,
5076this variable will become obsolete. */); 5076this variable will become obsolete. */);
diff --git a/src/mini-gmp.c b/src/mini-gmp.c
index bf8a6164981..2e789a2dfcc 100644
--- a/src/mini-gmp.c
+++ b/src/mini-gmp.c
@@ -94,11 +94,13 @@ see https://www.gnu.org/licenses/. */
94 94
95#define gmp_clz(count, x) do { \ 95#define gmp_clz(count, x) do { \
96 mp_limb_t __clz_x = (x); \ 96 mp_limb_t __clz_x = (x); \
97 unsigned __clz_c; \ 97 unsigned __clz_c = 0; \
98 for (__clz_c = 0; \ 98 int LOCAL_SHIFT_BITS = 8; \
99 (__clz_x & ((mp_limb_t) 0xff << (GMP_LIMB_BITS - 8))) == 0; \ 99 if (GMP_LIMB_BITS > LOCAL_SHIFT_BITS) \
100 __clz_c += 8) \ 100 for (; \
101 __clz_x <<= 8; \ 101 (__clz_x & ((mp_limb_t) 0xff << (GMP_LIMB_BITS - 8))) == 0; \
102 __clz_c += 8) \
103 { __clz_x <<= LOCAL_SHIFT_BITS; } \
102 for (; (__clz_x & GMP_LIMB_HIGHBIT) == 0; __clz_c++) \ 104 for (; (__clz_x & GMP_LIMB_HIGHBIT) == 0; __clz_c++) \
103 __clz_x <<= 1; \ 105 __clz_x <<= 1; \
104 (count) = __clz_c; \ 106 (count) = __clz_c; \
@@ -143,27 +145,27 @@ see https://www.gnu.org/licenses/. */
143 w1 = (mp_limb_t) (__ww >> LOCAL_GMP_LIMB_BITS); \ 145 w1 = (mp_limb_t) (__ww >> LOCAL_GMP_LIMB_BITS); \
144 } \ 146 } \
145 else { \ 147 else { \
146 mp_limb_t __x0, __x1, __x2, __x3; \ 148 mp_limb_t __x0, __x1, __x2, __x3; \
147 unsigned __ul, __vl, __uh, __vh; \ 149 unsigned __ul, __vl, __uh, __vh; \
148 mp_limb_t __u = (u), __v = (v); \ 150 mp_limb_t __u = (u), __v = (v); \
149 \ 151 \
150 __ul = __u & GMP_LLIMB_MASK; \ 152 __ul = __u & GMP_LLIMB_MASK; \
151 __uh = __u >> (GMP_LIMB_BITS / 2); \ 153 __uh = __u >> (GMP_LIMB_BITS / 2); \
152 __vl = __v & GMP_LLIMB_MASK; \ 154 __vl = __v & GMP_LLIMB_MASK; \
153 __vh = __v >> (GMP_LIMB_BITS / 2); \ 155 __vh = __v >> (GMP_LIMB_BITS / 2); \
154 \ 156 \
155 __x0 = (mp_limb_t) __ul * __vl; \ 157 __x0 = (mp_limb_t) __ul * __vl; \
156 __x1 = (mp_limb_t) __ul * __vh; \ 158 __x1 = (mp_limb_t) __ul * __vh; \
157 __x2 = (mp_limb_t) __uh * __vl; \ 159 __x2 = (mp_limb_t) __uh * __vl; \
158 __x3 = (mp_limb_t) __uh * __vh; \ 160 __x3 = (mp_limb_t) __uh * __vh; \
159 \ 161 \
160 __x1 += __x0 >> (GMP_LIMB_BITS / 2);/* this can't give carry */ \ 162 __x1 += __x0 >> (GMP_LIMB_BITS / 2);/* this can't give carry */ \
161 __x1 += __x2; /* but this indeed can */ \ 163 __x1 += __x2; /* but this indeed can */ \
162 if (__x1 < __x2) /* did we get it? */ \ 164 if (__x1 < __x2) /* did we get it? */ \
163 __x3 += GMP_HLIMB_BIT; /* yes, add it in the proper pos. */ \ 165 __x3 += GMP_HLIMB_BIT; /* yes, add it in the proper pos. */ \
164 \ 166 \
165 (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \ 167 (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \
166 (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \ 168 (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \
167 } \ 169 } \
168 } while (0) 170 } while (0)
169 171
@@ -768,91 +770,81 @@ mpn_neg (mp_ptr rp, mp_srcptr up, mp_size_t n)
768mp_limb_t 770mp_limb_t
769mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0) 771mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0)
770{ 772{
771 int GMP_LIMB_BITS_MUL_3 = GMP_LIMB_BITS * 3; 773 mp_limb_t r, m;
772 if (sizeof (unsigned) * CHAR_BIT > GMP_LIMB_BITS * 3)
773 {
774 return (((unsigned) 1 << GMP_LIMB_BITS_MUL_3) - 1) /
775 (((unsigned) u1 << GMP_LIMB_BITS_MUL_3 / 3) + u0);
776 }
777 else if (GMP_ULONG_BITS > GMP_LIMB_BITS * 3)
778 {
779 return (((unsigned long) 1 << GMP_LIMB_BITS_MUL_3) - 1) /
780 (((unsigned long) u1 << GMP_LIMB_BITS_MUL_3 / 3) + u0);
781 }
782 else {
783 mp_limb_t r, p, m, ql;
784 unsigned ul, uh, qh;
785 774
786 assert (u1 >= GMP_LIMB_HIGHBIT); 775 {
776 mp_limb_t p, ql;
777 unsigned ul, uh, qh;
787 778
788 /* For notation, let b denote the half-limb base, so that B = b^2. 779 /* For notation, let b denote the half-limb base, so that B = b^2.
789 Split u1 = b uh + ul. */ 780 Split u1 = b uh + ul. */
790 ul = u1 & GMP_LLIMB_MASK; 781 ul = u1 & GMP_LLIMB_MASK;
791 uh = u1 >> (GMP_LIMB_BITS / 2); 782 uh = u1 >> (GMP_LIMB_BITS / 2);
792 783
793 /* Approximation of the high half of quotient. Differs from the 2/1 784 /* Approximation of the high half of quotient. Differs from the 2/1
794 inverse of the half limb uh, since we have already subtracted 785 inverse of the half limb uh, since we have already subtracted
795 u0. */ 786 u0. */
796 qh = ~u1 / uh; 787 qh = (u1 ^ GMP_LIMB_MAX) / uh;
797 788
798 /* Adjust to get a half-limb 3/2 inverse, i.e., we want 789 /* Adjust to get a half-limb 3/2 inverse, i.e., we want
799 790
800 qh' = floor( (b^3 - 1) / u) - b = floor ((b^3 - b u - 1) / u 791 qh' = floor( (b^3 - 1) / u) - b = floor ((b^3 - b u - 1) / u
801 = floor( (b (~u) + b-1) / u), 792 = floor( (b (~u) + b-1) / u),
802 793
803 and the remainder 794 and the remainder
804 795
805 r = b (~u) + b-1 - qh (b uh + ul) 796 r = b (~u) + b-1 - qh (b uh + ul)
806 = b (~u - qh uh) + b-1 - qh ul 797 = b (~u - qh uh) + b-1 - qh ul
807 798
808 Subtraction of qh ul may underflow, which implies adjustments. 799 Subtraction of qh ul may underflow, which implies adjustments.
809 But by normalization, 2 u >= B > qh ul, so we need to adjust by 800 But by normalization, 2 u >= B > qh ul, so we need to adjust by
810 at most 2. 801 at most 2.
811 */ 802 */
812 803
813 r = ((~u1 - (mp_limb_t) qh * uh) << (GMP_LIMB_BITS / 2)) | GMP_LLIMB_MASK; 804 r = ((~u1 - (mp_limb_t) qh * uh) << (GMP_LIMB_BITS / 2)) | GMP_LLIMB_MASK;
814 805
815 p = (mp_limb_t) qh * ul; 806 p = (mp_limb_t) qh * ul;
816 /* Adjustment steps taken from udiv_qrnnd_c */ 807 /* Adjustment steps taken from udiv_qrnnd_c */
817 if (r < p) 808 if (r < p)
818 { 809 {
819 qh--; 810 qh--;
820 r += u1; 811 r += u1;
821 if (r >= u1) /* i.e. we didn't get carry when adding to r */ 812 if (r >= u1) /* i.e. we didn't get carry when adding to r */
822 if (r < p) 813 if (r < p)
823 { 814 {
824 qh--; 815 qh--;
825 r += u1; 816 r += u1;
826 } 817 }
827 } 818 }
828 r -= p; 819 r -= p;
829 820
830 /* Low half of the quotient is 821 /* Low half of the quotient is
831 822
832 ql = floor ( (b r + b-1) / u1). 823 ql = floor ( (b r + b-1) / u1).
833 824
834 This is a 3/2 division (on half-limbs), for which qh is a 825 This is a 3/2 division (on half-limbs), for which qh is a
835 suitable inverse. */ 826 suitable inverse. */
836 827
837 p = (r >> (GMP_LIMB_BITS / 2)) * qh + r; 828 p = (r >> (GMP_LIMB_BITS / 2)) * qh + r;
838 /* Unlike full-limb 3/2, we can add 1 without overflow. For this to 829 /* Unlike full-limb 3/2, we can add 1 without overflow. For this to
839 work, it is essential that ql is a full mp_limb_t. */ 830 work, it is essential that ql is a full mp_limb_t. */
840 ql = (p >> (GMP_LIMB_BITS / 2)) + 1; 831 ql = (p >> (GMP_LIMB_BITS / 2)) + 1;
841 832
842 /* By the 3/2 trick, we don't need the high half limb. */ 833 /* By the 3/2 trick, we don't need the high half limb. */
843 r = (r << (GMP_LIMB_BITS / 2)) + GMP_LLIMB_MASK - ql * u1; 834 r = (r << (GMP_LIMB_BITS / 2)) + GMP_LLIMB_MASK - ql * u1;
844 835
845 if (r >= (p << (GMP_LIMB_BITS / 2))) 836 if (r >= (GMP_LIMB_MAX & (p << (GMP_LIMB_BITS / 2))))
846 { 837 {
847 ql--; 838 ql--;
848 r += u1; 839 r += u1;
849 } 840 }
850 m = ((mp_limb_t) qh << (GMP_LIMB_BITS / 2)) + ql; 841 m = ((mp_limb_t) qh << (GMP_LIMB_BITS / 2)) + ql;
851 if (r >= u1) 842 if (r >= u1)
852 { 843 {
853 m++; 844 m++;
854 r -= u1; 845 r -= u1;
855 } 846 }
847 }
856 848
857 /* Now m is the 2/1 inverse of u1. If u0 > 0, adjust it to become a 849 /* Now m is the 2/1 inverse of u1. If u0 > 0, adjust it to become a
858 3/2 inverse. */ 850 3/2 inverse. */
@@ -881,7 +873,6 @@ mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0)
881 } 873 }
882 874
883 return m; 875 return m;
884 }
885} 876}
886 877
887struct gmp_div_inverse 878struct gmp_div_inverse
@@ -3332,7 +3323,7 @@ mpz_bin_uiui (mpz_t r, unsigned long n, unsigned long k)
3332 mpz_fac_ui (t, k); 3323 mpz_fac_ui (t, k);
3333 3324
3334 for (; k > 0; --k) 3325 for (; k > 0; --k)
3335 mpz_mul_ui (r, r, n--); 3326 mpz_mul_ui (r, r, n--);
3336 3327
3337 mpz_divexact (r, r, t); 3328 mpz_divexact (r, r, t);
3338 mpz_clear (t); 3329 mpz_clear (t);
@@ -3990,13 +3981,18 @@ gmp_popcount_limb (mp_limb_t x)
3990 unsigned c; 3981 unsigned c;
3991 3982
3992 /* Do 16 bits at a time, to avoid limb-sized constants. */ 3983 /* Do 16 bits at a time, to avoid limb-sized constants. */
3993 for (c = 0; x > 0; x >>= 16) 3984 int LOCAL_SHIFT_BITS = 16;
3985 for (c = 0; x > 0;)
3994 { 3986 {
3995 unsigned w = x - ((x >> 1) & 0x5555); 3987 unsigned w = x - ((x >> 1) & 0x5555);
3996 w = ((w >> 2) & 0x3333) + (w & 0x3333); 3988 w = ((w >> 2) & 0x3333) + (w & 0x3333);
3997 w = (w >> 4) + w; 3989 w = (w >> 4) + w;
3998 w = ((w >> 8) & 0x000f) + (w & 0x000f); 3990 w = ((w >> 8) & 0x000f) + (w & 0x000f);
3999 c += w; 3991 c += w;
3992 if (GMP_LIMB_BITS > LOCAL_SHIFT_BITS)
3993 x >>= LOCAL_SHIFT_BITS;
3994 else
3995 x = 0;
4000 } 3996 }
4001 return c; 3997 return c;
4002} 3998}
@@ -4503,10 +4499,15 @@ mpz_export (void *r, size_t *countp, int order, size_t size, int endian,
4503 limb = u->_mp_d[un-1]; 4499 limb = u->_mp_d[un-1];
4504 assert (limb != 0); 4500 assert (limb != 0);
4505 4501
4506 k = 0; 4502 k = (GMP_LIMB_BITS <= CHAR_BIT);
4507 do { 4503 if (!k)
4508 k++; limb >>= CHAR_BIT; 4504 {
4509 } while (limb != 0); 4505 do {
4506 int LOCAL_CHAR_BIT = CHAR_BIT;
4507 k++; limb >>= LOCAL_CHAR_BIT;
4508 } while (limb != 0);
4509 }
4510 /* else limb = 0; */
4510 4511
4511 count = (k + (un-1) * sizeof (mp_limb_t) + size - 1) / size; 4512 count = (k + (un-1) * sizeof (mp_limb_t) + size - 1) / size;
4512 4513
@@ -4535,17 +4536,28 @@ mpz_export (void *r, size_t *countp, int order, size_t size, int endian,
4535 for (bytes = 0, i = 0, k = 0; k < count; k++, p += word_step) 4536 for (bytes = 0, i = 0, k = 0; k < count; k++, p += word_step)
4536 { 4537 {
4537 size_t j; 4538 size_t j;
4538 for (j = 0; j < size; j++, p -= (ptrdiff_t) endian) 4539 for (j = 0; j < size; ++j, p -= (ptrdiff_t) endian)
4539 { 4540 {
4540 if (bytes == 0) 4541 if (sizeof (mp_limb_t) == 1)
4541 { 4542 {
4542 if (i < un) 4543 if (i < un)
4543 limb = u->_mp_d[i++]; 4544 *p = u->_mp_d[i++];
4544 bytes = sizeof (mp_limb_t); 4545 else
4546 *p = 0;
4547 }
4548 else
4549 {
4550 int LOCAL_CHAR_BIT = CHAR_BIT;
4551 if (bytes == 0)
4552 {
4553 if (i < un)
4554 limb = u->_mp_d[i++];
4555 bytes = sizeof (mp_limb_t);
4556 }
4557 *p = limb;
4558 limb >>= LOCAL_CHAR_BIT;
4559 bytes--;
4545 } 4560 }
4546 *p = limb;
4547 limb >>= CHAR_BIT;
4548 bytes--;
4549 } 4561 }
4550 } 4562 }
4551 assert (i == un); 4563 assert (i == un);
diff --git a/src/mini-gmp.h b/src/mini-gmp.h
index 27e0c0671a2..7cce3f7a328 100644
--- a/src/mini-gmp.h
+++ b/src/mini-gmp.h
@@ -1,6 +1,6 @@
1/* mini-gmp, a minimalistic implementation of a GNU GMP subset. 1/* mini-gmp, a minimalistic implementation of a GNU GMP subset.
2 2
3Copyright 2011-2015, 2017 Free Software Foundation, Inc. 3Copyright 2011-2015, 2017, 2019 Free Software Foundation, Inc.
4 4
5This file is part of the GNU MP Library. 5This file is part of the GNU MP Library.
6 6
@@ -53,7 +53,11 @@ void mp_get_memory_functions (void *(**) (size_t),
53 void *(**) (void *, size_t, size_t), 53 void *(**) (void *, size_t, size_t),
54 void (**) (void *, size_t)); 54 void (**) (void *, size_t));
55 55
56typedef unsigned long mp_limb_t; 56#ifndef MINI_GMP_LIMB_TYPE
57#define MINI_GMP_LIMB_TYPE long
58#endif
59
60typedef unsigned MINI_GMP_LIMB_TYPE mp_limb_t;
57typedef long mp_size_t; 61typedef long mp_size_t;
58typedef unsigned long mp_bitcnt_t; 62typedef unsigned long mp_bitcnt_t;
59 63
diff --git a/src/minibuf.c b/src/minibuf.c
index 8ebdff12527..9d870ce3640 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -697,10 +697,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
697 else 697 else
698 histstring = Qnil; 698 histstring = Qnil;
699 699
700 /* If Lisp form desired instead of string, parse it. */
701 if (expflag)
702 val = string_to_object (val, defalt);
703
704 /* The appropriate frame will get selected 700 /* The appropriate frame will get selected
705 in set-window-configuration. */ 701 in set-window-configuration. */
706 unbind_to (count, Qnil); 702 unbind_to (count, Qnil);
@@ -711,6 +707,10 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
711 if (! (NILP (Vhistory_add_new_input) || NILP (histstring))) 707 if (! (NILP (Vhistory_add_new_input) || NILP (histstring)))
712 call2 (intern ("add-to-history"), histvar, histstring); 708 call2 (intern ("add-to-history"), histvar, histstring);
713 709
710 /* If Lisp form desired instead of string, parse it. */
711 if (expflag)
712 val = string_to_object (val, defalt);
713
714 return val; 714 return val;
715} 715}
716 716
diff --git a/src/module-env-28.h b/src/module-env-28.h
index dec8704edde..a2479a8f744 100644
--- a/src/module-env-28.h
+++ b/src/module-env-28.h
@@ -1,3 +1,11 @@
1 /* Add module environment functions newly added in Emacs 28 here. 1 /* Add module environment functions newly added in Emacs 28 here.
2 Before Emacs 28 is released, remove this comment and start 2 Before Emacs 28 is released, remove this comment and start
3 module-env-29.h on the master branch. */ 3 module-env-29.h on the master branch. */
4
5 void (*(*EMACS_ATTRIBUTE_NONNULL (1)
6 get_function_finalizer) (emacs_env *env,
7 emacs_value arg)) (void *) EMACS_NOEXCEPT;
8
9 void (*set_function_finalizer) (emacs_env *env, emacs_value arg,
10 void (*fin) (void *) EMACS_NOEXCEPT)
11 EMACS_ATTRIBUTE_NONNULL (1);
diff --git a/src/nsfns.m b/src/nsfns.m
index 4d47a90a720..cbde93b3f10 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -287,12 +287,6 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
287 error ("Unknown color"); 287 error ("Unknown color");
288 } 288 }
289 289
290 /* Clear the frame; in some instances the NS-internal GC appears not
291 to update, or it does update and cannot clear old text
292 properly. */
293 if (FRAME_VISIBLE_P (f))
294 ns_clear_frame (f);
295
296 [col retain]; 290 [col retain];
297 [f->output_data.ns->background_color release]; 291 [f->output_data.ns->background_color release];
298 f->output_data.ns->background_color = col; 292 f->output_data.ns->background_color = col;
@@ -324,7 +318,10 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
324 } 318 }
325 319
326 if (FRAME_VISIBLE_P (f)) 320 if (FRAME_VISIBLE_P (f))
327 SET_FRAME_GARBAGED (f); 321 {
322 SET_FRAME_GARBAGED (f);
323 ns_clear_frame (f);
324 }
328 } 325 }
329 unblock_input (); 326 unblock_input ();
330} 327}
@@ -499,11 +496,11 @@ ns_set_represented_filename (struct frame *f)
499#if defined (NS_IMPL_COCOA) && defined (MAC_OS_X_VERSION_10_7) 496#if defined (NS_IMPL_COCOA) && defined (MAC_OS_X_VERSION_10_7)
500 /* Work around for Mach port leaks on macOS 10.15 (bug#38618). */ 497 /* Work around for Mach port leaks on macOS 10.15 (bug#38618). */
501 NSURL *fileURL = [NSURL fileURLWithPath:fstr isDirectory:NO]; 498 NSURL *fileURL = [NSURL fileURLWithPath:fstr isDirectory:NO];
502 BOOL isUbiquitousItem = YES; 499 NSNumber *isUbiquitousItem = @YES;
503 [fileURL getResourceValue:(id *)&isUbiquitousItem 500 [fileURL getResourceValue:(id *)&isUbiquitousItem
504 forKey:NSURLIsUbiquitousItemKey 501 forKey:NSURLIsUbiquitousItemKey
505 error:nil]; 502 error:nil];
506 if (isUbiquitousItem) 503 if ([isUbiquitousItem boolValue])
507 fstr = @""; 504 fstr = @"";
508#endif 505#endif
509 506
@@ -1277,14 +1274,20 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1277#ifdef NS_IMPL_COCOA 1274#ifdef NS_IMPL_COCOA
1278 tem = gui_display_get_arg (dpyinfo, parms, Qns_appearance, NULL, NULL, 1275 tem = gui_display_get_arg (dpyinfo, parms, Qns_appearance, NULL, NULL,
1279 RES_TYPE_SYMBOL); 1276 RES_TYPE_SYMBOL);
1280 FRAME_NS_APPEARANCE (f) = EQ (tem, Qdark) 1277 if (EQ (tem, Qdark))
1281 ? ns_appearance_vibrant_dark : ns_appearance_aqua; 1278 FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark;
1282 store_frame_param (f, Qns_appearance, tem); 1279 else if (EQ (tem, Qlight))
1280 FRAME_NS_APPEARANCE (f) = ns_appearance_aqua;
1281 else
1282 FRAME_NS_APPEARANCE (f) = ns_appearance_system_default;
1283 store_frame_param (f, Qns_appearance,
1284 (!NILP (tem) && !EQ (tem, Qunbound)) ? tem : Qnil);
1283 1285
1284 tem = gui_display_get_arg (dpyinfo, parms, Qns_transparent_titlebar, 1286 tem = gui_display_get_arg (dpyinfo, parms, Qns_transparent_titlebar,
1285 NULL, NULL, RES_TYPE_BOOLEAN); 1287 NULL, NULL, RES_TYPE_BOOLEAN);
1286 FRAME_NS_TRANSPARENT_TITLEBAR (f) = !NILP (tem) && !EQ (tem, Qunbound); 1288 FRAME_NS_TRANSPARENT_TITLEBAR (f) = !NILP (tem) && !EQ (tem, Qunbound);
1287 store_frame_param (f, Qns_transparent_titlebar, tem); 1289 store_frame_param (f, Qns_transparent_titlebar,
1290 FRAME_NS_TRANSPARENT_TITLEBAR (f) ? Qt : Qnil);
1288#endif 1291#endif
1289 1292
1290 parent_frame = gui_display_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL, 1293 parent_frame = gui_display_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL,
@@ -1628,7 +1631,7 @@ Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */)
1628 dirS = [dirS stringByExpandingTildeInPath]; 1631 dirS = [dirS stringByExpandingTildeInPath];
1629 1632
1630 panel = isSave ? 1633 panel = isSave ?
1631 (id)[EmacsSavePanel savePanel] : (id)[EmacsOpenPanel openPanel]; 1634 (id)[NSSavePanel savePanel] : (id)[NSOpenPanel openPanel];
1632 1635
1633 [panel setTitle: promptS]; 1636 [panel setTitle: promptS];
1634 1637
@@ -3083,29 +3086,6 @@ handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent)
3083 return ret; 3086 return ret;
3084} 3087}
3085 3088
3086@implementation EmacsSavePanel
3087- (BOOL)performKeyEquivalent:(NSEvent *)theEvent
3088{
3089 BOOL ret = handlePanelKeys (self, theEvent);
3090 if (! ret)
3091 ret = [super performKeyEquivalent:theEvent];
3092 return ret;
3093}
3094@end
3095
3096
3097@implementation EmacsOpenPanel
3098- (BOOL)performKeyEquivalent:(NSEvent *)theEvent
3099{
3100 // NSOpenPanel inherits NSSavePanel, so passing self is OK.
3101 BOOL ret = handlePanelKeys (self, theEvent);
3102 if (! ret)
3103 ret = [super performKeyEquivalent:theEvent];
3104 return ret;
3105}
3106@end
3107
3108
3109@implementation EmacsFileDelegate 3089@implementation EmacsFileDelegate
3110/* -------------------------------------------------------------------------- 3090/* --------------------------------------------------------------------------
3111 Delegate methods for Open/Save panels 3091 Delegate methods for Open/Save panels
@@ -3141,6 +3121,7 @@ syms_of_nsfns (void)
3141 DEFSYM (Qframe_title_format, "frame-title-format"); 3121 DEFSYM (Qframe_title_format, "frame-title-format");
3142 DEFSYM (Qicon_title_format, "icon-title-format"); 3122 DEFSYM (Qicon_title_format, "icon-title-format");
3143 DEFSYM (Qdark, "dark"); 3123 DEFSYM (Qdark, "dark");
3124 DEFSYM (Qlight, "light");
3144 3125
3145 DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist, 3126 DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
3146 doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames. 3127 doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
diff --git a/src/nsterm.h b/src/nsterm.h
index fb9ac1b462c..980ca534cfa 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -417,6 +417,9 @@ typedef id instancetype;
417 int maximized_width, maximized_height; 417 int maximized_width, maximized_height;
418 NSWindow *nonfs_window; 418 NSWindow *nonfs_window;
419 BOOL fs_is_native; 419 BOOL fs_is_native;
420#ifdef NS_IMPL_COCOA
421 NSBitmapImageRep *drawingBuffer;
422#endif
420@public 423@public
421 struct frame *emacsframe; 424 struct frame *emacsframe;
422 int rows, cols; 425 int rows, cols;
@@ -457,7 +460,13 @@ typedef id instancetype;
457#endif 460#endif
458- (int)fullscreenState; 461- (int)fullscreenState;
459 462
460/* Non-notification versions of NSView methods. Used for direct calls. */ 463#ifdef NS_IMPL_COCOA
464- (void)focusOnDrawingBuffer;
465#endif
466- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect;
467- (void)createDrawingBufferWithRect:(NSRect)rect;
468
469/* Non-notification versions of NSView methods. Used for direct calls. */
461- (void)windowWillEnterFullScreen; 470- (void)windowWillEnterFullScreen;
462- (void)windowDidEnterFullScreen; 471- (void)windowDidEnterFullScreen;
463- (void)windowWillExitFullScreen; 472- (void)windowWillExitFullScreen;
@@ -471,6 +480,8 @@ typedef id instancetype;
471{ 480{
472 NSPoint grabOffset; 481 NSPoint grabOffset;
473} 482}
483
484- (void)setAppearance;
474@end 485@end
475 486
476 487
@@ -595,22 +606,6 @@ typedef id instancetype;
595@end 606@end
596 607
597 608
598/* ==========================================================================
599
600 File open/save panels
601 This and next override methods to handle keyboard input in panels.
602
603 ========================================================================== */
604
605@interface EmacsSavePanel : NSSavePanel
606{
607}
608@end
609@interface EmacsOpenPanel : NSOpenPanel
610{
611}
612@end
613
614@interface EmacsFileDelegate : NSObject 609@interface EmacsFileDelegate : NSObject
615{ 610{
616} 611}
diff --git a/src/nsterm.m b/src/nsterm.m
index 2b6be86db82..9d427b9b38d 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -287,7 +287,10 @@ struct ns_display_info *x_display_list; /* Chain of existing displays */
287long context_menu_value = 0; 287long context_menu_value = 0;
288 288
289/* display update */ 289/* display update */
290static struct frame *ns_updating_frame;
291static NSView *focus_view = NULL;
290static int ns_window_num = 0; 292static int ns_window_num = 0;
293static BOOL gsaved = NO;
291static BOOL ns_fake_keydown = NO; 294static BOOL ns_fake_keydown = NO;
292#ifdef NS_IMPL_COCOA 295#ifdef NS_IMPL_COCOA
293static BOOL ns_menu_bar_is_hidden = NO; 296static BOOL ns_menu_bar_is_hidden = NO;
@@ -1097,13 +1100,12 @@ ns_update_begin (struct frame *f)
1097 external (RIF) call; whole frame, called before gui_update_window_begin 1100 external (RIF) call; whole frame, called before gui_update_window_begin
1098 -------------------------------------------------------------------------- */ 1101 -------------------------------------------------------------------------- */
1099{ 1102{
1100#ifdef NS_IMPL_COCOA
1101 EmacsView *view = FRAME_NS_VIEW (f); 1103 EmacsView *view = FRAME_NS_VIEW (f);
1102
1103 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_begin"); 1104 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_begin");
1104 1105
1105 ns_update_auto_hide_menu_bar (); 1106 ns_update_auto_hide_menu_bar ();
1106 1107
1108#ifdef NS_IMPL_COCOA
1107 if ([view isFullscreen] && [view fsIsNative]) 1109 if ([view isFullscreen] && [view fsIsNative])
1108 { 1110 {
1109 // Fix reappearing tool bar in fullscreen for Mac OS X 10.7 1111 // Fix reappearing tool bar in fullscreen for Mac OS X 10.7
@@ -1113,6 +1115,13 @@ ns_update_begin (struct frame *f)
1113 [toolbar setVisible: tbar_visible]; 1115 [toolbar setVisible: tbar_visible];
1114 } 1116 }
1115#endif 1117#endif
1118
1119 ns_updating_frame = f;
1120#ifdef NS_IMPL_COCOA
1121 [view focusOnDrawingBuffer];
1122#else
1123 [view lockFocus];
1124#endif
1116} 1125}
1117 1126
1118 1127
@@ -1123,57 +1132,124 @@ ns_update_end (struct frame *f)
1123 external (RIF) call; for whole frame, called after gui_update_window_end 1132 external (RIF) call; for whole frame, called after gui_update_window_end
1124 -------------------------------------------------------------------------- */ 1133 -------------------------------------------------------------------------- */
1125{ 1134{
1135 EmacsView *view = FRAME_NS_VIEW (f);
1136
1126 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end"); 1137 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end");
1127 1138
1128/* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */ 1139/* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */
1129 MOUSE_HL_INFO (f)->mouse_face_defer = 0; 1140 MOUSE_HL_INFO (f)->mouse_face_defer = 0;
1130}
1131 1141
1142#ifdef NS_IMPL_COCOA
1143 [NSGraphicsContext setCurrentContext:nil];
1144 [view display];
1145#else
1146 block_input ();
1132 1147
1133static BOOL 1148 [view unlockFocus];
1134ns_clip_to_rect (struct frame *f, NSRect *r, int n) 1149 [[view window] flushWindow];
1150
1151 unblock_input ();
1152#endif
1153 ns_updating_frame = NULL;
1154}
1155
1156static void
1157ns_focus (struct frame *f, NSRect *r, int n)
1135/* -------------------------------------------------------------------------- 1158/* --------------------------------------------------------------------------
1136 Clip the drawing area to rectangle r in frame f. If drawing is not 1159 Internal: Focus on given frame. During small local updates this is used to
1137 currently possible mark r as dirty and return NO, otherwise return 1160 draw, however during large updates, ns_update_begin and ns_update_end are
1138 YES. 1161 called to wrap the whole thing, in which case these calls are stubbed out.
1162 Except, on GNUstep, we accumulate the rectangle being drawn into, because
1163 the back end won't do this automatically, and will just end up flushing
1164 the entire window.
1139 -------------------------------------------------------------------------- */ 1165 -------------------------------------------------------------------------- */
1140{ 1166{
1141 NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_clip_to_rect"); 1167 EmacsView *view = FRAME_NS_VIEW (f);
1142 if (r) 1168
1169 NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus");
1170 if (r != NULL)
1143 { 1171 {
1144 NSTRACE_RECT ("r", *r); 1172 NSTRACE_RECT ("r", *r);
1173 }
1145 1174
1146 if ([NSView focusView] == FRAME_NS_VIEW (f)) 1175 if (f != ns_updating_frame)
1176#ifdef NS_IMPL_COCOA
1177 [view focusOnDrawingBuffer];
1178#else
1179 {
1180 if (view != focus_view)
1147 { 1181 {
1148 [[NSGraphicsContext currentContext] saveGraphicsState]; 1182 if (focus_view != NULL)
1149 if (n == 2) 1183 {
1150 NSRectClipList (r, 2); 1184 [focus_view unlockFocus];
1151 else 1185 [[focus_view window] flushWindow];
1152 NSRectClip (*r); 1186 }
1153 1187
1154 return YES; 1188 if (view)
1189 [view lockFocus];
1190 focus_view = view;
1155 } 1191 }
1192 }
1193#endif
1194
1195 /* clipping */
1196 if (r)
1197 {
1198#ifdef NS_IMPL_COCOA
1199 int i;
1200 for (i = 0 ; i < n ; i++)
1201 [view setNeedsDisplayInRect:r[i]];
1202#endif
1203
1204 [[NSGraphicsContext currentContext] saveGraphicsState];
1205 if (n == 2)
1206 NSRectClipList (r, 2);
1156 else 1207 else
1208 NSRectClip (*r);
1209 gsaved = YES;
1210 }
1211}
1212
1213
1214static void
1215ns_unfocus (struct frame *f)
1216/* --------------------------------------------------------------------------
1217 Internal: Remove focus on given frame
1218 -------------------------------------------------------------------------- */
1219{
1220 NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_unfocus");
1221
1222 if (gsaved)
1223 {
1224 [[NSGraphicsContext currentContext] restoreGraphicsState];
1225 gsaved = NO;
1226 }
1227
1228#ifdef NS_IMPL_GNUSTEP
1229 if (f != ns_updating_frame)
1230 {
1231 if (focus_view != NULL)
1157 { 1232 {
1158 NSView *view = FRAME_NS_VIEW (f); 1233 [focus_view unlockFocus];
1159 int i; 1234 [[focus_view window] flushWindow];
1160 for (i = 0 ; i < n ; i++) 1235 focus_view = NULL;
1161 [view setNeedsDisplayInRect:r[i]];
1162 } 1236 }
1163 } 1237 }
1164 1238#endif
1165 return NO;
1166} 1239}
1167 1240
1168 1241
1169static void 1242static void
1170ns_reset_clipping (struct frame *f) 1243ns_clip_to_row (struct window *w, struct glyph_row *row,
1171/* Internal: Restore the previous graphics state, unsetting any 1244 enum glyph_row_area area, BOOL gc)
1172 clipping areas. */ 1245/* --------------------------------------------------------------------------
1246 Internal (but parallels other terms): Focus drawing on given row
1247 -------------------------------------------------------------------------- */
1173{ 1248{
1174 NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_reset_clipping"); 1249 struct frame *f = XFRAME (WINDOW_FRAME (w));
1250 NSRect clip_rect = ns_row_rect (w, row, area);
1175 1251
1176 [[NSGraphicsContext currentContext] restoreGraphicsState]; 1252 ns_focus (f, &clip_rect, 1);
1177} 1253}
1178 1254
1179 1255
@@ -1644,6 +1720,7 @@ ns_free_frame_resources (struct frame *f)
1644 [view release]; 1720 [view release];
1645 1721
1646 xfree (f->output_data.ns); 1722 xfree (f->output_data.ns);
1723 f->output_data.ns = NULL;
1647 1724
1648 unblock_input (); 1725 unblock_input ();
1649} 1726}
@@ -2025,17 +2102,13 @@ ns_set_appearance (struct frame *f, Lisp_Object new_value, Lisp_Object old_value
2025 return; 2102 return;
2026 2103
2027 if (EQ (new_value, Qdark)) 2104 if (EQ (new_value, Qdark))
2028 { 2105 FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark;
2029 window.appearance = [NSAppearance 2106 else if (EQ (new_value, Qlight))
2030 appearanceNamed: NSAppearanceNameVibrantDark]; 2107 FRAME_NS_APPEARANCE (f) = ns_appearance_aqua;
2031 FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark;
2032 }
2033 else 2108 else
2034 { 2109 FRAME_NS_APPEARANCE (f) = ns_appearance_system_default;
2035 window.appearance = [NSAppearance 2110
2036 appearanceNamed: NSAppearanceNameAqua]; 2111 [window setAppearance];
2037 FRAME_NS_APPEARANCE (f) = ns_appearance_aqua;
2038 }
2039#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */ 2112#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */
2040} 2113}
2041 2114
@@ -2773,16 +2846,14 @@ ns_clear_frame (struct frame *f)
2773 r = [view bounds]; 2846 r = [view bounds];
2774 2847
2775 block_input (); 2848 block_input ();
2776 if (ns_clip_to_rect (f, &r, 1)) 2849 ns_focus (f, &r, 1);
2777 { 2850 [ns_lookup_indexed_color (NS_FACE_BACKGROUND
2778 [ns_lookup_indexed_color (NS_FACE_BACKGROUND 2851 (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set];
2779 (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set]; 2852 NSRectFill (r);
2780 NSRectFill (r); 2853 ns_unfocus (f);
2781 ns_reset_clipping (f); 2854
2782 2855 /* as of 2006/11 or so this is now needed */
2783 /* as of 2006/11 or so this is now needed */ 2856 ns_redraw_scroll_bars (f);
2784 ns_redraw_scroll_bars (f);
2785 }
2786 unblock_input (); 2857 unblock_input ();
2787} 2858}
2788 2859
@@ -2803,46 +2874,15 @@ ns_clear_frame_area (struct frame *f, int x, int y, int width, int height)
2803 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_clear_frame_area"); 2874 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_clear_frame_area");
2804 2875
2805 r = NSIntersectionRect (r, [view frame]); 2876 r = NSIntersectionRect (r, [view frame]);
2806 if (ns_clip_to_rect (f, &r, 1)) 2877 ns_focus (f, &r, 1);
2807 { 2878 [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
2808 [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set];
2809 2879
2810 NSRectFill (r); 2880 NSRectFill (r);
2811 2881
2812 ns_reset_clipping (f); 2882 ns_unfocus (f);
2813 } 2883 return;
2814} 2884}
2815 2885
2816static void
2817ns_copy_bits (struct frame *f, NSRect src, NSRect dest)
2818{
2819 NSSize delta = NSMakeSize (dest.origin.x - src.origin.x,
2820 dest.origin.y - src.origin.y);
2821 NSTRACE ("ns_copy_bits");
2822
2823 if (FRAME_NS_VIEW (f))
2824 {
2825 hide_bell(); // Ensure the bell image isn't scrolled.
2826
2827 /* FIXME: scrollRect:by: is deprecated in macOS 10.14. There is
2828 no obvious replacement so we may have to come up with our own. */
2829 [FRAME_NS_VIEW (f) scrollRect: src by: delta];
2830
2831#ifdef NS_IMPL_COCOA
2832 /* As far as I can tell from the documentation, scrollRect:by:,
2833 above, should copy the dirty rectangles from our source
2834 rectangle to our destination, however it appears it clips the
2835 operation to src. As a result we need to use
2836 translateRectsNeedingDisplayInRect:by: below, and we have to
2837 union src and dest so it can pick up the dirty rectangles,
2838 and place them, as it also clips to the rectangle.
2839
2840 FIXME: We need a GNUstep equivalent. */
2841 [FRAME_NS_VIEW (f) translateRectsNeedingDisplayInRect:NSUnionRect (src, dest)
2842 by:delta];
2843#endif
2844 }
2845}
2846 2886
2847static void 2887static void
2848ns_scroll_run (struct window *w, struct run *run) 2888ns_scroll_run (struct window *w, struct run *run)
@@ -2895,8 +2935,12 @@ ns_scroll_run (struct window *w, struct run *run)
2895 { 2935 {
2896 NSRect srcRect = NSMakeRect (x, from_y, width, height); 2936 NSRect srcRect = NSMakeRect (x, from_y, width, height);
2897 NSRect dstRect = NSMakeRect (x, to_y, width, height); 2937 NSRect dstRect = NSMakeRect (x, to_y, width, height);
2938 EmacsView *view = FRAME_NS_VIEW (f);
2898 2939
2899 ns_copy_bits (f, srcRect , dstRect); 2940 [view copyRect:srcRect to:dstRect];
2941#ifdef NS_IMPL_COCOA
2942 [view setNeedsDisplayInRect:srcRect];
2943#endif
2900 } 2944 }
2901 2945
2902 unblock_input (); 2946 unblock_input ();
@@ -2950,20 +2994,12 @@ ns_shift_glyphs_for_insert (struct frame *f,
2950 External (RIF): copy an area horizontally, don't worry about clearing src 2994 External (RIF): copy an area horizontally, don't worry about clearing src
2951 -------------------------------------------------------------------------- */ 2995 -------------------------------------------------------------------------- */
2952{ 2996{
2953 //NSRect srcRect = NSMakeRect (x, y, width, height); 2997 NSRect srcRect = NSMakeRect (x, y, width, height);
2954 NSRect dstRect = NSMakeRect (x+shift_by, y, width, height); 2998 NSRect dstRect = NSMakeRect (x+shift_by, y, width, height);
2955 2999
2956 NSTRACE ("ns_shift_glyphs_for_insert"); 3000 NSTRACE ("ns_shift_glyphs_for_insert");
2957 3001
2958 /* This doesn't work now as we copy the "bits" before we've had a 3002 [FRAME_NS_VIEW (f) copyRect:srcRect to:dstRect];
2959 chance to actually draw any changes to the screen. This means in
2960 certain circumstances we end up with copies of the cursor all
2961 over the place. Just mark the area dirty so it is redrawn later.
2962
2963 FIXME: Work out how to do this properly. */
2964 // ns_copy_bits (f, srcRect, dstRect);
2965
2966 [FRAME_NS_VIEW (f) setNeedsDisplayInRect:dstRect];
2967} 3003}
2968 3004
2969 3005
@@ -3083,66 +3119,76 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
3083 3119
3084 /* The visible portion of imageRect will always be contained within 3120 /* The visible portion of imageRect will always be contained within
3085 clearRect. */ 3121 clearRect. */
3086 if (ns_clip_to_rect (f, &clearRect, 1)) 3122 ns_focus (f, &clearRect, 1);
3123 if (! NSIsEmptyRect (clearRect))
3087 { 3124 {
3088 if (! NSIsEmptyRect (clearRect)) 3125 NSTRACE_RECT ("clearRect", clearRect);
3089 {
3090 NSTRACE_RECT ("clearRect", clearRect);
3091 3126
3092 [ns_lookup_indexed_color(face->background, f) set]; 3127 [ns_lookup_indexed_color(face->background, f) set];
3093 NSRectFill (clearRect); 3128 NSRectFill (clearRect);
3094 } 3129 }
3095 3130
3096 if (p->which) 3131 if (p->which)
3132 {
3133 EmacsImage *img = bimgs[p->which - 1];
3134
3135 if (!img)
3097 { 3136 {
3098 EmacsImage *img = bimgs[p->which - 1]; 3137 // Note: For "periodic" images, allocate one EmacsImage for
3138 // the base image, and use it for all dh:s.
3139 unsigned short *bits = p->bits;
3140 int full_height = p->h + p->dh;
3141 int i;
3142 unsigned char *cbits = xmalloc (full_height);
3143
3144 for (i = 0; i < full_height; i++)
3145 cbits[i] = bits[i];
3146 img = [[EmacsImage alloc] initFromXBM: cbits width: 8
3147 height: full_height
3148 fg: 0 bg: 0
3149 reverseBytes: NO];
3150 bimgs[p->which - 1] = img;
3151 xfree (cbits);
3152 }
3099 3153
3100 if (!img)
3101 {
3102 // Note: For "periodic" images, allocate one EmacsImage for
3103 // the base image, and use it for all dh:s.
3104 unsigned short *bits = p->bits;
3105 int full_height = p->h + p->dh;
3106 int i;
3107 unsigned char *cbits = xmalloc (full_height);
3108
3109 for (i = 0; i < full_height; i++)
3110 cbits[i] = bits[i];
3111 img = [[EmacsImage alloc] initFromXBM: cbits width: 8
3112 height: full_height
3113 fg: 0 bg: 0
3114 reverseBytes: NO];
3115 bimgs[p->which - 1] = img;
3116 xfree (cbits);
3117 }
3118 3154
3155 {
3156 NSColor *bm_color;
3157 if (!p->cursor_p)
3158 bm_color = ns_lookup_indexed_color(face->foreground, f);
3159 else if (p->overlay_p)
3160 bm_color = ns_lookup_indexed_color(face->background, f);
3161 else
3162 bm_color = f->output_data.ns->cursor_color;
3163 [img setXBMColor: bm_color];
3164 }
3119 3165
3120 { 3166 // Note: For periodic images, the full image height is "h + hd".
3121 NSColor *bm_color; 3167 // By using the height h, a suitable part of the image is used.
3122 if (!p->cursor_p) 3168 NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h);
3123 bm_color = ns_lookup_indexed_color(face->foreground, f);
3124 else if (p->overlay_p)
3125 bm_color = ns_lookup_indexed_color(face->background, f);
3126 else
3127 bm_color = f->output_data.ns->cursor_color;
3128 [img setXBMColor: bm_color];
3129 }
3130 3169
3131 // Note: For periodic images, the full image height is "h + hd". 3170 NSTRACE_RECT ("fromRect", fromRect);
3132 // By using the height h, a suitable part of the image is used.
3133 NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h);
3134 3171
3135 NSTRACE_RECT ("fromRect", fromRect); 3172 /* Because we're drawing into an offscreen buffer which isn't
3173 flipped, the images come out upside down. To work around it
3174 we need to do some fancy transforms. */
3175 {
3176 NSAffineTransform *transform = [NSAffineTransform transform];
3177 [transform translateXBy:0 yBy:NSMaxY(imageRect)];
3178 [transform scaleXBy:1 yBy:-1];
3179 [transform concat];
3136 3180
3137 [img drawInRect: imageRect 3181 imageRect.origin.y = 0;
3138 fromRect: fromRect 3182 }
3139 operation: NSCompositingOperationSourceOver 3183
3140 fraction: 1.0 3184 [img drawInRect: imageRect
3141 respectFlipped: YES 3185 fromRect: fromRect
3142 hints: nil]; 3186 operation: NSCompositingOperationSourceOver
3143 } 3187 fraction: 1.0
3144 ns_reset_clipping (f); 3188 respectFlipped: YES
3189 hints: nil];
3145 } 3190 }
3191 ns_unfocus (f);
3146} 3192}
3147 3193
3148 3194
@@ -3227,60 +3273,52 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
3227 /* Prevent the cursor from being drawn outside the text area. */ 3273 /* Prevent the cursor from being drawn outside the text area. */
3228 r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA)); 3274 r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA));
3229 3275
3230 if (ns_clip_to_rect (f, &r, 1)) 3276 face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id);
3277 if (face && NS_FACE_BACKGROUND (face)
3278 == ns_index_color (FRAME_CURSOR_COLOR (f), f))
3231 { 3279 {
3232 face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); 3280 [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set];
3233 if (face && NS_FACE_BACKGROUND (face) 3281 hollow_color = FRAME_CURSOR_COLOR (f);
3234 == ns_index_color (FRAME_CURSOR_COLOR (f), f)) 3282 }
3235 { 3283 else
3236 [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; 3284 [FRAME_CURSOR_COLOR (f) set];
3237 hollow_color = FRAME_CURSOR_COLOR (f);
3238 }
3239 else
3240 [FRAME_CURSOR_COLOR (f) set];
3241
3242 switch (cursor_type)
3243 {
3244 case DEFAULT_CURSOR:
3245 case NO_CURSOR:
3246 break;
3247 case FILLED_BOX_CURSOR:
3248 NSRectFill (r);
3249 break;
3250 case HOLLOW_BOX_CURSOR:
3251 NSRectFill (r);
3252 [hollow_color set];
3253 NSRectFill (NSInsetRect (r, 1, 1));
3254 [FRAME_CURSOR_COLOR (f) set];
3255 break;
3256 case HBAR_CURSOR:
3257 NSRectFill (r);
3258 break;
3259 case BAR_CURSOR:
3260 s = r;
3261 /* If the character under cursor is R2L, draw the bar cursor
3262 on the right of its glyph, rather than on the left. */
3263 cursor_glyph = get_phys_cursor_glyph (w);
3264 if ((cursor_glyph->resolved_level & 1) != 0)
3265 s.origin.x += cursor_glyph->pixel_width - s.size.width;
3266
3267 NSRectFill (s);
3268 break;
3269 }
3270 3285
3271 /* Draw the character under the cursor. Other terms only draw 3286 ns_focus (f, &r, 1);
3272 the character on top of box cursors, so do the same here. */
3273 if (cursor_type == FILLED_BOX_CURSOR || cursor_type == HOLLOW_BOX_CURSOR)
3274 draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
3275 3287
3276 ns_reset_clipping (f); 3288 switch (cursor_type)
3277 }
3278 else if (! redisplaying_p)
3279 { 3289 {
3280 /* If this function is called outside redisplay, it probably 3290 case DEFAULT_CURSOR:
3281 means we need an immediate update. */ 3291 case NO_CURSOR:
3282 [FRAME_NS_VIEW (f) display]; 3292 break;
3293 case FILLED_BOX_CURSOR:
3294 NSRectFill (r);
3295 break;
3296 case HOLLOW_BOX_CURSOR:
3297 NSRectFill (r);
3298 [hollow_color set];
3299 NSRectFill (NSInsetRect (r, 1, 1));
3300 [FRAME_CURSOR_COLOR (f) set];
3301 break;
3302 case HBAR_CURSOR:
3303 NSRectFill (r);
3304 break;
3305 case BAR_CURSOR:
3306 s = r;
3307 /* If the character under cursor is R2L, draw the bar cursor
3308 on the right of its glyph, rather than on the left. */
3309 cursor_glyph = get_phys_cursor_glyph (w);
3310 if ((cursor_glyph->resolved_level & 1) != 0)
3311 s.origin.x += cursor_glyph->pixel_width - s.size.width;
3312
3313 NSRectFill (s);
3314 break;
3283 } 3315 }
3316 ns_unfocus (f);
3317
3318 /* Draw the character under the cursor. Other terms only draw
3319 the character on top of box cursors, so do the same here. */
3320 if (cursor_type == FILLED_BOX_CURSOR || cursor_type == HOLLOW_BOX_CURSOR)
3321 draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR);
3284} 3322}
3285 3323
3286 3324
@@ -3298,14 +3336,12 @@ ns_draw_vertical_window_border (struct window *w, int x, int y0, int y1)
3298 3336
3299 face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID); 3337 face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID);
3300 3338
3301 if (ns_clip_to_rect (f, &r, 1)) 3339 ns_focus (f, &r, 1);
3302 { 3340 if (face)
3303 if (face) 3341 [ns_lookup_indexed_color(face->foreground, f) set];
3304 [ns_lookup_indexed_color(face->foreground, f) set];
3305 3342
3306 NSRectFill(r); 3343 NSRectFill(r);
3307 ns_reset_clipping (f); 3344 ns_unfocus (f);
3308 }
3309} 3345}
3310 3346
3311 3347
@@ -3332,42 +3368,42 @@ ns_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
3332 3368
3333 NSTRACE ("ns_draw_window_divider"); 3369 NSTRACE ("ns_draw_window_divider");
3334 3370
3335 if (ns_clip_to_rect (f, &divider, 1)) 3371 ns_focus (f, &divider, 1);
3336 {
3337 if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3))
3338 /* A vertical divider, at least three pixels wide: Draw first and
3339 last pixels differently. */
3340 {
3341 [ns_lookup_indexed_color(color_first, f) set];
3342 NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0));
3343 [ns_lookup_indexed_color(color, f) set];
3344 NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0));
3345 [ns_lookup_indexed_color(color_last, f) set];
3346 NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0));
3347 }
3348 else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3))
3349 /* A horizontal divider, at least three pixels high: Draw first and
3350 last pixels differently. */
3351 {
3352 [ns_lookup_indexed_color(color_first, f) set];
3353 NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1));
3354 [ns_lookup_indexed_color(color, f) set];
3355 NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2));
3356 [ns_lookup_indexed_color(color_last, f) set];
3357 NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1));
3358 }
3359 else
3360 {
3361 /* In any other case do not draw the first and last pixels
3362 differently. */
3363 [ns_lookup_indexed_color(color, f) set];
3364 NSRectFill(divider);
3365 }
3366 3372
3367 ns_reset_clipping (f); 3373 if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3))
3374 /* A vertical divider, at least three pixels wide: Draw first and
3375 last pixels differently. */
3376 {
3377 [ns_lookup_indexed_color(color_first, f) set];
3378 NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0));
3379 [ns_lookup_indexed_color(color, f) set];
3380 NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0));
3381 [ns_lookup_indexed_color(color_last, f) set];
3382 NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0));
3383 }
3384 else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3))
3385 /* A horizontal divider, at least three pixels high: Draw first and
3386 last pixels differently. */
3387 {
3388 [ns_lookup_indexed_color(color_first, f) set];
3389 NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1));
3390 [ns_lookup_indexed_color(color, f) set];
3391 NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2));
3392 [ns_lookup_indexed_color(color_last, f) set];
3393 NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1));
3368 } 3394 }
3395 else
3396 {
3397 /* In any other case do not draw the first and last pixels
3398 differently. */
3399 [ns_lookup_indexed_color(color, f) set];
3400 NSRectFill(divider);
3401 }
3402
3403 ns_unfocus (f);
3369} 3404}
3370 3405
3406
3371static void 3407static void
3372ns_show_hourglass (struct frame *f) 3408ns_show_hourglass (struct frame *f)
3373{ 3409{
@@ -3891,15 +3927,27 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
3891 3927
3892 [[NSGraphicsContext currentContext] saveGraphicsState]; 3928 [[NSGraphicsContext currentContext] saveGraphicsState];
3893 3929
3894 /* Because of the transforms it's far too difficult to work out 3930 /* Because of the transforms it's difficult to work out what
3895 what portion of the original, untransformed, image will be 3931 portion of the original, untransformed, image will be drawn,
3896 drawn, so the clipping area will ensure we draw only the 3932 so the clipping area will ensure we draw only the correct
3897 correct bit. */ 3933 bit. */
3898 NSRectClip (dr); 3934 NSRectClip (dr);
3899 3935
3900 [setOrigin translateXBy:x - s->slice.x yBy:y - s->slice.y]; 3936 [setOrigin translateXBy:x - s->slice.x yBy:y - s->slice.y];
3901 [setOrigin concat]; 3937 [setOrigin concat];
3902 [img->transform concat]; 3938
3939 NSAffineTransform *doTransform = [NSAffineTransform transform];
3940
3941 /* We have to flip the image around the X axis as the offscreen
3942 bitmap we're drawing to is flipped. */
3943 [doTransform scaleXBy:1 yBy:-1];
3944 [doTransform translateXBy:0 yBy:-[img size].height];
3945
3946 /* ImageMagick images don't have transforms. */
3947 if (img->transform)
3948 [doTransform appendTransform:img->transform];
3949
3950 [doTransform concat];
3903 3951
3904 [img drawInRect:ir fromRect:ir 3952 [img drawInRect:ir fromRect:ir
3905 operation:NSCompositingOperationSourceOver 3953 operation:NSCompositingOperationSourceOver
@@ -3972,6 +4020,7 @@ static void
3972ns_dumpglyphs_stretch (struct glyph_string *s) 4020ns_dumpglyphs_stretch (struct glyph_string *s)
3973{ 4021{
3974 NSRect r[2]; 4022 NSRect r[2];
4023 NSRect glyphRect;
3975 int n, i; 4024 int n, i;
3976 struct face *face; 4025 struct face *face;
3977 NSColor *fgCol, *bgCol; 4026 NSColor *fgCol, *bgCol;
@@ -3979,82 +4028,57 @@ ns_dumpglyphs_stretch (struct glyph_string *s)
3979 if (!s->background_filled_p) 4028 if (!s->background_filled_p)
3980 { 4029 {
3981 n = ns_get_glyph_string_clip_rect (s, r); 4030 n = ns_get_glyph_string_clip_rect (s, r);
4031 ns_focus (s->f, r, n);
3982 4032
3983 if (ns_clip_to_rect (s->f, r, n)) 4033 if (s->hl == DRAW_MOUSE_FACE)
3984 { 4034 {
3985 /* FIXME: Why are we reusing the clipping rectangles? The 4035 face = FACE_FROM_ID_OR_NULL (s->f,
3986 other terms don't appear to do anything like this. */ 4036 MOUSE_HL_INFO (s->f)->mouse_face_face_id);
3987 *r = NSMakeRect (s->x, s->y, s->background_width, s->height); 4037 if (!face)
4038 face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
4039 }
4040 else
4041 face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
3988 4042
3989 if (s->hl == DRAW_MOUSE_FACE) 4043 bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f);
3990 { 4044 fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f);
3991 face = FACE_FROM_ID_OR_NULL (s->f,
3992 MOUSE_HL_INFO (s->f)->mouse_face_face_id);
3993 if (!face)
3994 face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
3995 }
3996 else
3997 face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
3998 4045
3999 bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); 4046 glyphRect = NSMakeRect (s->x, s->y, s->background_width, s->height);
4000 fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f);
4001 4047
4002 for (i = 0; i < n; ++i) 4048 [bgCol set];
4003 {
4004 if (!s->row->full_width_p)
4005 {
4006 int overrun, leftoverrun;
4007
4008 /* truncate to avoid overwriting fringe and/or scrollbar */
4009 overrun = max (0, (s->x + s->background_width)
4010 - (WINDOW_BOX_RIGHT_EDGE_X (s->w)
4011 - WINDOW_RIGHT_FRINGE_WIDTH (s->w)));
4012 r[i].size.width -= overrun;
4013
4014 /* truncate to avoid overwriting to left of the window box */
4015 leftoverrun = (WINDOW_BOX_LEFT_EDGE_X (s->w)
4016 + WINDOW_LEFT_FRINGE_WIDTH (s->w)) - s->x;
4017
4018 if (leftoverrun > 0)
4019 {
4020 r[i].origin.x += leftoverrun;
4021 r[i].size.width -= leftoverrun;
4022 }
4023 }
4024 4049
4025 [bgCol set]; 4050 /* NOTE: under NS this is NOT used to draw cursors, but we must avoid
4051 overwriting cursor (usually when cursor on a tab) */
4052 if (s->hl == DRAW_CURSOR)
4053 {
4054 CGFloat x, width;
4026 4055
4027 /* NOTE: under NS this is NOT used to draw cursors, but we must avoid 4056 /* FIXME: This looks like it will only work for left to
4028 overwriting cursor (usually when cursor on a tab). */ 4057 right languages. */
4029 if (s->hl == DRAW_CURSOR) 4058 x = NSMinX (glyphRect);
4030 { 4059 width = s->w->phys_cursor_width;
4031 CGFloat x, width; 4060 glyphRect.size.width -= width;
4061 glyphRect.origin.x += width;
4032 4062
4033 x = r[i].origin.x; 4063 NSRectFill (glyphRect);
4034 width = s->w->phys_cursor_width;
4035 r[i].size.width -= width;
4036 r[i].origin.x += width;
4037 4064
4038 NSRectFill (r[i]); 4065 /* Draw overlining, etc. on the cursor. */
4066 if (s->w->phys_cursor_type == FILLED_BOX_CURSOR)
4067 ns_draw_text_decoration (s, face, bgCol, width, x);
4068 else
4069 ns_draw_text_decoration (s, face, fgCol, width, x);
4070 }
4071 else
4072 {
4073 NSRectFill (glyphRect);
4074 }
4039 4075
4040 /* Draw overlining, etc. on the cursor. */ 4076 /* Draw overlining, etc. on the stretch glyph (or the part
4041 if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) 4077 of the stretch glyph after the cursor). */
4042 ns_draw_text_decoration (s, face, bgCol, width, x); 4078 ns_draw_text_decoration (s, face, fgCol, NSWidth (glyphRect),
4043 else 4079 NSMinX (glyphRect));
4044 ns_draw_text_decoration (s, face, fgCol, width, x);
4045 }
4046 else
4047 {
4048 NSRectFill (r[i]);
4049 }
4050 4080
4051 /* Draw overlining, etc. on the stretch glyph (or the part 4081 ns_unfocus (s->f);
4052 of the stretch glyph after the cursor). */
4053 ns_draw_text_decoration (s, face, fgCol, r[i].size.width,
4054 r[i].origin.x);
4055 }
4056 ns_reset_clipping (s->f);
4057 }
4058 s->background_filled_p = 1; 4082 s->background_filled_p = 1;
4059 } 4083 }
4060} 4084}
@@ -4204,11 +4228,9 @@ ns_draw_glyph_string (struct glyph_string *s)
4204 if (next->first_glyph->type != STRETCH_GLYPH) 4228 if (next->first_glyph->type != STRETCH_GLYPH)
4205 { 4229 {
4206 n = ns_get_glyph_string_clip_rect (s->next, r); 4230 n = ns_get_glyph_string_clip_rect (s->next, r);
4207 if (ns_clip_to_rect (s->f, r, n)) 4231 ns_focus (s->f, r, n);
4208 { 4232 ns_maybe_dumpglyphs_background (s->next, 1);
4209 ns_maybe_dumpglyphs_background (s->next, 1); 4233 ns_unfocus (s->f);
4210 ns_reset_clipping (s->f);
4211 }
4212 } 4234 }
4213 else 4235 else
4214 { 4236 {
@@ -4223,12 +4245,10 @@ ns_draw_glyph_string (struct glyph_string *s)
4223 || s->first_glyph->type == COMPOSITE_GLYPH)) 4245 || s->first_glyph->type == COMPOSITE_GLYPH))
4224 { 4246 {
4225 n = ns_get_glyph_string_clip_rect (s, r); 4247 n = ns_get_glyph_string_clip_rect (s, r);
4226 if (ns_clip_to_rect (s->f, r, n)) 4248 ns_focus (s->f, r, n);
4227 { 4249 ns_maybe_dumpglyphs_background (s, 1);
4228 ns_maybe_dumpglyphs_background (s, 1); 4250 ns_dumpglyphs_box_or_relief (s);
4229 ns_dumpglyphs_box_or_relief (s); 4251 ns_unfocus (s->f);
4230 ns_reset_clipping (s->f);
4231 }
4232 box_drawn_p = 1; 4252 box_drawn_p = 1;
4233 } 4253 }
4234 4254
@@ -4237,11 +4257,9 @@ ns_draw_glyph_string (struct glyph_string *s)
4237 4257
4238 case IMAGE_GLYPH: 4258 case IMAGE_GLYPH:
4239 n = ns_get_glyph_string_clip_rect (s, r); 4259 n = ns_get_glyph_string_clip_rect (s, r);
4240 if (ns_clip_to_rect (s->f, r, n)) 4260 ns_focus (s->f, r, n);
4241 { 4261 ns_dumpglyphs_image (s, r[0]);
4242 ns_dumpglyphs_image (s, r[0]); 4262 ns_unfocus (s->f);
4243 ns_reset_clipping (s->f);
4244 }
4245 break; 4263 break;
4246 4264
4247 case STRETCH_GLYPH: 4265 case STRETCH_GLYPH:
@@ -4251,68 +4269,66 @@ ns_draw_glyph_string (struct glyph_string *s)
4251 case CHAR_GLYPH: 4269 case CHAR_GLYPH:
4252 case COMPOSITE_GLYPH: 4270 case COMPOSITE_GLYPH:
4253 n = ns_get_glyph_string_clip_rect (s, r); 4271 n = ns_get_glyph_string_clip_rect (s, r);
4254 if (ns_clip_to_rect (s->f, r, n)) 4272 ns_focus (s->f, r, n);
4255 {
4256 if (s->for_overlaps || (s->cmp_from > 0
4257 && ! s->first_glyph->u.cmp.automatic))
4258 s->background_filled_p = 1;
4259 else
4260 ns_maybe_dumpglyphs_background
4261 (s, s->first_glyph->type == COMPOSITE_GLYPH);
4262 4273
4263 if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) 4274 if (s->for_overlaps || (s->cmp_from > 0
4264 { 4275 && ! s->first_glyph->u.cmp.automatic))
4265 unsigned long tmp = NS_FACE_BACKGROUND (s->face); 4276 s->background_filled_p = 1;
4266 NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); 4277 else
4267 NS_FACE_FOREGROUND (s->face) = tmp; 4278 ns_maybe_dumpglyphs_background
4268 } 4279 (s, s->first_glyph->type == COMPOSITE_GLYPH);
4269 4280
4270 { 4281 if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR)
4271 BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; 4282 {
4283 unsigned long tmp = NS_FACE_BACKGROUND (s->face);
4284 NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face);
4285 NS_FACE_FOREGROUND (s->face) = tmp;
4286 }
4272 4287
4273 if (isComposite) 4288 {
4274 ns_draw_composite_glyph_string_foreground (s); 4289 BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH;
4275 else
4276 ns_draw_glyph_string_foreground (s);
4277 }
4278 4290
4279 { 4291 if (isComposite)
4280 NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 4292 ns_draw_composite_glyph_string_foreground (s);
4281 ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), 4293 else
4282 s->f) 4294 ns_draw_glyph_string_foreground (s);
4283 : FRAME_FOREGROUND_COLOR (s->f)); 4295 }
4284 [col set];
4285
4286 /* Draw underline, overline, strike-through. */
4287 ns_draw_text_decoration (s, s->face, col, s->width, s->x);
4288 }
4289 4296
4290 if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) 4297 {
4291 { 4298 NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0
4292 unsigned long tmp = NS_FACE_BACKGROUND (s->face); 4299 ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face),
4293 NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); 4300 s->f)
4294 NS_FACE_FOREGROUND (s->face) = tmp; 4301 : FRAME_FOREGROUND_COLOR (s->f));
4295 } 4302 [col set];
4303
4304 /* Draw underline, overline, strike-through. */
4305 ns_draw_text_decoration (s, s->face, col, s->width, s->x);
4306 }
4296 4307
4297 ns_reset_clipping (s->f); 4308 if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR)
4309 {
4310 unsigned long tmp = NS_FACE_BACKGROUND (s->face);
4311 NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face);
4312 NS_FACE_FOREGROUND (s->face) = tmp;
4298 } 4313 }
4314
4315 ns_unfocus (s->f);
4299 break; 4316 break;
4300 4317
4301 case GLYPHLESS_GLYPH: 4318 case GLYPHLESS_GLYPH:
4302 n = ns_get_glyph_string_clip_rect (s, r); 4319 n = ns_get_glyph_string_clip_rect (s, r);
4303 if (ns_clip_to_rect (s->f, r, n)) 4320 ns_focus (s->f, r, n);
4304 { 4321
4305 if (s->for_overlaps || (s->cmp_from > 0 4322 if (s->for_overlaps || (s->cmp_from > 0
4306 && ! s->first_glyph->u.cmp.automatic)) 4323 && ! s->first_glyph->u.cmp.automatic))
4307 s->background_filled_p = 1; 4324 s->background_filled_p = 1;
4308 else 4325 else
4309 ns_maybe_dumpglyphs_background 4326 ns_maybe_dumpglyphs_background
4310 (s, s->first_glyph->type == COMPOSITE_GLYPH); 4327 (s, s->first_glyph->type == COMPOSITE_GLYPH);
4311 /* ... */ 4328 /* ... */
4312 /* Not yet implemented. */ 4329 /* Not yet implemented. */
4313 /* ... */ 4330 /* ... */
4314 ns_reset_clipping (s->f); 4331 ns_unfocus (s->f);
4315 }
4316 break; 4332 break;
4317 4333
4318 default: 4334 default:
@@ -4323,11 +4339,9 @@ ns_draw_glyph_string (struct glyph_string *s)
4323 if (!s->for_overlaps && !box_drawn_p && s->face->box != FACE_NO_BOX) 4339 if (!s->for_overlaps && !box_drawn_p && s->face->box != FACE_NO_BOX)
4324 { 4340 {
4325 n = ns_get_glyph_string_clip_rect (s, r); 4341 n = ns_get_glyph_string_clip_rect (s, r);
4326 if (ns_clip_to_rect (s->f, r, n)) 4342 ns_focus (s->f, r, n);
4327 { 4343 ns_dumpglyphs_box_or_relief (s);
4328 ns_dumpglyphs_box_or_relief (s); 4344 ns_unfocus (s->f);
4329 ns_reset_clipping (s->f);
4330 }
4331 } 4345 }
4332 4346
4333 s->num_clips = 0; 4347 s->num_clips = 0;
@@ -7090,6 +7104,7 @@ not_in_argv (NSString *arg)
7090 from non-native fullscreen, in other circumstances it appears 7104 from non-native fullscreen, in other circumstances it appears
7091 to be a noop. (bug#28872) */ 7105 to be a noop. (bug#28872) */
7092 wr = NSMakeRect (0, 0, neww, newh); 7106 wr = NSMakeRect (0, 0, neww, newh);
7107 [self createDrawingBufferWithRect:wr];
7093 [view setFrame: wr]; 7108 [view setFrame: wr];
7094 7109
7095 // To do: consider using [NSNotificationCenter postNotificationName:]. 7110 // To do: consider using [NSNotificationCenter postNotificationName:].
@@ -7172,6 +7187,7 @@ not_in_argv (NSString *arg)
7172 size_title = xmalloc (strlen (old_title) + 40); 7187 size_title = xmalloc (strlen (old_title) + 40);
7173 esprintf (size_title, "%s — (%d x %d)", old_title, cols, rows); 7188 esprintf (size_title, "%s — (%d x %d)", old_title, cols, rows);
7174 [window setTitle: [NSString stringWithUTF8String: size_title]]; 7189 [window setTitle: [NSString stringWithUTF8String: size_title]];
7190 [window display];
7175 xfree (size_title); 7191 xfree (size_title);
7176 } 7192 }
7177 } 7193 }
@@ -7428,6 +7444,8 @@ not_in_argv (NSString *arg)
7428 maximizing_resize = NO; 7444 maximizing_resize = NO;
7429#endif 7445#endif
7430 7446
7447 [self createDrawingBufferWithRect:r];
7448
7431 win = [[EmacsWindow alloc] 7449 win = [[EmacsWindow alloc]
7432 initWithContentRect: r 7450 initWithContentRect: r
7433 styleMask: (FRAME_UNDECORATED (f) 7451 styleMask: (FRAME_UNDECORATED (f)
@@ -7469,16 +7487,8 @@ not_in_argv (NSString *arg)
7469 if (! FRAME_UNDECORATED (f)) 7487 if (! FRAME_UNDECORATED (f))
7470 [self createToolbar: f]; 7488 [self createToolbar: f];
7471 7489
7472#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
7473#ifndef NSAppKitVersionNumber10_10
7474#define NSAppKitVersionNumber10_10 1343
7475#endif
7476 7490
7477 if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_10 7491 [win setAppearance];
7478 && FRAME_NS_APPEARANCE (f) != ns_appearance_aqua)
7479 win.appearance = [NSAppearance
7480 appearanceNamed: NSAppearanceNameVibrantDark];
7481#endif
7482 7492
7483#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 7493#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
7484 if ([win respondsToSelector: @selector(titlebarAppearsTransparent)]) 7494 if ([win respondsToSelector: @selector(titlebarAppearsTransparent)])
@@ -8219,55 +8229,105 @@ not_in_argv (NSString *arg)
8219} 8229}
8220 8230
8221 8231
8222- (void)viewWillDraw 8232- (void)createDrawingBufferWithRect:(NSRect)rect
8233 /* Create and store a new NSBitmapImageRep for Emacs to draw
8234 into.
8235
8236 Drawing to an offscreen bitmap doesn't work in GNUstep as there's
8237 a bug in graphicsContextWithBitmapImageRep
8238 (https://savannah.gnu.org/bugs/?38405). So under GNUstep we
8239 retain the old method of drawing direct to the EmacsView. */
8223{ 8240{
8224 /* If the frame has been garbaged there's no point in redrawing 8241#ifdef NS_IMPL_COCOA
8225 anything. */ 8242 if (drawingBuffer != nil)
8226 if (FRAME_GARBAGED_P (emacsframe)) 8243 [drawingBuffer release];
8227 [self setNeedsDisplay:NO]; 8244
8245 drawingBuffer = [[self bitmapImageRepForCachingDisplayInRect:rect] retain];
8246#endif
8228} 8247}
8229 8248
8230- (void)drawRect: (NSRect)rect 8249
8250#ifdef NS_IMPL_COCOA
8251- (void)focusOnDrawingBuffer
8231{ 8252{
8232 const NSRect *rectList; 8253 /* Creating the graphics context each time is very slow, but it
8233 NSInteger numRects; 8254 doesn't seem possible to cache and reuse it. */
8255 [NSGraphicsContext
8256 setCurrentContext:
8257 [NSGraphicsContext graphicsContextWithBitmapImageRep:drawingBuffer]];
8258}
8234 8259
8235 NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]",
8236 NSTRACE_ARG_RECT(rect));
8237 8260
8238 if (!emacsframe || !emacsframe->output_data.ns) 8261- (void)windowDidChangeBackingProperties:(NSNotification *)notification
8239 return; 8262 /* Update the drawing buffer when the backing scale factor changes. */
8263{
8264 CGFloat old = [[[notification userInfo]
8265 objectForKey:@"NSBackingPropertyOldScaleFactorKey"]
8266 doubleValue];
8267 CGFloat new = [[self window] backingScaleFactor];
8240 8268
8241 block_input (); 8269 if (old != new)
8270 {
8271 NSRect frame = [self frame];
8272 [self createDrawingBufferWithRect:frame];
8273 ns_clear_frame (emacsframe);
8274 expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
8275 }
8276}
8277#endif
8242 8278
8243 /* Get only the precise dirty rectangles to avoid redrawing
8244 potentially large areas of the frame that haven't changed.
8245 8279
8246 I'm not sure this actually provides much of a performance benefit 8280- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect
8247 as it's hard to benchmark, but it certainly doesn't seem to 8281{
8248 hurt. */ 8282 NSTRACE ("[EmacsView copyRect:To:]");
8249 [self getRectsBeingDrawn:&rectList count:&numRects]; 8283 NSTRACE_RECT ("Source", srcRect);
8250 for (int i = 0 ; i < numRects ; i++) 8284 NSTRACE_RECT ("Destination", dstRect);
8251 {
8252 NSRect r = rectList[i];
8253 8285
8254 NSTRACE_RECT ("r", r); 8286#ifdef NS_IMPL_COCOA
8287 [drawingBuffer drawInRect:dstRect
8288 fromRect:srcRect
8289 operation:NSCompositingOperationCopy
8290 fraction:1.0
8291 respectFlipped:NO
8292 hints:nil];
8293
8294 [self setNeedsDisplayInRect:dstRect];
8295#else
8296 hide_bell(); // Ensure the bell image isn't scrolled.
8255 8297
8256 expose_frame (emacsframe, 8298 ns_focus (emacsframe, &dstRect, 1);
8257 NSMinX (r), NSMinY (r), 8299 [self scrollRect: srcRect
8258 NSWidth (r), NSHeight (r)); 8300 by: NSMakeSize (dstRect.origin.x - srcRect.origin.x,
8259 } 8301 dstRect.origin.y - srcRect.origin.y)];
8302 ns_unfocus (emacsframe);
8303#endif
8304}
8260 8305
8261 unblock_input ();
8262 8306
8263 /* 8307- (void)drawRect: (NSRect)rect
8264 drawRect: may be called (at least in Mac OS X 10.5) for invisible 8308{
8265 views as well for some reason. Thus, do not infer visibility 8309 NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]",
8266 here. 8310 NSTRACE_ARG_RECT(rect));
8311
8312 if (!emacsframe || !emacsframe->output_data.ns)
8313 return;
8267 8314
8268 emacsframe->async_visible = 1; 8315#ifdef NS_IMPL_COCOA
8269 emacsframe->async_iconified = 0; 8316 [drawingBuffer drawInRect:rect
8270 */ 8317 fromRect:rect
8318 operation:NSCompositingOperationSourceOver
8319 fraction:1
8320 respectFlipped:NO
8321 hints:nil];
8322#else
8323 int x = NSMinX (rect), y = NSMinY (rect);
8324 int width = NSWidth (rect), height = NSHeight (rect);
8325
8326 ns_clear_frame_area (emacsframe, x, y, width, height);
8327 block_input ();
8328 expose_frame (emacsframe, x, y, width, height);
8329 unblock_input ();
8330#endif
8271} 8331}
8272 8332
8273 8333
@@ -8728,6 +8788,32 @@ not_in_argv (NSString *arg)
8728#endif 8788#endif
8729} 8789}
8730 8790
8791- (void)setAppearance
8792{
8793#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
8794 struct frame *f = ((EmacsView *)[self delegate])->emacsframe;
8795 NSAppearance *appearance = nil;
8796
8797 NSTRACE ("[EmacsWindow setAppearance]");
8798
8799#ifndef NSAppKitVersionNumber10_10
8800#define NSAppKitVersionNumber10_10 1343
8801#endif
8802
8803 if (NSAppKitVersionNumber < NSAppKitVersionNumber10_10)
8804 return;
8805
8806 if (FRAME_NS_APPEARANCE (f) == ns_appearance_vibrant_dark)
8807 appearance =
8808 [NSAppearance appearanceNamed:NSAppearanceNameVibrantDark];
8809 else if (FRAME_NS_APPEARANCE (f) == ns_appearance_aqua)
8810 appearance =
8811 [NSAppearance appearanceNamed:NSAppearanceNameAqua];
8812
8813 [self setAppearance:appearance];
8814#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */
8815}
8816
8731- (void)setFrame:(NSRect)windowFrame 8817- (void)setFrame:(NSRect)windowFrame
8732 display:(BOOL)displayViews 8818 display:(BOOL)displayViews
8733{ 8819{
diff --git a/src/pdumper.c b/src/pdumper.c
index 3ee11460405..0039f1a9ed8 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2961,7 +2961,7 @@ dump_vectorlike (struct dump_context *ctx,
2961 Lisp_Object lv, 2961 Lisp_Object lv,
2962 dump_off offset) 2962 dump_off offset)
2963{ 2963{
2964#if CHECK_STRUCTS && !defined HASH_pvec_type_E55BD36F8E 2964#if CHECK_STRUCTS && !defined HASH_pvec_type_A4A6E9984D
2965# error "pvec_type changed. See CHECK_STRUCTS comment in config.h." 2965# error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
2966#endif 2966#endif
2967 const struct Lisp_Vector *v = XVECTOR (lv); 2967 const struct Lisp_Vector *v = XVECTOR (lv);
diff --git a/src/print.c b/src/print.c
index 425b0dc4ee3..634169dbdbd 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1365,6 +1365,22 @@ data_from_funcptr (void (*funcptr) (void))
1365 interchangeably, so it's OK to assume that here too. */ 1365 interchangeably, so it's OK to assume that here too. */
1366 return (void const *) funcptr; 1366 return (void const *) funcptr;
1367} 1367}
1368
1369/* Print the value of the pointer PTR. */
1370
1371static void
1372print_pointer (Lisp_Object printcharfun, char *buf, const char *prefix,
1373 const void *ptr)
1374{
1375 uintptr_t ui = (uintptr_t) ptr;
1376
1377 /* In theory this assignment could lose info on pre-C99 hosts, but
1378 in practice it doesn't. */
1379 uintmax_t up = ui;
1380
1381 int len = sprintf (buf, "%s 0x%" PRIxMAX, prefix, up);
1382 strout (buf, len, len, printcharfun);
1383}
1368#endif 1384#endif
1369 1385
1370static bool 1386static bool
@@ -1796,26 +1812,22 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
1796 case PVEC_MODULE_FUNCTION: 1812 case PVEC_MODULE_FUNCTION:
1797 { 1813 {
1798 print_c_string ("#<module function ", printcharfun); 1814 print_c_string ("#<module function ", printcharfun);
1799 module_funcptr ptr = module_function_address (XMODULE_FUNCTION (obj)); 1815 const struct Lisp_Module_Function *function = XMODULE_FUNCTION (obj);
1816 module_funcptr ptr = module_function_address (function);
1800 char const *file; 1817 char const *file;
1801 char const *symbol; 1818 char const *symbol;
1802 dynlib_addr (ptr, &file, &symbol); 1819 dynlib_addr (ptr, &file, &symbol);
1803 1820
1804 if (symbol == NULL) 1821 if (symbol == NULL)
1805 { 1822 print_pointer (printcharfun, buf, "at", data_from_funcptr (ptr));
1806 uintptr_t ui = (uintptr_t) data_from_funcptr (ptr); 1823 else
1807
1808 /* In theory this assignment could lose info on pre-C99
1809 hosts, but in practice it doesn't. */
1810 uintmax_t up = ui;
1811
1812 int len = sprintf (buf, "at 0x%"PRIxMAX, up);
1813 strout (buf, len, len, printcharfun);
1814 }
1815 else
1816 print_c_string (symbol, printcharfun); 1824 print_c_string (symbol, printcharfun);
1817 1825
1818 if (file != NULL) 1826 void *data = module_function_data (function);
1827 if (data != NULL)
1828 print_pointer (printcharfun, buf, " with data", data);
1829
1830 if (file != NULL)
1819 { 1831 {
1820 print_c_string (" from ", printcharfun); 1832 print_c_string (" from ", printcharfun);
1821 print_c_string (file, printcharfun); 1833 print_c_string (file, printcharfun);
@@ -1838,7 +1850,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1838{ 1850{
1839 char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT), 1851 char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT),
1840 max (sizeof " . #" + INT_STRLEN_BOUND (intmax_t), 1852 max (sizeof " . #" + INT_STRLEN_BOUND (intmax_t),
1841 max ((sizeof "at 0x" 1853 max ((sizeof " with data 0x"
1842 + (sizeof (uintmax_t) * CHAR_BIT + 4 - 1) / 4), 1854 + (sizeof (uintmax_t) * CHAR_BIT + 4 - 1) / 4),
1843 40)))]; 1855 40)))];
1844 current_thread->stack_top = buf; 1856 current_thread->stack_top = buf;
diff --git a/src/sysdep.c b/src/sysdep.c
index c6344d8cec7..e8e8bbfb502 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -312,8 +312,8 @@ get_current_dir_name_or_unreachable (void)
312 if (pwd 312 if (pwd
313 && (pwdlen = strnlen (pwd, bufsize_max)) < bufsize_max 313 && (pwdlen = strnlen (pwd, bufsize_max)) < bufsize_max
314 && IS_DIRECTORY_SEP (pwd[pwdlen && IS_DEVICE_SEP (pwd[1]) ? 2 : 0]) 314 && IS_DIRECTORY_SEP (pwd[pwdlen && IS_DEVICE_SEP (pwd[1]) ? 2 : 0])
315 && stat (pwd, &pwdstat) == 0 315 && emacs_fstatat (AT_FDCWD, pwd, &pwdstat, 0) == 0
316 && stat (".", &dotstat) == 0 316 && emacs_fstatat (AT_FDCWD, ".", &dotstat, 0) == 0
317 && dotstat.st_ino == pwdstat.st_ino 317 && dotstat.st_ino == pwdstat.st_ino
318 && dotstat.st_dev == pwdstat.st_dev) 318 && dotstat.st_dev == pwdstat.st_dev)
319 { 319 {
@@ -2449,7 +2449,27 @@ emacs_abort (void)
2449} 2449}
2450#endif 2450#endif
2451 2451
2452/* Open FILE for Emacs use, using open flags OFLAG and mode MODE. 2452/* Assuming the directory DIRFD, store information about FILENAME into *ST,
2453 using FLAGS to control how the status is obtained.
2454 Do not fail merely because fetching info was interrupted by a signal.
2455 Allow the user to quit.
2456
2457 The type of ST is void * instead of struct stat * because the
2458 latter type would be problematic in lisp.h. Some platforms may
2459 play tricks like "#define stat stat64" in <sys/stat.h>, and lisp.h
2460 does not include <sys/stat.h>. */
2461
2462int
2463emacs_fstatat (int dirfd, char const *filename, void *st, int flags)
2464{
2465 int r;
2466 while ((r = fstatat (dirfd, filename, st, flags)) != 0 && errno == EINTR)
2467 maybe_quit ();
2468 return r;
2469}
2470
2471/* Assuming the directory DIRFD, open FILE for Emacs use,
2472 using open flags OFLAGS and mode MODE.
2453 Use binary I/O on systems that care about text vs binary I/O. 2473 Use binary I/O on systems that care about text vs binary I/O.
2454 Arrange for subprograms to not inherit the file descriptor. 2474 Arrange for subprograms to not inherit the file descriptor.
2455 Prefer a method that is multithread-safe, if available. 2475 Prefer a method that is multithread-safe, if available.
@@ -2457,17 +2477,23 @@ emacs_abort (void)
2457 Allow the user to quit. */ 2477 Allow the user to quit. */
2458 2478
2459int 2479int
2460emacs_open (const char *file, int oflags, int mode) 2480emacs_openat (int dirfd, char const *file, int oflags, int mode)
2461{ 2481{
2462 int fd; 2482 int fd;
2463 if (! (oflags & O_TEXT)) 2483 if (! (oflags & O_TEXT))
2464 oflags |= O_BINARY; 2484 oflags |= O_BINARY;
2465 oflags |= O_CLOEXEC; 2485 oflags |= O_CLOEXEC;
2466 while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR) 2486 while ((fd = openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR)
2467 maybe_quit (); 2487 maybe_quit ();
2468 return fd; 2488 return fd;
2469} 2489}
2470 2490
2491int
2492emacs_open (char const *file, int oflags, int mode)
2493{
2494 return emacs_openat (AT_FDCWD, file, oflags, mode);
2495}
2496
2471/* Open FILE as a stream for Emacs use, with mode MODE. 2497/* Open FILE as a stream for Emacs use, with mode MODE.
2472 Act like emacs_open with respect to threads, signals, and quits. */ 2498 Act like emacs_open with respect to threads, signals, and quits. */
2473 2499
diff --git a/src/systhread.c b/src/systhread.c
index c3e4e6a2c5a..0d600d6895e 100644
--- a/src/systhread.c
+++ b/src/systhread.c
@@ -81,10 +81,13 @@ sys_thread_equal (sys_thread_t t, sys_thread_t u)
81{ 81{
82 return t == u; 82 return t == u;
83} 83}
84void
85sys_thread_set_name (const char *name)
86{
87}
84 88
85bool 89bool
86sys_thread_create (sys_thread_t *t, const char *name, 90sys_thread_create (sys_thread_t *t, thread_creation_function *func, void *datum)
87 thread_creation_function *func, void *datum)
88{ 91{
89 return false; 92 return false;
90} 93}
@@ -98,10 +101,6 @@ sys_thread_yield (void)
98 101
99#include <sched.h> 102#include <sched.h>
100 103
101#ifdef HAVE_SYS_PRCTL_H
102#include <sys/prctl.h>
103#endif
104
105void 104void
106sys_mutex_init (sys_mutex_t *mutex) 105sys_mutex_init (sys_mutex_t *mutex)
107{ 106{
@@ -204,9 +203,30 @@ sys_thread_equal (sys_thread_t t, sys_thread_t u)
204 return pthread_equal (t, u); 203 return pthread_equal (t, u);
205} 204}
206 205
206void
207sys_thread_set_name (const char *name)
208{
209#ifdef HAVE_PTHREAD_SETNAME_NP
210 /* We need to truncate here otherwise pthread_setname_np
211 fails to set the name. TASK_COMM_LEN is what the length
212 is called in the Linux kernel headers (Bug#38632). */
213#define TASK_COMM_LEN 16
214 char p_name[TASK_COMM_LEN];
215 strncpy (p_name, name, TASK_COMM_LEN - 1);
216 p_name[TASK_COMM_LEN - 1] = '\0';
217# ifdef HAVE_PTHREAD_SETNAME_NP_1ARG
218 pthread_setname_np (p_name);
219# elif defined HAVE_PTHREAD_SETNAME_NP_3ARG
220 pthread_setname_np (pthread_self (), "%s", p_name);
221# else
222 pthread_setname_np (pthread_self (), p_name);
223# endif
224#endif
225}
226
207bool 227bool
208sys_thread_create (sys_thread_t *thread_ptr, const char *name, 228sys_thread_create (sys_thread_t *thread_ptr, thread_creation_function *func,
209 thread_creation_function *func, void *arg) 229 void *arg)
210{ 230{
211 pthread_attr_t attr; 231 pthread_attr_t attr;
212 bool result = false; 232 bool result = false;
@@ -225,13 +245,7 @@ sys_thread_create (sys_thread_t *thread_ptr, const char *name,
225 } 245 }
226 246
227 if (!pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED)) 247 if (!pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED))
228 { 248 result = pthread_create (thread_ptr, &attr, func, arg) == 0;
229 result = pthread_create (thread_ptr, &attr, func, arg) == 0;
230#if defined (HAVE_SYS_PRCTL_H) && defined (HAVE_PRCTL) && defined (PR_SET_NAME)
231 if (result && name != NULL)
232 prctl (PR_SET_NAME, name);
233#endif
234 }
235 249
236 out: ; 250 out: ;
237 int error = pthread_attr_destroy (&attr); 251 int error = pthread_attr_destroy (&attr);
@@ -452,26 +466,24 @@ w32_set_thread_name (DWORD thread_id, const char *name)
452 466
453static thread_creation_function *thread_start_address; 467static thread_creation_function *thread_start_address;
454 468
469void
470sys_thread_set_name (const char *name)
471{
472 w32_set_thread_name (GetCurrentThreadId (), name);
473}
474
455/* _beginthread wants a void function, while we are passed a function 475/* _beginthread wants a void function, while we are passed a function
456 that returns a pointer. So we use a wrapper. See the command in 476 that returns a pointer. So we use a wrapper. See the command in
457 w32term.h about the need for ALIGN_STACK attribute. */ 477 w32term.h about the need for ALIGN_STACK attribute. */
458static void ALIGN_STACK 478static void ALIGN_STACK
459w32_beginthread_wrapper (void *arg) 479w32_beginthread_wrapper (void *arg)
460{ 480{
461 /* FIXME: This isn't very clean: systhread.c is not supposed to know
462 that ARG is a pointer to a thread_state object, or be familiar
463 with thread_state object's structure in general. */
464 struct thread_state *this_thread = arg;
465
466 if (this_thread->thread_name)
467 w32_set_thread_name (GetCurrentThreadId (), this_thread->thread_name);
468
469 (void)thread_start_address (arg); 481 (void)thread_start_address (arg);
470} 482}
471 483
472bool 484bool
473sys_thread_create (sys_thread_t *thread_ptr, const char *name, 485sys_thread_create (sys_thread_t *thread_ptr, thread_creation_function *func,
474 thread_creation_function *func, void *arg) 486 void *arg)
475{ 487{
476 /* FIXME: Do threads that run Lisp require some minimum amount of 488 /* FIXME: Do threads that run Lisp require some minimum amount of
477 stack? Zero here means each thread will get the same amount as 489 stack? Zero here means each thread will get the same amount as
diff --git a/src/systhread.h b/src/systhread.h
index 5368acfb52c..005388fd5a4 100644
--- a/src/systhread.h
+++ b/src/systhread.h
@@ -112,10 +112,11 @@ extern sys_thread_t sys_thread_self (void)
112extern bool sys_thread_equal (sys_thread_t, sys_thread_t) 112extern bool sys_thread_equal (sys_thread_t, sys_thread_t)
113 ATTRIBUTE_WARN_UNUSED_RESULT; 113 ATTRIBUTE_WARN_UNUSED_RESULT;
114 114
115extern bool sys_thread_create (sys_thread_t *, const char *, 115extern bool sys_thread_create (sys_thread_t *, thread_creation_function *,
116 thread_creation_function *, void *) 116 void *)
117 ATTRIBUTE_WARN_UNUSED_RESULT; 117 ATTRIBUTE_WARN_UNUSED_RESULT;
118 118
119extern void sys_thread_yield (void); 119extern void sys_thread_yield (void);
120extern void sys_thread_set_name (const char *);
120 121
121#endif /* SYSTHREAD_H */ 122#endif /* SYSTHREAD_H */
diff --git a/src/term.c b/src/term.c
index 871734318c0..a3aef31ec25 100644
--- a/src/term.c
+++ b/src/term.c
@@ -2568,6 +2568,14 @@ handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event,
2568 else { 2568 else {
2569 f->mouse_moved = 0; 2569 f->mouse_moved = 0;
2570 term_mouse_click (&ie, event, f); 2570 term_mouse_click (&ie, event, f);
2571 if (tty_handle_tab_bar_click (f, event->x, event->y,
2572 (ie.modifiers & down_modifier) != 0, &ie))
2573 {
2574 /* tty_handle_tab_bar_click stores 2 events in the event
2575 queue, so we are done here. */
2576 count += 2;
2577 return count;
2578 }
2571 } 2579 }
2572 2580
2573 done: 2581 done:
diff --git a/src/thread.c b/src/thread.c
index f81163414bb..df1a7053826 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -725,6 +725,9 @@ run_thread (void *state)
725 self->m_stack_bottom = self->stack_top = (char *) &stack_pos; 725 self->m_stack_bottom = self->stack_top = (char *) &stack_pos;
726 self->thread_id = sys_thread_self (); 726 self->thread_id = sys_thread_self ();
727 727
728 if (self->thread_name)
729 sys_thread_set_name (self->thread_name);
730
728 acquire_global_lock (self); 731 acquire_global_lock (self);
729 732
730 /* Put a dummy catcher at top-level so that handlerlist is never NULL. 733 /* Put a dummy catcher at top-level so that handlerlist is never NULL.
@@ -826,13 +829,13 @@ If NAME is given, it must be a string; it names the new thread. */)
826 new_thread->next_thread = all_threads; 829 new_thread->next_thread = all_threads;
827 all_threads = new_thread; 830 all_threads = new_thread;
828 831
829 char const *c_name = !NILP (name) ? SSDATA (ENCODE_UTF_8 (name)) : NULL; 832 char const *c_name = !NILP (name) ? SSDATA (ENCODE_SYSTEM (name)) : NULL;
830 if (c_name) 833 if (c_name)
831 new_thread->thread_name = xstrdup (c_name); 834 new_thread->thread_name = xstrdup (c_name);
832 else 835 else
833 new_thread->thread_name = NULL; 836 new_thread->thread_name = NULL;
834 sys_thread_t thr; 837 sys_thread_t thr;
835 if (! sys_thread_create (&thr, c_name, run_thread, new_thread)) 838 if (! sys_thread_create (&thr, run_thread, new_thread))
836 { 839 {
837 /* Restore the previous situation. */ 840 /* Restore the previous situation. */
838 all_threads = all_threads->next_thread; 841 all_threads = all_threads->next_thread;
@@ -1111,9 +1114,6 @@ syms_of_threads (void)
1111 staticpro (&last_thread_error); 1114 staticpro (&last_thread_error);
1112 last_thread_error = Qnil; 1115 last_thread_error = Qnil;
1113 1116
1114 Fdefalias (intern_c_string ("thread-alive-p"),
1115 intern_c_string ("thread-live-p"), Qnil);
1116
1117 Fprovide (intern_c_string ("threads"), Qnil); 1117 Fprovide (intern_c_string ("threads"), Qnil);
1118 } 1118 }
1119 1119
diff --git a/src/thread.h b/src/thread.h
index e96a063a10b..a09929fa440 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -169,8 +169,7 @@ struct thread_state
169 interrupter should broadcast to this condition. */ 169 interrupter should broadcast to this condition. */
170 sys_cond_t *wait_condvar; 170 sys_cond_t *wait_condvar;
171 171
172 /* Thread's name in the locale encoding. Actually used only on 172 /* Thread's name in the locale encoding. */
173 WINDOWSNT. */
174 char *thread_name; 173 char *thread_name;
175 174
176 /* This thread might have released the global lock. If so, this is 175 /* This thread might have released the global lock. If so, this is
diff --git a/src/w32.c b/src/w32.c
index 62c53fd7711..a3b9a5683ad 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -4592,6 +4592,27 @@ sys_open (const char * path, int oflag, int mode)
4592} 4592}
4593 4593
4594int 4594int
4595openat (int fd, const char * path, int oflag, int mode)
4596{
4597 /* Rely on a hack: an open directory is modeled as file descriptor 0,
4598 as in fstatat. FIXME: Add proper support for openat. */
4599 char fullname[MAX_UTF8_PATH];
4600
4601 if (fd != AT_FDCWD)
4602 {
4603 if (_snprintf (fullname, sizeof fullname, "%s/%s", dir_pathname, path)
4604 < 0)
4605 {
4606 errno = ENAMETOOLONG;
4607 return -1;
4608 }
4609 path = fullname;
4610 }
4611
4612 return sys_open (path, oflag, mode);
4613}
4614
4615int
4595fchmod (int fd, mode_t mode) 4616fchmod (int fd, mode_t mode)
4596{ 4617{
4597 return 0; 4618 return 0;
diff --git a/src/w32.h b/src/w32.h
index b8655ec788c..f301b3836ca 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -221,6 +221,7 @@ extern void register_child (pid_t, int);
221 221
222extern void sys_sleep (int); 222extern void sys_sleep (int);
223extern int sys_link (const char *, const char *); 223extern int sys_link (const char *, const char *);
224extern int openat (int, const char *, int, int);
224 225
225/* Return total and free memory info. */ 226/* Return total and free memory info. */
226extern int w32_memory_info (unsigned long long *, unsigned long long *, 227extern int w32_memory_info (unsigned long long *, unsigned long long *,
diff --git a/src/w32fns.c b/src/w32fns.c
index 75e0d531a23..61e22e57009 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -2146,6 +2146,9 @@ w32_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_val
2146 | SWP_FRAMECHANGED); 2146 | SWP_FRAMECHANGED);
2147 FRAME_UNDECORATED (f) = false; 2147 FRAME_UNDECORATED (f) = false;
2148 } 2148 }
2149
2150 f->output_data.w32->dwStyle = GetWindowLong (hwnd, GWL_STYLE);
2151
2149 unblock_input (); 2152 unblock_input ();
2150} 2153}
2151 2154
diff --git a/src/w32heap.c b/src/w32heap.c
index 3a6c7804675..ececc73c026 100644
--- a/src/w32heap.c
+++ b/src/w32heap.c
@@ -597,6 +597,16 @@ free_after_dump_9x (void *ptr)
597 } 597 }
598} 598}
599 599
600void *
601sys_calloc (size_t number, size_t size)
602{
603 size_t nbytes = number * size;
604 void *ptr = (*the_malloc_fn) (nbytes);
605 if (ptr)
606 memset (ptr, 0, nbytes);
607 return ptr;
608}
609
600#if defined HAVE_UNEXEC && defined ENABLE_CHECKING 610#if defined HAVE_UNEXEC && defined ENABLE_CHECKING
601void 611void
602report_temacs_memory_usage (void) 612report_temacs_memory_usage (void)
diff --git a/src/w32term.c b/src/w32term.c
index c38e7409d90..4eb5045fc5b 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -560,7 +560,8 @@ static void
560w32_update_window_begin (struct window *w) 560w32_update_window_begin (struct window *w)
561{ 561{
562 /* Hide the system caret during an update. */ 562 /* Hide the system caret during an update. */
563 if (w32_use_visible_system_caret && w32_system_caret_hwnd) 563 if (w32_use_visible_system_caret && w32_system_caret_hwnd
564 && w == w32_system_caret_window)
564 { 565 {
565 SendMessageTimeout (w32_system_caret_hwnd, WM_EMACS_HIDE_CARET, 0, 0, 566 SendMessageTimeout (w32_system_caret_hwnd, WM_EMACS_HIDE_CARET, 0, 0,
566 0, 6000, NULL); 567 0, 6000, NULL);
@@ -657,7 +658,8 @@ w32_update_window_end (struct window *w, bool cursor_on_p,
657 /* Unhide the caret. This won't actually show the cursor, unless it 658 /* Unhide the caret. This won't actually show the cursor, unless it
658 was visible before the corresponding call to HideCaret in 659 was visible before the corresponding call to HideCaret in
659 w32_update_window_begin. */ 660 w32_update_window_begin. */
660 if (w32_use_visible_system_caret && w32_system_caret_hwnd) 661 if (w32_use_visible_system_caret && w32_system_caret_hwnd
662 && w == w32_system_caret_window)
661 { 663 {
662 SendMessageTimeout (w32_system_caret_hwnd, WM_EMACS_SHOW_CARET, 0, 0, 664 SendMessageTimeout (w32_system_caret_hwnd, WM_EMACS_SHOW_CARET, 0, 0,
663 0, 6000, NULL); 665 0, 6000, NULL);
diff --git a/src/w32term.h b/src/w32term.h
index 5a54f542365..737764b8942 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -371,6 +371,10 @@ struct w32_output
371 /* Non-hourglass cursor that is currently active. */ 371 /* Non-hourglass cursor that is currently active. */
372 HCURSOR current_cursor; 372 HCURSOR current_cursor;
373 373
374 /* The window style for this frame. Set up when the frame is
375 created and updated when adding/removing decorations in
376 w32_set_undecorated. Used by w32_set_window_size to adjust the
377 frame's window rectangle. */
374 DWORD dwStyle; 378 DWORD dwStyle;
375 379
376 /* This is the Emacs structure for the display this frame is on. */ 380 /* This is the Emacs structure for the display this frame is on. */
diff --git a/src/window.c b/src/window.c
index ff17cd88f38..8cdad27b664 100644
--- a/src/window.c
+++ b/src/window.c
@@ -7976,19 +7976,17 @@ foreach_window_1 (struct window *w, bool (*fn) (struct window *, void *),
7976/* Return true if window configurations CONFIGURATION1 and CONFIGURATION2 7976/* Return true if window configurations CONFIGURATION1 and CONFIGURATION2
7977 describe the same state of affairs. This is used by Fequal. 7977 describe the same state of affairs. This is used by Fequal.
7978 7978
7979 IGNORE_POSITIONS means ignore non-matching scroll positions 7979 Ignore non-matching scroll positions and the like.
7980 and the like.
7981 7980
7982 This ignores a couple of things like the dedication status of 7981 This ignores a couple of things like the dedication status of
7983 window, combination_limit and the like. This might have to be 7982 window, combination_limit and the like. This might have to be
7984 fixed. */ 7983 fixed. */
7985 7984
7986bool 7985static bool
7987compare_window_configurations (Lisp_Object configuration1, 7986compare_window_configurations (Lisp_Object configuration1,
7988 Lisp_Object configuration2, 7987 Lisp_Object configuration2)
7989 bool ignore_positions)
7990{ 7988{
7991 register struct save_window_data *d1, *d2; 7989 struct save_window_data *d1, *d2;
7992 struct Lisp_Vector *sws1, *sws2; 7990 struct Lisp_Vector *sws1, *sws2;
7993 ptrdiff_t i; 7991 ptrdiff_t i;
7994 7992
@@ -8006,9 +8004,6 @@ compare_window_configurations (Lisp_Object configuration1,
8006 || d1->frame_menu_bar_lines != d2->frame_menu_bar_lines 8004 || d1->frame_menu_bar_lines != d2->frame_menu_bar_lines
8007 || !EQ (d1->selected_frame, d2->selected_frame) 8005 || !EQ (d1->selected_frame, d2->selected_frame)
8008 || !EQ (d1->f_current_buffer, d2->f_current_buffer) 8006 || !EQ (d1->f_current_buffer, d2->f_current_buffer)
8009 || (!ignore_positions
8010 && (!EQ (d1->minibuf_scroll_window, d2->minibuf_scroll_window)
8011 || !EQ (d1->minibuf_selected_window, d2->minibuf_selected_window)))
8012 || !EQ (d1->focus_frame, d2->focus_frame) 8007 || !EQ (d1->focus_frame, d2->focus_frame)
8013 /* Verify that the two configurations have the same number of windows. */ 8008 /* Verify that the two configurations have the same number of windows. */
8014 || sws1->header.size != sws2->header.size) 8009 || sws1->header.size != sws2->header.size)
@@ -8041,12 +8036,6 @@ compare_window_configurations (Lisp_Object configuration1,
8041 equality. */ 8036 equality. */
8042 || !EQ (sw1->parent, sw2->parent) 8037 || !EQ (sw1->parent, sw2->parent)
8043 || !EQ (sw1->prev, sw2->prev) 8038 || !EQ (sw1->prev, sw2->prev)
8044 || (!ignore_positions
8045 && (!EQ (sw1->hscroll, sw2->hscroll)
8046 || !EQ (sw1->min_hscroll, sw2->min_hscroll)
8047 || !EQ (sw1->start_at_line_beg, sw2->start_at_line_beg)
8048 || NILP (Fequal (sw1->start, sw2->start))
8049 || NILP (Fequal (sw1->pointm, sw2->pointm))))
8050 || !EQ (sw1->left_margin_cols, sw2->left_margin_cols) 8039 || !EQ (sw1->left_margin_cols, sw2->left_margin_cols)
8051 || !EQ (sw1->right_margin_cols, sw2->right_margin_cols) 8040 || !EQ (sw1->right_margin_cols, sw2->right_margin_cols)
8052 || !EQ (sw1->left_fringe_width, sw2->left_fringe_width) 8041 || !EQ (sw1->left_fringe_width, sw2->left_fringe_width)
@@ -8071,7 +8060,7 @@ This function ignores details such as the values of point
8071and scrolling positions. */) 8060and scrolling positions. */)
8072 (Lisp_Object x, Lisp_Object y) 8061 (Lisp_Object x, Lisp_Object y)
8073{ 8062{
8074 if (compare_window_configurations (x, y, true)) 8063 if (compare_window_configurations (x, y))
8075 return Qt; 8064 return Qt;
8076 return Qnil; 8065 return Qnil;
8077} 8066}
diff --git a/src/window.h b/src/window.h
index aa8d2c8d1d2..167d1be7abb 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1184,7 +1184,6 @@ extern Lisp_Object window_list (void);
1184extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter); 1184extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter);
1185extern struct window *decode_live_window (Lisp_Object); 1185extern struct window *decode_live_window (Lisp_Object);
1186extern struct window *decode_any_window (Lisp_Object); 1186extern struct window *decode_any_window (Lisp_Object);
1187extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool);
1188extern void mark_window_cursors_off (struct window *); 1187extern void mark_window_cursors_off (struct window *);
1189extern bool window_wants_mode_line (struct window *); 1188extern bool window_wants_mode_line (struct window *);
1190extern bool window_wants_header_line (struct window *); 1189extern bool window_wants_header_line (struct window *);
diff --git a/src/xdisp.c b/src/xdisp.c
index 6b677b63ae4..68a504fb2d4 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -1093,44 +1093,60 @@ window_box_height (struct window *w)
1093 1093
1094 /* Note: the code below that determines the mode-line/header-line/tab-line 1094 /* Note: the code below that determines the mode-line/header-line/tab-line
1095 height is essentially the same as that contained in the macro 1095 height is essentially the same as that contained in the macro
1096 CURRENT_{MODE,HEADER}_LINE_HEIGHT, except that it checks whether 1096 CURRENT_{MODE,HEADER,TAB}_LINE_HEIGHT, except that it checks whether
1097 the appropriate glyph row has its `mode_line_p' flag set, 1097 the appropriate glyph row has its `mode_line_p' flag set, and if
1098 and if it doesn't, uses estimate_mode_line_height instead. */ 1098 it doesn't, uses estimate_mode_line_height instead. */
1099 1099
1100 if (window_wants_mode_line (w)) 1100 if (window_wants_mode_line (w))
1101 { 1101 {
1102 struct glyph_row *ml_row 1102 if (w->mode_line_height >= 0)
1103 = (w->current_matrix && w->current_matrix->rows 1103 height -= w->mode_line_height;
1104 ? MATRIX_MODE_LINE_ROW (w->current_matrix)
1105 : 0);
1106 if (ml_row && ml_row->mode_line_p)
1107 height -= ml_row->height;
1108 else 1104 else
1109 height -= estimate_mode_line_height (f, CURRENT_MODE_LINE_FACE_ID (w)); 1105 {
1106 struct glyph_row *ml_row
1107 = (w->current_matrix && w->current_matrix->rows
1108 ? MATRIX_MODE_LINE_ROW (w->current_matrix)
1109 : 0);
1110 if (ml_row && ml_row->mode_line_p)
1111 height -= ml_row->height;
1112 else
1113 height -= estimate_mode_line_height (f,
1114 CURRENT_MODE_LINE_FACE_ID (w));
1115 }
1110 } 1116 }
1111 1117
1112 if (window_wants_tab_line (w)) 1118 if (window_wants_tab_line (w))
1113 { 1119 {
1114 struct glyph_row *tl_row 1120 if (w->tab_line_height >= 0)
1115 = (w->current_matrix && w->current_matrix->rows 1121 height -= w->tab_line_height;
1116 ? MATRIX_TAB_LINE_ROW (w->current_matrix)
1117 : 0);
1118 if (tl_row && tl_row->mode_line_p)
1119 height -= tl_row->height;
1120 else 1122 else
1121 height -= estimate_mode_line_height (f, TAB_LINE_FACE_ID); 1123 {
1124 struct glyph_row *tl_row
1125 = (w->current_matrix && w->current_matrix->rows
1126 ? MATRIX_TAB_LINE_ROW (w->current_matrix)
1127 : 0);
1128 if (tl_row && tl_row->mode_line_p)
1129 height -= tl_row->height;
1130 else
1131 height -= estimate_mode_line_height (f, TAB_LINE_FACE_ID);
1132 }
1122 } 1133 }
1123 1134
1124 if (window_wants_header_line (w)) 1135 if (window_wants_header_line (w))
1125 { 1136 {
1126 struct glyph_row *hl_row 1137 if (w->header_line_height >= 0)
1127 = (w->current_matrix && w->current_matrix->rows 1138 height -= w->header_line_height;
1128 ? MATRIX_HEADER_LINE_ROW (w->current_matrix)
1129 : 0);
1130 if (hl_row && hl_row->mode_line_p)
1131 height -= hl_row->height;
1132 else 1139 else
1133 height -= estimate_mode_line_height (f, HEADER_LINE_FACE_ID); 1140 {
1141 struct glyph_row *hl_row
1142 = (w->current_matrix && w->current_matrix->rows
1143 ? MATRIX_HEADER_LINE_ROW (w->current_matrix)
1144 : 0);
1145 if (hl_row && hl_row->mode_line_p)
1146 height -= hl_row->height;
1147 else
1148 height -= estimate_mode_line_height (f, HEADER_LINE_FACE_ID);
1149 }
1134 } 1150 }
1135 1151
1136 /* With a very small font and a mode-line that's taller than 1152 /* With a very small font and a mode-line that's taller than
@@ -8557,7 +8573,7 @@ compute_stop_pos_backwards (struct it *it)
8557 position before that. This is called when we bump into a stop 8573 position before that. This is called when we bump into a stop
8558 position while reordering bidirectional text. CHARPOS should be 8574 position while reordering bidirectional text. CHARPOS should be
8559 the last previously processed stop_pos (or BEGV/0, if none were 8575 the last previously processed stop_pos (or BEGV/0, if none were
8560 processed yet) whose position is less that IT's current 8576 processed yet) whose position is less than IT's current
8561 position. */ 8577 position. */
8562 8578
8563static void 8579static void
@@ -13500,6 +13516,10 @@ tty_handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
13500 f->last_tab_bar_item = prop_idx; 13516 f->last_tab_bar_item = prop_idx;
13501 else 13517 else
13502 { 13518 {
13519 /* Force reset of up_modifier bit from the event modifiers. */
13520 if (event->modifiers & up_modifier)
13521 event->modifiers &= ~up_modifier;
13522
13503 /* Generate a TAB_BAR_EVENT event. */ 13523 /* Generate a TAB_BAR_EVENT event. */
13504 Lisp_Object frame; 13524 Lisp_Object frame;
13505 Lisp_Object key = AREF (f->tab_bar_items, 13525 Lisp_Object key = AREF (f->tab_bar_items,
@@ -16228,8 +16248,8 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
16228 bool string_from_text_prop = false; 16248 bool string_from_text_prop = false;
16229 16249
16230 /* Don't even try doing anything if called for a mode-line or 16250 /* Don't even try doing anything if called for a mode-line or
16231 header-line row, since the rest of the code isn't prepared to 16251 header-line or tab-line row, since the rest of the code isn't
16232 deal with such calamities. */ 16252 prepared to deal with such calamities. */
16233 eassert (!row->mode_line_p); 16253 eassert (!row->mode_line_p);
16234 if (row->mode_line_p) 16254 if (row->mode_line_p)
16235 return false; 16255 return false;
@@ -17488,6 +17508,9 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
17488 else 17508 else
17489 { 17509 {
17490 row = MATRIX_ROW (w->current_matrix, w->last_cursor_vpos); 17510 row = MATRIX_ROW (w->current_matrix, w->last_cursor_vpos);
17511 /* Skip the tab-line and header-line rows, if any. */
17512 if (row->tab_line_p)
17513 ++row;
17491 if (row->mode_line_p) 17514 if (row->mode_line_p)
17492 ++row; 17515 ++row;
17493 if (!row->enabled_p) 17516 if (!row->enabled_p)
@@ -17560,6 +17583,9 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
17560 || row->mode_line_p) 17583 || row->mode_line_p)
17561 { 17584 {
17562 row = w->current_matrix->rows; 17585 row = w->current_matrix->rows;
17586 /* Skip the tab-line and header-line rows, if any. */
17587 if (row->tab_line_p)
17588 ++row;
17563 if (row->mode_line_p) 17589 if (row->mode_line_p)
17564 ++row; 17590 ++row;
17565 } 17591 }
@@ -17624,8 +17650,9 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
17624 ; 17650 ;
17625 else if (rc != CURSOR_MOVEMENT_SUCCESS 17651 else if (rc != CURSOR_MOVEMENT_SUCCESS
17626 && MATRIX_ROW_PARTIALLY_VISIBLE_P (w, row) 17652 && MATRIX_ROW_PARTIALLY_VISIBLE_P (w, row)
17627 /* Make sure this isn't a header line by any chance, since 17653 /* Make sure this isn't a header line nor a tab-line by
17628 then MATRIX_ROW_PARTIALLY_VISIBLE_P might yield true. */ 17654 any chance, since then MATRIX_ROW_PARTIALLY_VISIBLE_P
17655 might yield true. */
17629 && !row->mode_line_p 17656 && !row->mode_line_p
17630 && !cursor_row_fully_visible_p (w, true, true, true)) 17657 && !cursor_row_fully_visible_p (w, true, true, true))
17631 { 17658 {
@@ -18753,11 +18780,14 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
18753 } 18780 }
18754 } 18781 }
18755 /* Finally, fall back on the first row of the window after the 18782 /* Finally, fall back on the first row of the window after the
18756 header line (if any). This is slightly better than not 18783 tab-line and header line (if any). This is slightly better
18757 displaying the cursor at all. */ 18784 than not displaying the cursor at all. */
18758 if (!row) 18785 if (!row)
18759 { 18786 {
18760 row = matrix->rows; 18787 row = matrix->rows;
18788 /* Skip the tab-line and header-line rows, if any. */
18789 if (row->tab_line_p)
18790 ++row;
18761 if (row->mode_line_p) 18791 if (row->mode_line_p)
18762 ++row; 18792 ++row;
18763 } 18793 }
@@ -19161,6 +19191,14 @@ try_window_reusing_current_matrix (struct window *w)
19161 if (!NILP (Vdisplay_line_numbers)) 19191 if (!NILP (Vdisplay_line_numbers))
19162 return false; 19192 return false;
19163 19193
19194 /* Can't scroll the display of w32 GUI frames when position of point
19195 is indicated by the system caret, because scrolling the display
19196 will then "copy" the pixels used by the caret. */
19197#ifdef HAVE_NTGUI
19198 if (w32_use_visible_system_caret)
19199 return false;
19200#endif
19201
19164 /* The variable new_start now holds the new window start. The old 19202 /* The variable new_start now holds the new window start. The old
19165 start `start' can be determined from the current matrix. */ 19203 start `start' can be determined from the current matrix. */
19166 SET_TEXT_POS_FROM_MARKER (new_start, w->start); 19204 SET_TEXT_POS_FROM_MARKER (new_start, w->start);
@@ -19771,7 +19809,9 @@ row_containing_pos (struct window *w, ptrdiff_t charpos,
19771 ptrdiff_t mindif = BUF_ZV (XBUFFER (w->contents)) + 1; 19809 ptrdiff_t mindif = BUF_ZV (XBUFFER (w->contents)) + 1;
19772 int last_y; 19810 int last_y;
19773 19811
19774 /* If we happen to start on a header-line, skip that. */ 19812 /* If we happen to start on a header-line or a tab-line, skip that. */
19813 if (row->tab_line_p)
19814 ++row;
19775 if (row->mode_line_p) 19815 if (row->mode_line_p)
19776 ++row; 19816 ++row;
19777 19817
@@ -20143,6 +20183,15 @@ try_window_id (struct window *w)
20143 if (MATRIX_ROW_START_CHARPOS (row) == MATRIX_ROW_END_CHARPOS (row)) 20183 if (MATRIX_ROW_START_CHARPOS (row) == MATRIX_ROW_END_CHARPOS (row))
20144 GIVE_UP (20); 20184 GIVE_UP (20);
20145 20185
20186 /* Can't let scroll_run_hook below run on w32 GUI frames when
20187 position of point is indicated by the system caret, because
20188 scrolling the display will then "copy" the pixels used by the
20189 caret. */
20190#ifdef HAVE_NTGUI
20191 if (FRAME_W32_P (f) && w32_use_visible_system_caret)
20192 GIVE_UP (25);
20193#endif
20194
20146 /* Compute the position at which we have to start displaying new 20195 /* Compute the position at which we have to start displaying new
20147 lines. Some of the lines at the top of the window might be 20196 lines. Some of the lines at the top of the window might be
20148 reusable because they are not displaying changed text. Find the 20197 reusable because they are not displaying changed text. Find the
@@ -22364,7 +22413,7 @@ find_row_edges (struct it *it, struct glyph_row *row,
22364 if (STRINGP (it->object) 22413 if (STRINGP (it->object)
22365 /* this is not the first row */ 22414 /* this is not the first row */
22366 && row > it->w->desired_matrix->rows 22415 && row > it->w->desired_matrix->rows
22367 /* previous row is not the header line */ 22416 /* previous row is not the header line or tab-line */
22368 && !r1->mode_line_p 22417 && !r1->mode_line_p
22369 /* previous row also ends in a newline from a string */ 22418 /* previous row also ends in a newline from a string */
22370 && r1->ends_in_newline_from_string_p) 22419 && r1->ends_in_newline_from_string_p)
diff --git a/src/xfns.c b/src/xfns.c
index b94666d5548..5758bb7a18c 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -3878,8 +3878,6 @@ This function is an internal primitive--use `make-frame' instead. */)
3878#ifdef HAVE_HARFBUZZ 3878#ifdef HAVE_HARFBUZZ
3879 register_font_driver (&xfthbfont_driver, f); 3879 register_font_driver (&xfthbfont_driver, f);
3880#endif 3880#endif
3881#else /* not HAVE_XFT */
3882 register_font_driver (&ftxfont_driver, f);
3883#endif /* not HAVE_XFT */ 3881#endif /* not HAVE_XFT */
3884#endif /* HAVE_FREETYPE */ 3882#endif /* HAVE_FREETYPE */
3885#endif /* not USE_CAIRO */ 3883#endif /* not USE_CAIRO */
@@ -4572,7 +4570,7 @@ On MS Windows, this just returns nil. */)
4572 return Qnil; 4570 return Qnil;
4573} 4571}
4574 4572
4575#ifndef USE_GTK 4573#if !defined USE_GTK || !defined HAVE_GTK3
4576 4574
4577/* Store the geometry of the workarea on display DPYINFO into *RECT. 4575/* Store the geometry of the workarea on display DPYINFO into *RECT.
4578 Return false if and only if the workarea information cannot be 4576 Return false if and only if the workarea information cannot be
@@ -5089,6 +5087,8 @@ Internal use only, use `display-monitor-attributes-list' instead. */)
5089#elif defined HAVE_GTK3 5087#elif defined HAVE_GTK3
5090 scale = gdk_screen_get_monitor_scale_factor (gscreen, i); 5088 scale = gdk_screen_get_monitor_scale_factor (gscreen, i);
5091#endif 5089#endif
5090 rec.x *= scale;
5091 rec.y *= scale;
5092 rec.width *= scale; 5092 rec.width *= scale;
5093 rec.height *= scale; 5093 rec.height *= scale;
5094 work.x *= scale; 5094 work.x *= scale;
@@ -6362,8 +6362,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
6362#ifdef HAVE_HARFBUZZ 6362#ifdef HAVE_HARFBUZZ
6363 register_font_driver (&xfthbfont_driver, f); 6363 register_font_driver (&xfthbfont_driver, f);
6364#endif 6364#endif
6365#else /* not HAVE_XFT */
6366 register_font_driver (&ftxfont_driver, f);
6367#endif /* not HAVE_XFT */ 6365#endif /* not HAVE_XFT */
6368#endif /* HAVE_FREETYPE */ 6366#endif /* HAVE_FREETYPE */
6369#endif /* not USE_CAIRO */ 6367#endif /* not USE_CAIRO */
diff --git a/src/xterm.c b/src/xterm.c
index ada3cec1636..21d99f0c7bb 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -8934,6 +8934,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
8934 if (f) 8934 if (f)
8935 x_cr_update_surface_desired_size (f, configureEvent.xconfigure.width, 8935 x_cr_update_surface_desired_size (f, configureEvent.xconfigure.width,
8936 configureEvent.xconfigure.height); 8936 configureEvent.xconfigure.height);
8937 else if (any && configureEvent.xconfigure.window == FRAME_X_WINDOW (any))
8938 x_cr_update_surface_desired_size (any,
8939 configureEvent.xconfigure.width,
8940 configureEvent.xconfigure.height);
8937#endif 8941#endif
8938#ifdef USE_GTK 8942#ifdef USE_GTK
8939 if (!f 8943 if (!f
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-08 02:28:51 +0000