diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/.gdbinit | 6 | ||||
| -rw-r--r-- | src/Makefile.in | 6 | ||||
| -rw-r--r-- | src/alloc.c | 419 | ||||
| -rw-r--r-- | src/bidi.c | 20 | ||||
| -rw-r--r-- | src/bignum.c | 36 | ||||
| -rw-r--r-- | src/bignum.h | 5 | ||||
| -rw-r--r-- | src/buffer.c | 112 | ||||
| -rw-r--r-- | src/buffer.h | 154 | ||||
| -rw-r--r-- | src/bytecode.c | 10 | ||||
| -rw-r--r-- | src/callproc.c | 12 | ||||
| -rw-r--r-- | src/casefiddle.c | 32 | ||||
| -rw-r--r-- | src/ccl.c | 11 | ||||
| -rw-r--r-- | src/character.c | 164 | ||||
| -rw-r--r-- | src/character.h | 838 | ||||
| -rw-r--r-- | src/charset.c | 37 | ||||
| -rw-r--r-- | src/chartab.c | 10 | ||||
| -rw-r--r-- | src/cmds.c | 17 | ||||
| -rw-r--r-- | src/coding.c | 197 | ||||
| -rw-r--r-- | src/coding.h | 4 | ||||
| -rw-r--r-- | src/composite.c | 72 | ||||
| -rw-r--r-- | src/composite.h | 9 | ||||
| -rw-r--r-- | src/conf_post.h | 109 | ||||
| -rw-r--r-- | src/data.c | 186 | ||||
| -rw-r--r-- | src/deps.mk | 3 | ||||
| -rw-r--r-- | src/dired.c | 4 | ||||
| -rw-r--r-- | src/dispextern.h | 55 | ||||
| -rw-r--r-- | src/editfns.c | 186 | ||||
| -rw-r--r-- | src/emacs-module.c | 227 | ||||
| -rw-r--r-- | src/emacs-module.h.in | 52 | ||||
| -rw-r--r-- | src/emacs.c | 86 | ||||
| -rw-r--r-- | src/fileio.c | 142 | ||||
| -rw-r--r-- | src/filelock.c | 33 | ||||
| -rw-r--r-- | src/fns.c | 226 | ||||
| -rw-r--r-- | src/font.c | 55 | ||||
| -rw-r--r-- | src/font.h | 6 | ||||
| -rw-r--r-- | src/frame.c | 101 | ||||
| -rw-r--r-- | src/frame.h | 48 | ||||
| -rw-r--r-- | src/fringe.c | 10 | ||||
| -rw-r--r-- | src/ftcrfont.c | 5 | ||||
| -rw-r--r-- | src/ftfont.c | 7 | ||||
| -rw-r--r-- | src/ftxfont.c | 371 | ||||
| -rw-r--r-- | src/gtkutil.c | 7 | ||||
| -rw-r--r-- | src/image.c | 214 | ||||
| -rw-r--r-- | src/indent.c | 36 | ||||
| -rw-r--r-- | src/insdel.c | 7 | ||||
| -rw-r--r-- | src/intervals.c | 12 | ||||
| -rw-r--r-- | src/intervals.h | 24 | ||||
| -rw-r--r-- | src/json.c | 1 | ||||
| -rw-r--r-- | src/keyboard.c | 50 | ||||
| -rw-r--r-- | src/keymap.c | 171 | ||||
| -rw-r--r-- | src/lcms.c | 7 | ||||
| -rw-r--r-- | src/lisp.h | 113 | ||||
| -rw-r--r-- | src/lread.c | 205 | ||||
| -rw-r--r-- | src/macfont.m | 3 | ||||
| -rw-r--r-- | src/marker.c | 10 | ||||
| -rw-r--r-- | src/menu.c | 26 | ||||
| -rw-r--r-- | src/mini-gmp.c | 218 | ||||
| -rw-r--r-- | src/mini-gmp.h | 8 | ||||
| -rw-r--r-- | src/minibuf.c | 7 | ||||
| -rw-r--r-- | src/module-env-25.h | 67 | ||||
| -rw-r--r-- | src/module-env-27.h | 2 | ||||
| -rw-r--r-- | src/module-env-28.h | 14 | ||||
| -rw-r--r-- | src/msdos.c | 4 | ||||
| -rw-r--r-- | src/nsfns.m | 129 | ||||
| -rw-r--r-- | src/nsfont.m | 9 | ||||
| -rw-r--r-- | src/nsimage.m | 56 | ||||
| -rw-r--r-- | src/nsmenu.m | 2 | ||||
| -rw-r--r-- | src/nsterm.h | 43 | ||||
| -rw-r--r-- | src/nsterm.m | 1542 | ||||
| -rw-r--r-- | src/pdumper.c | 17 | ||||
| -rw-r--r-- | src/print.c | 71 | ||||
| -rw-r--r-- | src/process.c | 54 | ||||
| -rw-r--r-- | src/process.h | 2 | ||||
| -rw-r--r-- | src/regex-emacs.c | 53 | ||||
| -rw-r--r-- | src/search.c | 68 | ||||
| -rw-r--r-- | src/syntax.c | 131 | ||||
| -rw-r--r-- | src/sysdep.c | 72 | ||||
| -rw-r--r-- | src/systhread.h | 12 | ||||
| -rw-r--r-- | src/systime.h | 3 | ||||
| -rw-r--r-- | src/textprop.c | 27 | ||||
| -rw-r--r-- | src/thread.c | 3 | ||||
| -rw-r--r-- | src/timefns.c | 92 | ||||
| -rw-r--r-- | src/w32.c | 194 | ||||
| -rw-r--r-- | src/w32.h | 4 | ||||
| -rw-r--r-- | src/w32fns.c | 91 | ||||
| -rw-r--r-- | src/w32gui.h | 6 | ||||
| -rw-r--r-- | src/w32heap.c | 10 | ||||
| -rw-r--r-- | src/w32image.c | 477 | ||||
| -rw-r--r-- | src/w32proc.c | 2 | ||||
| -rw-r--r-- | src/w32term.c | 131 | ||||
| -rw-r--r-- | src/w32term.h | 6 | ||||
| -rw-r--r-- | src/window.c | 71 | ||||
| -rw-r--r-- | src/window.h | 1 | ||||
| -rw-r--r-- | src/xdisp.c | 420 | ||||
| -rw-r--r-- | src/xfaces.c | 32 | ||||
| -rw-r--r-- | src/xfns.c | 34 | ||||
| -rw-r--r-- | src/xfont.c | 2 | ||||
| -rw-r--r-- | src/xrdb.c | 2 | ||||
| -rw-r--r-- | src/xterm.c | 151 | ||||
| -rw-r--r-- | src/xwidget.c | 6 |
100 files changed, 4988 insertions, 4327 deletions
diff --git a/src/.gdbinit b/src/.gdbinit index 30c7b055ce0..78536fc01fb 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -500,6 +500,9 @@ define pgx # IMAGE_GLYPH if ($g.type == 3) printf "IMAGE[%d]", $g.u.img_id + if ($g.slice.img.x || $g.slice.img.y || $g.slice.img.width || $g.slice.img.height) + printf " slice=%d,%d,%d,%d" ,$g.slice.img.x, $g.slice.img.y, $g.slice.img.width, $g.slice.img.height + end end # STRETCH_GLYPH if ($g.type == 4) @@ -551,9 +554,6 @@ define pgx if ($g.right_box_line_p) printf " ]" end - if ($g.slice.img.x || $g.slice.img.y || $g.slice.img.width || $g.slice.img.height) - printf " slice=%d,%d,%d,%d" ,$g.slice.img.x, $g.slice.img.y, $g.slice.img.width, $g.slice.img.height - end printf "\n" end document pgx 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@ W32_RES_LINK=@W32_RES_LINK@ ## Empty if !HAVE_X_WINDOWS -## xfont.o ftfont.o xftfont.o ftxfont.o if HAVE_XFT -## xfont.o ftfont.o ftxfont.o if HAVE_FREETYPE +## xfont.o ftfont.o xftfont.o if HAVE_XFT +## xfont.o ftfont.o if HAVE_FREETYPE ## xfont.o ftfont.o ftcrfont.o if USE_CAIRO ## else xfont.o ## if HAVE_HARFBUZZ, hbfont.o is added regardless of the rest @@ -436,7 +436,7 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o macfont.o \ w32.o w32console.o w32cygwinx.o w32fns.o w32heap.o w32inevt.o w32notify.o \ w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \ - w16select.o widget.o xfont.o ftfont.o xftfont.o ftxfont.o gtkutil.o \ + w16select.o widget.o xfont.o ftfont.o xftfont.o gtkutil.o \ xsettings.o xgselect.o termcap.o hbfont.o ## gmalloc.o if !SYSTEM_MALLOC && !DOUG_LEA_MALLOC, else empty. diff --git a/src/alloc.c b/src/alloc.c index 1c6b664b220..cc9ba8dbf50 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/>. */ #include "w32heap.h" /* for sbrk */ #endif +/* MALLOC_SIZE_NEAR (N) is a good number to pass to malloc when + allocating a block of memory with size close to N bytes. + For best results N should be a power of 2. + + When calculating how much memory to allocate, GNU malloc (SIZE) + adds sizeof (size_t) to SIZE for internal overhead, and then rounds + up to a multiple of MALLOC_ALIGNMENT. Emacs can improve + performance a bit on GNU platforms by arranging for the resulting + size to be a power of two. This heuristic is good for glibc 2.0 + (1997) through at least glibc 2.31 (2020), and does not affect + correctness on other platforms. */ + +#define MALLOC_SIZE_NEAR(n) \ + (ROUNDUP (max (n, sizeof (size_t)), MALLOC_ALIGNMENT) - sizeof (size_t)) +#ifdef __i386 +enum { MALLOC_ALIGNMENT = 16 }; +#else +enum { MALLOC_ALIGNMENT = max (2 * sizeof (size_t), alignof (long double)) }; +#endif + #ifdef DOUG_LEA_MALLOC /* Specify maximum number of areas to mmap. It would be nice to use a @@ -412,7 +432,6 @@ inline static void set_interval_marked (INTERVAL i); enum mem_type { MEM_TYPE_NON_LISP, - MEM_TYPE_BUFFER, MEM_TYPE_CONS, MEM_TYPE_STRING, MEM_TYPE_SYMBOL, @@ -694,7 +713,7 @@ malloc_unblock_input (void) malloc_probe (size); \ } while (0) -static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); +static void *lmalloc (size_t, bool) ATTRIBUTE_MALLOC_SIZE ((1)); static void *lrealloc (void *, size_t); /* Like malloc but check for no memory and block interrupt input. */ @@ -705,7 +724,7 @@ xmalloc (size_t size) void *val; MALLOC_BLOCK_INPUT; - val = lmalloc (size); + val = lmalloc (size, false); MALLOC_UNBLOCK_INPUT; if (!val && size) @@ -722,12 +741,11 @@ xzalloc (size_t size) void *val; MALLOC_BLOCK_INPUT; - val = lmalloc (size); + val = lmalloc (size, true); MALLOC_UNBLOCK_INPUT; if (!val && size) memory_full (size); - memset (val, 0, size); MALLOC_PROBE (size); return val; } @@ -743,7 +761,7 @@ xrealloc (void *block, size_t size) /* We must call malloc explicitly when BLOCK is 0, since some reallocs don't do this. */ if (! block) - val = lmalloc (size); + val = lmalloc (size, false); else val = lrealloc (block, size); MALLOC_UNBLOCK_INPUT; @@ -939,7 +957,7 @@ void *lisp_malloc_loser EXTERNALLY_VISIBLE; #endif static void * -lisp_malloc (size_t nbytes, enum mem_type type) +lisp_malloc (size_t nbytes, bool clearit, enum mem_type type) { register void *val; @@ -949,7 +967,7 @@ lisp_malloc (size_t nbytes, enum mem_type type) allocated_mem_type = type; #endif - val = lmalloc (nbytes); + val = lmalloc (nbytes, clearit); #if ! USE_LSB_TAG /* If the memory just allocated cannot be addressed thru a Lisp @@ -1290,16 +1308,21 @@ laligned (void *p, size_t size) that's never really exercised) for little benefit. */ static void * -lmalloc (size_t size) +lmalloc (size_t size, bool clearit) { #ifdef USE_ALIGNED_ALLOC if (! MALLOC_IS_LISP_ALIGNED && size % LISP_ALIGNMENT == 0) - return aligned_alloc (LISP_ALIGNMENT, size); + { + void *p = aligned_alloc (LISP_ALIGNMENT, size); + if (clearit && p) + memclear (p, size); + return p; + } #endif while (true) { - void *p = malloc (size); + void *p = clearit ? calloc (1, size) : malloc (size); if (laligned (p, size)) return p; free (p); @@ -1328,11 +1351,11 @@ lrealloc (void *p, size_t size) Interval Allocation ***********************************************************************/ -/* Number of intervals allocated in an interval_block structure. - The 1020 is 1024 minus malloc overhead. */ +/* Number of intervals allocated in an interval_block structure. */ -#define INTERVAL_BLOCK_SIZE \ - ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval)) +enum { INTERVAL_BLOCK_SIZE + = ((MALLOC_SIZE_NEAR (1024) - sizeof (struct interval_block *)) + / sizeof (struct interval)) }; /* Intervals are allocated in chunks in the form of an interval_block structure. */ @@ -1377,7 +1400,7 @@ make_interval (void) if (interval_block_index == INTERVAL_BLOCK_SIZE) { struct interval_block *newi - = lisp_malloc (sizeof *newi, MEM_TYPE_NON_LISP); + = lisp_malloc (sizeof *newi, false, MEM_TYPE_NON_LISP); newi->next = interval_block; interval_block = newi; @@ -1444,10 +1467,9 @@ mark_interval_tree (INTERVAL i) longer used, can be easily recognized, and it's easy to compact the sblocks of small strings which we do in compact_small_strings. */ -/* Size in bytes of an sblock structure used for small strings. This - is 8192 minus malloc overhead. */ +/* Size in bytes of an sblock structure used for small strings. */ -#define SBLOCK_SIZE 8188 +enum { SBLOCK_SIZE = MALLOC_SIZE_NEAR (8192) }; /* Strings larger than this are considered large strings. String data for large strings is allocated from individual sblocks. */ @@ -1522,11 +1544,11 @@ struct sblock sdata data[FLEXIBLE_ARRAY_MEMBER]; }; -/* Number of Lisp strings in a string_block structure. The 1020 is - 1024 minus malloc overhead. */ +/* Number of Lisp strings in a string_block structure. */ -#define STRING_BLOCK_SIZE \ - ((1020 - sizeof (struct string_block *)) / sizeof (struct Lisp_String)) +enum { STRING_BLOCK_SIZE + = ((MALLOC_SIZE_NEAR (1024) - sizeof (struct string_block *)) + / sizeof (struct Lisp_String)) }; /* Structure describing a block from which Lisp_String structures are allocated. */ @@ -1730,7 +1752,7 @@ allocate_string (void) add all the Lisp_Strings in it to the free-list. */ if (string_free_list == NULL) { - struct string_block *b = lisp_malloc (sizeof *b, MEM_TYPE_STRING); + struct string_block *b = lisp_malloc (sizeof *b, false, MEM_TYPE_STRING); int i; b->next = string_blocks; @@ -1778,15 +1800,16 @@ allocate_string (void) plus a NUL byte at the end. Allocate an sdata structure DATA for S, and set S->u.s.data to SDATA->u.data. Store a NUL byte at the end of S->u.s.data. Set S->u.s.size to NCHARS and S->u.s.size_byte - to NBYTES. Free S->u.s.data if it was initially non-null. */ + to NBYTES. Free S->u.s.data if it was initially non-null. -void + If CLEARIT, also clear the other bytes of S->u.s.data. */ + +static void allocate_string_data (struct Lisp_String *s, - EMACS_INT nchars, EMACS_INT nbytes) + EMACS_INT nchars, EMACS_INT nbytes, bool clearit) { - sdata *data, *old_data; + sdata *data; struct sblock *b; - ptrdiff_t old_nbytes; if (STRING_BYTES_MAX < nbytes) string_overflow (); @@ -1794,13 +1817,6 @@ allocate_string_data (struct Lisp_String *s, /* Determine the number of bytes needed to store NBYTES bytes of string data. */ ptrdiff_t needed = sdata_size (nbytes); - if (s->u.s.data) - { - old_data = SDATA_OF_STRING (s); - old_nbytes = STRING_BYTES (s); - } - else - old_data = NULL; MALLOC_BLOCK_INPUT; @@ -1813,7 +1829,7 @@ allocate_string_data (struct Lisp_String *s, mallopt (M_MMAP_MAX, 0); #endif - b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP); + b = lisp_malloc (size + GC_STRING_EXTRA, clearit, MEM_TYPE_NON_LISP); #ifdef DOUG_LEA_MALLOC if (!mmap_lisp_allowed_p ()) @@ -1825,27 +1841,30 @@ allocate_string_data (struct Lisp_String *s, b->next_free = data; large_sblocks = b; } - else if (current_sblock == NULL - || (((char *) current_sblock + SBLOCK_SIZE - - (char *) current_sblock->next_free) - < (needed + GC_STRING_EXTRA))) - { - /* Not enough room in the current sblock. */ - b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP); - data = b->data; - b->next = NULL; - b->next_free = data; - - if (current_sblock) - current_sblock->next = b; - else - oldest_sblock = b; - current_sblock = b; - } else { b = current_sblock; + + if (b == NULL + || (SBLOCK_SIZE - GC_STRING_EXTRA + < (char *) b->next_free - (char *) b + needed)) + { + /* Not enough room in the current sblock. */ + b = lisp_malloc (SBLOCK_SIZE, false, MEM_TYPE_NON_LISP); + data = b->data; + b->next = NULL; + b->next_free = data; + + if (current_sblock) + current_sblock->next = b; + else + oldest_sblock = b; + current_sblock = b; + } + data = b->next_free; + if (clearit) + memset (SDATA_DATA (data), 0, nbytes); } data->string = s; @@ -1866,16 +1885,55 @@ allocate_string_data (struct Lisp_String *s, GC_STRING_OVERRUN_COOKIE_SIZE); #endif - /* Note that Faset may call to this function when S has already data - assigned. In this case, mark data as free by setting it's string - back-pointer to null, and record the size of the data in it. */ - if (old_data) + tally_consing (needed); +} + +/* Reallocate multibyte STRING data when a single character is replaced. + The character is at byte offset CIDX_BYTE in the string. + The character being replaced is CLEN bytes long, + and the character that will replace it is NEW_CLEN bytes long. + Return the address of where the caller should store the + the new character. */ + +unsigned char * +resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte, + int clen, int new_clen) +{ + eassume (STRING_MULTIBYTE (string)); + sdata *old_sdata = SDATA_OF_STRING (XSTRING (string)); + ptrdiff_t nchars = SCHARS (string); + ptrdiff_t nbytes = SBYTES (string); + ptrdiff_t new_nbytes = nbytes + (new_clen - clen); + unsigned char *data = SDATA (string); + unsigned char *new_charaddr; + + if (sdata_size (nbytes) == sdata_size (new_nbytes)) { - SDATA_NBYTES (old_data) = old_nbytes; - old_data->string = NULL; + /* No need to reallocate, as the size change falls within the + alignment slop. */ + XSTRING (string)->u.s.size_byte = new_nbytes; + new_charaddr = data + cidx_byte; + memmove (new_charaddr + new_clen, new_charaddr + clen, + nbytes - (cidx_byte + (clen - 1))); + } + else + { + allocate_string_data (XSTRING (string), nchars, new_nbytes, false); + unsigned char *new_data = SDATA (string); + new_charaddr = new_data + cidx_byte; + memcpy (new_charaddr + new_clen, data + cidx_byte + clen, + nbytes - (cidx_byte + clen)); + memcpy (new_data, data, cidx_byte); + + /* Mark old string data as free by setting its string back-pointer + to null, and record the size of the data in it. */ + SDATA_NBYTES (old_sdata) = nbytes; + old_sdata->string = NULL; } - tally_consing (needed); + clear_string_char_byte_cache (); + + return new_charaddr; } @@ -2110,6 +2168,9 @@ string_overflow (void) error ("Maximum string size exceeded"); } +static Lisp_Object make_clear_string (EMACS_INT, bool); +static Lisp_Object make_clear_multibyte_string (EMACS_INT, EMACS_INT, bool); + DEFUN ("make-string", Fmake_string, Smake_string, 2, 3, 0, doc: /* Return a newly created string of length LENGTH, with INIT in each element. LENGTH must be an integer. @@ -2118,19 +2179,20 @@ If optional argument MULTIBYTE is non-nil, the result will be a multibyte string even if INIT is an ASCII character. */) (Lisp_Object length, Lisp_Object init, Lisp_Object multibyte) { - register Lisp_Object val; - int c; + Lisp_Object val; EMACS_INT nbytes; CHECK_FIXNAT (length); CHECK_CHARACTER (init); - c = XFIXNAT (init); + int c = XFIXNAT (init); + bool clearit = !c; + if (ASCII_CHAR_P (c) && NILP (multibyte)) { nbytes = XFIXNUM (length); - val = make_uninit_string (nbytes); - if (nbytes) + val = make_clear_string (nbytes, clearit); + if (nbytes && !clearit) { memset (SDATA (val), c, nbytes); SDATA (val)[nbytes] = 0; @@ -2141,26 +2203,27 @@ a multibyte string even if INIT is an ASCII character. */) unsigned char str[MAX_MULTIBYTE_LENGTH]; ptrdiff_t len = CHAR_STRING (c, str); EMACS_INT string_len = XFIXNUM (length); - unsigned char *p, *beg, *end; if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes)) string_overflow (); - val = make_uninit_multibyte_string (string_len, nbytes); - for (beg = SDATA (val), p = beg, end = beg + nbytes; p < end; p += len) + val = make_clear_multibyte_string (string_len, nbytes, clearit); + if (!clearit) { - /* First time we just copy `str' to the data of `val'. */ - if (p == beg) - memcpy (p, str, len); - else + unsigned char *beg = SDATA (val), *end = beg + nbytes; + for (unsigned char *p = beg; p < end; p += len) { - /* Next time we copy largest possible chunk from - initialized to uninitialized part of `val'. */ - len = min (p - beg, end - p); - memcpy (p, beg, len); + /* First time we just copy STR to the data of VAL. */ + if (p == beg) + memcpy (p, str, len); + else + { + /* Next time we copy largest possible chunk from + initialized to uninitialized part of VAL. */ + len = min (p - beg, end - p); + memcpy (p, beg, len); + } } } - if (nbytes) - *p = 0; } return val; @@ -2330,26 +2393,37 @@ make_specified_string (const char *contents, /* Return a unibyte Lisp_String set up to hold LENGTH characters - occupying LENGTH bytes. */ + occupying LENGTH bytes. If CLEARIT, clear its contents to null + bytes; otherwise, the contents are uninitialized. */ -Lisp_Object -make_uninit_string (EMACS_INT length) +static Lisp_Object +make_clear_string (EMACS_INT length, bool clearit) { Lisp_Object val; if (!length) return empty_unibyte_string; - val = make_uninit_multibyte_string (length, length); + val = make_clear_multibyte_string (length, length, clearit); STRING_SET_UNIBYTE (val); return val; } +/* Return a unibyte Lisp_String set up to hold LENGTH characters + occupying LENGTH bytes. */ + +Lisp_Object +make_uninit_string (EMACS_INT length) +{ + return make_clear_string (length, false); +} + /* Return a multibyte Lisp_String set up to hold NCHARS characters - which occupy NBYTES bytes. */ + which occupy NBYTES bytes. If CLEARIT, clear its contents to null + bytes; otherwise, the contents are uninitialized. */ -Lisp_Object -make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) +static Lisp_Object +make_clear_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes, bool clearit) { Lisp_Object string; struct Lisp_String *s; @@ -2361,12 +2435,21 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) s = allocate_string (); s->u.s.intervals = NULL; - allocate_string_data (s, nchars, nbytes); + allocate_string_data (s, nchars, nbytes, clearit); XSETSTRING (string, s); string_chars_consed += nbytes; return string; } +/* Return a multibyte Lisp_String set up to hold NCHARS characters + which occupy NBYTES bytes. */ + +Lisp_Object +make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) +{ + return make_clear_multibyte_string (nchars, nbytes, false); +} + /* Print arguments to BUF according to a FORMAT, then return a Lisp_String initialized with the data from BUF. */ @@ -3023,6 +3106,14 @@ cleanup_vector (struct Lisp_Vector *vector) if (uptr->finalizer) uptr->finalizer (uptr->p); } +#ifdef HAVE_MODULES + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MODULE_FUNCTION)) + { + ATTRIBUTE_MAY_ALIAS struct Lisp_Module_Function *function + = (struct Lisp_Module_Function *) vector; + module_finalize_function (function); + } +#endif } /* Reclaim space used by unmarked vectors. */ @@ -3137,7 +3228,7 @@ sweep_vectors (void) at most VECTOR_ELTS_MAX. */ static struct Lisp_Vector * -allocate_vectorlike (ptrdiff_t len) +allocate_vectorlike (ptrdiff_t len, bool clearit) { eassert (0 < len && len <= VECTOR_ELTS_MAX); ptrdiff_t nbytes = header_size + len * word_size; @@ -3151,11 +3242,15 @@ allocate_vectorlike (ptrdiff_t len) #endif if (nbytes <= VBLOCK_BYTES_MAX) - p = allocate_vector_from_block (vroundup (nbytes)); + { + p = allocate_vector_from_block (vroundup (nbytes)); + if (clearit) + memclear (p, nbytes); + } else { struct large_vector *lv = lisp_malloc (large_vector_offset + nbytes, - MEM_TYPE_VECTORLIKE); + clearit, MEM_TYPE_VECTORLIKE); lv->next = large_vectors; large_vectors = lv; p = large_vector_vec (lv); @@ -3178,20 +3273,37 @@ allocate_vectorlike (ptrdiff_t len) } -/* Allocate a vector with LEN slots. */ +/* Allocate a vector with LEN slots. If CLEARIT, clear its slots; + otherwise the vector's slots are uninitialized. */ -struct Lisp_Vector * -allocate_vector (ptrdiff_t len) +static struct Lisp_Vector * +allocate_clear_vector (ptrdiff_t len, bool clearit) { if (len == 0) return XVECTOR (zero_vector); if (VECTOR_ELTS_MAX < len) memory_full (SIZE_MAX); - struct Lisp_Vector *v = allocate_vectorlike (len); + struct Lisp_Vector *v = allocate_vectorlike (len, clearit); v->header.size = len; return v; } +/* Allocate a vector with LEN uninitialized slots. */ + +struct Lisp_Vector * +allocate_vector (ptrdiff_t len) +{ + return allocate_clear_vector (len, false); +} + +/* Allocate a vector with LEN nil slots. */ + +struct Lisp_Vector * +allocate_nil_vector (ptrdiff_t len) +{ + return allocate_clear_vector (len, true); +} + /* Allocate other vector-like structures. */ @@ -3208,7 +3320,7 @@ allocate_pseudovector (int memlen, int lisplen, eassert (lisplen <= size_max); eassert (memlen <= size_max + rest_max); - struct Lisp_Vector *v = allocate_vectorlike (memlen); + struct Lisp_Vector *v = allocate_vectorlike (memlen, false); /* Only the first LISPLEN slots will be traced normally by the GC. */ memclear (v->contents, zerolen * word_size); XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen); @@ -3218,12 +3330,10 @@ allocate_pseudovector (int memlen, int lisplen, struct buffer * allocate_buffer (void) { - struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER); - + struct buffer *b + = ALLOCATE_PSEUDOVECTOR (struct buffer, cursor_in_non_selected_windows_, + PVEC_BUFFER); BUFFER_PVEC_INIT (b); - /* Put B on the chain of all buffers including killed ones. */ - b->next = all_buffers; - all_buffers = b; /* Note that the rest fields of B are not initialized. */ return b; } @@ -3238,7 +3348,7 @@ allocate_record (EMACS_INT count) if (count > PSEUDOVECTOR_SIZE_MASK) error ("Attempt to allocate a record of %"pI"d slots; max is %d", count, PSEUDOVECTOR_SIZE_MASK); - struct Lisp_Vector *p = allocate_vectorlike (count); + struct Lisp_Vector *p = allocate_vectorlike (count, false); p->header.size = count; XSETPVECTYPE (p, PVEC_RECORD); return p; @@ -3291,9 +3401,11 @@ See also the function `vector'. */) Lisp_Object make_vector (ptrdiff_t length, Lisp_Object init) { - struct Lisp_Vector *p = allocate_vector (length); - for (ptrdiff_t i = 0; i < length; i++) - p->contents[i] = init; + bool clearit = NIL_IS_ZERO && NILP (init); + struct Lisp_Vector *p = allocate_clear_vector (length, clearit); + if (!clearit) + for (ptrdiff_t i = 0; i < length; i++) + p->contents[i] = init; return make_lisp_ptr (p, Lisp_Vectorlike); } @@ -3442,7 +3554,7 @@ Its value is void, and its function definition and property list are nil. */) if (symbol_block_index == SYMBOL_BLOCK_SIZE) { struct symbol_block *new - = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL); + = lisp_malloc (sizeof *new, false, MEM_TYPE_SYMBOL); new->next = symbol_block; symbol_block = new; symbol_block_index = 0; @@ -3904,10 +4016,10 @@ refill_memory_reserve (void) MEM_TYPE_SPARE); if (spare_memory[5] == 0) spare_memory[5] = lisp_malloc (sizeof (struct string_block), - MEM_TYPE_SPARE); + false, MEM_TYPE_SPARE); if (spare_memory[6] == 0) spare_memory[6] = lisp_malloc (sizeof (struct string_block), - MEM_TYPE_SPARE); + false, MEM_TYPE_SPARE); if (spare_memory[0] && spare_memory[1] && spare_memory[5]) Vmemory_full = Qnil; #endif @@ -4481,36 +4593,6 @@ live_vector_p (struct mem_node *m, void *p) return !NILP (live_vector_holding (m, p)); } -/* If P is a pointer into a live buffer, return the buffer. - Otherwise, return nil. M is a pointer to the mem_block for P. */ - -static Lisp_Object -live_buffer_holding (struct mem_node *m, void *p) -{ - /* P must point into the block, and the buffer - must not have been killed. */ - if (m->type == MEM_TYPE_BUFFER) - { - struct buffer *b = m->start; - char *cb = m->start; - char *cp = p; - ptrdiff_t offset = cp - cb; - if (0 <= offset && offset < sizeof *b && !NILP (b->name_)) - { - Lisp_Object obj; - XSETBUFFER (obj, b); - return obj; - } - } - return Qnil; -} - -static bool -live_buffer_p (struct mem_node *m, void *p) -{ - return !NILP (live_buffer_holding (m, p)); -} - /* Mark OBJ if we can prove it's a Lisp_Object. */ static void @@ -4565,8 +4647,7 @@ mark_maybe_object (Lisp_Object obj) break; case Lisp_Vectorlike: - mark_p = (EQ (obj, live_vector_holding (m, po)) - || EQ (obj, live_buffer_holding (m, po))); + mark_p = (EQ (obj, live_vector_holding (m, po))); break; default: @@ -4635,10 +4716,6 @@ mark_maybe_pointer (void *p) /* Nothing to do; not a pointer to Lisp memory. */ break; - case MEM_TYPE_BUFFER: - obj = live_buffer_holding (m, p); - break; - case MEM_TYPE_CONS: obj = live_cons_holding (m, p); break; @@ -5038,9 +5115,6 @@ valid_lisp_object_p (Lisp_Object obj) case MEM_TYPE_SPARE: return 0; - case MEM_TYPE_BUFFER: - return live_buffer_p (m, p) ? 1 : 2; - case MEM_TYPE_CONS: return live_cons_p (m, p); @@ -5857,7 +5931,7 @@ maybe_garbage_collect (void) void garbage_collect (void) { - struct buffer *nextb; + Lisp_Object tail, buffer; char stack_top_variable; bool message_p; ptrdiff_t count = SPECPDL_INDEX (); @@ -5873,8 +5947,8 @@ garbage_collect (void) /* Don't keep undo information around forever. Do this early on, so it is no problem if the user quits. */ - FOR_EACH_BUFFER (nextb) - compact_buffer (nextb); + FOR_EACH_LIVE_BUFFER (tail, buffer) + compact_buffer (XBUFFER (buffer)); byte_ct tot_before = (profiler_memory_running ? total_bytes_of_live_objects () @@ -5964,8 +6038,9 @@ garbage_collect (void) compact_font_caches (); - FOR_EACH_BUFFER (nextb) + FOR_EACH_LIVE_BUFFER (tail, buffer) { + struct buffer *nextb = XBUFFER (buffer); if (!EQ (BVAR (nextb, undo_list), Qt)) bset_undo_list (nextb, compact_undo_list (BVAR (nextb, undo_list))); /* Now that we have stripped the elements that need not be @@ -6230,7 +6305,12 @@ mark_buffer (struct buffer *buffer) /* For now, we just don't mark the undo_list. It's done later in a special way just before the sweep phase, and after stripping - some of its elements that are not needed any more. */ + some of its elements that are not needed any more. + Note: this later processing is only done for live buffers, so + for dead buffers, the undo_list should be nil (set by Fkill_buffer), + but just to be on the safe side, we mark it here. */ + if (!BUFFER_LIVE_P (buffer)) + mark_object (BVAR (buffer, undo_list)); mark_overlay (buffer->overlays_before); mark_overlay (buffer->overlays_after); @@ -6494,23 +6574,12 @@ mark_object (Lisp_Object arg) = PSEUDOVECTOR_TYPE (ptr); if (pvectype != PVEC_SUBR && - pvectype != PVEC_BUFFER && !main_thread_p (po)) CHECK_LIVE (live_vector_p); switch (pvectype) { case PVEC_BUFFER: -#if GC_CHECK_MARKED_OBJECTS - { - struct buffer *b; - FOR_EACH_BUFFER (b) - if (b == po) - break; - if (b == NULL) - emacs_abort (); - } -#endif /* GC_CHECK_MARKED_OBJECTS */ mark_buffer ((struct buffer *) ptr); break; @@ -6989,25 +7058,17 @@ NO_INLINE /* For better stack traces */ static void sweep_buffers (void) { - struct buffer *buffer, **bprev = &all_buffers; + Lisp_Object tail, buf; gcstat.total_buffers = 0; - for (buffer = all_buffers; buffer; buffer = *bprev) - if (!vectorlike_marked_p (&buffer->header)) - { - *bprev = buffer->next; - lisp_free (buffer); - } - else - { - if (!pdumper_object_p (buffer)) - XUNMARK_VECTOR (buffer); - /* Do not use buffer_(set|get)_intervals here. */ - buffer->text->intervals = balance_intervals (buffer->text->intervals); - unchain_dead_markers (buffer); - gcstat.total_buffers++; - bprev = &buffer->next; - } + FOR_EACH_LIVE_BUFFER (tail, buf) + { + struct buffer *buffer = XBUFFER (buf); + /* Do not use buffer_(set|get)_intervals here. */ + buffer->text->intervals = balance_intervals (buffer->text->intervals); + unchain_dead_markers (buffer); + gcstat.total_buffers++; + } } /* Sweep: find all structures not marked, and free them. */ diff --git a/src/bidi.c b/src/bidi.c index 3abde7fcb09..1017bd2d523 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -109,7 +109,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ ------------------- In a nutshell, fetching the next character boils down to calling - STRING_CHAR_AND_LENGTH, passing it the address of a buffer or + string_char_and_length, passing it the address of a buffer or string position. See bidi_fetch_char. However, if the next character is "covered" by a display property of some kind, bidi_fetch_char returns the u+FFFC "object replacement character" @@ -1269,7 +1269,6 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t *disp_pos, ptrdiff_t endpos = (string->s || STRINGP (string->lstring)) ? string->schars : ZV; struct text_pos pos; - int len; /* If we got past the last known position of display string, compute the position of the next one. That position could be at CHARPOS. */ @@ -1341,10 +1340,10 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t *disp_pos, normal_char: if (string->s) { - if (!string->unibyte) { - ch = STRING_CHAR_AND_LENGTH (string->s + bytepos, len); + int len; + ch = string_char_and_length (string->s + bytepos, &len); *ch_len = len; } else @@ -1357,8 +1356,9 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t *disp_pos, { if (!string->unibyte) { - ch = STRING_CHAR_AND_LENGTH (SDATA (string->lstring) + bytepos, - len); + int len; + ch = string_char_and_length (SDATA (string->lstring) + bytepos, + &len); *ch_len = len; } else @@ -1369,9 +1369,11 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t *disp_pos, } else { - ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (bytepos), len); + int len; + ch = string_char_and_length (BYTE_POS_ADDR (bytepos), &len); *ch_len = len; } + *nchars = 1; } @@ -1550,7 +1552,7 @@ bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte) display string? And what if a display string covering some of the text over which we scan back includes paragraph_start_re? */ - DEC_BOTH (pos, pos_byte); + dec_both (&pos, &pos_byte); if (bpc && region_cache_backward (cache_buffer, bpc, pos, &next)) { pos = next, pos_byte = CHAR_TO_BYTE (pos); @@ -1763,7 +1765,7 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, bool no_default_p) /* FXIME: What if p is covered by a display string? See also a FIXME inside bidi_find_paragraph_start. */ - DEC_BOTH (p, pbyte); + dec_both (&p, &pbyte); prevpbyte = bidi_find_paragraph_start (p, pbyte); } pstartbyte = prevpbyte; diff --git a/src/bignum.c b/src/bignum.c index 51d90ffaefa..669df4d9ee3 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -431,3 +431,39 @@ make_bignum_str (char const *num, int base) eassert (check == 0); return make_lisp_ptr (b, Lisp_Vectorlike); } + +/* Check that X is a Lisp integer in the range LO..HI. + Return X's value as an intmax_t. */ + +intmax_t +check_integer_range (Lisp_Object x, intmax_t lo, intmax_t hi) +{ + CHECK_INTEGER (x); + intmax_t i; + if (! (integer_to_intmax (x, &i) && lo <= i && i <= hi)) + args_out_of_range_3 (x, make_int (lo), make_int (hi)); + return i; +} + +/* Check that X is a Lisp integer in the range 0..HI. + Return X's value as an uintmax_t. */ + +uintmax_t +check_uinteger_max (Lisp_Object x, uintmax_t hi) +{ + CHECK_INTEGER (x); + uintmax_t i; + if (! (integer_to_uintmax (x, &i) && i <= hi)) + args_out_of_range_3 (x, make_fixnum (0), make_uint (hi)); + return i; +} + +/* Check that X is a Lisp integer no greater than INT_MAX, + and return its value or zero, whichever is greater. */ + +int +check_int_nonnegative (Lisp_Object x) +{ + CHECK_INTEGER (x); + return NILP (Fnatnump (x)) ? 0 : check_integer_range (x, 0, INT_MAX); +} diff --git a/src/bignum.h b/src/bignum.h index 0c2541a9dc7..4a906c3c0eb 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -55,7 +55,7 @@ extern void emacs_mpz_mul_2exp (mpz_t, mpz_t const, EMACS_INT) ARG_NONNULL ((1, 2)); extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long) ARG_NONNULL ((1, 2)); -extern double mpz_get_d_rounded (mpz_t const); +extern double mpz_get_d_rounded (mpz_t const) ATTRIBUTE_CONST; INLINE_HEADER_BEGIN @@ -108,7 +108,8 @@ bignum_integer (mpz_t *tmp, Lisp_Object i) if (FIXNUMP (i)) { mpz_set_intmax (*tmp, XFIXNUM (i)); - return tmp; + /* The unnecessary cast pacifies a buggy GCC 4.8.5. */ + return (mpz_t const *) tmp; } return xbignum_val (i); } diff --git a/src/buffer.c b/src/buffer.c index 92ed405b6f7..53b3bd960c4 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -51,11 +51,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "w32heap.h" /* for mmap_* */ #endif -/* First buffer in chain of all buffers (in reverse order of creation). - Threaded through ->header.next.buffer. */ - -struct buffer *all_buffers; - /* This structure holds the default values of the buffer-local variables defined with DEFVAR_PER_BUFFER, that have special slots in each buffer. The default value occupies the same slot in this structure @@ -131,6 +126,23 @@ CHECK_OVERLAY (Lisp_Object x) CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); } +/* Convert the position POS to an EMACS_INT that fits in a fixnum. + Yield POS's value if POS is already a fixnum, POS's marker position + if POS is a marker, and MOST_NEGATIVE_FIXNUM or + MOST_POSITIVE_FIXNUM if POS is a negative or positive bignum. + Signal an error if POS is not of the proper form. */ + +EMACS_INT +fix_position (Lisp_Object pos) +{ + if (FIXNUMP (pos)) + return XFIXNUM (pos); + if (MARKERP (pos)) + return marker_position (pos); + CHECK_TYPE (BIGNUMP (pos), Qinteger_or_marker_p, pos); + return !NILP (Fnatnump (pos)) ? MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM; +} + /* These setters are used only in this file, so they can be private. The public setters are inline functions defined in buffer.h. */ static void @@ -1769,15 +1781,11 @@ cleaning up all windows currently displaying the buffer to be killed. */) ask questions or their hooks get errors. */ if (!b->base_buffer && b->indirections > 0) { - struct buffer *other; + Lisp_Object tail, other; - FOR_EACH_BUFFER (other) - if (other->base_buffer == b) - { - Lisp_Object buf; - XSETBUFFER (buf, other); - Fkill_buffer (buf); - } + FOR_EACH_LIVE_BUFFER (tail, other) + if (XBUFFER (other)->base_buffer == b) + Fkill_buffer (other); /* Exit if we now have killed the base buffer (Bug#11665). */ if (!BUFFER_LIVE_P (b)) @@ -1832,6 +1840,9 @@ cleaning up all windows currently displaying the buffer to be killed. */) tem = Vinhibit_quit; Vinhibit_quit = Qt; + /* Once the buffer is removed from Vbuffer_alist, its undo_list field is + not traced by the GC in the same way. So set it to nil early. */ + bset_undo_list (b, Qnil); /* Remove the buffer from the list of all buffers. */ Vbuffer_alist = Fdelq (Frassq (buffer, Vbuffer_alist), Vbuffer_alist); /* If replace_buffer_in_windows didn't do its job fix that now. */ @@ -1946,7 +1957,6 @@ cleaning up all windows currently displaying the buffer to be killed. */) } bset_width_table (b, Qnil); unblock_input (); - bset_undo_list (b, Qnil); /* Run buffer-list-update-hook. */ if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks) @@ -2257,19 +2267,20 @@ so the buffer is truly empty after this. */) } void -validate_region (register Lisp_Object *b, register Lisp_Object *e) +validate_region (Lisp_Object *b, Lisp_Object *e) { - CHECK_FIXNUM_COERCE_MARKER (*b); - CHECK_FIXNUM_COERCE_MARKER (*e); + EMACS_INT beg = fix_position (*b), end = fix_position (*e); - if (XFIXNUM (*b) > XFIXNUM (*e)) + if (end < beg) { - Lisp_Object tem; - tem = *b; *b = *e; *e = tem; + EMACS_INT tem = beg; beg = end; end = tem; } - if (! (BEGV <= XFIXNUM (*b) && XFIXNUM (*e) <= ZV)) + if (! (BEGV <= beg && end <= ZV)) args_out_of_range_3 (Fcurrent_buffer (), *b, *e); + + *b = make_fixnum (beg); + *e = make_fixnum (end); } /* Advance BYTE_POS up to a character boundary @@ -2297,7 +2308,7 @@ advance_to_char_boundary (ptrdiff_t byte_pos) c = FETCH_BYTE (byte_pos); } while (! CHAR_HEAD_P (c) && byte_pos > BEG); - INC_POS (byte_pos); + byte_pos += next_char_len (byte_pos); if (byte_pos < orig_byte_pos) byte_pos = orig_byte_pos; /* If C is a constituent of a multibyte sequence, BYTE_POS was @@ -2333,10 +2344,10 @@ results, see Info node `(elisp)Swapping Text'. */) error ("Cannot swap indirect buffers's text"); { /* This is probably harder to make work. */ - struct buffer *other; - FOR_EACH_BUFFER (other) - if (other->base_buffer == other_buffer - || other->base_buffer == current_buffer) + Lisp_Object tail, other; + FOR_EACH_LIVE_BUFFER (tail, other) + if (XBUFFER (other)->base_buffer == other_buffer + || XBUFFER (other)->base_buffer == current_buffer) error ("One of the buffers to swap has indirect buffers"); } @@ -2484,7 +2495,7 @@ current buffer is cleared. */) (Lisp_Object flag) { struct Lisp_Marker *tail, *markers; - struct buffer *other; + Lisp_Object btail, other; ptrdiff_t begv, zv; bool narrowed = (BEG != BEGV || Z != ZV); bool modified_p = !NILP (Fbuffer_modified_p (Qnil)); @@ -2541,8 +2552,6 @@ current buffer is cleared. */) p = BEG_ADDR; while (1) { - int c, bytes; - if (pos == stop) { if (pos == Z) @@ -2554,7 +2563,7 @@ current buffer is cleared. */) p++, pos++; else if (CHAR_BYTE8_HEAD_P (*p)) { - c = STRING_CHAR_AND_LENGTH (p, bytes); + int bytes, c = string_char_and_length (p, &bytes); /* Delete all bytes for this 8-bit character but the last one, and change the last one to the character code. */ @@ -2571,7 +2580,7 @@ current buffer is cleared. */) } else { - bytes = BYTES_BY_CHAR_HEAD (*p); + int bytes = BYTES_BY_CHAR_HEAD (*p); p += bytes, pos += bytes; } } @@ -2625,8 +2634,7 @@ current buffer is cleared. */) if (ASCII_CHAR_P (*p)) p++, pos++; else if (EQ (flag, Qt) - && ! CHAR_BYTE8_HEAD_P (*p) - && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0) + && 0 < (bytes = multibyte_length (p, pend, true, false))) p += bytes, pos += bytes; else { @@ -2737,13 +2745,16 @@ current buffer is cleared. */) /* Copy this buffer's new multibyte status into all of its indirect buffers. */ - FOR_EACH_BUFFER (other) - if (other->base_buffer == current_buffer && BUFFER_LIVE_P (other)) - { - BVAR (other, enable_multibyte_characters) - = BVAR (current_buffer, enable_multibyte_characters); - other->prevent_redisplay_optimizations_p = 1; - } + FOR_EACH_LIVE_BUFFER (btail, other) + { + struct buffer *o = XBUFFER (other); + if (o->base_buffer == current_buffer && BUFFER_LIVE_P (o)) + { + BVAR (o, enable_multibyte_characters) + = BVAR (current_buffer, enable_multibyte_characters); + o->prevent_redisplay_optimizations_p = true; + } + } /* Restore the modifiedness of the buffer. */ if (!modified_p && !NILP (Fbuffer_modified_p (Qnil))) @@ -5309,8 +5320,6 @@ init_buffer_once (void) Vbuffer_alist = Qnil; current_buffer = 0; pdumper_remember_lv_ptr_raw (¤t_buffer, Lisp_Vectorlike); - all_buffers = 0; - pdumper_remember_lv_ptr_raw (&all_buffers, Lisp_Vectorlike); QSFundamental = build_pure_c_string ("Fundamental"); @@ -5341,7 +5350,7 @@ init_buffer (void) #ifdef USE_MMAP_FOR_BUFFERS if (dumped_with_unexec_p ()) { - struct buffer *b; + Lisp_Object tail, buffer; #ifndef WINDOWSNT /* These must be reset in the dumped Emacs, to avoid stale @@ -5363,23 +5372,13 @@ init_buffer (void) " *code-conversion-work*". They are created by init_buffer_once and init_window_once (which are not called in the dumped Emacs), and by the first call to coding.c routines. */ - FOR_EACH_BUFFER (b) + FOR_EACH_LIVE_BUFFER (tail, buffer) { + struct buffer *b = XBUFFER (buffer); b->text->beg = NULL; enlarge_buffer_text (b, 0); } } - else - { - struct buffer *b; - - /* Only buffers with allocated buffer text should be present at - this point in temacs. */ - FOR_EACH_BUFFER (b) - { - eassert (b->text->beg != NULL); - } - } #endif /* USE_MMAP_FOR_BUFFERS */ AUTO_STRING (scratch, "*scratch*"); @@ -6247,6 +6246,9 @@ Values are interpreted as follows: t use the cursor specified for the frame nil don't display a cursor box display a filled box cursor + (box . SIZE) display a filled box cursor, but make it + hollow if cursor is under masked image larger than + SIZE pixels in either dimension. hollow display a hollow box cursor bar display a vertical bar cursor with default width (bar . WIDTH) display a vertical bar cursor with width WIDTH diff --git a/src/buffer.h b/src/buffer.h index fd05fdd37de..3da49414bb8 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -570,9 +570,6 @@ struct buffer In an indirect buffer, this is the own_text field of another buffer. */ struct buffer_text *text; - /* Next buffer, in chain of all buffers, including killed ones. */ - struct buffer *next; - /* Char position of point in buffer. */ ptrdiff_t pt; @@ -1104,15 +1101,6 @@ BUFFER_CHECK_INDIRECTION (struct buffer *b) } } -/* Chain of all buffers, including killed ones. */ - -extern struct buffer *all_buffers; - -/* Used to iterate over the chain above. */ - -#define FOR_EACH_BUFFER(b) \ - for ((b) = all_buffers; (b); (b) = (b)->next) - /* This structure holds the default values of the buffer-local variables that have special slots in each buffer. The default value occupies the same slot in this structure @@ -1150,6 +1138,8 @@ extern Lisp_Object interval_insert_behind_hooks; extern Lisp_Object interval_insert_in_front_hooks; +extern EMACS_INT fix_position (Lisp_Object); +#define CHECK_FIXNUM_COERCE_MARKER(x) ((x) = make_fixnum (fix_position (x))) extern void delete_all_overlays (struct buffer *); extern void reset_buffer (struct buffer *); extern void compact_buffer (struct buffer *); @@ -1533,6 +1523,146 @@ lowercasep (int c) return !uppercasep (c) && upcase (c) != c; } +/* Return a non-outlandish value for the tab width. */ + +INLINE int +sanitize_tab_width (Lisp_Object width) +{ + return (FIXNUMP (width) && 0 < XFIXNUM (width) && XFIXNUM (width) <= 1000 + ? XFIXNUM (width) : 8); +} + +INLINE int +SANE_TAB_WIDTH (struct buffer *buf) +{ + return sanitize_tab_width (BVAR (buf, tab_width)); +} + +/* Return a non-outlandish value for a character width. */ + +INLINE int +sanitize_char_width (EMACS_INT width) +{ + return 0 <= width && width <= 1000 ? width : 1000; +} + +/* Return the width of character C. The width is measured by how many + columns C will occupy on the screen when displayed in the current + buffer. The name CHARACTER_WIDTH avoids a collision with <limits.h> + CHAR_WIDTH. */ + +INLINE int +CHARACTER_WIDTH (int c) +{ + return (0x20 <= c && c < 0x7f ? 1 + : 0x7f < c ? (sanitize_char_width + (XFIXNUM (CHAR_TABLE_REF (Vchar_width_table, c)))) + : c == '\t' ? SANE_TAB_WIDTH (current_buffer) + : c == '\n' ? 0 + : !NILP (BVAR (current_buffer, ctl_arrow)) ? 2 : 4); +} + + +/* Like fetch_string_char_advance, but fetch character from the current + buffer. */ + +INLINE int +fetch_char_advance (ptrdiff_t *charidx, ptrdiff_t *byteidx) +{ + int output; + ptrdiff_t c = *charidx, b = *byteidx; + c++; + unsigned char *chp = BYTE_POS_ADDR (b); + if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) + { + int chlen; + output = string_char_and_length (chp, &chlen); + b += chlen; + } + else + { + output = *chp; + b++; + } + *charidx = c; + *byteidx = b; + return output; +} + + +/* Like fetch_char_advance, but assumes the current buffer is multibyte. */ + +INLINE int +fetch_char_advance_no_check (ptrdiff_t *charidx, ptrdiff_t *byteidx) +{ + int output; + ptrdiff_t c = *charidx, b = *byteidx; + c++; + unsigned char *chp = BYTE_POS_ADDR (b); + int chlen; + output = string_char_and_length (chp, &chlen); + b += chlen; + *charidx = c; + *byteidx = b; + return output; +} + +/* Return the number of bytes in the multibyte character in BUF + that starts at position POS_BYTE. This relies on the fact that + *GPT_ADDR and *Z_ADDR are always accessible and the values are + '\0'. No range checking of POS_BYTE. */ + +INLINE int +buf_next_char_len (struct buffer *buf, ptrdiff_t pos_byte) +{ + unsigned char *chp = BUF_BYTE_ADDRESS (buf, pos_byte); + return BYTES_BY_CHAR_HEAD (*chp); +} + +INLINE int +next_char_len (ptrdiff_t pos_byte) +{ + return buf_next_char_len (current_buffer, pos_byte); +} + +/* Return the number of bytes in the multibyte character in BUF just + before POS_BYTE. No range checking of POS_BYTE. */ + +INLINE int +buf_prev_char_len (struct buffer *buf, ptrdiff_t pos_byte) +{ + unsigned char *chp + = (BUF_BEG_ADDR (buf) + pos_byte - BEG_BYTE + + (pos_byte <= BUF_GPT_BYTE (buf) ? 0 : BUF_GAP_SIZE (buf))); + return raw_prev_char_len (chp); +} + +INLINE int +prev_char_len (ptrdiff_t pos_byte) +{ + return buf_prev_char_len (current_buffer, pos_byte); +} + +/* Increment both *CHARPOS and *BYTEPOS, each in the appropriate way. */ + +INLINE void +inc_both (ptrdiff_t *charpos, ptrdiff_t *bytepos) +{ + (*charpos)++; + (*bytepos) += (!NILP (BVAR (current_buffer, enable_multibyte_characters)) + ? next_char_len (*bytepos) : 1); +} + +/* Decrement both *CHARPOS and *BYTEPOS, each in the appropriate way. */ + +INLINE void +dec_both (ptrdiff_t *charpos, ptrdiff_t *bytepos) +{ + (*charpos)--; + (*bytepos) -= (!NILP (BVAR (current_buffer, enable_multibyte_characters)) + ? prev_char_len (*bytepos) : 1); +} + INLINE_HEADER_END #endif /* EMACS_BUFFER_H */ diff --git a/src/bytecode.c b/src/bytecode.c index 9e75c9012e0..3c90544f3f2 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -220,10 +220,10 @@ DEFINE (Bdup, 0211) \ DEFINE (Bsave_excursion, 0212) \ DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \ DEFINE (Bsave_restriction, 0214) \ -DEFINE (Bcatch, 0215) \ +DEFINE (Bcatch, 0215) /* Obsolete since Emacs-25. */ \ \ DEFINE (Bunwind_protect, 0216) \ -DEFINE (Bcondition_case, 0217) \ +DEFINE (Bcondition_case, 0217) /* Obsolete since Emacs-25. */ \ DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \ DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \ \ @@ -763,7 +763,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, save_restriction_save ()); NEXT; - CASE (Bcatch): /* Obsolete since 24.4. */ + CASE (Bcatch): /* Obsolete since 25. */ { Lisp_Object v1 = POP; TOP = internal_catch (TOP, eval_sub, v1); @@ -807,7 +807,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; } - CASE (Bcondition_case): /* Obsolete since 24.4. */ + CASE (Bcondition_case): /* Obsolete since 25. */ { Lisp_Object handlers = POP, body = POP; TOP = internal_lisp_condition_case (TOP, body, handlers); @@ -1172,7 +1172,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CHECK_CHARACTER (TOP); int c = XFIXNAT (TOP); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) - MAKE_CHAR_MULTIBYTE (c); + c = make_char_multibyte (c); XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]); } NEXT; diff --git a/src/callproc.c b/src/callproc.c index 8883415f3f5..65c858393a9 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1099,7 +1099,17 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r } if (nargs > 3 && !NILP (args[3])) - Fdelete_region (start, end); + { + if (NILP (start)) + { + /* No need to save restrictions since we delete everything + anyway. */ + Fwiden (); + del_range (BEG, Z); + } + else + Fdelete_region (start, end); + } if (nargs > 3) { diff --git a/src/casefiddle.c b/src/casefiddle.c index 1945aa15e71..debd2412238 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -220,6 +220,13 @@ case_character (struct casing_str_buf *buf, struct casing_context *ctx, return changed; } +/* If C is not ASCII, make it unibyte. */ +static inline int +make_char_unibyte (int c) +{ + return ASCII_CHAR_P (c) ? c : CHAR_TO_BYTE8 (c); +} + static Lisp_Object do_casify_natnum (struct casing_context *ctx, Lisp_Object obj) { @@ -229,7 +236,7 @@ do_casify_natnum (struct casing_context *ctx, Lisp_Object obj) /* If the character has higher bits set above the flags, return it unchanged. It is not a real character. */ - if (UNSIGNED_CMP (ch, >, flagbits)) + if (! (0 <= ch && ch <= flagbits)) return obj; int flags = ch & flagbits; @@ -243,13 +250,13 @@ do_casify_natnum (struct casing_context *ctx, Lisp_Object obj) || !NILP (BVAR (current_buffer, enable_multibyte_characters))); if (! multibyte) - MAKE_CHAR_MULTIBYTE (ch); + ch = make_char_multibyte (ch); int cased = case_single_character (ctx, ch); if (cased == ch) return obj; if (! multibyte) - MAKE_CHAR_UNIBYTE (cased); + cased = make_char_unibyte (cased); return make_fixed_natnum (cased | flags); } @@ -278,7 +285,7 @@ do_casify_multibyte_string (struct casing_context *ctx, Lisp_Object obj) { if (dst_end - o < sizeof (struct casing_str_buf)) string_overflow (); - int ch = STRING_CHAR_ADVANCE (src); + int ch = string_char_advance (&src); case_character ((struct casing_str_buf *) o, ctx, ch, size > 1 ? src : NULL); n += ((struct casing_str_buf *) o)->len_chars; @@ -299,15 +306,14 @@ do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj) obj = Fcopy_sequence (obj); for (i = 0; i < size; i++) { - ch = SREF (obj, i); - MAKE_CHAR_MULTIBYTE (ch); + ch = make_char_multibyte (SREF (obj, i)); cased = case_single_character (ctx, ch); if (ch == cased) continue; - MAKE_CHAR_UNIBYTE (cased); + cased = make_char_unibyte (cased); /* If the char can't be converted to a valid byte, just don't change it. */ - if (cased >= 0 && cased < 256) + if (SINGLE_BYTE_CHAR_P (cased)) SSET (obj, i, cased); } return obj; @@ -397,9 +403,7 @@ do_casify_unibyte_region (struct casing_context *ctx, for (ptrdiff_t pos = *startp; pos < end; ++pos) { - int ch = FETCH_BYTE (pos); - MAKE_CHAR_MULTIBYTE (ch); - + int ch = make_char_multibyte (FETCH_BYTE (pos)); int cased = case_single_character (ctx, ch); if (cased == ch) continue; @@ -408,8 +412,7 @@ do_casify_unibyte_region (struct casing_context *ctx, if (first < 0) first = pos; - MAKE_CHAR_UNIBYTE (cased); - FETCH_BYTE (pos) = cased; + FETCH_BYTE (pos) = make_char_unibyte (cased); } *startp = first; @@ -433,8 +436,7 @@ do_casify_multibyte_region (struct casing_context *ctx, for (; size; --size) { - int len; - int ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (pos_byte), len); + int len, ch = string_char_and_length (BYTE_POS_ADDR (pos_byte), &len); struct casing_str_buf buf; if (!case_character (&buf, ctx, ch, size > 1 ? BYTE_POS_ADDR (pos_byte + len) : NULL)) diff --git a/src/ccl.c b/src/ccl.c index ac44dc1f608..ef059ffff25 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -855,6 +855,13 @@ struct ccl_prog_stack /* For the moment, we only support depth 256 of stack. */ static struct ccl_prog_stack ccl_prog_stack_struct[256]; +/* Return a translation table of id number ID. */ +static inline Lisp_Object +GET_TRANSLATION_TABLE (int id) +{ + return XCDR (XVECTOR (Vtranslation_table_vector)->contents[id]); +} + void ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size, int dst_size, Lisp_Object charset_list) { @@ -2101,7 +2108,7 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY source[j++] = *p++; else while (j < CCL_EXECUTE_BUF_SIZE && p < endp) - source[j++] = STRING_CHAR_ADVANCE (p); + source[j++] = string_char_advance (&p); consumed_chars += j; consumed_bytes = p - SDATA (str); @@ -2126,7 +2133,7 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY if (NILP (unibyte_p)) { for (j = 0; j < ccl.produced; j++) - CHAR_STRING_ADVANCE (destination[j], outp); + outp += CHAR_STRING (destination[j], outp); } else { diff --git a/src/character.c b/src/character.c index 5d419a2e836..4902e564b1d 100644 --- a/src/character.c +++ b/src/character.c @@ -141,58 +141,6 @@ char_string (unsigned int c, unsigned char *p) } -/* Return a character whose multibyte form is at P. If LEN is not - NULL, it must be a pointer to integer. In that case, set *LEN to - the byte length of the multibyte form. If ADVANCED is not NULL, it - must be a pointer to unsigned char. In that case, set *ADVANCED to - the ending address (i.e., the starting address of the next - character) of the multibyte form. */ - -int -string_char (const unsigned char *p, const unsigned char **advanced, int *len) -{ - int c; - const unsigned char *saved_p = p; - - if (*p < 0x80 || ! (*p & 0x20) || ! (*p & 0x10)) - { - /* 1-, 2-, and 3-byte sequences can be handled by the macro. */ - c = STRING_CHAR_ADVANCE (p); - } - else if (! (*p & 0x08)) - { - /* A 4-byte sequence of this form: - 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx */ - c = ((((p)[0] & 0x7) << 18) - | (((p)[1] & 0x3F) << 12) - | (((p)[2] & 0x3F) << 6) - | ((p)[3] & 0x3F)); - p += 4; - } - else - { - /* A 5-byte sequence of this form: - - 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - - Note that the top 4 `x's are always 0, so shifting p[1] can - never exceed the maximum valid character codepoint. */ - c = (/* (((p)[0] & 0x3) << 24) ... always 0, so no need to shift. */ - (((p)[1] & 0x3F) << 18) - | (((p)[2] & 0x3F) << 12) - | (((p)[3] & 0x3F) << 6) - | ((p)[4] & 0x3F)); - p += 5; - } - - if (len) - *len = p - saved_p; - if (advanced) - *advanced = p; - return c; -} - - /* Translate character C by translation table TABLE. If no translation is found in TABLE, return the untranslated character. If TABLE is a list, elements are char tables. In that case, recursively translate C by all the @@ -248,8 +196,7 @@ DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte, c = XFIXNAT (ch); if (c >= 0x100) error ("Not a unibyte character: %d", c); - MAKE_CHAR_MULTIBYTE (c); - return make_fixnum (c); + return make_fixnum (make_char_multibyte (c)); } DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte, @@ -340,8 +287,7 @@ c_string_width (const unsigned char *str, ptrdiff_t len, int precision, while (i_byte < len) { - int bytes; - int c = STRING_CHAR_AND_LENGTH (str + i_byte, bytes); + int bytes, c = string_char_and_length (str + i_byte, &bytes); ptrdiff_t thiswidth = char_width (c, dp); if (0 < precision && precision - width < thiswidth) @@ -418,7 +364,7 @@ lisp_string_width (Lisp_Object string, ptrdiff_t precision, if (multibyte) { int cbytes; - c = STRING_CHAR_AND_LENGTH (str + i_byte, cbytes); + c = string_char_and_length (str + i_byte, &cbytes); bytes = cbytes; } else @@ -495,7 +441,7 @@ multibyte_chars_in_text (const unsigned char *ptr, ptrdiff_t nbytes) while (ptr < endp) { - int len = MULTIBYTE_LENGTH (ptr, endp); + int len = multibyte_length (ptr, endp, true, true); if (len == 0) emacs_abort (); @@ -517,16 +463,15 @@ parse_str_as_multibyte (const unsigned char *str, ptrdiff_t len, ptrdiff_t *nchars, ptrdiff_t *nbytes) { const unsigned char *endp = str + len; - int n; ptrdiff_t chars = 0, bytes = 0; if (len >= MAX_MULTIBYTE_LENGTH) { - const unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH; + const unsigned char *adjusted_endp = endp - (MAX_MULTIBYTE_LENGTH - 1); while (str < adjusted_endp) { - if (! CHAR_BYTE8_HEAD_P (*str) - && (n = MULTIBYTE_LENGTH_NO_CHECK (str)) > 0) + int n = multibyte_length (str, NULL, false, false); + if (0 < n) str += n, bytes += n; else str++, bytes += 2; @@ -535,8 +480,8 @@ parse_str_as_multibyte (const unsigned char *str, ptrdiff_t len, } while (str < endp) { - if (! CHAR_BYTE8_HEAD_P (*str) - && (n = MULTIBYTE_LENGTH (str, endp)) > 0) + int n = multibyte_length (str, endp, true, false); + if (0 < n) str += n, bytes += n; else str++, bytes += 2; @@ -563,20 +508,25 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes, unsigned char *p = str, *endp = str + nbytes; unsigned char *to; ptrdiff_t chars = 0; - int n; if (nbytes >= MAX_MULTIBYTE_LENGTH) { - unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH; - while (p < adjusted_endp - && ! CHAR_BYTE8_HEAD_P (*p) - && (n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0) - p += n, chars++; + unsigned char *adjusted_endp = endp - (MAX_MULTIBYTE_LENGTH - 1); + while (p < adjusted_endp) + { + int n = multibyte_length (p, NULL, false, false); + if (n <= 0) + break; + p += n, chars++; + } + } + while (true) + { + int n = multibyte_length (p, endp, true, false); + if (n <= 0) + break; + p += n, chars++; } - while (p < endp - && ! CHAR_BYTE8_HEAD_P (*p) - && (n = MULTIBYTE_LENGTH (p, endp)) > 0) - p += n, chars++; if (nchars) *nchars = chars; if (p == endp) @@ -590,11 +540,11 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes, if (nbytes >= MAX_MULTIBYTE_LENGTH) { - unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH; + unsigned char *adjusted_endp = endp - (MAX_MULTIBYTE_LENGTH - 1); while (p < adjusted_endp) { - if (! CHAR_BYTE8_HEAD_P (*p) - && (n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0) + int n = multibyte_length (p, NULL, false, false); + if (0 < n) { while (n--) *to++ = *p++; @@ -610,8 +560,8 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes, } while (p < endp) { - if (! CHAR_BYTE8_HEAD_P (*p) - && (n = MULTIBYTE_LENGTH (p, endp)) > 0) + int n = multibyte_length (p, endp, true, false); + if (0 < n) { while (n--) *to++ = *p++; @@ -706,7 +656,7 @@ str_as_unibyte (unsigned char *str, ptrdiff_t bytes) len = BYTES_BY_CHAR_HEAD (c); if (CHAR_BYTE8_HEAD_P (c)) { - c = STRING_CHAR_ADVANCE (p); + c = string_char_advance (&p); *to++ = CHAR_TO_BYTE8 (c); } else @@ -730,7 +680,7 @@ str_to_unibyte (const unsigned char *src, unsigned char *dst, ptrdiff_t chars) for (i = 0; i < chars; i++) { - int c = STRING_CHAR_ADVANCE (src); + int c = string_char_advance (&src); if (CHAR_BYTE8_P (c)) c = CHAR_TO_BYTE8 (c); @@ -823,7 +773,7 @@ string_escape_byte8 (Lisp_Object string) if (CHAR_BYTE8_HEAD_P (c)) { - c = STRING_CHAR_ADVANCE (src); + c = string_char_advance (&src); c = CHAR_TO_BYTE8 (c); dst += sprintf ((char *) dst, "\\%03o", c + 0u); } @@ -849,24 +799,22 @@ Concatenate all the argument characters and make the result a string. usage: (string &rest CHARACTERS) */) (ptrdiff_t n, Lisp_Object *args) { - ptrdiff_t i; - int c; - unsigned char *buf, *p; - Lisp_Object str; - USE_SAFE_ALLOCA; - - SAFE_NALLOCA (buf, MAX_MULTIBYTE_LENGTH, n); - p = buf; - - for (i = 0; i < n; i++) + ptrdiff_t nbytes = 0; + for (ptrdiff_t i = 0; i < n; i++) { CHECK_CHARACTER (args[i]); - c = XFIXNUM (args[i]); + nbytes += CHAR_BYTES (XFIXNUM (args[i])); + } + if (nbytes == n) + return Funibyte_string (n, args); + Lisp_Object str = make_uninit_multibyte_string (n, nbytes); + unsigned char *p = SDATA (str); + for (ptrdiff_t i = 0; i < n; i++) + { + eassume (CHARACTERP (args[i])); + int c = XFIXNUM (args[i]); p += CHAR_STRING (c, p); } - - str = make_string_from_bytes ((char *) buf, n, p - buf); - SAFE_FREE (); return str; } @@ -875,20 +823,10 @@ DEFUN ("unibyte-string", Funibyte_string, Sunibyte_string, 0, MANY, 0, usage: (unibyte-string &rest BYTES) */) (ptrdiff_t n, Lisp_Object *args) { - ptrdiff_t i; - Lisp_Object str; - USE_SAFE_ALLOCA; - unsigned char *buf = SAFE_ALLOCA (n); - unsigned char *p = buf; - - for (i = 0; i < n; i++) - { - CHECK_RANGED_INTEGER (args[i], 0, 255); - *p++ = XFIXNUM (args[i]); - } - - str = make_string_from_bytes ((char *) buf, n, p - buf); - SAFE_FREE (); + Lisp_Object str = make_uninit_string (n); + unsigned char *p = SDATA (str); + for (ptrdiff_t i = 0; i < n; i++) + *p++ = check_integer_range (args[i], 0, 255); return str; } @@ -931,10 +869,10 @@ character is not ASCII nor 8-bit character, an error is signaled. */) } else { - CHECK_FIXNUM_COERCE_MARKER (position); - if (XFIXNUM (position) < BEGV || XFIXNUM (position) >= ZV) + EMACS_INT fixed_pos = fix_position (position); + if (! (BEGV <= fixed_pos && fixed_pos < ZV)) args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); - pos = XFIXNAT (position); + pos = fixed_pos; p = CHAR_POS_ADDR (pos); } if (NILP (BVAR (current_buffer, enable_multibyte_characters))) diff --git a/src/character.h b/src/character.h index 3642a540448..af5023f77cc 100644 --- a/src/character.h +++ b/src/character.h @@ -31,35 +31,39 @@ INLINE_HEADER_BEGIN /* character code 1st byte byte sequence -------------- -------- ------------- 0-7F 00..7F 0xxxxxxx - 80-7FF C2..DF 110xxxxx 10xxxxxx - 800-FFFF E0..EF 1110xxxx 10xxxxxx 10xxxxxx - 10000-1FFFFF F0..F7 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - 200000-3FFF7F F8 11111000 1000xxxx 10xxxxxx 10xxxxxx 10xxxxxx + 80-7FF C2..DF 110yyyyx 10xxxxxx + 800-FFFF E0..EF 1110yyyy 10yxxxxx 10xxxxxx + 10000-1FFFFF F0..F7 11110yyy 10yyxxxx 10xxxxxx 10xxxxxx + 200000-3FFF7F F8 11111000 1000yxxx 10xxxxxx 10xxxxxx 10xxxxxx 3FFF80-3FFFFF C0..C1 1100000x 10xxxxxx (for eight-bit-char) 400000-... invalid invalid 1st byte 80..BF 10xxxxxx - F9..FF 11111xxx (xxx != 000) + F9..FF 11111yyy + + In each bit pattern, 'x' and 'y' each represent a single bit of the + character code payload, and least one 'y' must be a 1 bit. + In the 5-byte sequence, the 22-bit payload cannot exceed 3FFF7F. */ /* Maximum character code ((1 << CHARACTERBITS) - 1). */ -#define MAX_CHAR 0x3FFFFF +enum { MAX_CHAR = 0x3FFFFF }; /* Maximum Unicode character code. */ -#define MAX_UNICODE_CHAR 0x10FFFF +enum { MAX_UNICODE_CHAR = 0x10FFFF }; /* Maximum N-byte character codes. */ -#define MAX_1_BYTE_CHAR 0x7F -#define MAX_2_BYTE_CHAR 0x7FF -#define MAX_3_BYTE_CHAR 0xFFFF -#define MAX_4_BYTE_CHAR 0x1FFFFF -#define MAX_5_BYTE_CHAR 0x3FFF7F +enum { MAX_1_BYTE_CHAR = 0x7F }; +enum { MAX_2_BYTE_CHAR = 0x7FF }; +enum { MAX_3_BYTE_CHAR = 0xFFFF }; +enum { MAX_4_BYTE_CHAR = 0x1FFFFF }; +enum { MAX_5_BYTE_CHAR = 0x3FFF7F }; /* Minimum leading code of multibyte characters. */ -#define MIN_MULTIBYTE_LEADING_CODE 0xC0 +enum { MIN_MULTIBYTE_LEADING_CODE = 0xC0 }; /* Maximum leading code of multibyte characters. Note: this must be updated if we ever increase MAX_CHAR above. */ -#define MAX_MULTIBYTE_LEADING_CODE 0xF8 +enum { MAX_MULTIBYTE_LEADING_CODE = 0xF8 }; /* Unicode character values. */ enum @@ -80,533 +84,432 @@ enum OBJECT_REPLACEMENT_CHARACTER = 0xFFFC, }; +extern int char_string (unsigned, unsigned char *); + /* UTF-8 encodings. Use \x escapes, so they are portable to pre-C11 compilers and can be concatenated with ordinary string literals. */ #define uLSQM "\xE2\x80\x98" /* U+2018 LEFT SINGLE QUOTATION MARK */ #define uRSQM "\xE2\x80\x99" /* U+2019 RIGHT SINGLE QUOTATION MARK */ -/* Nonzero iff C is a character that corresponds to a raw 8-bit +/* True iff C is a character of code less than 0x100. */ +INLINE bool +SINGLE_BYTE_CHAR_P (intmax_t c) +{ + return 0 <= c && c < 0x100; +} + +/* True iff C is a character that corresponds to a raw 8-bit byte. */ -#define CHAR_BYTE8_P(c) ((c) > MAX_5_BYTE_CHAR) +INLINE bool +CHAR_BYTE8_P (int c) +{ + return MAX_5_BYTE_CHAR < c; +} /* Return the character code for raw 8-bit byte BYTE. */ -#define BYTE8_TO_CHAR(byte) ((byte) + 0x3FFF00) +INLINE int +BYTE8_TO_CHAR (int byte) +{ + return byte + 0x3FFF00; +} -#define UNIBYTE_TO_CHAR(byte) \ - (ASCII_CHAR_P (byte) ? (byte) : BYTE8_TO_CHAR (byte)) +INLINE int +UNIBYTE_TO_CHAR (int byte) +{ + return ASCII_CHAR_P (byte) ? byte : BYTE8_TO_CHAR (byte); +} /* Return the raw 8-bit byte for character C. */ -#define CHAR_TO_BYTE8(c) (CHAR_BYTE8_P (c) ? (c) - 0x3FFF00 : (c & 0xFF)) +INLINE int +CHAR_TO_BYTE8 (int c) +{ + return CHAR_BYTE8_P (c) ? c - 0x3FFF00 : c & 0xFF; +} /* Return the raw 8-bit byte for character C, or -1 if C doesn't correspond to a byte. */ -#define CHAR_TO_BYTE_SAFE(c) \ - (ASCII_CHAR_P (c) ? c : (CHAR_BYTE8_P (c) ? (c) - 0x3FFF00 : -1)) +INLINE int +CHAR_TO_BYTE_SAFE (int c) +{ + return ASCII_CHAR_P (c) ? c : CHAR_BYTE8_P (c) ? c - 0x3FFF00 : -1; +} -/* Nonzero iff BYTE is the 1st byte of a multibyte form of a character +/* True iff BYTE is the 1st byte of a multibyte form of a character that corresponds to a raw 8-bit byte. */ -#define CHAR_BYTE8_HEAD_P(byte) ((byte) == 0xC0 || (byte) == 0xC1) - -/* If C is not ASCII, make it unibyte. */ -#define MAKE_CHAR_UNIBYTE(c) \ - do { \ - if (! ASCII_CHAR_P (c)) \ - c = CHAR_TO_BYTE8 (c); \ - } while (false) - +INLINE bool +CHAR_BYTE8_HEAD_P (int byte) +{ + return byte == 0xC0 || byte == 0xC1; +} /* If C is not ASCII, make it multibyte. Assumes C < 256. */ -#define MAKE_CHAR_MULTIBYTE(c) \ - (eassert ((c) >= 0 && (c) < 256), (c) = UNIBYTE_TO_CHAR (c)) +INLINE int +make_char_multibyte (int c) +{ + eassert (SINGLE_BYTE_CHAR_P (c)); + return UNIBYTE_TO_CHAR (c); +} /* This is the maximum byte length of multibyte form. */ -#define MAX_MULTIBYTE_LENGTH 5 - -/* Nonzero iff X is a character. */ -#define CHARACTERP(x) (FIXNATP (x) && XFIXNAT (x) <= MAX_CHAR) +enum { MAX_MULTIBYTE_LENGTH = 5 }; /* Nonzero iff C is valid as a character code. */ -#define CHAR_VALID_P(c) UNSIGNED_CMP (c, <=, MAX_CHAR) +INLINE bool +CHAR_VALID_P (intmax_t c) +{ + return 0 <= c && c <= MAX_CHAR; +} -/* Check if Lisp object X is a character or not. */ -#define CHECK_CHARACTER(x) \ - CHECK_TYPE (CHARACTERP (x), Qcharacterp, x) +/* Nonzero iff X is a character. */ +INLINE bool +CHARACTERP (Lisp_Object x) +{ + return FIXNUMP (x) && CHAR_VALID_P (XFIXNUM (x)); +} -#define CHECK_CHARACTER_CAR(x) \ - do { \ - Lisp_Object tmp = XCAR (x); \ - CHECK_CHARACTER (tmp); \ - } while (false) +/* Check if Lisp object X is a character or not. */ +INLINE void +CHECK_CHARACTER (Lisp_Object x) +{ + CHECK_TYPE (CHARACTERP (x), Qcharacterp, x); +} -#define CHECK_CHARACTER_CDR(x) \ - do { \ - Lisp_Object tmp = XCDR (x); \ - CHECK_CHARACTER (tmp); \ - } while (false) +INLINE void +CHECK_CHARACTER_CAR (Lisp_Object x) +{ + CHECK_CHARACTER (XCAR (x)); +} -/* Nonzero iff C is a character of code less than 0x100. */ -#define SINGLE_BYTE_CHAR_P(c) UNSIGNED_CMP (c, <, 0x100) +INLINE void +CHECK_CHARACTER_CDR (Lisp_Object x) +{ + CHECK_CHARACTER (XCDR (x)); +} -/* Nonzero if character C has a printable glyph. */ -#define CHAR_PRINTABLE_P(c) \ - (((c) >= 32 && (c) < 127) \ - || ! NILP (CHAR_TABLE_REF (Vprintable_chars, (c)))) +/* True if character C has a printable glyph. */ +INLINE bool +CHAR_PRINTABLE_P (int c) +{ + return ((32 <= c && c < 127) + || ! NILP (CHAR_TABLE_REF (Vprintable_chars, c))); +} /* Return byte length of multibyte form for character C. */ -#define CHAR_BYTES(c) \ - ( (c) <= MAX_1_BYTE_CHAR ? 1 \ - : (c) <= MAX_2_BYTE_CHAR ? 2 \ - : (c) <= MAX_3_BYTE_CHAR ? 3 \ - : (c) <= MAX_4_BYTE_CHAR ? 4 \ - : (c) <= MAX_5_BYTE_CHAR ? 5 \ - : 2) - +INLINE int +CHAR_BYTES (int c) +{ + return ((MAX_5_BYTE_CHAR < c ? -2 : 1) + + (MAX_1_BYTE_CHAR < c) + + (MAX_2_BYTE_CHAR < c) + + (MAX_3_BYTE_CHAR < c) + + (MAX_4_BYTE_CHAR < c)); +} /* Return the leading code of multibyte form of C. */ -#define CHAR_LEADING_CODE(c) \ - ((c) <= MAX_1_BYTE_CHAR ? c \ - : (c) <= MAX_2_BYTE_CHAR ? (0xC0 | ((c) >> 6)) \ - : (c) <= MAX_3_BYTE_CHAR ? (0xE0 | ((c) >> 12)) \ - : (c) <= MAX_4_BYTE_CHAR ? (0xF0 | ((c) >> 18)) \ - : (c) <= MAX_5_BYTE_CHAR ? 0xF8 \ - : (0xC0 | (((c) >> 6) & 0x01))) +INLINE int +CHAR_LEADING_CODE (int c) +{ + return (c <= MAX_1_BYTE_CHAR ? c + : c <= MAX_2_BYTE_CHAR ? 0xC0 | (c >> 6) + : c <= MAX_3_BYTE_CHAR ? 0xE0 | (c >> 12) + : c <= MAX_4_BYTE_CHAR ? 0xF0 | (c >> 18) + : c <= MAX_5_BYTE_CHAR ? 0xF8 + : 0xC0 | ((c >> 6) & 0x01)); +} /* Store multibyte form of the character C in P. The caller should allocate at least MAX_MULTIBYTE_LENGTH bytes area at P in advance. Returns the length of the multibyte form. */ -#define CHAR_STRING(c, p) \ - (UNSIGNED_CMP (c, <=, MAX_1_BYTE_CHAR) \ - ? ((p)[0] = (c), \ - 1) \ - : UNSIGNED_CMP (c, <=, MAX_2_BYTE_CHAR) \ - ? ((p)[0] = (0xC0 | ((c) >> 6)), \ - (p)[1] = (0x80 | ((c) & 0x3F)), \ - 2) \ - : UNSIGNED_CMP (c, <=, MAX_3_BYTE_CHAR) \ - ? ((p)[0] = (0xE0 | ((c) >> 12)), \ - (p)[1] = (0x80 | (((c) >> 6) & 0x3F)), \ - (p)[2] = (0x80 | ((c) & 0x3F)), \ - 3) \ - : verify_expr (sizeof (c) <= sizeof (unsigned), char_string (c, p))) +INLINE int +CHAR_STRING (int c, unsigned char *p) +{ + eassume (0 <= c); + if (c <= MAX_1_BYTE_CHAR) + { + p[0] = c; + return 1; + } + if (c <= MAX_2_BYTE_CHAR) + { + p[0] = 0xC0 | (c >> 6); + p[1] = 0x80 | (c & 0x3F); + return 2; + } + if (c <= MAX_3_BYTE_CHAR) + { + p[0] = 0xE0 | (c >> 12); + p[1] = 0x80 | ((c >> 6) & 0x3F); + p[2] = 0x80 | (c & 0x3F); + return 3; + } + int len = char_string (c, p); + eassume (0 < len && len <= MAX_MULTIBYTE_LENGTH); + return len; +} /* Store multibyte form of byte B in P. The caller should allocate at least MAX_MULTIBYTE_LENGTH bytes area at P in advance. Returns the length of the multibyte form. */ -#define BYTE8_STRING(b, p) \ - ((p)[0] = (0xC0 | (((b) >> 6) & 0x01)), \ - (p)[1] = (0x80 | ((b) & 0x3F)), \ - 2) - - -/* Store multibyte form of the character C in P and advance P to the - end of the multibyte form. The caller should allocate at least - MAX_MULTIBYTE_LENGTH bytes area at P in advance. */ - -#define CHAR_STRING_ADVANCE(c, p) \ - do { \ - if ((c) <= MAX_1_BYTE_CHAR) \ - *(p)++ = (c); \ - else if ((c) <= MAX_2_BYTE_CHAR) \ - *(p)++ = (0xC0 | ((c) >> 6)), \ - *(p)++ = (0x80 | ((c) & 0x3F)); \ - else if ((c) <= MAX_3_BYTE_CHAR) \ - *(p)++ = (0xE0 | ((c) >> 12)), \ - *(p)++ = (0x80 | (((c) >> 6) & 0x3F)), \ - *(p)++ = (0x80 | ((c) & 0x3F)); \ - else \ - { \ - verify (sizeof (c) <= sizeof (unsigned)); \ - (p) += char_string (c, p); \ - } \ - } while (false) - - -/* Nonzero iff BYTE starts a non-ASCII character in a multibyte - form. */ -#define LEADING_CODE_P(byte) (((byte) & 0xC0) == 0xC0) - -/* Nonzero iff BYTE is a trailing code of a non-ASCII character in a +INLINE int +BYTE8_STRING (int b, unsigned char *p) +{ + p[0] = 0xC0 | ((b >> 6) & 0x01); + p[1] = 0x80 | (b & 0x3F); + return 2; +} + + +/* True iff BYTE starts a non-ASCII character in a multibyte form. */ +INLINE bool +LEADING_CODE_P (int byte) +{ + return (byte & 0xC0) == 0xC0; +} + +/* True iff BYTE is a trailing code of a non-ASCII character in a multibyte form. */ -#define TRAILING_CODE_P(byte) (((byte) & 0xC0) == 0x80) +INLINE bool +TRAILING_CODE_P (int byte) +{ + return (byte & 0xC0) == 0x80; +} -/* Nonzero iff BYTE starts a character in a multibyte form. +/* True iff BYTE starts a character in a multibyte form. This is equivalent to: (ASCII_CHAR_P (byte) || LEADING_CODE_P (byte)) */ -#define CHAR_HEAD_P(byte) (((byte) & 0xC0) != 0x80) +INLINE bool +CHAR_HEAD_P (int byte) +{ + return (byte & 0xC0) != 0x80; +} /* How many bytes a character that starts with BYTE occupies in a - multibyte form. Unlike MULTIBYTE_LENGTH below, this macro does not + multibyte form. Unlike multibyte_length, this function does not validate the multibyte form, but looks only at its first byte. */ -#define BYTES_BY_CHAR_HEAD(byte) \ - (!((byte) & 0x80) ? 1 \ - : !((byte) & 0x20) ? 2 \ - : !((byte) & 0x10) ? 3 \ - : !((byte) & 0x08) ? 4 \ - : 5) +INLINE int +BYTES_BY_CHAR_HEAD (int byte) +{ + return (!(byte & 0x80) ? 1 + : !(byte & 0x20) ? 2 + : !(byte & 0x10) ? 3 + : !(byte & 0x08) ? 4 + : 5); +} -/* The byte length of multibyte form at unibyte string P ending at - PEND. If the string doesn't point to a valid multibyte form, - return 0. Unlike BYTES_BY_CHAR_HEAD, this macro validates the - multibyte form. */ +/* The byte length of the multibyte form at the unibyte string P, + ending at PEND if CHECK, and without a length check if !CHECK. + If ALLOW_8BIT, allow multibyte forms of eight-bit characters. + If the string doesn't point to a valid multibyte form, return 0. + Unlike BYTES_BY_CHAR_HEAD, this function validates the multibyte form. */ + +INLINE int +multibyte_length (unsigned char const *p, unsigned char const *pend, + bool check, bool allow_8bit) +{ + if (!check || p < pend) + { + unsigned char c = p[0]; + if (c < 0x80) + return 1; + if (!check || p + 1 < pend) + { + unsigned char d = p[1]; + int w = ((d & 0xC0) << 2) + c; + if ((allow_8bit ? 0x2C0 : 0x2C2) <= w && w <= 0x2DF) + return 2; + if (!check || p + 2 < pend) + { + unsigned char e = p[2]; + w += (e & 0xC0) << 4; + int w1 = w | ((d & 0x20) >> 2); + if (0xAE1 <= w1 && w1 <= 0xAEF) + return 3; + if (!check || p + 3 < pend) + { + unsigned char f = p[3]; + w += (f & 0xC0) << 6; + int w2 = w | ((d & 0x30) >> 3); + if (0x2AF1 <= w2 && w2 <= 0x2AF7) + return 4; + if (!check || p + 4 < pend) + { + int_fast64_t lw = w + ((p[4] & 0xC0) << 8), + w3 = (lw << 24) + (d << 16) + (e << 8) + f; + if (0xAAF8888080 <= w3 && w3 <= 0xAAF88FBFBD) + return 5; + } + } + } + } + } + + return 0; +} + -#define MULTIBYTE_LENGTH(p, pend) \ - (p >= pend ? 0 \ - : !((p)[0] & 0x80) ? 1 \ - : ((p + 1 >= pend) || (((p)[1] & 0xC0) != 0x80)) ? 0 \ - : ((p)[0] & 0xE0) == 0xC0 ? 2 \ - : ((p + 2 >= pend) || (((p)[2] & 0xC0) != 0x80)) ? 0 \ - : ((p)[0] & 0xF0) == 0xE0 ? 3 \ - : ((p + 3 >= pend) || (((p)[3] & 0xC0) != 0x80)) ? 0 \ - : ((p)[0] & 0xF8) == 0xF0 ? 4 \ - : ((p + 4 >= pend) || (((p)[4] & 0xC0) != 0x80)) ? 0 \ - : (p)[0] == 0xF8 && ((p)[1] & 0xF0) == 0x80 ? 5 \ - : 0) - - -/* Like MULTIBYTE_LENGTH, but don't check the ending address. The - multibyte form is still validated, unlike BYTES_BY_CHAR_HEAD. */ - -#define MULTIBYTE_LENGTH_NO_CHECK(p) \ - (!((p)[0] & 0x80) ? 1 \ - : ((p)[1] & 0xC0) != 0x80 ? 0 \ - : ((p)[0] & 0xE0) == 0xC0 ? 2 \ - : ((p)[2] & 0xC0) != 0x80 ? 0 \ - : ((p)[0] & 0xF0) == 0xE0 ? 3 \ - : ((p)[3] & 0xC0) != 0x80 ? 0 \ - : ((p)[0] & 0xF8) == 0xF0 ? 4 \ - : ((p)[4] & 0xC0) != 0x80 ? 0 \ - : (p)[0] == 0xF8 && ((p)[1] & 0xF0) == 0x80 ? 5 \ - : 0) - -/* If P is before LIMIT, advance P to the next character boundary. +/* Return number of bytes in the multibyte character just before P. Assumes that P is already at a character boundary of the same - multibyte form whose end address is LIMIT. */ + multibyte form, and is not at the start of that form. */ -#define NEXT_CHAR_BOUNDARY(p, limit) \ - do { \ - if ((p) < (limit)) \ - (p) += BYTES_BY_CHAR_HEAD (*(p)); \ - } while (false) +INLINE int +raw_prev_char_len (unsigned char const *p) +{ + for (int len = 1; ; len++) + if (CHAR_HEAD_P (p[-len])) + return len; +} -/* If P is after LIMIT, advance P to the previous character boundary. - Assumes that P is already at a character boundary of the same - multibyte form whose beginning address is LIMIT. */ - -#define PREV_CHAR_BOUNDARY(p, limit) \ - do { \ - if ((p) > (limit)) \ - { \ - const unsigned char *chp = (p); \ - do { \ - chp--; \ - } while (chp >= limit && ! CHAR_HEAD_P (*chp)); \ - (p) = (BYTES_BY_CHAR_HEAD (*chp) == (p) - chp) ? chp : (p) - 1; \ - } \ - } while (false) +/* Return the character code of character whose multibyte form is at P, + and set *LENGTH to its length. */ + +INLINE int +string_char_and_length (unsigned char const *p, int *length) +{ + int c = p[0]; + if (! (c & 0x80)) + { + *length = 1; + return c; + } + eassume (0xC0 <= c); + + int d = (c << 6) + p[1] - ((0xC0 << 6) + 0x80); + if (! (c & 0x20)) + { + *length = 2; + return d + (c < 0xC2 ? 0x3FFF80 : 0); + } + + d = (d << 6) + p[2] - ((0x20 << 12) + 0x80); + if (! (c & 0x10)) + { + *length = 3; + eassume (MAX_2_BYTE_CHAR < d && d <= MAX_3_BYTE_CHAR); + return d; + } + + d = (d << 6) + p[3] - ((0x10 << 18) + 0x80); + if (! (c & 0x08)) + { + *length = 4; + eassume (MAX_3_BYTE_CHAR < d && d <= MAX_4_BYTE_CHAR); + return d; + } + + d = (d << 6) + p[4] - ((0x08 << 24) + 0x80); + *length = 5; + eassume (MAX_4_BYTE_CHAR < d && d <= MAX_5_BYTE_CHAR); + return d; +} /* Return the character code of character whose multibyte form is at P. */ -#define STRING_CHAR(p) \ - (!((p)[0] & 0x80) \ - ? (p)[0] \ - : ! ((p)[0] & 0x20) \ - ? (((((p)[0] & 0x1F) << 6) \ - | ((p)[1] & 0x3F)) \ - + (((unsigned char) (p)[0]) < 0xC2 ? 0x3FFF80 : 0)) \ - : ! ((p)[0] & 0x10) \ - ? ((((p)[0] & 0x0F) << 12) \ - | (((p)[1] & 0x3F) << 6) \ - | ((p)[2] & 0x3F)) \ - : string_char ((p), NULL, NULL)) - - -/* Like STRING_CHAR, but set ACTUAL_LEN to the length of multibyte - form. */ - -#define STRING_CHAR_AND_LENGTH(p, actual_len) \ - (!((p)[0] & 0x80) \ - ? ((actual_len) = 1, (p)[0]) \ - : ! ((p)[0] & 0x20) \ - ? ((actual_len) = 2, \ - (((((p)[0] & 0x1F) << 6) \ - | ((p)[1] & 0x3F)) \ - + (((unsigned char) (p)[0]) < 0xC2 ? 0x3FFF80 : 0))) \ - : ! ((p)[0] & 0x10) \ - ? ((actual_len) = 3, \ - ((((p)[0] & 0x0F) << 12) \ - | (((p)[1] & 0x3F) << 6) \ - | ((p)[2] & 0x3F))) \ - : string_char ((p), NULL, &actual_len)) - - -/* Like STRING_CHAR, but advance P to the end of multibyte form. */ - -#define STRING_CHAR_ADVANCE(p) \ - (!((p)[0] & 0x80) \ - ? *(p)++ \ - : ! ((p)[0] & 0x20) \ - ? ((p) += 2, \ - ((((p)[-2] & 0x1F) << 6) \ - | ((p)[-1] & 0x3F) \ - | ((unsigned char) ((p)[-2]) < 0xC2 ? 0x3FFF80 : 0))) \ - : ! ((p)[0] & 0x10) \ - ? ((p) += 3, \ - ((((p)[-3] & 0x0F) << 12) \ - | (((p)[-2] & 0x3F) << 6) \ - | ((p)[-1] & 0x3F))) \ - : string_char ((p), &(p), NULL)) - - -/* Fetch the "next" character from Lisp string STRING at byte position - BYTEIDX, character position CHARIDX. Store it into OUTPUT. - - All the args must be side-effect-free. - BYTEIDX and CHARIDX must be lvalues; - we increment them past the character fetched. */ - -#define FETCH_STRING_CHAR_ADVANCE(OUTPUT, STRING, CHARIDX, BYTEIDX) \ - do \ - { \ - CHARIDX++; \ - if (STRING_MULTIBYTE (STRING)) \ - { \ - unsigned char *chp = &SDATA (STRING)[BYTEIDX]; \ - int chlen; \ - \ - OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \ - BYTEIDX += chlen; \ - } \ - else \ - { \ - OUTPUT = SREF (STRING, BYTEIDX); \ - BYTEIDX++; \ - } \ - } \ - while (false) - -/* Like FETCH_STRING_CHAR_ADVANCE, but return a multibyte character - even if STRING is unibyte. */ +INLINE int +STRING_CHAR (unsigned char const *p) +{ + int len; + return string_char_and_length (p, &len); +} + -#define FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE(OUTPUT, STRING, CHARIDX, BYTEIDX) \ - do \ - { \ - CHARIDX++; \ - if (STRING_MULTIBYTE (STRING)) \ - { \ - unsigned char *chp = &SDATA (STRING)[BYTEIDX]; \ - int chlen; \ - \ - OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \ - BYTEIDX += chlen; \ - } \ - else \ - { \ - OUTPUT = SREF (STRING, BYTEIDX); \ - BYTEIDX++; \ - MAKE_CHAR_MULTIBYTE (OUTPUT); \ - } \ - } \ - while (false) - - -/* Like FETCH_STRING_CHAR_ADVANCE, but assumes STRING is multibyte. */ - -#define FETCH_STRING_CHAR_ADVANCE_NO_CHECK(OUTPUT, STRING, CHARIDX, BYTEIDX) \ - do \ - { \ - unsigned char *fetch_ptr = &SDATA (STRING)[BYTEIDX]; \ - int fetch_len; \ - \ - OUTPUT = STRING_CHAR_AND_LENGTH (fetch_ptr, fetch_len); \ - BYTEIDX += fetch_len; \ - CHARIDX++; \ - } \ - while (false) - - -/* Like FETCH_STRING_CHAR_ADVANCE, but fetch character from the current - buffer. */ - -#define FETCH_CHAR_ADVANCE(OUTPUT, CHARIDX, BYTEIDX) \ - do \ - { \ - CHARIDX++; \ - if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) \ - { \ - unsigned char *chp = BYTE_POS_ADDR (BYTEIDX); \ - int chlen; \ - \ - OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \ - BYTEIDX += chlen; \ - } \ - else \ - { \ - OUTPUT = *(BYTE_POS_ADDR (BYTEIDX)); \ - BYTEIDX++; \ - } \ - } \ - while (false) - - -/* Like FETCH_CHAR_ADVANCE, but assumes the current buffer is multibyte. */ - -#define FETCH_CHAR_ADVANCE_NO_CHECK(OUTPUT, CHARIDX, BYTEIDX) \ - do \ - { \ - unsigned char *chp = BYTE_POS_ADDR (BYTEIDX); \ - int chlen; \ - \ - OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \ - BYTEIDX += chlen; \ - CHARIDX++; \ - } \ - while (false) - - -/* Increment the buffer byte position POS_BYTE of the current buffer to - the next character boundary. No range checking of POS. */ - -#define INC_POS(pos_byte) \ - do { \ - unsigned char *chp = BYTE_POS_ADDR (pos_byte); \ - pos_byte += BYTES_BY_CHAR_HEAD (*chp); \ - } while (false) - - -/* Decrement the buffer byte position POS_BYTE of the current buffer to - the previous character boundary. No range checking of POS. */ - -#define DEC_POS(pos_byte) \ - do { \ - unsigned char *chp; \ - \ - pos_byte--; \ - if (pos_byte < GPT_BYTE) \ - chp = BEG_ADDR + pos_byte - BEG_BYTE; \ - else \ - chp = BEG_ADDR + GAP_SIZE + pos_byte - BEG_BYTE; \ - while (!CHAR_HEAD_P (*chp)) \ - { \ - chp--; \ - pos_byte--; \ - } \ - } while (false) - -/* Increment both CHARPOS and BYTEPOS, each in the appropriate way. */ - -#define INC_BOTH(charpos, bytepos) \ - do \ - { \ - (charpos)++; \ - if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \ - (bytepos)++; \ - else \ - INC_POS ((bytepos)); \ - } \ - while (false) - - -/* Decrement both CHARPOS and BYTEPOS, each in the appropriate way. */ - -#define DEC_BOTH(charpos, bytepos) \ - do \ - { \ - (charpos)--; \ - if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \ - (bytepos)--; \ - else \ - DEC_POS ((bytepos)); \ - } \ - while (false) - - -/* Increment the buffer byte position POS_BYTE of the current buffer to - the next character boundary. This macro relies on the fact that - *GPT_ADDR and *Z_ADDR are always accessible and the values are - '\0'. No range checking of POS_BYTE. */ - -#define BUF_INC_POS(buf, pos_byte) \ - do { \ - unsigned char *chp = BUF_BYTE_ADDRESS (buf, pos_byte); \ - pos_byte += BYTES_BY_CHAR_HEAD (*chp); \ - } while (false) - - -/* Decrement the buffer byte position POS_BYTE of the current buffer to - the previous character boundary. No range checking of POS_BYTE. */ - -#define BUF_DEC_POS(buf, pos_byte) \ - do { \ - unsigned char *chp; \ - pos_byte--; \ - if (pos_byte < BUF_GPT_BYTE (buf)) \ - chp = BUF_BEG_ADDR (buf) + pos_byte - BEG_BYTE; \ - else \ - chp = BUF_BEG_ADDR (buf) + BUF_GAP_SIZE (buf) + pos_byte - BEG_BYTE;\ - while (!CHAR_HEAD_P (*chp)) \ - { \ - chp--; \ - pos_byte--; \ - } \ - } while (false) - - -/* Return a non-outlandish value for the tab width. */ - -#define SANE_TAB_WIDTH(buf) sanitize_tab_width (BVAR (buf, tab_width)) +/* Like STRING_CHAR (*PP), but advance *PP to the end of multibyte form. */ INLINE int -sanitize_tab_width (Lisp_Object width) +string_char_advance (unsigned char const **pp) { - return (FIXNUMP (width) && 0 < XFIXNUM (width) && XFIXNUM (width) <= 1000 - ? XFIXNUM (width) : 8); + unsigned char const *p = *pp; + int len, c = string_char_and_length (p, &len); + *pp = p + len; + return c; } -/* Return the width of ASCII character C. The width is measured by - how many columns C will occupy on the screen when displayed in the - current buffer. */ -#define ASCII_CHAR_WIDTH(c) \ - (c < 0x20 \ - ? (c == '\t' \ - ? SANE_TAB_WIDTH (current_buffer) \ - : (c == '\n' ? 0 : (NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2))) \ - : (c < 0x7f \ - ? 1 \ - : ((NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2)))) +/* Return the next character from Lisp string STRING at byte position + *BYTEIDX, character position *CHARIDX. Update *BYTEIDX and + *CHARIDX past the character fetched. */ + +INLINE int +fetch_string_char_advance (Lisp_Object string, + ptrdiff_t *charidx, ptrdiff_t *byteidx) +{ + int output; + ptrdiff_t b = *byteidx; + unsigned char *chp = SDATA (string) + b; + if (STRING_MULTIBYTE (string)) + { + int chlen; + output = string_char_and_length (chp, &chlen); + b += chlen; + } + else + { + output = *chp; + b++; + } + (*charidx)++; + *byteidx = b; + return output; +} -/* Return a non-outlandish value for a character width. */ +/* Like fetch_string_char_advance, but return a multibyte character + even if STRING is unibyte. */ INLINE int -sanitize_char_width (EMACS_INT width) +fetch_string_char_as_multibyte_advance (Lisp_Object string, + ptrdiff_t *charidx, ptrdiff_t *byteidx) { - return 0 <= width && width <= 1000 ? width : 1000; + int output; + ptrdiff_t b = *byteidx; + unsigned char *chp = SDATA (string) + b; + if (STRING_MULTIBYTE (string)) + { + int chlen; + output = string_char_and_length (chp, &chlen); + b += chlen; + } + else + { + output = make_char_multibyte (*chp); + b++; + } + (*charidx)++; + *byteidx = b; + return output; } -/* Return the width of character C. The width is measured by how many - columns C will occupy on the screen when displayed in the current - buffer. The name CHARACTER_WIDTH avoids a collision with <limits.h> - CHAR_WIDTH when enabled; see ISO/IEC TS 18661-1:2014. */ -#define CHARACTER_WIDTH(c) \ - (ASCII_CHAR_P (c) \ - ? ASCII_CHAR_WIDTH (c) \ - : sanitize_char_width (XFIXNUM (CHAR_TABLE_REF (Vchar_width_table, c)))) +/* Like fetch_string_char_advance, but assumes STRING is multibyte. */ + +INLINE int +fetch_string_char_advance_no_check (Lisp_Object string, + ptrdiff_t *charidx, ptrdiff_t *byteidx) +{ + ptrdiff_t b = *byteidx; + unsigned char *chp = SDATA (string) + b; + int chlen, output = string_char_and_length (chp, &chlen); + (*charidx)++; + *byteidx = b + chlen; + return output; +} + /* If C is a variation selector, return the index of the variation selector (1..256). Otherwise, return 0. */ -#define CHAR_VARIATION_SELECTOR_P(c) \ - ((c) < 0xFE00 ? 0 \ - : (c) <= 0xFE0F ? (c) - 0xFE00 + 1 \ - : (c) < 0xE0100 ? 0 \ - : (c) <= 0xE01EF ? (c) - 0xE0100 + 17 \ - : 0) +INLINE int +CHAR_VARIATION_SELECTOR_P (int c) +{ + return (c < 0xFE00 ? 0 + : c <= 0xFE0F ? c - 0xFE00 + 1 + : c < 0xE0100 ? 0 + : c <= 0xE01EF ? c - 0xE0100 + 17 + : 0); +} /* Return true if C is a surrogate. */ @@ -657,9 +560,6 @@ typedef enum { } unicode_category_t; extern EMACS_INT char_resolve_modifier_mask (EMACS_INT) ATTRIBUTE_CONST; -extern int char_string (unsigned, unsigned char *); -extern int string_char (const unsigned char *, - const unsigned char **, int *); extern int translate_char (Lisp_Object, int c); extern ptrdiff_t count_size_as_multibyte (const unsigned char *, ptrdiff_t); @@ -684,10 +584,6 @@ extern bool graphicp (int); extern bool printablep (int); extern bool blankp (int); -/* Return a translation table of id number ID. */ -#define GET_TRANSLATION_TABLE(id) \ - (XCDR (XVECTOR (Vtranslation_table_vector)->contents[(id)])) - /* Look up the element in char table OBJ at index CH, and return it as an integer. If the element is not a character, return CH itself. */ diff --git a/src/charset.c b/src/charset.c index 2771b0ba2ac..8635aad3ed6 100644 --- a/src/charset.c +++ b/src/charset.c @@ -866,15 +866,10 @@ usage: (define-charset-internal ...) */) val = args[charset_arg_code_space]; for (i = 0, dimension = 0, nchars = 1; ; i++) { - Lisp_Object min_byte_obj, max_byte_obj; - int min_byte, max_byte; - - min_byte_obj = Faref (val, make_fixnum (i * 2)); - max_byte_obj = Faref (val, make_fixnum (i * 2 + 1)); - CHECK_RANGED_INTEGER (min_byte_obj, 0, 255); - min_byte = XFIXNUM (min_byte_obj); - CHECK_RANGED_INTEGER (max_byte_obj, min_byte, 255); - max_byte = XFIXNUM (max_byte_obj); + Lisp_Object min_byte_obj = Faref (val, make_fixnum (i * 2)); + Lisp_Object max_byte_obj = Faref (val, make_fixnum (i * 2 + 1)); + int min_byte = check_integer_range (min_byte_obj, 0, 255); + int max_byte = check_integer_range (max_byte_obj, min_byte, 255); charset.code_space[i * 4] = min_byte; charset.code_space[i * 4 + 1] = max_byte; charset.code_space[i * 4 + 2] = max_byte - min_byte + 1; @@ -887,13 +882,8 @@ usage: (define-charset-internal ...) */) } val = args[charset_arg_dimension]; - if (NILP (val)) - charset.dimension = dimension; - else - { - CHECK_RANGED_INTEGER (val, 1, 4); - charset.dimension = XFIXNUM (val); - } + charset.dimension + = !NILP (val) ? check_integer_range (val, 1, 4) : dimension; charset.code_linear_p = (charset.dimension == 1 @@ -979,13 +969,7 @@ usage: (define-charset-internal ...) */) } val = args[charset_arg_iso_revision]; - if (NILP (val)) - charset.iso_revision = -1; - else - { - CHECK_RANGED_INTEGER (val, -1, 63); - charset.iso_revision = XFIXNUM (val); - } + charset.iso_revision = !NILP (val) ? check_integer_range (val, -1, 63) : -1; val = args[charset_arg_emacs_mule_id]; if (NILP (val)) @@ -1090,8 +1074,7 @@ usage: (define-charset-internal ...) */) car_part = XCAR (elt); cdr_part = XCDR (elt); CHECK_CHARSET_GET_ID (car_part, this_id); - CHECK_TYPE_RANGED_INTEGER (int, cdr_part); - offset = XFIXNUM (cdr_part); + offset = check_integer_range (cdr_part, INT_MIN, INT_MAX); } else { @@ -1477,7 +1460,7 @@ string_xstring_p (Lisp_Object string) while (p < endp) { - int c = STRING_CHAR_ADVANCE (p); + int c = string_char_advance (&p); if (c >= 0x100) return 2; @@ -1521,7 +1504,7 @@ find_charsets_in_text (const unsigned char *ptr, ptrdiff_t nchars, { while (ptr < pend) { - int c = STRING_CHAR_ADVANCE (ptr); + int c = string_char_advance (&ptr); struct charset *charset; if (!NILP (table)) diff --git a/src/chartab.c b/src/chartab.c index 04205ac1032..cb2ced568d9 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -1117,10 +1117,10 @@ uniprop_table_uncompress (Lisp_Object table, int idx) { /* SIMPLE TABLE */ p++; - idx = STRING_CHAR_ADVANCE (p); + idx = string_char_advance (&p); while (p < pend && idx < chartab_chars[2]) { - int v = STRING_CHAR_ADVANCE (p); + int v = string_char_advance (&p); set_sub_char_table_contents (sub, idx++, v > 0 ? make_fixnum (v) : Qnil); } @@ -1131,13 +1131,13 @@ uniprop_table_uncompress (Lisp_Object table, int idx) p++; for (idx = 0; p < pend; ) { - int v = STRING_CHAR_ADVANCE (p); + int v = string_char_advance (&p); int count = 1; - int len; if (p < pend) { - count = STRING_CHAR_AND_LENGTH (p, len); + int len; + count = string_char_and_length (p, &len); if (count < 128) count = 1; else diff --git a/src/cmds.c b/src/cmds.c index 5d7a45e65f6..9f96f210b9f 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -31,15 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ static int internal_self_insert (int, EMACS_INT); -DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0, - doc: /* Return buffer position N characters after (before if N negative) point. */) - (Lisp_Object n) -{ - CHECK_FIXNUM (n); - - return make_fixnum (PT + XFIXNUM (n)); -} - /* Add N to point; or subtract N if FORWARD is false. N defaults to 1. Validate the new location. Return nil. */ static Lisp_Object @@ -398,7 +389,7 @@ internal_self_insert (int c, EMACS_INT n) /* We will delete too many columns. Let's fill columns by spaces so that the remaining text won't move. */ ptrdiff_t actual = PT_BYTE; - DEC_POS (actual); + actual -= prev_char_len (actual); if (FETCH_CHAR (actual) == '\t') /* Rather than add spaces, let's just keep the tab. */ chars_to_delete--; @@ -460,7 +451,10 @@ internal_self_insert (int c, EMACS_INT n) string = concat2 (string, tem); } - replace_range (PT, PT + chars_to_delete, string, 1, 1, 1, 0); + ptrdiff_t to; + if (INT_ADD_WRAPV (PT, chars_to_delete, &to)) + to = PTRDIFF_MAX; + replace_range (PT, to, string, 1, 1, 1, 0); Fforward_char (make_fixnum (n)); } else if (n > 1) @@ -526,7 +520,6 @@ syms_of_cmds (void) This is run after inserting the character. */); Vpost_self_insert_hook = Qnil; - defsubr (&Sforward_point); defsubr (&Sforward_char); defsubr (&Sbackward_char); defsubr (&Sforward_line); diff --git a/src/coding.c b/src/coding.c index ed755b1afcf..34f36d5a86a 100644 --- a/src/coding.c +++ b/src/coding.c @@ -643,7 +643,7 @@ growable_destination (struct coding_system *coding) else \ { \ src--; \ - c = - string_char (src, &src, NULL); \ + c = - string_char_advance (&src); \ record_conversion_result \ (coding, CODING_RESULT_INVALID_SRC); \ } \ @@ -728,7 +728,7 @@ growable_destination (struct coding_system *coding) unsigned ch = (c); \ if (ch >= 0x80) \ ch = BYTE8_TO_CHAR (ch); \ - CHAR_STRING_ADVANCE (ch, dst); \ + dst += CHAR_STRING (ch, dst); \ } \ else \ *dst++ = (c); \ @@ -747,11 +747,11 @@ growable_destination (struct coding_system *coding) ch = (c1); \ if (ch >= 0x80) \ ch = BYTE8_TO_CHAR (ch); \ - CHAR_STRING_ADVANCE (ch, dst); \ + dst += CHAR_STRING (ch, dst); \ ch = (c2); \ if (ch >= 0x80) \ ch = BYTE8_TO_CHAR (ch); \ - CHAR_STRING_ADVANCE (ch, dst); \ + dst += CHAR_STRING (ch, dst); \ } \ else \ { \ @@ -884,18 +884,18 @@ record_conversion_result (struct coding_system *coding, /* Store multibyte form of the character C in P, and advance P to the - end of the multibyte form. This used to be like CHAR_STRING_ADVANCE + end of the multibyte form. This used to be like adding CHAR_STRING without ever calling MAYBE_UNIFY_CHAR, but nowadays we don't call - MAYBE_UNIFY_CHAR in CHAR_STRING_ADVANCE. */ + MAYBE_UNIFY_CHAR in CHAR_STRING. */ -#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) CHAR_STRING_ADVANCE(c, p) +#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) ((p) += CHAR_STRING (c, p)) /* Return the character code of character whose multibyte form is at P, and advance P to the end of the multibyte form. This used to be - like STRING_CHAR_ADVANCE without ever calling MAYBE_UNIFY_CHAR, but - nowadays STRING_CHAR_ADVANCE doesn't call MAYBE_UNIFY_CHAR. */ + like string_char_advance without ever calling MAYBE_UNIFY_CHAR, but + nowadays string_char_advance doesn't call MAYBE_UNIFY_CHAR. */ -#define STRING_CHAR_ADVANCE_NO_UNIFY(p) STRING_CHAR_ADVANCE(p) +#define STRING_CHAR_ADVANCE_NO_UNIFY(p) string_char_advance (&(p)) /* Set coding->source from coding->src_object. */ @@ -5131,7 +5131,7 @@ decode_coding_ccl (struct coding_system *coding) while (i < 1024 && p < src_end) { source_byteidx[i] = p - src; - source_charbuf[i++] = STRING_CHAR_ADVANCE (p); + source_charbuf[i++] = string_char_advance (&p); } source_byteidx[i] = p - src; } @@ -5308,15 +5308,10 @@ encode_coding_raw_text (struct coding_system *coding) } else { - unsigned char str[MAX_MULTIBYTE_LENGTH], *p0 = str, *p1 = str; - - CHAR_STRING_ADVANCE (c, p1); - do - { - EMIT_ONE_BYTE (*p0); - p0++; - } - while (p0 < p1); + unsigned char str[MAX_MULTIBYTE_LENGTH]; + int len = CHAR_STRING (c, str); + for (int i = 0; i < len; i++) + EMIT_ONE_BYTE (str[i]); } } else @@ -5342,7 +5337,7 @@ encode_coding_raw_text (struct coding_system *coding) else if (CHAR_BYTE8_P (c)) *dst++ = CHAR_TO_BYTE8 (c); else - CHAR_STRING_ADVANCE (c, dst); + dst += CHAR_STRING (c, dst); } } else @@ -7457,7 +7452,7 @@ decode_coding (struct coding_system *coding) if (coding->src_multibyte && CHAR_BYTE8_HEAD_P (*src) && nbytes > 0) { - c = STRING_CHAR_ADVANCE (src); + c = string_char_advance (&src); nbytes--; } else @@ -7551,10 +7546,8 @@ handle_composition_annotation (ptrdiff_t pos, ptrdiff_t limit, len = SCHARS (components); i = i_byte = 0; while (i < len) - { - FETCH_STRING_CHAR_ADVANCE (*buf, components, i, i_byte); - buf++; - } + *buf++ = fetch_string_char_advance (components, + &i, &i_byte); } else if (FIXNUMP (components)) { @@ -7677,15 +7670,17 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table, if (! multibytep) { - int bytes; - if (coding->encoder == encode_coding_raw_text || coding->encoder == encode_coding_ccl) c = *src++, pos++; - else if ((bytes = MULTIBYTE_LENGTH (src, src_end)) > 0) - c = STRING_CHAR_ADVANCE_NO_UNIFY (src), pos += bytes; else - c = BYTE8_TO_CHAR (*src), src++, pos++; + { + int bytes = multibyte_length (src, src_end, true, true); + if (0 < bytes) + c = STRING_CHAR_ADVANCE_NO_UNIFY (src), pos += bytes; + else + c = BYTE8_TO_CHAR (*src), src++, pos++; + } } else c = STRING_CHAR_ADVANCE_NO_UNIFY (src), pos++; @@ -7715,7 +7710,7 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table, lookup_buf[0] = c; for (i = 1; i < max_lookup && p < src_end; i++) - lookup_buf[i] = STRING_CHAR_ADVANCE (p); + lookup_buf[i] = string_char_advance (&p); lookup_buf_end = lookup_buf + i; trans = get_translation (trans, lookup_buf, lookup_buf_end, &from_nchars); @@ -7734,7 +7729,7 @@ consume_chars (struct coding_system *coding, Lisp_Object translation_table, for (i = 1; i < to_nchars; i++) *buf++ = XFIXNUM (AREF (trans, i)); for (i = 1; i < from_nchars; i++, pos++) - src += MULTIBYTE_LENGTH_NO_CHECK (src); + src += multibyte_length (src, NULL, false, true); } } @@ -9023,23 +9018,23 @@ DEFUN ("find-coding-systems-region-internal", } else { - CHECK_FIXNUM_COERCE_MARKER (start); - CHECK_FIXNUM_COERCE_MARKER (end); - if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end)) + EMACS_INT s = fix_position (start); + EMACS_INT e = fix_position (end); + if (! (BEG <= s && s <= e && e <= Z)) args_out_of_range (start, end); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return Qt; - start_byte = CHAR_TO_BYTE (XFIXNUM (start)); - end_byte = CHAR_TO_BYTE (XFIXNUM (end)); - if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte) + start_byte = CHAR_TO_BYTE (s); + end_byte = CHAR_TO_BYTE (e); + if (e - s == end_byte - start_byte) return Qt; - if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT) + if (s < GPT && GPT < e) { - if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT)) - move_gap_both (XFIXNUM (start), start_byte); + if (GPT - s < e - GPT) + move_gap_both (s, start_byte); else - move_gap_both (XFIXNUM (end), end_byte); + move_gap_both (e, end_byte); } } @@ -9075,7 +9070,7 @@ DEFUN ("find-coding-systems-region-internal", p++; else { - c = STRING_CHAR_ADVANCE (p); + c = string_char_advance (&p); if (!NILP (char_table_ref (work_table, c))) /* This character was already checked. Ignore it. */ continue; @@ -9208,7 +9203,7 @@ to the string and treated as in `substring'. */) p = GAP_END_ADDR; } - c = STRING_CHAR_ADVANCE (p); + c = string_char_advance (&p); if (! (ASCII_CHAR_P (c) && ascii_compatible) && ! char_charset (translate_char (translation_table, c), charset_list, NULL)) @@ -9277,32 +9272,35 @@ is nil. */) } else { - CHECK_FIXNUM_COERCE_MARKER (start); - CHECK_FIXNUM_COERCE_MARKER (end); - if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end)) + EMACS_INT s = fix_position (start); + EMACS_INT e = fix_position (end); + if (! (BEG <= s && s <= e && e <= Z)) args_out_of_range (start, end); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return Qnil; - start_byte = CHAR_TO_BYTE (XFIXNUM (start)); - end_byte = CHAR_TO_BYTE (XFIXNUM (end)); - if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte) + start_byte = CHAR_TO_BYTE (s); + end_byte = CHAR_TO_BYTE (e); + if (e - s == end_byte - start_byte) return Qnil; - if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT) + if (s < GPT && GPT < e) { - if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT)) - move_gap_both (XFIXNUM (start), start_byte); + if (GPT - s < e - GPT) + move_gap_both (s, start_byte); else - move_gap_both (XFIXNUM (end), end_byte); + move_gap_both (e, end_byte); } - pos = XFIXNUM (start); + pos = s; } list = Qnil; for (tail = coding_system_list; CONSP (tail); tail = XCDR (tail)) { elt = XCAR (tail); - attrs = AREF (CODING_SYSTEM_SPEC (elt), 0); + Lisp_Object spec = CODING_SYSTEM_SPEC (elt); + if (!VECTORP (spec)) + xsignal1 (Qcoding_system_error, elt); + attrs = AREF (spec, 0); ASET (attrs, coding_attr_trans_tbl, get_translation_table (attrs, 1, NULL)); list = Fcons (list2 (elt, attrs), list); @@ -9323,7 +9321,7 @@ is nil. */) p++; else { - c = STRING_CHAR_ADVANCE (p); + c = string_char_advance (&p); charset_map_loaded = 0; for (tail = list; CONSP (tail); tail = XCDR (tail)) @@ -9471,6 +9469,17 @@ not fully specified.) */) return code_convert_region (start, end, coding_system, destination, 1, 0); } +/* Whether STRING only contains chars in the 0..127 range. */ +static bool +string_ascii_p (Lisp_Object string) +{ + ptrdiff_t nbytes = SBYTES (string); + for (ptrdiff_t i = 0; i < nbytes; i++) + if (SREF (string, i) > 127) + return false; + return true; +} + Lisp_Object code_convert_string (Lisp_Object string, Lisp_Object coding_system, Lisp_Object dst_object, bool encodep, bool nocopy, @@ -9485,7 +9494,7 @@ code_convert_string (Lisp_Object string, Lisp_Object coding_system, if (! norecord) Vlast_coding_system_used = Qno_conversion; if (NILP (dst_object)) - return (nocopy ? Fcopy_sequence (string) : string); + return nocopy ? string : Fcopy_sequence (string); } if (NILP (coding_system)) @@ -9502,7 +9511,28 @@ code_convert_string (Lisp_Object string, Lisp_Object coding_system, chars = SCHARS (string); bytes = SBYTES (string); - if (BUFFERP (dst_object)) + if (EQ (dst_object, Qt)) + { + /* Fast path for ASCII-only input and an ASCII-compatible coding: + act as identity if no EOL conversion is needed. */ + Lisp_Object attrs = CODING_ID_ATTRS (coding.id); + if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs)) + && (STRING_MULTIBYTE (string) + ? (chars == bytes) : string_ascii_p (string)) + && (EQ (CODING_ID_EOL_TYPE (coding.id), Qunix) + || inhibit_eol_conversion + || ! memchr (SDATA (string), encodep ? '\n' : '\r', bytes))) + { + if (! norecord) + Vlast_coding_system_used = coding_system; + return (nocopy + ? string + : (encodep + ? make_unibyte_string (SSDATA (string), bytes) + : make_multibyte_string (SSDATA (string), bytes, bytes))); + } + } + else if (BUFFERP (dst_object)) { struct buffer *buf = XBUFFER (dst_object); ptrdiff_t buf_pt = BUF_PT (buf); @@ -9524,10 +9554,7 @@ code_convert_string (Lisp_Object string, Lisp_Object coding_system, /* Encode or decode STRING according to CODING_SYSTEM. - Do not set Vlast_coding_system_used. - - This function is called only from macros DECODE_FILE and - ENCODE_FILE, thus we ignore character composition. */ + Do not set Vlast_coding_system_used. */ Lisp_Object code_convert_string_norecord (Lisp_Object string, Lisp_Object coding_system, @@ -9696,7 +9723,7 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object buffer, || (len == 2 ? ! CHAR_BYTE8_HEAD_P (c) : (EQ (handle_over_uni, Qt) || (len == 4 - && string_char (p, NULL, NULL) <= MAX_UNICODE_CHAR)))) + && STRING_CHAR (p) <= MAX_UNICODE_CHAR)))) { p += len; continue; @@ -9978,8 +10005,7 @@ decode_string_utf_8 (Lisp_Object string, const char *str, ptrdiff_t str_len, && (len == 3 || (UTF_8_EXTRA_OCTET_P (p[3]) && len == 4 - && (string_char (p, NULL, NULL) - <= MAX_UNICODE_CHAR)))))) + && STRING_CHAR (p) <= MAX_UNICODE_CHAR))))) { p += len; continue; @@ -10116,8 +10142,7 @@ decode_string_utf_8 (Lisp_Object string, const char *str, ptrdiff_t str_len, mlen++); if (mlen == len && (len <= 3 - || (len == 4 - && string_char (p, NULL, NULL) <= MAX_UNICODE_CHAR) + || (len == 4 && STRING_CHAR (p) <= MAX_UNICODE_CHAR) || EQ (handle_over_uni, Qt))) { p += len; @@ -10297,6 +10322,16 @@ DEFUN ("internal-decode-string-utf-8", Finternal_decode_string_utf_8, #endif /* ENABLE_UTF_8_CONVERTER_TEST */ +/* Encode or decode STRING using CODING_SYSTEM, with the possibility of + returning STRING itself if it equals the result. + Do not set Vlast_coding_system_used. */ +static Lisp_Object +convert_string_nocopy (Lisp_Object string, Lisp_Object coding_system, + bool encodep) +{ + return code_convert_string (string, coding_system, Qt, encodep, 1, 1); +} + /* Encode or decode a file name, to or from a unibyte string suitable for passing to C library functions. */ Lisp_Object @@ -10307,14 +10342,13 @@ decode_file_name (Lisp_Object fname) converts the file names either to UTF-16LE or to the system ANSI codepage internally, depending on the underlying OS; see w32.c. */ if (! NILP (Fcoding_system_p (Qutf_8))) - return code_convert_string_norecord (fname, Qutf_8, 0); + return convert_string_nocopy (fname, Qutf_8, 0); return fname; #else /* !WINDOWSNT */ if (! NILP (Vfile_name_coding_system)) - return code_convert_string_norecord (fname, Vfile_name_coding_system, 0); + return convert_string_nocopy (fname, Vfile_name_coding_system, 0); else if (! NILP (Vdefault_file_name_coding_system)) - return code_convert_string_norecord (fname, - Vdefault_file_name_coding_system, 0); + return convert_string_nocopy (fname, Vdefault_file_name_coding_system, 0); else return fname; #endif @@ -10334,14 +10368,13 @@ encode_file_name (Lisp_Object fname) converts the file names either to UTF-16LE or to the system ANSI codepage internally, depending on the underlying OS; see w32.c. */ if (! NILP (Fcoding_system_p (Qutf_8))) - return code_convert_string_norecord (fname, Qutf_8, 1); + return convert_string_nocopy (fname, Qutf_8, 1); return fname; #else /* !WINDOWSNT */ if (! NILP (Vfile_name_coding_system)) - return code_convert_string_norecord (fname, Vfile_name_coding_system, 1); + return convert_string_nocopy (fname, Vfile_name_coding_system, 1); else if (! NILP (Vdefault_file_name_coding_system)) - return code_convert_string_norecord (fname, - Vdefault_file_name_coding_system, 1); + return convert_string_nocopy (fname, Vdefault_file_name_coding_system, 1); else return fname; #endif @@ -11061,10 +11094,8 @@ usage: (define-coding-system-internal ...) */) else { CHECK_CONS (val); - CHECK_RANGED_INTEGER (XCAR (val), 0, 255); - from = XFIXNUM (XCAR (val)); - CHECK_RANGED_INTEGER (XCDR (val), from, 255); - to = XFIXNUM (XCDR (val)); + from = check_integer_range (XCAR (val), 0, 255); + to = check_integer_range (XCDR (val), from, 255); } for (int i = from; i <= to; i++) SSET (valids, i, 1); @@ -11149,7 +11180,7 @@ usage: (define-coding-system-internal ...) */) val = XCAR (tail); CHECK_CONS (val); CHECK_CHARSET_GET_ID (XCAR (val), id); - CHECK_RANGED_INTEGER (XCDR (val), 0, 3); + check_integer_range (XCDR (val), 0, 3); XSETCAR (val, make_fixnum (id)); } @@ -11745,6 +11776,8 @@ syms_of_coding (void) DEFSYM (Qignored, "ignored"); + DEFSYM (Qutf_8_string_p, "utf-8-string-p"); + defsubr (&Scoding_system_p); defsubr (&Sread_coding_system); defsubr (&Sread_non_nil_coding_system); diff --git a/src/coding.h b/src/coding.h index 91856c5702b..c2a7b2a00ff 100644 --- a/src/coding.h +++ b/src/coding.h @@ -642,11 +642,11 @@ struct coding_system } while (false) /* Encode the file name NAME using the specified coding system - for file names, if any. */ + for file names, if any. May return NAME itself. */ #define ENCODE_FILE(NAME) encode_file_name (NAME) /* Decode the file name NAME using the specified coding system - for file names, if any. */ + for file names, if any. May return NAME itself. */ #define DECODE_FILE(NAME) decode_file_name (NAME) /* Encode the string STR using the specified coding system diff --git a/src/composite.c b/src/composite.c index 364d5c9316e..518502be49f 100644 --- a/src/composite.c +++ b/src/composite.c @@ -170,7 +170,6 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, ptrdiff_t hash_index; enum composition_method method; struct composition *cmp; - ptrdiff_t i; int ch; /* Maximum length of a string of glyphs. XftGlyphExtents limits @@ -224,15 +223,15 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, { key = make_uninit_vector (nchars); if (STRINGP (string)) - for (i = 0; i < nchars; i++) + for (ptrdiff_t i = 0; i < nchars; i++) { - FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos); + ch = fetch_string_char_advance (string, &charpos, &bytepos); ASET (key, i, make_fixnum (ch)); } else - for (i = 0; i < nchars; i++) + for (ptrdiff_t i = 0; i < nchars; i++) { - FETCH_CHAR_ADVANCE (ch, charpos, bytepos); + ch = fetch_char_advance (&charpos, &bytepos); ASET (key, i, make_fixnum (ch)); } } @@ -273,7 +272,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, /* COMPONENTS is a glyph-string. */ ptrdiff_t len = ASIZE (key); - for (i = 1; i < len; i++) + for (ptrdiff_t i = 1; i < len; i++) if (! VECTORP (AREF (key, i))) goto invalid_composition; } @@ -286,7 +285,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, goto invalid_composition; /* All elements should be integers (character or encoded composition rule). */ - for (i = 0; i < len; i++) + for (ptrdiff_t i = 0; i < len; i++) { if (!FIXNUMP (key_contents[i])) goto invalid_composition; @@ -328,7 +327,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, { /* Relative composition. */ cmp->width = 0; - for (i = 0; i < glyph_len; i++) + for (ptrdiff_t i = 0; i < glyph_len; i++) { int this_width; ch = XFIXNUM (key_contents[i]); @@ -347,7 +346,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars, ch = XFIXNUM (key_contents[0]); rightmost = ch != '\t' ? CHARACTER_WIDTH (ch) : 1; - for (i = 1; i < glyph_len; i += 2) + for (ptrdiff_t i = 1; i < glyph_len; i += 2) { int rule, gref, nref; int this_width; @@ -800,12 +799,10 @@ fill_gstring_header (ptrdiff_t from, ptrdiff_t from_byte, ASET (header, 0, font_object); for (ptrdiff_t i = 0; i < len; i++) { - int c; - - if (NILP (string)) - FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte); - else - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte); + int c + = (NILP (string) + ? fetch_char_advance_no_check (&from, &from_byte) + : fetch_string_char_advance_no_check (string, &from, &from_byte)); ASET (header, i + 1, make_fixnum (c)); } return header; @@ -1012,10 +1009,9 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, /* Forward search. */ while (charpos < endpos) { - if (STRINGP (string)) - FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos); - else - FETCH_CHAR_ADVANCE (c, charpos, bytepos); + c = (STRINGP (string) + ? fetch_string_char_advance (string, &charpos, &bytepos) + : fetch_char_advance (&charpos, &bytepos)); if (c == '\n') { cmp_it->ch = -2; @@ -1070,7 +1066,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, p = BYTE_POS_ADDR (bytepos); else p = SDATA (string) + bytepos; - c = STRING_CHAR_AND_LENGTH (p, len); + c = string_char_and_length (p, &len); limit = bytepos + len; while (char_composable_p (c)) { @@ -1132,7 +1128,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, } else { - DEC_BOTH (charpos, bytepos); + dec_both (&charpos, &bytepos); p = BYTE_POS_ADDR (bytepos); } c = STRING_CHAR (p); @@ -1145,7 +1141,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, { while (charpos - 1 > endpos && ! char_composable_p (c)) { - DEC_BOTH (charpos, bytepos); + dec_both (&charpos, &bytepos); c = FETCH_MULTIBYTE_CHAR (bytepos); } } @@ -1290,7 +1286,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos, { charpos++; if (NILP (string)) - INC_POS (bytepos); + bytepos += next_char_len (bytepos); else bytepos += BYTES_BY_CHAR_HEAD (*(SDATA (string) + bytepos)); } @@ -1756,7 +1752,18 @@ should be ignored. */) CHECK_STRING (string); validate_subarray (string, from, to, SCHARS (string), &frompos, &topos); if (! STRING_MULTIBYTE (string)) - error ("Attempt to shape unibyte text"); + { + ptrdiff_t i; + + for (i = SBYTES (string) - 1; i >= 0; i--) + if (!ASCII_CHAR_P (SREF (string, i))) + error ("Attempt to shape unibyte text"); + /* STRING is a pure-ASCII string, so we can convert it (or, + rather, its copy) to multibyte and use that thereafter. */ + Lisp_Object string_copy = Fconcat (1, &string); + STRING_SET_MULTIBYTE (string_copy); + string = string_copy; + } frombyte = string_char_to_byte (string, frompos); } @@ -1828,27 +1835,24 @@ See `find-composition' for more details. */) ptrdiff_t start, end, from, to; int id; - CHECK_FIXNUM_COERCE_MARKER (pos); + EMACS_INT fixed_pos = fix_position (pos); if (!NILP (limit)) - { - CHECK_FIXNUM_COERCE_MARKER (limit); - to = min (XFIXNUM (limit), ZV); - } + to = clip_to_bounds (PTRDIFF_MIN, fix_position (limit), ZV); else to = -1; if (!NILP (string)) { CHECK_STRING (string); - if (XFIXNUM (pos) < 0 || XFIXNUM (pos) > SCHARS (string)) + if (! (0 <= fixed_pos && fixed_pos <= SCHARS (string))) args_out_of_range (string, pos); } else { - if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) > ZV) + if (! (BEGV <= fixed_pos && fixed_pos <= ZV)) args_out_of_range (Fcurrent_buffer (), pos); } - from = XFIXNUM (pos); + from = fixed_pos; if (!find_composition (from, to, &start, &end, &prop, string)) { @@ -1859,12 +1863,12 @@ See `find-composition' for more details. */) return list3 (make_fixnum (start), make_fixnum (end), gstring); return Qnil; } - if ((end <= XFIXNUM (pos) || start > XFIXNUM (pos))) + if (! (start <= fixed_pos && fixed_pos < end)) { ptrdiff_t s, e; if (find_automatic_composition (from, to, &s, &e, &gstring, string) - && (e <= XFIXNUM (pos) ? e > end : s < start)) + && (e <= fixed_pos ? e > end : s < start)) return list3 (make_fixnum (s), make_fixnum (e), gstring); } if (!composition_valid_p (start, end, prop)) diff --git a/src/composite.h b/src/composite.h index 62c4de40e3b..239f1e531ef 100644 --- a/src/composite.h +++ b/src/composite.h @@ -125,10 +125,13 @@ composition_registered_p (Lisp_Object prop) COMPOSITION_DECODE_REFS (rule_code, gref, nref); \ } while (false) -/* Nonzero if the global reference point GREF and new reference point NREF are +/* True if the global reference point GREF and new reference point NREF are valid. */ -#define COMPOSITION_ENCODE_RULE_VALID(gref, nref) \ - (UNSIGNED_CMP (gref, <, 12) && UNSIGNED_CMP (nref, <, 12)) +INLINE bool +COMPOSITION_ENCODE_RULE_VALID (int gref, int nref) +{ + return 0 <= gref && gref < 12 && 0 <= nref && nref < 12; +} /* Return encoded composition rule for the pair of global reference point GREF and new reference point NREF. Arguments must be valid. */ diff --git a/src/conf_post.h b/src/conf_post.h index 2f8d19fdca8..1ef4ff33428 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -30,13 +30,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #endif /* To help make dependencies clearer elsewhere, this file typically - does not #include other files. The exceptions are first stdbool.h + does not #include other files. The exceptions are stdbool.h because it is unlikely to interfere with configuration and bool is - such a core part of the C language, and second ms-w32.h (DOS_NT + such a core part of the C language, attribute.h because its + ATTRIBUTE_* macros are used here, and ms-w32.h (DOS_NT only) because it historically was included here and changing that would take some work. */ #include <stdbool.h> +#include <attribute.h> #if defined WINDOWSNT && !defined DEFER_MS_W32_H # include <ms-w32.h> @@ -65,30 +67,31 @@ typedef unsigned int bool_bf; typedef bool bool_bf; #endif -/* Simulate __has_attribute on compilers that lack it. It is used only - on arguments like alloc_size that are handled in this simulation. - __has_attribute should be used only in #if expressions, as Oracle +/* A substitute for __has_attribute on compilers that lack it. + It is used only on arguments like cleanup that are handled here. + This macro should be used only in #if expressions, as Oracle Studio 12.5's __has_attribute does not work in plain code. */ -#ifndef __has_attribute -# define __has_attribute(a) __has_attribute_##a -# define __has_attribute_alloc_size GNUC_PREREQ (4, 3, 0) -# define __has_attribute_cleanup GNUC_PREREQ (3, 4, 0) -# define __has_attribute_cold GNUC_PREREQ (4, 3, 0) -# define __has_attribute_externally_visible GNUC_PREREQ (4, 1, 0) -# define __has_attribute_no_address_safety_analysis false -# define __has_attribute_no_sanitize_address GNUC_PREREQ (4, 8, 0) -# define __has_attribute_no_sanitize_undefined GNUC_PREREQ (4, 9, 0) -# define __has_attribute_warn_unused_result GNUC_PREREQ (3, 4, 0) +#ifdef __has_attribute +# define HAS_ATTRIBUTE(a) __has_attribute (__##a##__) +#else +# define HAS_ATTRIBUTE(a) HAS_ATTR_##a +# define HAS_ATTR_cleanup GNUC_PREREQ (3, 4, 0) +# define HAS_ATTR_no_address_safety_analysis false +# define HAS_ATTR_no_sanitize false +# define HAS_ATTR_no_sanitize_address GNUC_PREREQ (4, 8, 0) +# define HAS_ATTR_no_sanitize_undefined GNUC_PREREQ (4, 9, 0) #endif -/* Simulate __has_feature on compilers that lack it. It is used only +/* A substitute for __has_feature on compilers that lack it. It is used only to define ADDRESS_SANITIZER below. */ -#ifndef __has_feature -# define __has_feature(a) false +#ifdef __has_feature +# define HAS_FEATURE(a) __has_feature (a) +#else +# define HAS_FEATURE(a) false #endif /* True if addresses are being sanitized. */ -#if defined __SANITIZE_ADDRESS__ || __has_feature (address_sanitizer) +#if defined __SANITIZE_ADDRESS__ || HAS_FEATURE (address_sanitizer) # define ADDRESS_SANITIZER true #else # define ADDRESS_SANITIZER false @@ -225,37 +228,8 @@ extern void _DebPrint (const char *fmt, ...); extern char *emacs_getenv_TZ (void); extern int emacs_setenv_TZ (char const *); -/* Avoid __attribute__ ((cold)) on MinGW; see thread starting at - <https://lists.gnu.org/r/emacs-devel/2019-04/msg01152.html>. */ -#if __has_attribute (cold) && !defined __MINGW32__ -# define ATTRIBUTE_COLD __attribute__ ((cold)) -#else -# define ATTRIBUTE_COLD -#endif - -#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */ -#define NO_INLINE __attribute__((noinline)) -#else -#define NO_INLINE -#endif - -#if __has_attribute (externally_visible) -#define EXTERNALLY_VISIBLE __attribute__((externally_visible)) -#else -#define EXTERNALLY_VISIBLE -#endif - -#if GNUC_PREREQ (2, 7, 0) -# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec)) -#else -# define ATTRIBUTE_FORMAT(spec) /* empty */ -#endif - -#if GNUC_PREREQ (7, 0, 0) -# define FALLTHROUGH __attribute__ ((__fallthrough__)) -#else -# define FALLTHROUGH ((void) 0) -#endif +#define NO_INLINE ATTRIBUTE_NOINLINE +#define EXTERNALLY_VISIBLE ATTRIBUTE_EXTERNALLY_VISIBLE #if GNUC_PREREQ (4, 4, 0) && defined __GLIBC_MINOR__ # define PRINTF_ARCHETYPE __gnu_printf__ @@ -287,15 +261,8 @@ extern int emacs_setenv_TZ (char const *); #define ATTRIBUTE_FORMAT_PRINTF(string_index, first_to_check) \ ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check)) -#define ARG_NONNULL _GL_ARG_NONNULL -#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST -#define ATTRIBUTE_UNUSED _GL_UNUSED - -#if GNUC_PREREQ (3, 3, 0) && !defined __ICC -# define ATTRIBUTE_MAY_ALIAS __attribute__ ((__may_alias__)) -#else -# define ATTRIBUTE_MAY_ALIAS -#endif +#define ARG_NONNULL ATTRIBUTE_NONNULL +#define ATTRIBUTE_UNUSED MAYBE_UNUSED /* Declare NAME to be a pointer to an object of type TYPE, initialized to the address ADDR, which may be of a different type. Accesses @@ -306,19 +273,11 @@ extern int emacs_setenv_TZ (char const *); type ATTRIBUTE_MAY_ALIAS *name = (type *) (addr) #if 3 <= __GNUC__ -# define ATTRIBUTE_MALLOC __attribute__ ((__malloc__)) # define ATTRIBUTE_SECTION(name) __attribute__((section (name))) #else -# define ATTRIBUTE_MALLOC #define ATTRIBUTE_SECTION(name) #endif -#if __has_attribute (alloc_size) -# define ATTRIBUTE_ALLOC_SIZE(args) __attribute__ ((__alloc_size__ args)) -#else -# define ATTRIBUTE_ALLOC_SIZE(args) -#endif - #define ATTRIBUTE_MALLOC_SIZE(args) ATTRIBUTE_MALLOC ATTRIBUTE_ALLOC_SIZE (args) /* Work around GCC bug 59600: when a function is inlined, the inlined @@ -336,10 +295,10 @@ extern int emacs_setenv_TZ (char const *); /* Attribute of functions whose code should not have addresses sanitized. */ -#if __has_attribute (no_sanitize_address) +#if HAS_ATTRIBUTE (no_sanitize_address) # define ATTRIBUTE_NO_SANITIZE_ADDRESS \ __attribute__ ((no_sanitize_address)) ADDRESS_SANITIZER_WORKAROUND -#elif __has_attribute (no_address_safety_analysis) +#elif HAS_ATTRIBUTE (no_address_safety_analysis) # define ATTRIBUTE_NO_SANITIZE_ADDRESS \ __attribute__ ((no_address_safety_analysis)) ADDRESS_SANITIZER_WORKAROUND #else @@ -348,9 +307,9 @@ extern int emacs_setenv_TZ (char const *); /* Attribute of functions whose undefined behavior should not be sanitized. */ -#if __has_attribute (no_sanitize_undefined) +#if HAS_ATTRIBUTE (no_sanitize_undefined) # define ATTRIBUTE_NO_SANITIZE_UNDEFINED __attribute__ ((no_sanitize_undefined)) -#elif __has_attribute (no_sanitize) +#elif HAS_ATTRIBUTE (no_sanitize) # define ATTRIBUTE_NO_SANITIZE_UNDEFINED \ __attribute__ ((no_sanitize ("undefined"))) #else @@ -425,15 +384,13 @@ extern int emacs_setenv_TZ (char const *); #else -/* Use 'static' instead of 'extern inline' because 'static' typically - has better performance for Emacs. Do not use the 'inline' keyword, - as modern compilers inline automatically. ATTRIBUTE_UNUSED - pacifies gcc -Wunused-function. */ +/* Use 'static inline' instead of 'extern inline' because 'static inline' + has much better performance for Emacs when compiled with 'gcc -Og'. */ # ifndef INLINE # define INLINE EXTERN_INLINE # endif -# define EXTERN_INLINE static ATTRIBUTE_UNUSED +# define EXTERN_INLINE static inline # define INLINE_HEADER_BEGIN # define INLINE_HEADER_END diff --git a/src/data.c b/src/data.c index 0f3ac8c6571..1db0a983b49 100644 --- a/src/data.c +++ b/src/data.c @@ -143,15 +143,9 @@ wrong_length_argument (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) } AVOID -wrong_type_argument (register Lisp_Object predicate, register Lisp_Object value) +wrong_type_argument (Lisp_Object predicate, Lisp_Object value) { - /* If VALUE is not even a valid Lisp object, we'd want to abort here - where we can get a backtrace showing where it came from. We used - to try and do that by checking the tagbits, but nowadays all - tagbits are potentially valid. */ - /* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit) - * emacs_abort (); */ - + eassert (!TAGGEDP (value, Lisp_Type_Unused0)); xsignal2 (Qwrong_type_argument, predicate, value); } @@ -2305,61 +2299,45 @@ bool-vector. IDX starts at 0. */) } else /* STRINGP */ { - int c; - CHECK_IMPURE (array, XSTRING (array)); if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); CHECK_CHARACTER (newelt); - c = XFIXNAT (newelt); + int c = XFIXNAT (newelt); + ptrdiff_t idxval_byte; + int prev_bytes; + unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; if (STRING_MULTIBYTE (array)) { - ptrdiff_t idxval_byte, nbytes; - int prev_bytes, new_bytes; - unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; - - nbytes = SBYTES (array); idxval_byte = string_char_to_byte (array, idxval); p1 = SDATA (array) + idxval_byte; prev_bytes = BYTES_BY_CHAR_HEAD (*p1); - new_bytes = CHAR_STRING (c, p0); - if (prev_bytes != new_bytes) - { - /* We must relocate the string data. */ - ptrdiff_t nchars = SCHARS (array); - USE_SAFE_ALLOCA; - unsigned char *str = SAFE_ALLOCA (nbytes); - - memcpy (str, SDATA (array), nbytes); - allocate_string_data (XSTRING (array), nchars, - nbytes + new_bytes - prev_bytes); - memcpy (SDATA (array), str, idxval_byte); - p1 = SDATA (array) + idxval_byte; - memcpy (p1 + new_bytes, str + idxval_byte + prev_bytes, - nbytes - (idxval_byte + prev_bytes)); - SAFE_FREE (); - clear_string_char_byte_cache (); - } - while (new_bytes--) - *p1++ = *p0++; } - else + else if (SINGLE_BYTE_CHAR_P (c)) { - if (! SINGLE_BYTE_CHAR_P (c)) - { - ptrdiff_t i; - - for (i = SBYTES (array) - 1; i >= 0; i--) - if (SREF (array, i) >= 0x80) - args_out_of_range (array, newelt); - /* ARRAY is an ASCII string. Convert it to a multibyte - string, and try `aset' again. */ - STRING_SET_MULTIBYTE (array); - return Faset (array, idx, newelt); - } SSET (array, idxval, c); + return newelt; + } + else + { + for (ptrdiff_t i = SBYTES (array) - 1; i >= 0; i--) + if (!ASCII_CHAR_P (SREF (array, i))) + args_out_of_range (array, newelt); + /* ARRAY is an ASCII string. Convert it to a multibyte string. */ + STRING_SET_MULTIBYTE (array); + idxval_byte = idxval; + p1 = SDATA (array) + idxval_byte; + prev_bytes = 1; } + + int new_bytes = CHAR_STRING (c, p0); + if (prev_bytes != new_bytes) + p1 = resize_string_data (array, idxval_byte, prev_bytes, new_bytes); + + do + *p1++ = *p0++; + while (--new_bytes != 0); } return newelt; @@ -2367,6 +2345,24 @@ bool-vector. IDX starts at 0. */) /* Arithmetic functions */ +static Lisp_Object +check_integer_coerce_marker (Lisp_Object x) +{ + if (MARKERP (x)) + return make_fixnum (marker_position (x)); + CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); + return x; +} + +static Lisp_Object +check_number_coerce_marker (Lisp_Object x) +{ + if (MARKERP (x)) + return make_fixnum (marker_position (x)); + CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); + return x; +} + Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison) @@ -2375,8 +2371,8 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, bool lt, eq = true, gt; bool test; - CHECK_NUMBER_COERCE_MARKER (num1); - CHECK_NUMBER_COERCE_MARKER (num2); + num1 = check_number_coerce_marker (num1); + num2 = check_number_coerce_marker (num2); /* If the comparison is mostly done by comparing two doubles, set LT, EQ, and GT to the <, ==, > results of that comparison, @@ -2778,9 +2774,7 @@ floatop_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, argnum++; if (argnum == nargs) return make_float (accum); - Lisp_Object val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); - next = XFLOATINT (val); + next = XFLOATINT (check_number_coerce_marker (args[argnum])); } } @@ -2842,8 +2836,7 @@ bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, argnum++; if (argnum == nargs) return make_integer_mpz (); - val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); + val = check_number_coerce_marker (args[argnum]); if (FLOATP (val)) return float_arith_driver (code, nargs, args, argnum, mpz_get_d_rounded (*accum), val); @@ -2872,8 +2865,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, argnum++; if (argnum == nargs) return make_int (accum); - val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); + val = check_number_coerce_marker (args[argnum]); /* Set NEXT to the next value if it fits, else exit the loop. */ intmax_t next; @@ -2920,8 +2912,7 @@ usage: (+ &rest NUMBERS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (0); - Lisp_Object a = args[0]; - CHECK_NUMBER_COERCE_MARKER (a); + Lisp_Object a = check_number_coerce_marker (args[0]); return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a); } @@ -2934,8 +2925,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (0); - Lisp_Object a = args[0]; - CHECK_NUMBER_COERCE_MARKER (a); + Lisp_Object a = check_number_coerce_marker (args[0]); if (nargs == 1) { if (FIXNUMP (a)) @@ -2955,8 +2945,7 @@ usage: (* &rest NUMBERS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (1); - Lisp_Object a = args[0]; - CHECK_NUMBER_COERCE_MARKER (a); + Lisp_Object a = check_number_coerce_marker (args[0]); return nargs == 1 ? a : arith_driver (Amult, nargs, args, a); } @@ -2968,8 +2957,7 @@ The arguments must be numbers or markers. usage: (/ NUMBER &rest DIVISORS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object a = args[0]; - CHECK_NUMBER_COERCE_MARKER (a); + Lisp_Object a = check_number_coerce_marker (args[0]); if (nargs == 1) { if (FIXNUMP (a)) @@ -3051,10 +3039,10 @@ integer_remainder (Lisp_Object num, Lisp_Object den, bool modulo) DEFUN ("%", Frem, Srem, 2, 2, 0, doc: /* Return remainder of X divided by Y. Both must be integers or markers. */) - (register Lisp_Object x, Lisp_Object y) + (Lisp_Object x, Lisp_Object y) { - CHECK_INTEGER_COERCE_MARKER (x); - CHECK_INTEGER_COERCE_MARKER (y); + x = check_integer_coerce_marker (x); + y = check_integer_coerce_marker (y); return integer_remainder (x, y, false); } @@ -3064,8 +3052,8 @@ The result falls between zero (inclusive) and Y (exclusive). Both X and Y must be numbers or markers. */) (Lisp_Object x, Lisp_Object y) { - CHECK_NUMBER_COERCE_MARKER (x); - CHECK_NUMBER_COERCE_MARKER (y); + x = check_number_coerce_marker (x); + y = check_number_coerce_marker (y); if (FLOATP (x) || FLOATP (y)) return fmod_float (x, y); return integer_remainder (x, y, true); @@ -3075,12 +3063,10 @@ static Lisp_Object minmax_driver (ptrdiff_t nargs, Lisp_Object *args, enum Arith_Comparison comparison) { - Lisp_Object accum = args[0]; - CHECK_NUMBER_COERCE_MARKER (accum); + Lisp_Object accum = check_number_coerce_marker (args[0]); for (ptrdiff_t argnum = 1; argnum < nargs; argnum++) { - Lisp_Object val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); + Lisp_Object val = check_number_coerce_marker (args[argnum]); if (!NILP (arithcompare (val, accum, comparison))) accum = val; else if (FLOATP (val) && isnan (XFLOAT_DATA (val))) @@ -3115,8 +3101,7 @@ usage: (logand &rest INTS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (-1); - Lisp_Object a = args[0]; - CHECK_INTEGER_COERCE_MARKER (a); + Lisp_Object a = check_integer_coerce_marker (args[0]); return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a); } @@ -3128,8 +3113,7 @@ usage: (logior &rest INTS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (0); - Lisp_Object a = args[0]; - CHECK_INTEGER_COERCE_MARKER (a); + Lisp_Object a = check_integer_coerce_marker (args[0]); return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a); } @@ -3141,8 +3125,7 @@ usage: (logxor &rest INTS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (0); - Lisp_Object a = args[0]; - CHECK_INTEGER_COERCE_MARKER (a); + Lisp_Object a = check_integer_coerce_marker (args[0]); return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a); } @@ -3261,9 +3244,9 @@ expt_integer (Lisp_Object x, Lisp_Object y) DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, doc: /* Return NUMBER plus one. NUMBER may be a number or a marker. Markers are converted to integers. */) - (register Lisp_Object number) + (Lisp_Object number) { - CHECK_NUMBER_COERCE_MARKER (number); + number = check_number_coerce_marker (number); if (FIXNUMP (number)) return make_int (XFIXNUM (number) + 1); @@ -3276,9 +3259,9 @@ Markers are converted to integers. */) DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, doc: /* Return NUMBER minus one. NUMBER may be a number or a marker. Markers are converted to integers. */) - (register Lisp_Object number) + (Lisp_Object number) { - CHECK_NUMBER_COERCE_MARKER (number); + number = check_number_coerce_marker (number); if (FIXNUMP (number)) return make_int (XFIXNUM (number) - 1); @@ -3322,27 +3305,14 @@ bool_vector_spare_mask (EMACS_INT nr_bits) return (((bits_word) 1) << (nr_bits % BITS_PER_BITS_WORD)) - 1; } -/* Info about unsigned long long, falling back on unsigned long - if unsigned long long is not available. */ - -#if HAVE_UNSIGNED_LONG_LONG_INT && defined ULLONG_WIDTH -enum { ULL_WIDTH = ULLONG_WIDTH }; -# define ULL_MAX ULLONG_MAX -#else -enum { ULL_WIDTH = ULONG_WIDTH }; -# define ULL_MAX ULONG_MAX -# define count_one_bits_ll count_one_bits_l -# define count_trailing_zeros_ll count_trailing_zeros_l -#endif - /* Shift VAL right by the width of an unsigned long long. - ULL_WIDTH must be less than BITS_PER_BITS_WORD. */ + ULLONG_WIDTH must be less than BITS_PER_BITS_WORD. */ static bits_word shift_right_ull (bits_word w) { /* Pacify bogus GCC warning about shift count exceeding type width. */ - int shift = ULL_WIDTH - BITS_PER_BITS_WORD < 0 ? ULL_WIDTH : 0; + int shift = ULLONG_WIDTH - BITS_PER_BITS_WORD < 0 ? ULLONG_WIDTH : 0; return w >> shift; } @@ -3359,7 +3329,7 @@ count_one_bits_word (bits_word w) { int i = 0, count = 0; while (count += count_one_bits_ll (w), - (i += ULL_WIDTH) < BITS_PER_BITS_WORD) + (i += ULLONG_WIDTH) < BITS_PER_BITS_WORD) w = shift_right_ull (w); return count; } @@ -3490,7 +3460,7 @@ count_trailing_zero_bits (bits_word val) return count_trailing_zeros (val); if (BITS_WORD_MAX == ULONG_MAX) return count_trailing_zeros_l (val); - if (BITS_WORD_MAX == ULL_MAX) + if (BITS_WORD_MAX == ULLONG_MAX) return count_trailing_zeros_ll (val); /* The rest of this code is for the unlikely platform where bits_word differs @@ -3504,18 +3474,18 @@ count_trailing_zero_bits (bits_word val) { int count; for (count = 0; - count < BITS_PER_BITS_WORD - ULL_WIDTH; - count += ULL_WIDTH) + count < BITS_PER_BITS_WORD - ULLONG_WIDTH; + count += ULLONG_WIDTH) { - if (val & ULL_MAX) + if (val & ULLONG_MAX) return count + count_trailing_zeros_ll (val); val = shift_right_ull (val); } - if (BITS_PER_BITS_WORD % ULL_WIDTH != 0 + if (BITS_PER_BITS_WORD % ULLONG_WIDTH != 0 && BITS_WORD_MAX == (bits_word) -1) val |= (bits_word) 1 << pre_value (ULONG_MAX < BITS_WORD_MAX, - BITS_PER_BITS_WORD % ULL_WIDTH); + BITS_PER_BITS_WORD % ULLONG_WIDTH); return count + count_trailing_zeros_ll (val); } } @@ -3528,10 +3498,8 @@ bits_word_to_host_endian (bits_word val) #else if (BITS_WORD_MAX >> 31 == 1) return bswap_32 (val); -# if HAVE_UNSIGNED_LONG_LONG if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1) return bswap_64 (val); -# endif { int i; bits_word r = 0; 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 \ xftfont.o: xftfont.c dispextern.h xterm.h frame.h blockinput.h character.h \ charset.h font.h lisp.h globals.h $(config_h) atimer.h systime.h \ fontset.h ccl.h ftfont.h composite.h -ftxfont.o: ftxfont.c dispextern.h xterm.h frame.h blockinput.h character.h \ - charset.h font.h lisp.h globals.h $(config_h) atimer.h systime.h \ - fontset.h ccl.h menu.o: menu.c lisp.h keyboard.h keymap.h frame.h termhooks.h blockinput.h \ dispextern.h $(srcdir)/../lwlib/lwlib.h xterm.h gtkutil.h menu.h \ 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, int err = EINVAL; #if defined O_PATH && !defined HAVE_CYGWIN_O_PATH_BUG - int namefd = openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW); + int namefd = emacs_openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW, 0); if (namefd < 0) err = errno; else @@ -970,7 +970,7 @@ file_attributes (int fd, char const *name, information to be accurate. */ w32_stat_get_owner_group = 1; #endif - err = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno; + err = emacs_fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno; #ifdef WINDOWSNT w32_stat_get_owner_group = 0; #endif diff --git a/src/dispextern.h b/src/dispextern.h index 724aad4227e..0b1f3d14aeb 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -234,7 +234,7 @@ struct text_pos { \ ++(POS).charpos; \ if (MULTIBYTE_P) \ - INC_POS ((POS).bytepos); \ + (POS).bytepos += next_char_len ((POS).bytepos); \ else \ ++(POS).bytepos; \ } \ @@ -247,7 +247,7 @@ struct text_pos { \ --(POS).charpos; \ if (MULTIBYTE_P) \ - DEC_POS ((POS).bytepos); \ + (POS).bytepos -= prev_char_len ((POS).bytepos); \ else \ --(POS).bytepos; \ } \ @@ -369,7 +369,7 @@ enum glyph_type /* Glyph describes a character. */ CHAR_GLYPH, - /* Glyph describes a static composition. */ + /* Glyph describes a static or automatic composition. */ COMPOSITE_GLYPH, /* Glyph describes a glyphless character. */ @@ -1693,12 +1693,17 @@ struct face int fontset; /* Non-zero means characters in this face have a box of that - thickness around them. If this value is negative, its absolute - value indicates the thickness, and the horizontal (top and - bottom) borders of box are drawn inside of the character glyphs' - area. The vertical (left and right) borders of the box are drawn - in the same way as when this value is positive. */ - int box_line_width; + thickness around them. Vertical (left and right) and horizontal + (top and bottom) borders size can be set separatedly using an + associated list of two ints in the form + (vertical_size . horizontal_size). In case one of the value is + negative, its absolute value indicates the thickness, and the + borders of box are drawn inside of the character glyphs' area + potentially over the glyph itself but the glyph drawing size is + not increase. If a (signed) int N is use instead of a list, it + is the same as setting ( abs(N) . N ) values. */ + int box_vertical_line_width; + int box_horizontal_line_width; /* Type of box drawn. A value of FACE_NO_BOX means no box is drawn around text in this face. A value of FACE_SIMPLE_BOX means a box @@ -1850,20 +1855,6 @@ struct face_cache bool_bf menu_face_changed_p : 1; }; -/* Return a non-null pointer to the cached face with ID on frame F. */ - -#define FACE_FROM_ID(F, ID) \ - (eassert (UNSIGNED_CMP (ID, <, FRAME_FACE_CACHE (F)->used)), \ - FRAME_FACE_CACHE (F)->faces_by_id[ID]) - -/* Return a pointer to the face with ID on frame F, or null if such a - face doesn't exist. */ - -#define FACE_FROM_ID_OR_NULL(F, ID) \ - (UNSIGNED_CMP (ID, <, FRAME_FACE_CACHE (F)->used) \ - ? FRAME_FACE_CACHE (F)->faces_by_id[ID] \ - : NULL) - #define FACE_EXTENSIBLE_P(F) \ (!NILP (F->lface[LFACE_EXTEND_INDEX])) @@ -2782,7 +2773,8 @@ struct it else \ produce_glyphs ((IT)); \ if ((IT)->glyph_row != NULL) \ - inhibit_free_realized_faces = true; \ + inhibit_free_realized_faces =true; \ + reset_box_start_end_flags ((IT)); \ } while (false) /* Bit-flags indicating what operation move_it_to should perform. */ @@ -3157,21 +3149,6 @@ struct image_cache ptrdiff_t refcount; }; - -/* A non-null pointer to the image with id ID on frame F. */ - -#define IMAGE_FROM_ID(F, ID) \ - (eassert (UNSIGNED_CMP (ID, <, FRAME_IMAGE_CACHE (F)->used)), \ - FRAME_IMAGE_CACHE (F)->images[ID]) - -/* Value is a pointer to the image with id ID on frame F, or null if - no image with that id exists. */ - -#define IMAGE_OPT_FROM_ID(F, ID) \ - (UNSIGNED_CMP (ID, <, FRAME_IMAGE_CACHE (F)->used) \ - ? FRAME_IMAGE_CACHE (F)->images[ID] \ - : NULL) - /* Size of bucket vector of image caches. Should be prime. */ #define IMAGE_CACHE_BUCKETS_SIZE 1001 diff --git a/src/editfns.c b/src/editfns.c index fe1feaf1e77..763d95bb8fa 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -162,20 +162,14 @@ DEFUN ("byte-to-string", Fbyte_to_string, Sbyte_to_string, 1, 1, 0, DEFUN ("string-to-char", Fstring_to_char, Sstring_to_char, 1, 1, 0, doc: /* Return the first character in STRING. */) - (register Lisp_Object string) + (Lisp_Object string) { - register Lisp_Object val; CHECK_STRING (string); - if (SCHARS (string)) - { - if (STRING_MULTIBYTE (string)) - XSETFASTINT (val, STRING_CHAR (SDATA (string))); - else - XSETFASTINT (val, SREF (string, 0)); - } - else - XSETFASTINT (val, 0); - return val; + + /* This returns zero if STRING is empty. */ + return make_fixnum (STRING_MULTIBYTE (string) + ? STRING_CHAR (SDATA (string)) + : SREF (string, 0)); } DEFUN ("point", Fpoint, Spoint, 0, 0, 0, @@ -725,18 +719,23 @@ boundaries, bind `inhibit-field-text-motion' to t. This function does not move point. */) (Lisp_Object n) { - ptrdiff_t charpos, bytepos; + ptrdiff_t charpos, bytepos, count; if (NILP (n)) - XSETFASTINT (n, 1); + count = 0; + else if (FIXNUMP (n)) + count = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n) - 1, BUF_BYTES_MAX); else - CHECK_FIXNUM (n); + { + CHECK_INTEGER (n); + count = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX; + } - scan_newline_from_point (XFIXNUM (n) - 1, &charpos, &bytepos); + scan_newline_from_point (count, &charpos, &bytepos); /* Return END constrained to the current input field. */ return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT), - XFIXNUM (n) != 1 ? Qt : Qnil, + count != 0 ? Qt : Qnil, Qt, Qnil); } @@ -763,11 +762,14 @@ This function does not move point. */) ptrdiff_t orig = PT; if (NILP (n)) - XSETFASTINT (n, 1); + clipped_n = 1; + else if (FIXNUMP (n)) + clipped_n = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n), BUF_BYTES_MAX); else - CHECK_FIXNUM (n); - - clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XFIXNUM (n), PTRDIFF_MAX); + { + CHECK_INTEGER (n); + clipped_n = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX; + } end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0), NULL); @@ -940,10 +942,10 @@ DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0, If POSITION is out of range, the value is nil. */) (Lisp_Object position) { - CHECK_FIXNUM_COERCE_MARKER (position); - if (XFIXNUM (position) < BEG || XFIXNUM (position) > Z) + EMACS_INT pos = fix_position (position); + if (! (BEG <= pos && pos <= Z)) return Qnil; - return make_fixnum (CHAR_TO_BYTE (XFIXNUM (position))); + return make_fixnum (CHAR_TO_BYTE (pos)); } DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0, @@ -991,7 +993,7 @@ At the beginning of the buffer or accessible region, return 0. */) else if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) { ptrdiff_t pos = PT_BYTE; - DEC_POS (pos); + pos -= prev_char_len (pos); XSETFASTINT (temp, FETCH_CHAR (pos)); } else @@ -1060,11 +1062,11 @@ If POS is out of range, the value is nil. */) } else { - CHECK_FIXNUM_COERCE_MARKER (pos); - if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) >= ZV) + EMACS_INT p = fix_position (pos); + if (! (BEGV <= p && p < ZV)) return Qnil; - pos_byte = CHAR_TO_BYTE (XFIXNUM (pos)); + pos_byte = CHAR_TO_BYTE (p); } return make_fixnum (FETCH_CHAR (pos_byte)); @@ -1094,17 +1096,17 @@ If POS is out of range, the value is nil. */) } else { - CHECK_FIXNUM_COERCE_MARKER (pos); + EMACS_INT p = fix_position (pos); - if (XFIXNUM (pos) <= BEGV || XFIXNUM (pos) > ZV) + if (! (BEGV < p && p <= ZV)) return Qnil; - pos_byte = CHAR_TO_BYTE (XFIXNUM (pos)); + pos_byte = CHAR_TO_BYTE (p); } if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) { - DEC_POS (pos_byte); + pos_byte -= prev_char_len (pos_byte); XSETFASTINT (val, FETCH_CHAR (pos_byte)); } else @@ -1262,14 +1264,17 @@ name, or nil if there is no such user. */) if (q) { Lisp_Object login = Fuser_login_name (INT_TO_INTEGER (pw->pw_uid)); - USE_SAFE_ALLOCA; - char *r = SAFE_ALLOCA (strlen (p) + SBYTES (login) + 1); - memcpy (r, p, q - p); - char *s = lispstpcpy (&r[q - p], login); - r[q - p] = upcase ((unsigned char) r[q - p]); - strcpy (s, q + 1); - full = build_string (r); - SAFE_FREE (); + if (!NILP (login)) + { + USE_SAFE_ALLOCA; + char *r = SAFE_ALLOCA (strlen (p) + SBYTES (login) + 1); + memcpy (r, p, q - p); + char *s = lispstpcpy (&r[q - p], login); + r[q - p] = upcase ((unsigned char) r[q - p]); + strcpy (s, q + 1); + full = build_string (r); + SAFE_FREE (); + } } #endif /* AMPERSAND_FULL_NAME */ @@ -1538,7 +1543,7 @@ from adjoining text, if those properties are sticky. */) make_uninit_string, which can cause the buffer arena to be compacted. make_string has no way of knowing that the data has been moved, and thus copies the wrong data into the string. This - doesn't effect most of the other users of make_string, so it should + doesn't affect most of the other users of make_string, so it should be left as is. But we should use this function when conjuring buffer substrings. */ @@ -1715,21 +1720,8 @@ using `string-make-multibyte' or `string-make-unibyte', which see. */) if (!BUFFER_LIVE_P (bp)) error ("Selecting deleted buffer"); - if (NILP (start)) - b = BUF_BEGV (bp); - else - { - CHECK_FIXNUM_COERCE_MARKER (start); - b = XFIXNUM (start); - } - if (NILP (end)) - e = BUF_ZV (bp); - else - { - CHECK_FIXNUM_COERCE_MARKER (end); - e = XFIXNUM (end); - } - + b = !NILP (start) ? fix_position (start) : BUF_BEGV (bp); + e = !NILP (end) ? fix_position (end) : BUF_ZV (bp); if (b > e) temp = b, b = e, e = temp; @@ -1783,21 +1775,8 @@ determines whether case is significant or ignored. */) error ("Selecting deleted buffer"); } - if (NILP (start1)) - begp1 = BUF_BEGV (bp1); - else - { - CHECK_FIXNUM_COERCE_MARKER (start1); - begp1 = XFIXNUM (start1); - } - if (NILP (end1)) - endp1 = BUF_ZV (bp1); - else - { - CHECK_FIXNUM_COERCE_MARKER (end1); - endp1 = XFIXNUM (end1); - } - + begp1 = !NILP (start1) ? fix_position (start1) : BUF_BEGV (bp1); + endp1 = !NILP (end1) ? fix_position (end1) : BUF_ZV (bp1); if (begp1 > endp1) temp = begp1, begp1 = endp1, endp1 = temp; @@ -1821,21 +1800,8 @@ determines whether case is significant or ignored. */) error ("Selecting deleted buffer"); } - if (NILP (start2)) - begp2 = BUF_BEGV (bp2); - else - { - CHECK_FIXNUM_COERCE_MARKER (start2); - begp2 = XFIXNUM (start2); - } - if (NILP (end2)) - endp2 = BUF_ZV (bp2); - else - { - CHECK_FIXNUM_COERCE_MARKER (end2); - endp2 = XFIXNUM (end2); - } - + begp2 = !NILP (start2) ? fix_position (start2) : BUF_BEGV (bp2); + endp2 = !NILP (end2) ? fix_position (end2) : BUF_ZV (bp2); if (begp2 > endp2) temp = begp2, begp2 = endp2, endp2 = temp; @@ -1858,26 +1824,24 @@ determines whether case is significant or ignored. */) if (! NILP (BVAR (bp1, enable_multibyte_characters))) { c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); - BUF_INC_POS (bp1, i1_byte); + i1_byte += buf_next_char_len (bp1, i1_byte); i1++; } else { - c1 = BUF_FETCH_BYTE (bp1, i1); - MAKE_CHAR_MULTIBYTE (c1); + c1 = make_char_multibyte (BUF_FETCH_BYTE (bp1, i1)); i1++; } if (! NILP (BVAR (bp2, enable_multibyte_characters))) { c2 = BUF_FETCH_MULTIBYTE_CHAR (bp2, i2_byte); - BUF_INC_POS (bp2, i2_byte); + i2_byte += buf_next_char_len (bp2, i2_byte); i2++; } else { - c2 = BUF_FETCH_BYTE (bp2, i2); - MAKE_CHAR_MULTIBYTE (c2); + c2 = make_char_multibyte (BUF_FETCH_BYTE (bp2, i2)); i2++; } @@ -2332,7 +2296,7 @@ Both characters must have the same length of multi-byte form. */) } p = BYTE_POS_ADDR (pos_byte); if (multibyte_p) - INC_POS (pos_byte_next); + pos_byte_next += next_char_len (pos_byte_next); else ++pos_byte_next; if (pos_byte_next - pos_byte == len @@ -2393,7 +2357,7 @@ Both characters must have the same length of multi-byte form. */) decrease it now. */ pos--; else - INC_POS (pos_byte_next); + pos_byte_next += next_char_len (pos_byte_next); if (! NILP (noundo)) bset_undo_list (current_buffer, tem); @@ -2470,7 +2434,7 @@ check_translation (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t end, memcpy (bufalloc, buf, sizeof initial_buf); buf = bufalloc; } - buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, len1); + buf[buf_used++] = string_char_and_length (p, &len1); pos_byte += len1; } if (XFIXNUM (AREF (elt, i)) != buf[i]) @@ -2529,13 +2493,13 @@ It returns the number of characters changed. */) int len, oc; if (multibyte) - oc = STRING_CHAR_AND_LENGTH (p, len); + oc = string_char_and_length (p, &len); else oc = *p, len = 1; if (oc < translatable_chars) { int nc; /* New character. */ - int str_len; + int str_len UNINIT; Lisp_Object val; if (STRINGP (table)) @@ -2546,7 +2510,7 @@ It returns the number of characters changed. */) if (string_multibyte) { str = tt + string_char_to_byte (table, oc); - nc = STRING_CHAR_AND_LENGTH (str, str_len); + nc = string_char_and_length (str, &str_len); } else { @@ -2689,29 +2653,27 @@ See also `save-restriction'. When calling from Lisp, pass two arguments START and END: positions (integers or markers) bounding the text that should remain visible. */) - (register Lisp_Object start, Lisp_Object end) + (Lisp_Object start, Lisp_Object end) { - CHECK_FIXNUM_COERCE_MARKER (start); - CHECK_FIXNUM_COERCE_MARKER (end); + EMACS_INT s = fix_position (start), e = fix_position (end); - if (XFIXNUM (start) > XFIXNUM (end)) + if (e < s) { - Lisp_Object tem; - tem = start; start = end; end = tem; + EMACS_INT tem = s; s = e; e = tem; } - if (!(BEG <= XFIXNUM (start) && XFIXNUM (start) <= XFIXNUM (end) && XFIXNUM (end) <= Z)) + if (!(BEG <= s && s <= e && e <= Z)) args_out_of_range (start, end); - if (BEGV != XFIXNAT (start) || ZV != XFIXNAT (end)) + if (BEGV != s || ZV != e) current_buffer->clip_changed = 1; - SET_BUF_BEGV (current_buffer, XFIXNAT (start)); - SET_BUF_ZV (current_buffer, XFIXNAT (end)); - if (PT < XFIXNAT (start)) - SET_PT (XFIXNAT (start)); - if (PT > XFIXNAT (end)) - SET_PT (XFIXNAT (end)); + SET_BUF_BEGV (current_buffer, s); + SET_BUF_ZV (current_buffer, e); + if (PT < s) + SET_PT (s); + if (e < PT) + SET_PT (e); /* Changing the buffer bounds invalidates any recorded current column. */ invalidate_current_column (); return Qnil; diff --git a/src/emacs-module.c b/src/emacs-module.c index 911b82b8a1a..3d1827c7dad 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -88,6 +88,7 @@ To add a new module function, proceed as follows: #include "dynlib.h" #include "coding.h" #include "keyboard.h" +#include "process.h" #include "syssignal.h" #include "sysstdio.h" #include "thread.h" @@ -122,12 +123,6 @@ To add a new module function, proceed as follows: /* Function prototype for the module init function. */ typedef int (*emacs_init_function) (struct emacs_runtime *); -/* Function prototype for module user-pointer finalizers. These - should not throw C++ exceptions, so emacs-module.h declares the - corresponding interfaces with EMACS_NOEXCEPT. There is only C code - in this module, though, so this constraint is not enforced here. */ -typedef void (*emacs_finalizer_function) (void *); - /* Memory management. */ @@ -219,6 +214,25 @@ static bool value_storage_contains_p (const struct emacs_value_storage *, static bool module_assertions = false; + +/* Small helper functions. */ + +/* Interprets the string at STR with length LEN as UTF-8 string. + Signals an error if it's not a valid UTF-8 string. */ + +static Lisp_Object +module_decode_utf_8 (const char *str, ptrdiff_t len) +{ + /* We set HANDLE-8-BIT and HANDLE-OVER-UNI to nil to signal an error + if the argument is not a valid UTF-8 string. While it isn't + documented how make_string and make_function behave in this case, + signaling an error is the most defensive and obvious reaction. */ + Lisp_Object s = decode_string_utf_8 (Qnil, str, len, Qnil, false, Qnil, Qnil); + CHECK_TYPE (!NILP (s), Qutf_8_string_p, make_string_from_utf8 (str, len)); + return s; +} + + /* Convenience macros for non-local exit handling. */ /* FIXME: The following implementation for non-local exit handling @@ -234,7 +248,7 @@ static bool module_assertions = false; of `internal_condition_case' etc., and to avoid worrying about passing information to the handler functions. */ -#if !__has_attribute (cleanup) +#if !HAS_ATTRIBUTE (cleanup) #error "__attribute__ ((cleanup)) not supported by this compiler; try GCC" #endif @@ -333,6 +347,12 @@ static bool module_assertions = false; MODULE_HANDLE_NONLOCAL_EXIT (error_retval) static void +CHECK_MODULE_FUNCTION (Lisp_Object obj) +{ + CHECK_TYPE (MODULE_FUNCTIONP (obj), Qmodule_function_p, obj); +} + +static void CHECK_USER_PTR (Lisp_Object obj) { CHECK_TYPE (USER_PTRP (obj), Quser_ptrp, obj); @@ -343,11 +363,11 @@ CHECK_USER_PTR (Lisp_Object obj) the Emacs main thread. */ static emacs_env * -module_get_environment (struct emacs_runtime *ert) +module_get_environment (struct emacs_runtime *runtime) { module_assert_thread (); - module_assert_runtime (ert); - return ert->private_members->env; + module_assert_runtime (runtime); + return runtime->private_members->env; } /* To make global refs (GC-protected global values) keep a hash that @@ -356,11 +376,11 @@ module_get_environment (struct emacs_runtime *ert) static Lisp_Object Vmodule_refs_hash; static emacs_value -module_make_global_ref (emacs_env *env, emacs_value ref) +module_make_global_ref (emacs_env *env, emacs_value value) { MODULE_FUNCTION_BEGIN (NULL); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); - Lisp_Object new_obj = value_to_lisp (ref), hashcode; + Lisp_Object new_obj = value_to_lisp (value), hashcode; ptrdiff_t i = hash_lookup (h, new_obj, &hashcode); if (i >= 0) @@ -381,14 +401,14 @@ module_make_global_ref (emacs_env *env, emacs_value ref) } static void -module_free_global_ref (emacs_env *env, emacs_value ref) +module_free_global_ref (emacs_env *env, emacs_value global_value) { /* TODO: This probably never signals. */ /* FIXME: Wait a minute. Shouldn't this function report an error if the hash lookup fails? */ MODULE_FUNCTION_BEGIN (); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); - Lisp_Object obj = value_to_lisp (ref); + Lisp_Object obj = value_to_lisp (global_value); ptrdiff_t i = hash_lookup (h, obj, NULL); if (i >= 0) @@ -406,7 +426,7 @@ module_free_global_ref (emacs_env *env, emacs_value ref) if (module_assertions) { ptrdiff_t count = 0; - if (value_storage_contains_p (&global_storage, ref, &count)) + if (value_storage_contains_p (&global_storage, global_value, &count)) return; module_abort ("Global value was not found in list of %"pD"d globals", count); @@ -430,14 +450,15 @@ module_non_local_exit_clear (emacs_env *env) } static enum emacs_funcall_exit -module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) +module_non_local_exit_get (emacs_env *env, + emacs_value *symbol, emacs_value *data) { module_assert_thread (); module_assert_env (env); struct emacs_env_private *p = env->private_members; if (p->pending_non_local_exit != emacs_funcall_exit_return) { - *sym = &p->non_local_exit_symbol; + *symbol = &p->non_local_exit_symbol; *data = &p->non_local_exit_data; } return p->pending_non_local_exit; @@ -445,12 +466,13 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) /* Like for `signal', DATA must be a list. */ static void -module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data) +module_non_local_exit_signal (emacs_env *env, + emacs_value symbol, emacs_value data) { module_assert_thread (); module_assert_env (env); if (module_non_local_exit_check (env) == emacs_funcall_exit_return) - module_non_local_exit_signal_1 (env, value_to_lisp (sym), + module_non_local_exit_signal_1 (env, value_to_lisp (symbol), value_to_lisp (data)); } @@ -464,10 +486,6 @@ module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value) value_to_lisp (value)); } -/* Function prototype for the module Lisp functions. */ -typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t, - emacs_value [], void *); - /* Module function. */ /* A function environment is an auxiliary structure returned by @@ -484,8 +502,9 @@ struct Lisp_Module_Function /* Fields ignored by GC. */ ptrdiff_t min_arity, max_arity; - emacs_subr subr; + emacs_function subr; void *data; + emacs_finalizer finalizer; } GCALIGNED_STRUCT; static struct Lisp_Module_Function * @@ -503,8 +522,7 @@ allocate_module_function (void) static emacs_value module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, - emacs_subr subr, const char *documentation, - void *data) + emacs_function func, const char *docstring, void *data) { MODULE_FUNCTION_BEGIN (NULL); @@ -518,11 +536,13 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, struct Lisp_Module_Function *function = allocate_module_function (); function->min_arity = min_arity; function->max_arity = max_arity; - function->subr = subr; + function->subr = func; function->data = data; + function->finalizer = NULL; - if (documentation) - function->documentation = build_string_from_utf8 (documentation); + if (docstring) + function->documentation + = module_decode_utf_8 (docstring, strlen (docstring)); Lisp_Object result; XSET_MODULE_FUNCTION (result, function); @@ -531,9 +551,35 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, return lisp_to_value (env, result); } +static emacs_finalizer +module_get_function_finalizer (emacs_env *env, emacs_value arg) +{ + MODULE_FUNCTION_BEGIN (NULL); + Lisp_Object lisp = value_to_lisp (arg); + CHECK_MODULE_FUNCTION (lisp); + return XMODULE_FUNCTION (lisp)->finalizer; +} + +static void +module_set_function_finalizer (emacs_env *env, emacs_value arg, + emacs_finalizer fin) +{ + MODULE_FUNCTION_BEGIN (); + Lisp_Object lisp = value_to_lisp (arg); + CHECK_MODULE_FUNCTION (lisp); + XMODULE_FUNCTION (lisp)->finalizer = fin; +} + +void +module_finalize_function (const struct Lisp_Module_Function *func) +{ + if (func->finalizer != NULL) + func->finalizer (func->data); +} + static emacs_value -module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, - emacs_value args[]) +module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs, + emacs_value *args) { MODULE_FUNCTION_BEGIN (NULL); @@ -545,7 +591,7 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, if (INT_ADD_WRAPV (nargs, 1, &nargs1)) overflow_error (); SAFE_ALLOCA_LISP (newargs, nargs1); - newargs[0] = value_to_lisp (fun); + newargs[0] = value_to_lisp (func); for (ptrdiff_t i = 0; i < nargs; i++) newargs[1 + i] = value_to_lisp (args[i]); emacs_value result = lisp_to_value (env, Ffuncall (nargs1, newargs)); @@ -561,17 +607,17 @@ module_intern (emacs_env *env, const char *name) } static emacs_value -module_type_of (emacs_env *env, emacs_value value) +module_type_of (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN (NULL); - return lisp_to_value (env, Ftype_of (value_to_lisp (value))); + return lisp_to_value (env, Ftype_of (value_to_lisp (arg))); } static bool -module_is_not_nil (emacs_env *env, emacs_value value) +module_is_not_nil (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN_NO_CATCH (false); - return ! NILP (value_to_lisp (value)); + return ! NILP (value_to_lisp (arg)); } static bool @@ -582,14 +628,14 @@ module_eq (emacs_env *env, emacs_value a, emacs_value b) } static intmax_t -module_extract_integer (emacs_env *env, emacs_value n) +module_extract_integer (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN (0); - Lisp_Object l = value_to_lisp (n); - CHECK_INTEGER (l); + Lisp_Object lisp = value_to_lisp (arg); + CHECK_INTEGER (lisp); intmax_t i; - if (! integer_to_intmax (l, &i)) - xsignal1 (Qoverflow_error, l); + if (! integer_to_intmax (lisp, &i)) + xsignal1 (Qoverflow_error, lisp); return i; } @@ -601,10 +647,10 @@ module_make_integer (emacs_env *env, intmax_t n) } static double -module_extract_float (emacs_env *env, emacs_value f) +module_extract_float (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN (0); - Lisp_Object lisp = value_to_lisp (f); + Lisp_Object lisp = value_to_lisp (arg); CHECK_TYPE (FLOATP (lisp), Qfloatp, lisp); return XFLOAT_DATA (lisp); } @@ -617,8 +663,8 @@ module_make_float (emacs_env *env, double d) } static bool -module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, - ptrdiff_t *length) +module_copy_string_contents (emacs_env *env, emacs_value value, char *buf, + ptrdiff_t *len) { MODULE_FUNCTION_BEGIN (false); Lisp_Object lisp_str = value_to_lisp (value); @@ -642,77 +688,77 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, ptrdiff_t raw_size = SBYTES (lisp_str_utf8); ptrdiff_t required_buf_size = raw_size + 1; - if (buffer == NULL) + if (buf == NULL) { - *length = required_buf_size; + *len = required_buf_size; return true; } - if (*length < required_buf_size) + if (*len < required_buf_size) { - ptrdiff_t actual = *length; - *length = required_buf_size; + ptrdiff_t actual = *len; + *len = required_buf_size; args_out_of_range_3 (INT_TO_INTEGER (actual), INT_TO_INTEGER (required_buf_size), INT_TO_INTEGER (PTRDIFF_MAX)); } - *length = required_buf_size; - memcpy (buffer, SDATA (lisp_str_utf8), raw_size + 1); + *len = required_buf_size; + memcpy (buf, SDATA (lisp_str_utf8), raw_size + 1); return true; } static emacs_value -module_make_string (emacs_env *env, const char *str, ptrdiff_t length) +module_make_string (emacs_env *env, const char *str, ptrdiff_t len) { MODULE_FUNCTION_BEGIN (NULL); - if (! (0 <= length && length <= STRING_BYTES_BOUND)) + if (! (0 <= len && len <= STRING_BYTES_BOUND)) overflow_error (); - Lisp_Object lstr = make_string_from_utf8 (str, length); + Lisp_Object lstr = module_decode_utf_8 (str, len); return lisp_to_value (env, lstr); } static emacs_value -module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) +module_make_user_ptr (emacs_env *env, emacs_finalizer fin, void *ptr) { MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, make_user_ptr (fin, ptr)); } static void * -module_get_user_ptr (emacs_env *env, emacs_value uptr) +module_get_user_ptr (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN (NULL); - Lisp_Object lisp = value_to_lisp (uptr); + Lisp_Object lisp = value_to_lisp (arg); CHECK_USER_PTR (lisp); return XUSER_PTR (lisp)->p; } static void -module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr) +module_set_user_ptr (emacs_env *env, emacs_value arg, void *ptr) { MODULE_FUNCTION_BEGIN (); - Lisp_Object lisp = value_to_lisp (uptr); + Lisp_Object lisp = value_to_lisp (arg); CHECK_USER_PTR (lisp); XUSER_PTR (lisp)->p = ptr; } -static emacs_finalizer_function -module_get_user_finalizer (emacs_env *env, emacs_value uptr) +static emacs_finalizer +module_get_user_finalizer (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN (NULL); - Lisp_Object lisp = value_to_lisp (uptr); + Lisp_Object lisp = value_to_lisp (arg); CHECK_USER_PTR (lisp); return XUSER_PTR (lisp)->finalizer; } static void -module_set_user_finalizer (emacs_env *env, emacs_value uptr, - emacs_finalizer_function fin) +module_set_user_finalizer (emacs_env *env, emacs_value arg, + emacs_finalizer fin) { MODULE_FUNCTION_BEGIN (); - Lisp_Object lisp = value_to_lisp (uptr); + Lisp_Object lisp = value_to_lisp (arg); CHECK_USER_PTR (lisp); XUSER_PTR (lisp)->finalizer = fin; } @@ -727,30 +773,31 @@ check_vec_index (Lisp_Object lvec, ptrdiff_t i) } static void -module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) +module_vec_set (emacs_env *env, emacs_value vector, ptrdiff_t index, + emacs_value value) { MODULE_FUNCTION_BEGIN (); - Lisp_Object lvec = value_to_lisp (vec); - check_vec_index (lvec, i); - ASET (lvec, i, value_to_lisp (val)); + Lisp_Object lisp = value_to_lisp (vector); + check_vec_index (lisp, index); + ASET (lisp, index, value_to_lisp (value)); } static emacs_value -module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) +module_vec_get (emacs_env *env, emacs_value vector, ptrdiff_t index) { MODULE_FUNCTION_BEGIN (NULL); - Lisp_Object lvec = value_to_lisp (vec); - check_vec_index (lvec, i); - return lisp_to_value (env, AREF (lvec, i)); + Lisp_Object lisp = value_to_lisp (vector); + check_vec_index (lisp, index); + return lisp_to_value (env, AREF (lisp, index)); } static ptrdiff_t -module_vec_size (emacs_env *env, emacs_value vec) +module_vec_size (emacs_env *env, emacs_value vector) { MODULE_FUNCTION_BEGIN (0); - Lisp_Object lvec = value_to_lisp (vec); - CHECK_VECTOR (lvec); - return ASIZE (lvec); + Lisp_Object lisp = value_to_lisp (vector); + CHECK_VECTOR (lisp); + return ASIZE (lisp); } /* This function should return true if and only if maybe_quit would @@ -771,10 +818,10 @@ module_process_input (emacs_env *env) } static struct timespec -module_extract_time (emacs_env *env, emacs_value value) +module_extract_time (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN ((struct timespec) {0}); - return lisp_time_argument (value_to_lisp (value)); + return lisp_time_argument (value_to_lisp (arg)); } static emacs_value @@ -931,6 +978,13 @@ module_make_big_integer (emacs_env *env, int sign, return lisp_to_value (env, make_integer_mpz ()); } +static int +module_open_channel (emacs_env *env, emacs_value pipe_process) +{ + MODULE_FUNCTION_BEGIN (-1); + return open_channel_for_module (value_to_lisp (pipe_process)); +} + /* Subroutines. */ @@ -1072,6 +1126,12 @@ module_function_address (const struct Lisp_Module_Function *function) return (module_funcptr) function->subr; } +void * +module_function_data (const struct Lisp_Module_Function *function) +{ + return function->data; +} + /* Helper functions. */ @@ -1088,14 +1148,14 @@ module_assert_thread (void) } static void -module_assert_runtime (struct emacs_runtime *ert) +module_assert_runtime (struct emacs_runtime *runtime) { if (! module_assertions) return; ptrdiff_t count = 0; for (Lisp_Object tail = Vmodule_runtimes; CONSP (tail); tail = XCDR (tail)) { - if (xmint_pointer (XCAR (tail)) == ert) + if (xmint_pointer (XCAR (tail)) == runtime) return; ++count; } @@ -1337,6 +1397,9 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env->make_time = module_make_time; env->extract_big_integer = module_extract_big_integer; env->make_big_integer = module_make_big_integer; + env->get_function_finalizer = module_get_function_finalizer; + env->set_function_finalizer = module_set_function_finalizer; + env->open_channel = module_open_channel; Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); return env; } diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index 898021dc5e6..6a39d507c84 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -42,10 +42,20 @@ information how to write modules and use this header file. # define EMACS_NOEXCEPT #endif -#ifdef __has_attribute -#if __has_attribute(__nonnull__) -# define EMACS_ATTRIBUTE_NONNULL(...) __attribute__((__nonnull__(__VA_ARGS__))) +#if defined __cplusplus && __cplusplus >= 201703L +# define EMACS_NOEXCEPT_TYPEDEF noexcept +#else +# define EMACS_NOEXCEPT_TYPEDEF #endif + +#if 3 < __GNUC__ + (3 <= __GNUC_MINOR__) +# define EMACS_ATTRIBUTE_NONNULL(...) \ + __attribute__ ((__nonnull__ (__VA_ARGS__))) +#elif defined __has_attribute +# if __has_attribute (__nonnull__) +# define EMACS_ATTRIBUTE_NONNULL(...) \ + __attribute__ ((__nonnull__ (__VA_ARGS__))) +# endif #endif #ifndef EMACS_ATTRIBUTE_NONNULL # define EMACS_ATTRIBUTE_NONNULL(...) @@ -56,7 +66,7 @@ extern "C" { #endif /* Current environment. */ -typedef struct emacs_env_27 emacs_env; +typedef struct emacs_env_@emacs_major_version@ emacs_env; /* Opaque pointer representing an Emacs Lisp value. BEWARE: Do not assume NULL is a valid value! */ @@ -74,10 +84,25 @@ struct emacs_runtime struct emacs_runtime_private *private_members; /* Return an environment pointer. */ - emacs_env *(*get_environment) (struct emacs_runtime *ert) - EMACS_ATTRIBUTE_NONNULL(1); + emacs_env *(*get_environment) (struct emacs_runtime *runtime) + EMACS_ATTRIBUTE_NONNULL (1); }; +/* Type aliases for function pointer types used in the module API. + Note that we don't use these aliases directly in the API to be able + to mark the function arguments as 'noexcept' before C++20. + However, users can use them if they want. */ + +/* Function prototype for the module Lisp functions. These must not + throw C++ exceptions. */ +typedef emacs_value (*emacs_function) (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, + void *data) + EMACS_NOEXCEPT_TYPEDEF EMACS_ATTRIBUTE_NONNULL (1); + +/* Function prototype for module user-pointer and function finalizers. + These must not throw C++ exceptions. */ +typedef void (*emacs_finalizer) (void *data) EMACS_NOEXCEPT_TYPEDEF; /* Possible Emacs function call outcomes. */ enum emacs_funcall_exit @@ -131,10 +156,21 @@ struct emacs_env_27 @module_env_snippet_27@ }; +struct emacs_env_28 +{ +@module_env_snippet_25@ + +@module_env_snippet_26@ + +@module_env_snippet_27@ + +@module_env_snippet_28@ +}; + /* Every module should define a function as follows. */ -extern int emacs_module_init (struct emacs_runtime *ert) +extern int emacs_module_init (struct emacs_runtime *runtime) EMACS_NOEXCEPT - EMACS_ATTRIBUTE_NONNULL(1); + EMACS_ATTRIBUTE_NONNULL (1); #ifdef __cplusplus } diff --git a/src/emacs.c b/src/emacs.c index c5a760d29f6..ea9c4cd79dc 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -930,7 +930,6 @@ main (int argc, char **argv) for pointers. */ void *stack_bottom_variable; - bool do_initial_setlocale; bool no_loadup = false; char *junk = 0; char *dname_arg = 0; @@ -1235,19 +1234,21 @@ main (int argc, char **argv) set_binary_mode (STDOUT_FILENO, O_BINARY); #endif /* MSDOS */ - /* Skip initial setlocale if LC_ALL is "C", as it's not needed in that case. - The build procedure uses this while dumping, to ensure that the - dumped Emacs does not have its system locale tables initialized, - as that might cause screwups when the dumped Emacs starts up. */ - { - char *lc_all = getenv ("LC_ALL"); - do_initial_setlocale = ! lc_all || strcmp (lc_all, "C"); - } - - /* Set locale now, so that initial error messages are localized properly. - fixup_locale must wait until later, since it builds strings. */ - if (do_initial_setlocale) - setlocale (LC_ALL, ""); + /* Set locale, so that initial error messages are localized properly. + However, skip this if LC_ALL is "C", as it's not needed in that case. + Skipping helps if dumping with unexec, to ensure that the dumped + Emacs does not have its system locale tables initialized, as that + might cause screwups when the dumped Emacs starts up. */ + char *lc_all = getenv ("LC_ALL"); + if (! (lc_all && strcmp (lc_all, "C") == 0)) + { + #ifdef HAVE_NS + ns_pool = ns_alloc_autorelease_pool (); + ns_init_locale (); + #endif + setlocale (LC_ALL, ""); + fixup_locale (); + } text_quoting_flag = using_utf8 (); inhibit_window_system = 0; @@ -1576,14 +1577,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_alloc (); init_bignum (); init_threads (); - - if (do_initial_setlocale) - { - fixup_locale (); - Vsystem_messages_locale = Vprevious_system_messages_locale; - Vsystem_time_locale = Vprevious_system_time_locale; - } - init_eval (); init_atimer (); running_asynch_code = 0; @@ -1620,12 +1613,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #endif #ifdef HAVE_NS - ns_pool = ns_alloc_autorelease_pool (); -#ifdef NS_IMPL_GNUSTEP - /* GNUstep stupidly resets our locale settings after we made them. */ - fixup_locale (); -#endif - if (!noninteractive) { #ifdef NS_IMPL_COCOA @@ -1735,11 +1722,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem globals_of_gfilenotify (); #endif -#ifdef HAVE_NS - /* Initialize the locale from user defaults. */ - ns_init_locale (); -#endif - /* Initialize and GC-protect Vinitial_environment and Vprocess_environment before set_initial_environment fills them in. */ @@ -1982,7 +1964,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem /* This calls putenv and so must precede init_process_emacs. */ init_timefns (); - /* This sets Voperating_system_release, which init_process_emacs uses. */ init_editfns (); /* These two call putenv. */ @@ -2617,25 +2598,25 @@ synchronize_locale (int category, Lisp_Object *plocale, Lisp_Object desired_loca if (! EQ (*plocale, desired_locale)) { *plocale = desired_locale; -#ifdef WINDOWSNT + char const *locale_string + = STRINGP (desired_locale) ? SSDATA (desired_locale) : ""; +# ifdef WINDOWSNT /* Changing categories like LC_TIME usually requires specifying an encoding suitable for the new locale, but MS-Windows's 'setlocale' will only switch the encoding when LC_ALL is specified. So we ignore CATEGORY, use LC_ALL instead, and then restore LC_NUMERIC to "C", so reading and printing numbers is unaffected. */ - setlocale (LC_ALL, (STRINGP (desired_locale) - ? SSDATA (desired_locale) - : "")); + setlocale (LC_ALL, locale_string); fixup_locale (); -#else /* !WINDOWSNT */ - setlocale (category, (STRINGP (desired_locale) - ? SSDATA (desired_locale) - : "")); -#endif /* !WINDOWSNT */ +# else /* !WINDOWSNT */ + setlocale (category, locale_string); +# endif /* !WINDOWSNT */ } } +static Lisp_Object Vprevious_system_time_locale; + /* Set system time locale to match Vsystem_time_locale, if possible. */ void synchronize_system_time_locale (void) @@ -2644,15 +2625,19 @@ synchronize_system_time_locale (void) Vsystem_time_locale); } +# ifdef LC_MESSAGES +static Lisp_Object Vprevious_system_messages_locale; +# endif + /* Set system messages locale to match Vsystem_messages_locale, if possible. */ void synchronize_system_messages_locale (void) { -#ifdef LC_MESSAGES +# ifdef LC_MESSAGES synchronize_locale (LC_MESSAGES, &Vprevious_system_messages_locale, Vsystem_messages_locale); -#endif +# endif } #endif /* HAVE_SETLOCALE */ @@ -2974,19 +2959,16 @@ build directory. */); DEFVAR_LISP ("system-messages-locale", Vsystem_messages_locale, doc: /* System locale for messages. */); Vsystem_messages_locale = Qnil; - - DEFVAR_LISP ("previous-system-messages-locale", - Vprevious_system_messages_locale, - doc: /* Most recently used system locale for messages. */); +#ifdef LC_MESSAGES Vprevious_system_messages_locale = Qnil; + staticpro (&Vprevious_system_messages_locale); +#endif DEFVAR_LISP ("system-time-locale", Vsystem_time_locale, doc: /* System locale for time. */); Vsystem_time_locale = Qnil; - - DEFVAR_LISP ("previous-system-time-locale", Vprevious_system_time_locale, - doc: /* Most recently used system locale for time. */); Vprevious_system_time_locale = Qnil; + staticpro (&Vprevious_system_time_locale); DEFVAR_LISP ("before-init-time", Vbefore_init_time, doc: /* Value of `current-time' before Emacs begins initialization. */); diff --git a/src/fileio.c b/src/fileio.c index 482f88627a5..2f1d2f82433 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -96,7 +96,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <acl.h> #include <allocator.h> #include <careadlinkat.h> -#include <dosname.h> +#include <filename.h> #include <fsusage.h> #include <stat-time.h> #include <tempname.h> @@ -1952,7 +1952,10 @@ barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist, encoded_filename = ENCODE_FILE (absname); - if (! known_to_exist && lstat (SSDATA (encoded_filename), &statbuf) == 0) + if (! known_to_exist + && (emacs_fstatat (AT_FDCWD, SSDATA (encoded_filename), + &statbuf, AT_SYMLINK_NOFOLLOW) + == 0)) { if (S_ISDIR (statbuf.st_mode)) xsignal2 (Qfile_error, @@ -2074,7 +2077,7 @@ permissions. */) report_file_error ("Copying permissions from", file); case -3: xsignal2 (Qfile_date_error, - build_string ("Resetting file times"), newname); + build_string ("Cannot set file date"), newname); case -4: report_file_error ("Copying permissions to", newname); } @@ -2250,9 +2253,8 @@ permissions. */) if (!NILP (keep_time)) { - struct timespec atime = get_stat_atime (&st); - struct timespec mtime = get_stat_mtime (&st); - if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime) != 0) + struct timespec ts[] = { get_stat_atime (&st), get_stat_mtime (&st) }; + if (futimens (ofd, ts) != 0) xsignal2 (Qfile_date_error, build_string ("Cannot set file date"), newname); } @@ -2555,7 +2557,9 @@ This is what happens in interactive use with M-x. */) bool dirp = !NILP (Fdirectory_name_p (file)); if (!dirp) { - if (lstat (SSDATA (encoded_file), &file_st) != 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (encoded_file), + &file_st, AT_SYMLINK_NOFOLLOW) + != 0) report_file_error ("Renaming", list2 (file, newname)); dirp = S_ISDIR (file_st.st_mode) != 0; } @@ -2928,7 +2932,8 @@ file_directory_p (Lisp_Object file) #else # ifdef O_PATH /* Use O_PATH if available, as it avoids races and EOVERFLOW issues. */ - int fd = openat (AT_FDCWD, SSDATA (file), O_PATH | O_CLOEXEC | O_DIRECTORY); + int fd = emacs_openat (AT_FDCWD, SSDATA (file), + O_PATH | O_CLOEXEC | O_DIRECTORY, 0); if (0 <= fd) { emacs_close (fd); @@ -2939,9 +2944,9 @@ file_directory_p (Lisp_Object file) /* O_PATH is defined but evidently this Linux kernel predates 2.6.39. Fall back on generic POSIX code. */ # endif - /* Use file_accessible_directory_p, as it avoids stat EOVERFLOW + /* Use file_accessible_directory_p, as it avoids fstatat EOVERFLOW problems and could be cheaper. However, if it fails because FILE - is inaccessible, fall back on stat; if the latter fails with + is inaccessible, fall back on fstatat; if the latter fails with EOVERFLOW then FILE must have been a directory unless a race condition occurred (a problem hard to work around portably). */ if (file_accessible_directory_p (file)) @@ -2949,7 +2954,7 @@ file_directory_p (Lisp_Object file) if (errno != EACCES) return false; struct stat st; - if (stat (SSDATA (file), &st) != 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (file), &st, 0) != 0) return errno == EOVERFLOW; if (S_ISDIR (st.st_mode)) return true; @@ -3080,7 +3085,7 @@ See `file-symlink-p' to distinguish symlinks. */) Vw32_get_true_file_attributes = Qt; #endif - int stat_result = stat (SSDATA (absname), &st); + int stat_result = emacs_fstatat (AT_FDCWD, SSDATA (absname), &st, 0); #ifdef WINDOWSNT Vw32_get_true_file_attributes = true_attributes; @@ -3326,50 +3331,60 @@ support. */) return Qnil; } -DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, +static int +symlink_nofollow_flag (Lisp_Object flag) +{ + /* For now, treat all non-nil FLAGs like 'nofollow'. */ + return !NILP (flag) ? AT_SYMLINK_NOFOLLOW : 0; +} + +DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 2, 0, doc: /* Return mode bits of file named FILENAME, as an integer. -Return nil if FILENAME does not exist. */) - (Lisp_Object filename) +Return nil if FILENAME does not exist. If optional FLAG is `nofollow', +do not follow FILENAME if it is a symbolic link. */) + (Lisp_Object filename, Lisp_Object flag) { struct stat st; + int nofollow = symlink_nofollow_flag (flag); Lisp_Object absname = expand_and_dir_to_file (filename); /* If the file name has special constructs in it, call the corresponding file name handler. */ Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_modes); if (!NILP (handler)) - return call2 (handler, Qfile_modes, absname); + return call3 (handler, Qfile_modes, absname, flag); - if (stat (SSDATA (ENCODE_FILE (absname)), &st) != 0) + char *fname = SSDATA (ENCODE_FILE (absname)); + if (emacs_fstatat (AT_FDCWD, fname, &st, nofollow) != 0) return file_attribute_errno (absname, errno); return make_fixnum (st.st_mode & 07777); } -DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, +DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 3, "(let ((file (read-file-name \"File: \"))) \ (list file (read-file-modes nil file)))", doc: /* Set mode bits of file named FILENAME to MODE (an integer). -Only the 12 low bits of MODE are used. +Only the 12 low bits of MODE are used. If optional FLAG is `nofollow', +do not follow FILENAME if it is a symbolic link. Interactively, mode bits are read by `read-file-modes', which accepts symbolic notation, like the `chmod' command from GNU Coreutils. */) - (Lisp_Object filename, Lisp_Object mode) + (Lisp_Object filename, Lisp_Object mode, Lisp_Object flag) { - Lisp_Object absname, encoded_absname; - Lisp_Object handler; - - absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); CHECK_FIXNUM (mode); + int nofollow = symlink_nofollow_flag (flag); + Lisp_Object absname = Fexpand_file_name (filename, + BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file name handler. */ - handler = Ffind_file_name_handler (absname, Qset_file_modes); + Lisp_Object handler = Ffind_file_name_handler (absname, Qset_file_modes); if (!NILP (handler)) - return call3 (handler, Qset_file_modes, absname, mode); - - encoded_absname = ENCODE_FILE (absname); + return call4 (handler, Qset_file_modes, absname, mode, flag); - if (chmod (SSDATA (encoded_absname), XFIXNUM (mode) & 07777) < 0) + char *fname = SSDATA (ENCODE_FILE (absname)); + mode_t imode = XFIXNUM (mode) & 07777; + if (fchmodat (AT_FDCWD, fname, imode, nofollow) != 0) report_file_error ("Doing chmod", absname); return Qnil; @@ -3414,39 +3429,41 @@ The value is an integer. */) } -DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0, +DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 3, 0, doc: /* Set times of file FILENAME to TIMESTAMP. -Set both access and modification times. -Return t on success, else nil. -Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of -`current-time'. */) - (Lisp_Object filename, Lisp_Object timestamp) +If optional FLAG is `nofollow', do not follow FILENAME if it is a +symbolic link. Set both access and modification times. Return t on +success, else nil. Use the current time if TIMESTAMP is nil. +TIMESTAMP is in the format of `current-time'. */) + (Lisp_Object filename, Lisp_Object timestamp, Lisp_Object flag) { - Lisp_Object absname, encoded_absname; - Lisp_Object handler; - struct timespec t = lisp_time_argument (timestamp); + int nofollow = symlink_nofollow_flag (flag); - absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); + struct timespec ts[2]; + if (!NILP (timestamp)) + ts[0] = ts[1] = lisp_time_argument (timestamp); + else + ts[0].tv_nsec = ts[1].tv_nsec = UTIME_NOW; /* If the file name has special constructs in it, call the corresponding file name handler. */ - handler = Ffind_file_name_handler (absname, Qset_file_times); + Lisp_Object + absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)), + handler = Ffind_file_name_handler (absname, Qset_file_times); if (!NILP (handler)) - return call3 (handler, Qset_file_times, absname, timestamp); + return call4 (handler, Qset_file_times, absname, timestamp, flag); - encoded_absname = ENCODE_FILE (absname); + Lisp_Object encoded_absname = ENCODE_FILE (absname); - { - if (set_file_times (-1, SSDATA (encoded_absname), t, t) != 0) - { + if (utimensat (AT_FDCWD, SSDATA (encoded_absname), ts, nofollow) != 0) + { #ifdef MSDOS - /* Setting times on a directory always fails. */ - if (file_directory_p (encoded_absname)) - return Qnil; + /* Setting times on a directory always fails. */ + if (file_directory_p (encoded_absname)) + return Qnil; #endif - report_file_error ("Setting file times", absname); - } - } + report_file_error ("Setting file times", absname); + } return Qt; } @@ -3486,7 +3503,7 @@ otherwise, if FILE2 does not exist, the answer is t. */) return call3 (handler, Qfile_newer_than_file_p, absname1, absname2); int err1; - if (stat (SSDATA (ENCODE_FILE (absname1)), &st1) == 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname1)), &st1, 0) == 0) err1 = 0; else { @@ -3494,7 +3511,7 @@ otherwise, if FILE2 does not exist, the answer is t. */) if (err1 != EOVERFLOW) return file_attribute_errno (absname1, err1); } - if (stat (SSDATA (ENCODE_FILE (absname2)), &st2) != 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname2)), &st2, 0) != 0) { file_attribute_errno (absname2, errno); return Qt; @@ -3880,7 +3897,7 @@ by calling `format-decode', which see. */) if (end_offset < 0) buffer_overflow (); - /* The file size returned from stat may be zero, but data + /* The file size returned from fstat may be zero, but data may be readable nonetheless, for example when this is a file in the /proc filesystem. */ if (end_offset == 0) @@ -5625,7 +5642,7 @@ See Info node `(elisp)Modification Time' for more details. */) filename = ENCODE_FILE (BVAR (b, filename)); - mtime = (stat (SSDATA (filename), &st) == 0 + mtime = (emacs_fstatat (AT_FDCWD, SSDATA (filename), &st, 0) == 0 ? get_stat_mtime (&st) : time_error_value (errno)); if (timespec_cmp (mtime, b->modtime) == 0 @@ -5665,8 +5682,8 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */) struct timespec mtime; if (FIXNUMP (time_flag)) { - CHECK_RANGED_INTEGER (time_flag, -1, 0); - mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XFIXNUM (time_flag)); + int flag = check_integer_range (time_flag, -1, 0); + mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - flag); } else mtime = lisp_time_argument (time_flag); @@ -5689,7 +5706,8 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */) /* The handler can find the file name the same way we did. */ return call2 (handler, Qset_visited_file_modtime, Qnil); - if (stat (SSDATA (ENCODE_FILE (filename)), &st) == 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (filename)), &st, 0) + == 0) { current_buffer->modtime = get_stat_mtime (&st); current_buffer->modtime_size = st.st_size; @@ -5728,12 +5746,14 @@ auto_save_1 (void) /* Get visited file's mode to become the auto save file's mode. */ if (! NILP (BVAR (current_buffer, filename))) { - if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (BVAR (current_buffer, filename)), + &st, 0) + == 0) /* But make sure we can overwrite it later! */ auto_save_mode_bits = (st.st_mode | 0600) & 0777; - else if (modes = Ffile_modes (BVAR (current_buffer, filename)), + else if (modes = Ffile_modes (BVAR (current_buffer, filename), Qnil), FIXNUMP (modes)) - /* Remote files don't cooperate with stat. */ + /* Remote files don't cooperate with fstatat. */ auto_save_mode_bits = (XFIXNUM (modes) | 0600) & 0777; } diff --git a/src/filelock.c b/src/filelock.c index b28f16e9b5a..ee46e0e3e00 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -347,7 +347,8 @@ rename_lock_file (char const *old, char const *new, bool force) potential race condition since some other process may create NEW immediately after the existence check, but it's the best we can portably do here. */ - if (lstat (new, &st) == 0 || errno == EOVERFLOW) + if (emacs_fstatat (AT_FDCWD, new, &st, AT_SYMLINK_NOFOLLOW) == 0 + || errno == EOVERFLOW) { errno = EEXIST; return -1; @@ -660,7 +661,7 @@ void lock_file (Lisp_Object fn) { Lisp_Object orig_fn, encoded_fn; - char *lfname; + char *lfname = NULL; lock_info_type lock_info; USE_SAFE_ALLOCA; @@ -679,28 +680,22 @@ lock_file (Lisp_Object fn) dostounix_filename (SSDATA (fn)); #endif encoded_fn = ENCODE_FILE (fn); + if (create_lockfiles) + /* Create the name of the lock-file for file fn */ + MAKE_LOCK_NAME (lfname, encoded_fn); /* See if this file is visited and has changed on disk since it was visited. */ - { - register Lisp_Object subject_buf; - - subject_buf = get_truename_buffer (orig_fn); - - if (!NILP (subject_buf) - && NILP (Fverify_visited_file_modtime (subject_buf)) - && !NILP (Ffile_exists_p (fn))) - call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); - - } + Lisp_Object subject_buf = get_truename_buffer (orig_fn); + if (!NILP (subject_buf) + && NILP (Fverify_visited_file_modtime (subject_buf)) + && !NILP (Ffile_exists_p (fn)) + && !(lfname && current_lock_owner (NULL, lfname) == -2)) + call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); /* Don't do locking if the user has opted out. */ - if (create_lockfiles) + if (lfname) { - - /* Create the name of the lock-file for file fn */ - MAKE_LOCK_NAME (lfname, encoded_fn); - /* Try to lock the lock. FIXME: This ignores errors when lock_if_free returns a positive errno value. */ if (lock_if_free (&lock_info, lfname) < 0) @@ -859,7 +854,7 @@ syms_of_filelock (void) The name of the (per-buffer) lockfile is constructed by prepending a '.#' to the name of the file being locked. See also `lock-buffer' and Info node `(emacs)Interlocking'. */); - create_lockfiles = 1; + create_lockfiles = true; defsubr (&Sunlock_buffer); defsubr (&Slock_buffer); diff --git a/src/fns.c b/src/fns.c index 392196e2c7a..d6808aa1280 100644 --- a/src/fns.c +++ b/src/fns.c @@ -47,6 +47,7 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t, enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; static bool internal_equal (Lisp_Object, Lisp_Object, enum equal_kind, int, Lisp_Object); +static EMACS_UINT sxhash_obj (Lisp_Object, int); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the ARGUMENT unchanged. */ @@ -225,12 +226,12 @@ Letter-case is significant, but text properties are ignored. */) for (x = 1; x <= len2; x++) { column[0] = x; - FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte); + c2 = fetch_string_char_advance (string2, &i2, &i2_byte); i1 = i1_byte = 0; for (y = 1, lastdiag = x - 1; y <= len1; y++) { olddiag = column[y]; - FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte); + c1 = fetch_string_char_advance (string1, &i1, &i1_byte); column[y] = min (min (column[y] + 1, column[y-1] + 1), lastdiag + (c1 == c2 ? 0 : 1)); lastdiag = olddiag; @@ -311,10 +312,8 @@ If string STR1 is greater, the value is a positive number N; { /* When we find a mismatch, we must compare the characters, not just the bytes. */ - int c1, c2; - - FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c1, str1, i1, i1_byte); - FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c2, str2, i2, i2_byte); + int c1 = fetch_string_char_as_multibyte_advance (str1, &i1, &i1_byte); + int c2 = fetch_string_char_as_multibyte_advance (str2, &i2, &i2_byte); if (c1 == c2) continue; @@ -349,11 +348,8 @@ DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0, doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic order. Case is significant. Symbols are also allowed; their print names are used instead. */) - (register Lisp_Object string1, Lisp_Object string2) + (Lisp_Object string1, Lisp_Object string2) { - register ptrdiff_t end; - register ptrdiff_t i1, i1_byte, i2, i2_byte; - if (SYMBOLP (string1)) string1 = SYMBOL_NAME (string1); if (SYMBOLP (string2)) @@ -361,21 +357,15 @@ Symbols are also allowed; their print names are used instead. */) CHECK_STRING (string1); CHECK_STRING (string2); - i1 = i1_byte = i2 = i2_byte = 0; - - end = SCHARS (string1); - if (end > SCHARS (string2)) - end = SCHARS (string2); + ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0, i2_byte = 0; + ptrdiff_t end = min (SCHARS (string1), SCHARS (string2)); while (i1 < end) { /* When we find a mismatch, we must compare the characters, not just the bytes. */ - int c1, c2; - - FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte); - FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte); - + int c1 = fetch_string_char_advance (string1, &i1, &i1_byte); + int c2 = fetch_string_char_advance (string2, &i2, &i2_byte); if (c1 != c2) return c1 < c2 ? Qt : Qnil; } @@ -766,8 +756,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args, { Lisp_Object thislen; ptrdiff_t thisleni = 0; - register ptrdiff_t thisindex = 0; - register ptrdiff_t thisindex_byte = 0; + ptrdiff_t thisindex = 0; + ptrdiff_t thisindex_byte = 0; this = args[argnum]; if (!CONSP (this)) @@ -820,9 +810,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args, { int c; if (STRING_MULTIBYTE (this)) - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this, - thisindex, - thisindex_byte); + c = fetch_string_char_advance_no_check (this, &thisindex, + &thisindex_byte); else { c = SREF (this, thisindex); thisindex++; @@ -1960,9 +1949,7 @@ See also the function `nreverse', which is used more often. */) p = SDATA (seq), q = SDATA (new) + bytes; while (q > SDATA (new)) { - int ch, len; - - ch = STRING_CHAR_AND_LENGTH (p, len); + int len, ch = string_char_and_length (p, &len); p += len, q -= len; CHAR_STRING (ch, q); } @@ -2433,6 +2420,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, same size. */ if (ASIZE (o2) != size) return false; + + /* Compare bignums, overlays, markers, and boolvectors + specially, by comparing their values. */ if (BIGNUMP (o1)) return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0; if (OVERLAYP (o1)) @@ -2453,21 +2443,12 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, && (XMARKER (o1)->buffer == 0 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); } - /* Boolvectors are compared much like strings. */ if (BOOL_VECTOR_P (o1)) { EMACS_INT size = bool_vector_size (o1); - if (size != bool_vector_size (o2)) - return false; - if (memcmp (bool_vector_data (o1), bool_vector_data (o2), - bool_vector_bytes (size))) - return false; - return true; - } - if (WINDOW_CONFIGURATIONP (o1)) - { - eassert (equal_kind != EQUAL_NO_QUIT); - return compare_window_configurations (o1, o2, false); + return (size == bool_vector_size (o2) + && !memcmp (bool_vector_data (o1), bool_vector_data (o2), + bool_vector_bytes (size))); } /* Aside from them, only true vectors, char-tables, compiled @@ -2493,16 +2474,11 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, break; case Lisp_String: - if (SCHARS (o1) != SCHARS (o2)) - return false; - if (SBYTES (o1) != SBYTES (o2)) - return false; - if (memcmp (SDATA (o1), SDATA (o2), SBYTES (o1))) - return false; - if (equal_kind == EQUAL_INCLUDING_PROPERTIES - && !compare_string_intervals (o1, o2)) - return false; - return true; + return (SCHARS (o1) == SCHARS (o2) + && SBYTES (o1) == SBYTES (o2) + && !memcmp (SDATA (o1), SDATA (o2), SBYTES (o1)) + && (equal_kind != EQUAL_INCLUDING_PROPERTIES + || compare_string_intervals (o1, o2))); default: break; @@ -2624,51 +2600,45 @@ usage: (nconc &rest LISTS) */) static EMACS_INT mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) { - Lisp_Object tail, dummy; - EMACS_INT i; - if (VECTORP (seq) || COMPILEDP (seq)) { - for (i = 0; i < leni; i++) + for (ptrdiff_t i = 0; i < leni; i++) { - dummy = call1 (fn, AREF (seq, i)); + Lisp_Object dummy = call1 (fn, AREF (seq, i)); if (vals) vals[i] = dummy; } } else if (BOOL_VECTOR_P (seq)) { - for (i = 0; i < leni; i++) + for (EMACS_INT i = 0; i < leni; i++) { - dummy = call1 (fn, bool_vector_ref (seq, i)); + Lisp_Object dummy = call1 (fn, bool_vector_ref (seq, i)); if (vals) vals[i] = dummy; } } else if (STRINGP (seq)) { - ptrdiff_t i_byte; + ptrdiff_t i_byte = 0; - for (i = 0, i_byte = 0; i < leni;) + for (ptrdiff_t i = 0; i < leni;) { - int c; ptrdiff_t i_before = i; - - FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte); - XSETFASTINT (dummy, c); - dummy = call1 (fn, dummy); + int c = fetch_string_char_advance (seq, &i, &i_byte); + Lisp_Object dummy = call1 (fn, make_fixnum (c)); if (vals) vals[i_before] = dummy; } } else /* Must be a list, since Flength did not get an error */ { - tail = seq; - for (i = 0; i < leni; i++) + Lisp_Object tail = seq; + for (ptrdiff_t i = 0; i < leni; i++) { if (! CONSP (tail)) return i; - dummy = call1 (fn, XCAR (tail)); + Lisp_Object dummy = call1 (fn, XCAR (tail)); if (vals) vals[i] = dummy; tail = XCDR (tail); @@ -2853,7 +2823,7 @@ advisable. */) while (loads-- > 0) { Lisp_Object load = (NILP (use_floats) - ? make_fixnum (100.0 * load_ave[loads]) + ? double_to_integer (100.0 * load_ave[loads]) : make_float (load_ave[loads])); ret = Fcons (load, ret); } @@ -3461,7 +3431,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length, { if (multibyte) { - c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes); + c = string_char_and_length ((unsigned char *) from + i, &bytes); if (CHAR_BYTE8_P (c)) c = CHAR_TO_BYTE8 (c); else if (c >= 256) @@ -3504,7 +3474,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length, if (multibyte) { - c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes); + c = string_char_and_length ((unsigned char *) from + i, &bytes); if (CHAR_BYTE8_P (c)) c = CHAR_TO_BYTE8 (c); else if (c >= 256) @@ -3529,7 +3499,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length, if (multibyte) { - c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes); + c = string_char_and_length ((unsigned char *) from + i, &bytes); if (CHAR_BYTE8_P (c)) c = CHAR_TO_BYTE8 (c); else if (c >= 256) @@ -3710,7 +3680,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, c = value >> 16 & 0xff; if (c & multibyte_bit) - e += BYTE8_STRING (c, e); + e += BYTE8_STRING (c, (unsigned char *) e); else *e++ = c; nchars++; @@ -3752,7 +3722,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, c = value >> 8 & 0xff; if (c & multibyte_bit) - e += BYTE8_STRING (c, e); + e += BYTE8_STRING (c, (unsigned char *) e); else *e++ = c; nchars++; @@ -3782,7 +3752,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, c = value & 0xff; if (c & multibyte_bit) - e += BYTE8_STRING (c, e); + e += BYTE8_STRING (c, (unsigned char *) e); else *e++ = c; nchars++; @@ -4022,7 +3992,7 @@ hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) Lisp_Object hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) { - return make_ufixnum (sxhash (key, 0)); + return make_ufixnum (sxhash (key)); } /* Ignore HT and return a hash code for KEY which uses 'eql' to compare keys. @@ -4042,7 +4012,7 @@ hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { Lisp_Object args[] = { h->test.user_hash_function, key }; Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h); - return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash, 0)); + return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash)); } struct hash_table_test const @@ -4606,13 +4576,13 @@ sxhash_list (Lisp_Object list, int depth) CONSP (list) && i < SXHASH_MAX_LEN; list = XCDR (list), ++i) { - EMACS_UINT hash2 = sxhash (XCAR (list), depth + 1); + EMACS_UINT hash2 = sxhash_obj (XCAR (list), depth + 1); hash = sxhash_combine (hash, hash2); } if (!NILP (list)) { - EMACS_UINT hash2 = sxhash (list, depth + 1); + EMACS_UINT hash2 = sxhash_obj (list, depth + 1); hash = sxhash_combine (hash, hash2); } @@ -4632,7 +4602,7 @@ sxhash_vector (Lisp_Object vec, int depth) n = min (SXHASH_MAX_LEN, hash & PSEUDOVECTOR_FLAG ? PVSIZE (vec) : hash); for (i = 0; i < n; ++i) { - EMACS_UINT hash2 = sxhash (AREF (vec, i), depth + 1); + EMACS_UINT hash2 = sxhash_obj (AREF (vec, i), depth + 1); hash = sxhash_combine (hash, hash2); } @@ -4675,58 +4645,78 @@ sxhash_bignum (Lisp_Object bignum) structure. Value is an unsigned integer clipped to INTMASK. */ EMACS_UINT -sxhash (Lisp_Object obj, int depth) +sxhash (Lisp_Object obj) { - EMACS_UINT hash; + return sxhash_obj (obj, 0); +} +static EMACS_UINT +sxhash_obj (Lisp_Object obj, int depth) +{ if (depth > SXHASH_MAX_DEPTH) return 0; switch (XTYPE (obj)) { case_Lisp_Int: - hash = XUFIXNUM (obj); - break; + return XUFIXNUM (obj); case Lisp_Symbol: - hash = XHASH (obj); - break; + return XHASH (obj); case Lisp_String: - hash = sxhash_string (SSDATA (obj), SBYTES (obj)); - break; + return sxhash_string (SSDATA (obj), SBYTES (obj)); - /* This can be everything from a vector to an overlay. */ case Lisp_Vectorlike: - if (BIGNUMP (obj)) - hash = sxhash_bignum (obj); - else if (VECTORP (obj) || RECORDP (obj)) - /* According to the CL HyperSpec, two arrays are equal only if - they are `eq', except for strings and bit-vectors. In - Emacs, this works differently. We have to compare element - by element. Same for records. */ - hash = sxhash_vector (obj, depth); - else if (BOOL_VECTOR_P (obj)) - hash = sxhash_bool_vector (obj); - else - /* Others are `equal' if they are `eq', so let's take their - address as hash. */ - hash = XHASH (obj); - break; + { + enum pvec_type pvec_type = PSEUDOVECTOR_TYPE (XVECTOR (obj)); + if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_COMPILED)) + { + /* According to the CL HyperSpec, two arrays are equal only if + they are 'eq', except for strings and bit-vectors. In + Emacs, this works differently. We have to compare element + by element. Same for pseudovectors that internal_equal + examines the Lisp contents of. */ + return (SUB_CHAR_TABLE_P (obj) + /* 'sxhash_vector' can't be applies to a sub-char-table and + it's probably not worth looking into them anyway! */ + ? 42 + : sxhash_vector (obj, depth)); + } + else if (pvec_type == PVEC_BIGNUM) + return sxhash_bignum (obj); + else if (pvec_type == PVEC_MARKER) + { + ptrdiff_t bytepos + = XMARKER (obj)->buffer ? XMARKER (obj)->bytepos : 0; + EMACS_UINT hash + = sxhash_combine ((intptr_t) XMARKER (obj)->buffer, bytepos); + return SXHASH_REDUCE (hash); + } + else if (pvec_type == PVEC_BOOL_VECTOR) + return sxhash_bool_vector (obj); + else if (pvec_type == PVEC_OVERLAY) + { + EMACS_UINT hash = sxhash_obj (OVERLAY_START (obj), depth); + hash = sxhash_combine (hash, sxhash_obj (OVERLAY_END (obj), depth)); + hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth)); + return SXHASH_REDUCE (hash); + } + else + /* Others are 'equal' if they are 'eq', so take their + address as hash. */ + return XHASH (obj); + } case Lisp_Cons: - hash = sxhash_list (obj, depth); - break; + return sxhash_list (obj, depth); case Lisp_Float: - hash = sxhash_float (XFLOAT_DATA (obj)); - break; + return sxhash_float (XFLOAT_DATA (obj)); default: emacs_abort (); } - - return hash; } @@ -5177,22 +5167,8 @@ extract_data_from_object (Lisp_Object spec, struct buffer *bp = XBUFFER (object); set_buffer_internal (bp); - if (NILP (start)) - b = BEGV; - else - { - CHECK_FIXNUM_COERCE_MARKER (start); - b = XFIXNUM (start); - } - - if (NILP (end)) - e = ZV; - else - { - CHECK_FIXNUM_COERCE_MARKER (end); - e = XFIXNUM (end); - } - + b = !NILP (start) ? fix_position (start) : BEGV; + e = !NILP (end) ? fix_position (end) : ZV; if (b > e) { EMACS_INT temp = b; diff --git a/src/font.c b/src/font.c index 39ec1b3562a..ab00402b40b 100644 --- a/src/font.c +++ b/src/font.c @@ -3856,13 +3856,10 @@ font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit, while (pos < *limit) { - Lisp_Object category; - - if (NILP (string)) - FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte); - else - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte); - category = CHAR_TABLE_REF (Vunicode_category_table, c); + c = (NILP (string) + ? fetch_char_advance_no_check (&pos, &pos_byte) + : fetch_string_char_advance_no_check (string, &pos, &pos_byte)); + Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c); if (FIXNUMP (category) && (XFIXNUM (category) == UNICODE_CATEGORY_Cf || CHAR_VARIATION_SELECTOR_P (c))) @@ -4606,10 +4603,10 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, Lisp_Object window; struct window *w; - CHECK_FIXNUM_COERCE_MARKER (position); - if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV)) + EMACS_INT fixed_pos = fix_position (position); + if (! (BEGV <= fixed_pos && fixed_pos < ZV)) args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); - pos = XFIXNUM (position); + pos = fixed_pos; pos_byte = CHAR_TO_BYTE (pos); if (NILP (ch)) c = FETCH_CHAR (pos_byte); @@ -4891,7 +4888,7 @@ the corresponding element is nil. */) Lisp_Object object) { struct font *font = CHECK_FONT_GET_OBJECT (font_object); - ptrdiff_t i, len; + ptrdiff_t len; Lisp_Object *chars, vec; USE_SAFE_ALLOCA; @@ -4906,10 +4903,9 @@ the corresponding element is nil. */) SAFE_ALLOCA_LISP (chars, len); charpos = XFIXNAT (from); bytepos = CHAR_TO_BYTE (charpos); - for (i = 0; charpos < XFIXNAT (to); i++) + for (ptrdiff_t i = 0; charpos < XFIXNAT (to); i++) { - int c; - FETCH_CHAR_ADVANCE (c, charpos, bytepos); + int c = fetch_char_advance (&charpos, &bytepos); chars[i] = make_fixnum (c); } } @@ -4929,18 +4925,18 @@ the corresponding element is nil. */) int c; /* Skip IFROM characters from the beginning. */ - for (i = 0; i < ifrom; i++) - c = STRING_CHAR_ADVANCE (p); + for (ptrdiff_t i = 0; i < ifrom; i++) + p += BYTES_BY_CHAR_HEAD (*p); /* Now fetch an interesting characters. */ - for (i = 0; i < len; i++) - { - c = STRING_CHAR_ADVANCE (p); - chars[i] = make_fixnum (c); - } + for (ptrdiff_t i = 0; i < len; i++) + { + c = string_char_advance (&p); + chars[i] = make_fixnum (c); + } } else - for (i = 0; i < len; i++) + for (ptrdiff_t i = 0; i < len; i++) chars[i] = make_fixnum (p[ifrom + i]); } else if (VECTORP (object)) @@ -4951,7 +4947,7 @@ the corresponding element is nil. */) if (ifrom == ito) return Qnil; len = ito - ifrom; - for (i = 0; i < len; i++) + for (ptrdiff_t i = 0; i < len; i++) { Lisp_Object elt = AREF (object, ifrom + i); CHECK_CHARACTER (elt); @@ -4962,7 +4958,7 @@ the corresponding element is nil. */) wrong_type_argument (Qarrayp, object); vec = make_uninit_vector (len); - for (i = 0; i < len; i++) + for (ptrdiff_t i = 0; i < len; i++) { Lisp_Object g; int c = XFIXNAT (chars[i]); @@ -5013,24 +5009,26 @@ character at index specified by POSITION. */) (Lisp_Object position, Lisp_Object window, Lisp_Object string) { struct window *w = decode_live_window (window); + EMACS_INT pos; if (NILP (string)) { if (XBUFFER (w->contents) != current_buffer) error ("Specified window is not displaying the current buffer"); - CHECK_FIXNUM_COERCE_MARKER (position); - if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV)) + pos = fix_position (position); + if (! (BEGV <= pos && pos < ZV)) args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); } else { CHECK_FIXNUM (position); CHECK_STRING (string); - if (! (0 <= XFIXNUM (position) && XFIXNUM (position) < SCHARS (string))) + pos = XFIXNUM (position); + if (! (0 <= pos && pos < SCHARS (string))) args_out_of_range (string, position); } - return font_at (-1, XFIXNUM (position), NULL, w, string); + return font_at (-1, pos, NULL, w, string); } #if 0 @@ -5543,7 +5541,6 @@ cause Xft crashes. Only has an effect in Xft builds. */); #ifdef USE_CAIRO syms_of_ftcrfont (); #else - syms_of_ftxfont (); #ifdef HAVE_XFT syms_of_xftfont (); #endif /* HAVE_XFT */ diff --git a/src/font.h b/src/font.h index 6f4792afe55..8614e7fa10a 100644 --- a/src/font.h +++ b/src/font.h @@ -69,8 +69,8 @@ INLINE_HEADER_BEGIN enum font_property_index { - /* FONT-TYPE is a symbol indicating a font backend; currently `x', - `xft', and `ftx' are available on X, `uniscribe' and `gdi' on + /* FONT-TYPE is a symbol indicating a font backend; currently `x' + and `xft' are available on X, `uniscribe' and `gdi' on Windows, and `ns' under Cocoa / GNUstep. */ FONT_TYPE_INDEX, @@ -938,7 +938,6 @@ extern void syms_of_ftfont (void); extern struct font_driver const xfont_driver; extern Lisp_Object xfont_get_cache (struct frame *); extern void syms_of_xfont (void); -extern void syms_of_ftxfont (void); #ifdef HAVE_XFT extern struct font_driver const xftfont_driver; #ifdef HAVE_HARFBUZZ @@ -946,7 +945,6 @@ extern struct font_driver xfthbfont_driver; #endif /* HAVE_HARFBUZZ */ #endif #if defined HAVE_FREETYPE || defined HAVE_XFT -extern struct font_driver const ftxfont_driver; extern void syms_of_xftfont (void); #endif #ifdef HAVE_BDFFONT diff --git a/src/frame.c b/src/frame.c index 4dd8bb18041..c871e4fd994 100644 --- a/src/frame.c +++ b/src/frame.c @@ -904,7 +904,7 @@ make_frame (bool mini_p) f->last_tool_bar_item = -1; #endif #ifdef NS_IMPL_COCOA - f->ns_appearance = ns_appearance_aqua; + f->ns_appearance = ns_appearance_system_default; f->ns_transparent_titlebar = false; #endif #endif @@ -2558,26 +2558,26 @@ before calling this function on it, like this. (Lisp_Object frame, Lisp_Object x, Lisp_Object y) { CHECK_LIVE_FRAME (frame); - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ - frame_set_mouse_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y)); + frame_set_mouse_position (XFRAME (frame), xval, yval); #else #if defined (MSDOS) if (FRAME_MSDOS_P (XFRAME (frame))) { Fselect_frame (frame, Qnil); - mouse_moveto (XFIXNUM (x), XFIXNUM (y)); + mouse_moveto (xval, yval); } #else #ifdef HAVE_GPM { Fselect_frame (frame, Qnil); - term_mouse_moveto (XFIXNUM (x), XFIXNUM (y)); + term_mouse_moveto (xval, yval); } #endif #endif @@ -2599,26 +2599,26 @@ before calling this function on it, like this. (Lisp_Object frame, Lisp_Object x, Lisp_Object y) { CHECK_LIVE_FRAME (frame); - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ - frame_set_mouse_pixel_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y)); + frame_set_mouse_pixel_position (XFRAME (frame), xval, yval); #else #if defined (MSDOS) if (FRAME_MSDOS_P (XFRAME (frame))) { Fselect_frame (frame, Qnil); - mouse_moveto (XFIXNUM (x), XFIXNUM (y)); + mouse_moveto (xval, yval); } #else #ifdef HAVE_GPM { Fselect_frame (frame, Qnil); - term_mouse_moveto (XFIXNUM (x), XFIXNUM (y)); + term_mouse_moveto (xval, yval); } #endif #endif @@ -3545,6 +3545,21 @@ DEFUN ("frame-bottom-divider-width", Fbottom_divider_width, Sbottom_divider_widt return make_fixnum (FRAME_BOTTOM_DIVIDER_WIDTH (decode_any_frame (frame))); } +static int +check_frame_pixels (Lisp_Object size, Lisp_Object pixelwise, int item_size) +{ + CHECK_INTEGER (size); + if (!NILP (pixelwise)) + item_size = 1; + intmax_t sz; + int pixel_size; /* size * item_size */ + if (! integer_to_intmax (size, &sz) + || INT_MULTIPLY_WRAPV (sz, item_size, &pixel_size)) + args_out_of_range_3 (size, make_int (INT_MIN / item_size), + make_int (INT_MAX / item_size)); + return pixel_size; +} + DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4, "(list (selected-frame) (prefix-numeric-value current-prefix-arg))", doc: /* Set text height of frame FRAME to HEIGHT lines. @@ -3562,15 +3577,9 @@ currently selected frame will be set to this height. */) (Lisp_Object frame, Lisp_Object height, Lisp_Object pretend, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); - int pixel_height; - - CHECK_TYPE_RANGED_INTEGER (int, height); - - pixel_height = (!NILP (pixelwise) - ? XFIXNUM (height) - : XFIXNUM (height) * FRAME_LINE_HEIGHT (f)); + int pixel_height = check_frame_pixels (height, pixelwise, + FRAME_LINE_HEIGHT (f)); adjust_frame_size (f, -1, pixel_height, 1, !NILP (pretend), Qheight); - return Qnil; } @@ -3591,15 +3600,9 @@ currently selected frame will be set to this width. */) (Lisp_Object frame, Lisp_Object width, Lisp_Object pretend, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); - int pixel_width; - - CHECK_TYPE_RANGED_INTEGER (int, width); - - pixel_width = (!NILP (pixelwise) - ? XFIXNUM (width) - : XFIXNUM (width) * FRAME_COLUMN_WIDTH (f)); + int pixel_width = check_frame_pixels (width, pixelwise, + FRAME_COLUMN_WIDTH (f)); adjust_frame_size (f, pixel_width, -1, 1, !NILP (pretend), Qwidth); - return Qnil; } @@ -3613,19 +3616,11 @@ font height. */) (Lisp_Object frame, Lisp_Object width, Lisp_Object height, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); - int pixel_width, pixel_height; - - CHECK_TYPE_RANGED_INTEGER (int, width); - CHECK_TYPE_RANGED_INTEGER (int, height); - - pixel_width = (!NILP (pixelwise) - ? XFIXNUM (width) - : XFIXNUM (width) * FRAME_COLUMN_WIDTH (f)); - pixel_height = (!NILP (pixelwise) - ? XFIXNUM (height) - : XFIXNUM (height) * FRAME_LINE_HEIGHT (f)); + int pixel_width = check_frame_pixels (width, pixelwise, + FRAME_COLUMN_WIDTH (f)); + int pixel_height = check_frame_pixels (height, pixelwise, + FRAME_LINE_HEIGHT (f)); adjust_frame_size (f, pixel_width, pixel_height, 1, 0, Qsize); - return Qnil; } @@ -3655,18 +3650,14 @@ bottom edge of FRAME's display. */) (Lisp_Object frame, Lisp_Object x, Lisp_Object y) { struct frame *f = decode_live_frame (frame); - - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); if (FRAME_WINDOW_P (f)) { #ifdef HAVE_WINDOW_SYSTEM if (FRAME_TERMINAL (f)->set_frame_offset_hook) - FRAME_TERMINAL (f)->set_frame_offset_hook (f, - XFIXNUM (x), - XFIXNUM (y), - 1); + FRAME_TERMINAL (f)->set_frame_offset_hook (f, xval, yval, 1); #endif } @@ -4641,23 +4632,22 @@ gui_set_right_fringe (struct frame *f, Lisp_Object new_value, Lisp_Object old_va void gui_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - CHECK_TYPE_RANGED_INTEGER (int, arg); + int border_width = check_integer_range (arg, INT_MIN, INT_MAX); - if (XFIXNUM (arg) == f->border_width) + if (border_width == f->border_width) return; if (FRAME_NATIVE_WINDOW (f) != 0) error ("Cannot change the border width of a frame"); - f->border_width = XFIXNUM (arg); + f->border_width = border_width; } void gui_set_right_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int old = FRAME_RIGHT_DIVIDER_WIDTH (f); - CHECK_TYPE_RANGED_INTEGER (int, arg); - int new = max (0, XFIXNUM (arg)); + int new = check_int_nonnegative (arg); if (new != old) { f->right_divider_width = new; @@ -4671,8 +4661,7 @@ void gui_set_bottom_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int old = FRAME_BOTTOM_DIVIDER_WIDTH (f); - CHECK_TYPE_RANGED_INTEGER (int, arg); - int new = max (0, XFIXNUM (arg)); + int new = check_int_nonnegative (arg); if (new != old) { f->bottom_divider_width = new; @@ -5651,8 +5640,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, f->top_pos = 0; else { - CHECK_TYPE_RANGED_INTEGER (int, top); - f->top_pos = XFIXNUM (top); + f->top_pos = check_integer_range (top, INT_MIN, INT_MAX); if (f->top_pos < 0) window_prompting |= YNegative; } @@ -5682,8 +5670,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, f->left_pos = 0; else { - CHECK_TYPE_RANGED_INTEGER (int, left); - f->left_pos = XFIXNUM (left); + f->left_pos = check_integer_range (left, INT_MIN, INT_MAX); if (f->left_pos < 0) window_prompting |= XNegative; } diff --git a/src/frame.h b/src/frame.h index a54b8623e50..476bac67faf 100644 --- a/src/frame.h +++ b/src/frame.h @@ -69,8 +69,9 @@ enum internal_border_part #ifdef NS_IMPL_COCOA enum ns_appearance_type { - ns_appearance_aqua, - ns_appearance_vibrant_dark + ns_appearance_system_default, + ns_appearance_aqua, + ns_appearance_vibrant_dark }; #endif #endif /* HAVE_WINDOW_SYSTEM */ @@ -1449,6 +1450,49 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f) { return frame_dimension (f->bottom_divider_width); } + +/* Return a non-null pointer to the cached face with ID on frame F. */ + +INLINE struct face * +FACE_FROM_ID (struct frame *f, int id) +{ + eassert (0 <= id && id < FRAME_FACE_CACHE (f)->used); + return FRAME_FACE_CACHE (f)->faces_by_id[id]; +} + +/* Return a pointer to the face with ID on frame F, or null if such a + face doesn't exist. */ + +INLINE struct face * +FACE_FROM_ID_OR_NULL (struct frame *f, int id) +{ + int used = FRAME_FACE_CACHE (f)->used; + eassume (0 <= used); + return 0 <= id && id < used ? FRAME_FACE_CACHE (f)->faces_by_id[id] : NULL; +} + +#ifdef HAVE_WINDOW_SYSTEM + +/* A non-null pointer to the image with id ID on frame F. */ + +INLINE struct image * +IMAGE_FROM_ID (struct frame *f, int id) +{ + eassert (0 <= id && id < FRAME_IMAGE_CACHE (f)->used); + return FRAME_IMAGE_CACHE (f)->images[id]; +} + +/* Value is a pointer to the image with id ID on frame F, or null if + no image with that id exists. */ + +INLINE struct image * +IMAGE_OPT_FROM_ID (struct frame *f, int id) +{ + int used = FRAME_IMAGE_CACHE (f)->used; + eassume (0 <= used); + return 0 <= id && id < used ? FRAME_IMAGE_CACHE (f)->images[id] : NULL; +} +#endif /*********************************************************************** Conversion between canonical units and pixels diff --git a/src/fringe.c b/src/fringe.c index 2a46e3c34f2..fc4c738dc2d 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -101,7 +101,7 @@ struct fringe_bitmap ...xx... */ static unsigned short question_mark_bits[] = { - 0x3c, 0x7e, 0x7e, 0x0c, 0x18, 0x18, 0x00, 0x18, 0x18}; + 0x3c, 0x7e, 0xc3, 0xc3, 0x0c, 0x18, 0x18, 0x00, 0x18, 0x18}; /* An exclamation mark. */ /* @@ -117,7 +117,7 @@ static unsigned short question_mark_bits[] = { ...XX... */ static unsigned short exclamation_mark_bits[] = { - 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x00, 0x18}; + 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x00, 0x18, 0x18}; /* An arrow like this: `<-'. */ /* @@ -1675,10 +1675,10 @@ Return nil if POS is not visible in WINDOW. */) if (!NILP (pos)) { - CHECK_FIXNUM_COERCE_MARKER (pos); - if (! (BEGV <= XFIXNUM (pos) && XFIXNUM (pos) <= ZV)) + EMACS_INT p = fix_position (pos); + if (! (BEGV <= p && p <= ZV)) args_out_of_range (window, pos); - textpos = XFIXNUM (pos); + textpos = p; } else if (w == XWINDOW (selected_window)) textpos = PT; diff --git a/src/ftcrfont.c b/src/ftcrfont.c index a0e18e13cfa..7832d4f5ce0 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -328,14 +328,13 @@ ftcrfont_encode_char (struct font *font, int c) struct font_info *ftcrfont_info = (struct font_info *) font; unsigned code = FONT_INVALID_CODE; unsigned char utf8[MAX_MULTIBYTE_LENGTH]; - unsigned char *p = utf8; + int utf8len = CHAR_STRING (c, utf8); cairo_glyph_t stack_glyph; cairo_glyph_t *glyphs = &stack_glyph; int num_glyphs = 1; - CHAR_STRING_ADVANCE (c, p); if (cairo_scaled_font_text_to_glyphs (ftcrfont_info->cr_scaled_font, 0, 0, - (char *) utf8, p - utf8, + (char *) utf8, utf8len, &glyphs, &num_glyphs, NULL, NULL, NULL) == CAIRO_STATUS_SUCCESS) diff --git a/src/ftfont.c b/src/ftfont.c index 6b549c3ddf2..696f5e65341 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -346,18 +346,15 @@ struct ftfont_cache_data static Lisp_Object ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for) { - Lisp_Object cache, val, entity; + Lisp_Object cache, val; struct ftfont_cache_data *cache_data; if (FONT_ENTITY_P (key)) { - entity = key; - val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX)); + val = assq_no_quit (QCfont_entity, AREF (key, FONT_EXTRA_INDEX)); eassert (CONSP (val)); key = XCDR (val); } - else - entity = Qnil; if (NILP (ft_face_cache)) cache = Qnil; 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 @@ -/* ftxfont.c -- FreeType font driver on X (without using XFT). - Copyright (C) 2006-2020 Free Software Foundation, Inc. - Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 - National Institute of Advanced Industrial Science and Technology (AIST) - Registration Number H13PRO009 - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ - -#include <config.h> -#include <X11/Xlib.h> - -#include "lisp.h" -#include "xterm.h" -#include "frame.h" -#include "blockinput.h" -#include "font.h" -#include "pdumper.h" - -/* FTX font driver. */ - -struct ftxfont_frame_data -{ - /* Background and foreground colors. */ - XColor colors[2]; - /* GCs interpolating the above colors. gcs[0] is for a color - closest to BACKGROUND, and gcs[5] is for a color closest to - FOREGROUND. */ - GC gcs[6]; - struct ftxfont_frame_data *next; -}; - - -/* Return an array of 6 GCs for antialiasing. */ - -static GC * -ftxfont_get_gcs (struct frame *f, unsigned long foreground, unsigned long background) -{ - XColor color; - XGCValues xgcv; - int i; - struct ftxfont_frame_data *data = font_get_frame_data (f, Qftx); - struct ftxfont_frame_data *prev = NULL, *this = NULL, *new; - - if (data) - { - for (this = data; this; prev = this, this = this->next) - { - if (this->colors[0].pixel < background) - continue; - if (this->colors[0].pixel > background) - break; - if (this->colors[1].pixel < foreground) - continue; - if (this->colors[1].pixel > foreground) - break; - return this->gcs; - } - } - - new = xmalloc (sizeof *new); - new->next = this; - if (prev) - prev->next = new; - font_put_frame_data (f, Qftx, new); - - new->colors[0].pixel = background; - new->colors[1].pixel = foreground; - - block_input (); - XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), new->colors, 2); - for (i = 1; i < 7; i++) - { - /* Interpolate colors linearly. Any better algorithm? */ - color.red - = (new->colors[1].red * i + new->colors[0].red * (8 - i)) / 8; - color.green - = (new->colors[1].green * i + new->colors[0].green * (8 - i)) / 8; - color.blue - = (new->colors[1].blue * i + new->colors[0].blue * (8 - i)) / 8; - if (! x_alloc_nearest_color (f, FRAME_X_COLORMAP (f), &color)) - break; - xgcv.foreground = color.pixel; - new->gcs[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - GCForeground, &xgcv); - } - unblock_input (); - - if (i < 7) - { - block_input (); - for (i--; i >= 0; i--) - XFreeGC (FRAME_X_DISPLAY (f), new->gcs[i]); - unblock_input (); - if (prev) - prev->next = new->next; - else if (data) - font_put_frame_data (f, Qftx, new->next); - xfree (new); - return NULL; - } - return new->gcs; -} - -static int -ftxfont_draw_bitmap (struct frame *f, GC gc_fore, GC *gcs, struct font *font, - unsigned int code, int x, int y, XPoint *p, int size, - int *n, bool flush) -{ - struct font_bitmap bitmap; - unsigned char *b; - int i, j; - - if (ftfont_get_bitmap (font, code, &bitmap, size > 0x100 ? 1 : 8) < 0) - return 0; - if (size > 0x100) - { - for (i = 0, b = bitmap.buffer; i < bitmap.rows; - i++, b += bitmap.pitch) - { - for (j = 0; j < bitmap.width; j++) - if (b[j / 8] & (1 << (7 - (j % 8)))) - { - p[n[0]].x = x + bitmap.left + j; - p[n[0]].y = y - bitmap.top + i; - if (++n[0] == size) - { - XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - gc_fore, p, size, CoordModeOrigin); - n[0] = 0; - } - } - } - if (flush && n[0] > 0) - XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - gc_fore, p, n[0], CoordModeOrigin); - } - else - { - for (i = 0, b = bitmap.buffer; i < bitmap.rows; - i++, b += bitmap.pitch) - { - for (j = 0; j < bitmap.width; j++) - { - int idx = (bitmap.bits_per_pixel == 1 - ? ((b[j / 8] & (1 << (7 - (j % 8)))) ? 6 : -1) - : (b[j] >> 5) - 1); - - if (idx >= 0) - { - XPoint *pp = p + size * idx; - - pp[n[idx]].x = x + bitmap.left + j; - pp[n[idx]].y = y - bitmap.top + i; - if (++(n[idx]) == size) - { - XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - idx == 6 ? gc_fore : gcs[idx], pp, size, - CoordModeOrigin); - n[idx] = 0; - } - } - } - } - if (flush) - { - for (i = 0; i < 6; i++) - if (n[i] > 0) - XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - gcs[i], p + 0x100 * i, n[i], CoordModeOrigin); - if (n[6] > 0) - XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - gc_fore, p + 0x600, n[6], CoordModeOrigin); - } - } - - /* There is no ftfont_free_bitmap, so do not try to free BITMAP. */ - - return bitmap.advance; -} - -static void -ftxfont_draw_background (struct frame *f, struct font *font, GC gc, int x, int y, - int width) -{ - XGCValues xgcv; - - XGetGCValues (FRAME_X_DISPLAY (f), gc, - GCForeground | GCBackground, &xgcv); - XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.background); - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), gc, - x, y - FONT_BASE (font), width, FONT_HEIGHT (font)); - XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.foreground); -} - -static Lisp_Object -ftxfont_list (struct frame *f, Lisp_Object spec) -{ - return ftfont_list2 (f, spec, Qftx); -} - -static Lisp_Object -ftxfont_match (struct frame *f, Lisp_Object spec) -{ - return ftfont_match2 (f, spec, Qftx); -} - -static Lisp_Object -ftxfont_open (struct frame *f, Lisp_Object entity, int pixel_size) -{ - Lisp_Object font_object = ftfont_open (f, entity, pixel_size); - if (NILP (font_object)) - return Qnil; - struct font *font = XFONT_OBJECT (font_object); - font->driver = &ftxfont_driver; - return font_object; -} - -static void -ftxfont_close (struct font *font) -{ - ftfont_close (font); -} - -static int -ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y, - bool with_background) -{ - struct frame *f = s->f; - struct face *face = s->face; - struct font *font = s->font; - XPoint p[0x700]; - int n[7]; - unsigned *code = s->char2b + from; - int len = to - from; - int i; - GC *gcs; - int xadvance; - - n[0] = n[1] = n[2] = n[3] = n[4] = n[5] = n[6] = 0; - - block_input (); - if (with_background) - ftxfont_draw_background (f, font, s->gc, x, y, s->width); - - if (face->gc == s->gc) - { - gcs = ftxfont_get_gcs (f, face->foreground, face->background); - } - else - { - XGCValues xgcv; - unsigned long mask = GCForeground | GCBackground; - - XGetGCValues (FRAME_X_DISPLAY (f), s->gc, mask, &xgcv); - gcs = ftxfont_get_gcs (f, xgcv.foreground, xgcv.background); - } - - if (gcs) - { - if (s->num_clips) - for (i = 0; i < 6; i++) - XSetClipRectangles (FRAME_X_DISPLAY (f), gcs[i], 0, 0, - s->clip, s->num_clips, Unsorted); - - for (i = 0; i < len; i++) - { - xadvance = ftxfont_draw_bitmap (f, s->gc, gcs, font, code[i], x, y, - p, 0x100, n, i + 1 == len); - x += (s->padding_p ? 1 : xadvance); - } - if (s->num_clips) - for (i = 0; i < 6; i++) - XSetClipMask (FRAME_X_DISPLAY (f), gcs[i], None); - } - else - { - /* We can't draw with antialiasing. - s->gc should already have a proper clipping setting. */ - for (i = 0; i < len; i++) - { - xadvance = ftxfont_draw_bitmap (f, s->gc, NULL, font, code[i], x, y, - p, 0x700, n, i + 1 == len); - x += (s->padding_p ? 1 : xadvance); - } - } - - unblock_input (); - - return len; -} - -static int -ftxfont_end_for_frame (struct frame *f) -{ - struct ftxfont_frame_data *data = font_get_frame_data (f, Qftx); - - block_input (); - while (data) - { - struct ftxfont_frame_data *next = data->next; - int i; - - for (i = 0; i < 6; i++) - XFreeGC (FRAME_X_DISPLAY (f), data->gcs[i]); - xfree (data); - data = next; - } - unblock_input (); - font_put_frame_data (f, Qftx, NULL); - return 0; -} - - - -static void syms_of_ftxfont_for_pdumper (void); - -struct font_driver const ftxfont_driver = - { - /* We can't draw a text without device dependent functions. */ - .type = LISPSYM_INITIALLY (Qftx), - .get_cache = ftfont_get_cache, - .list = ftxfont_list, - .match = ftxfont_match, - .list_family = ftfont_list_family, - .open_font = ftxfont_open, - .close_font = ftxfont_close, - .has_char = ftfont_has_char, - .encode_char = ftfont_encode_char, - .text_extents = ftfont_text_extents, - .draw = ftxfont_draw, - .get_bitmap = ftfont_get_bitmap, - .anchor_point = ftfont_anchor_point, -#ifdef HAVE_LIBOTF - .otf_capability = ftfont_otf_capability, -#endif - .end_for_frame = ftxfont_end_for_frame, -#if defined HAVE_M17N_FLT && defined HAVE_LIBOTF - .shape = ftfont_shape, -#endif -#if defined HAVE_OTF_GET_VARIATION_GLYPHS || defined HAVE_FT_FACE_GETCHARVARIANTINDEX - .get_variation_glyphs = ftfont_variation_glyphs, -#endif - .filter_properties = ftfont_filter_properties, - .combining_capability = ftfont_combining_capability, - }; - -void -syms_of_ftxfont (void) -{ - DEFSYM (Qftx, "ftx"); - pdumper_do_now_and_after_load (syms_of_ftxfont_for_pdumper); -} - -static void -syms_of_ftxfont_for_pdumper (void) -{ - register_font_driver (&ftxfont_driver, NULL); -} diff --git a/src/gtkutil.c b/src/gtkutil.c index 466cb42c7ee..681f86f51ba 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -4429,13 +4429,6 @@ xg_tool_bar_callback (GtkWidget *w, gpointer client_data) key = AREF (f->tool_bar_items, idx + TOOL_BAR_ITEM_KEY); XSETFRAME (frame, f); - /* We generate two events here. The first one is to set the prefix - to `(tool_bar)', see keyboard.c. */ - event.kind = TOOL_BAR_EVENT; - event.frame_or_window = frame; - event.arg = frame; - kbd_buffer_store_event (&event); - event.kind = TOOL_BAR_EVENT; event.frame_or_window = frame; event.arg = key; diff --git a/src/image.c b/src/image.c index 56878bcb8cb..c8a192aaaf1 100644 --- a/src/image.c +++ b/src/image.c @@ -24,7 +24,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* Include this before including <setjmp.h> to work around bugs with older libpng; see Bug#17429. */ -#if defined HAVE_PNG && !defined HAVE_NS +#if defined HAVE_PNG # include <png.h> #endif @@ -125,6 +125,7 @@ typedef struct ns_bitmap_record Bitmap_Record; #define NO_PIXMAP 0 #define PIX_MASK_RETAIN 0 +#define PIX_MASK_DRAW 1 #endif /* HAVE_NS */ @@ -816,7 +817,6 @@ valid_image_p (Lisp_Object object) return false; } - /* Log error message with format string FORMAT and trailing arguments. Signaling an error, e.g. when an image cannot be loaded, is not a good idea because this would interrupt redisplay, and the error @@ -1004,7 +1004,8 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, break; } - if (EQ (key, QCtype) && !EQ (type, value)) + if (EQ (key, QCtype) + && !(EQ (type, value) || EQ (type, Qnative_image))) return false; } @@ -1620,7 +1621,7 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash) static void uncache_image (struct frame *f, Lisp_Object spec) { - struct image *img = search_image_cache (f, spec, sxhash (spec, 0)); + struct image *img = search_image_cache (f, spec, sxhash (spec)); if (img) { free_image (f, img); @@ -2285,7 +2286,7 @@ lookup_image (struct frame *f, Lisp_Object spec) eassert (valid_image_p (spec)); /* Look up SPEC in the hash table of the image cache. */ - hash = sxhash (spec, 0); + hash = sxhash (spec); img = search_image_cache (f, spec, hash); if (img && img->load_failed_p) { @@ -4572,8 +4573,9 @@ xpm_scan (const char **s, const char *end, const char **beg, ptrdiff_t *len) while (*s < end) { /* Skip white-space. */ - while (*s < end && (c = *(*s)++, c_isspace (c))) - ; + do + c = *(*s)++; + while (c_isspace (c) && *s < end); /* gnus-pointer.xpm uses '-' in its identifier. sb-dir-plus.xpm uses '+' in its identifier. */ @@ -6232,10 +6234,104 @@ pbm_load (struct frame *f, struct image *img) /*********************************************************************** + NATIVE IMAGE HANDLING + ***********************************************************************/ + +#if HAVE_NATIVE_IMAGE_API +static bool +image_can_use_native_api (Lisp_Object type) +{ +# ifdef HAVE_NTGUI + return w32_can_use_native_image_api (type); +# elif defined HAVE_NS + return ns_can_use_native_image_api (type); +# else + return false; +# endif +} + +/* + * These functions are actually defined in the OS-native implementation + * file. Currently, for Windows GDI+ interface, w32image.c, but other + * operating systems can follow suit. + */ + +/* Indices of image specification fields in native format, below. */ +enum native_image_keyword_index +{ + NATIVE_IMAGE_TYPE, + NATIVE_IMAGE_DATA, + NATIVE_IMAGE_FILE, + NATIVE_IMAGE_ASCENT, + NATIVE_IMAGE_MARGIN, + NATIVE_IMAGE_RELIEF, + NATIVE_IMAGE_ALGORITHM, + NATIVE_IMAGE_HEURISTIC_MASK, + NATIVE_IMAGE_MASK, + NATIVE_IMAGE_BACKGROUND, + NATIVE_IMAGE_INDEX, + NATIVE_IMAGE_LAST +}; + +/* Vector of image_keyword structures describing the format + of valid user-defined image specifications. */ +static const struct image_keyword native_image_format[] = +{ + {":type", IMAGE_SYMBOL_VALUE, 1}, + {":data", IMAGE_STRING_VALUE, 0}, + {":file", IMAGE_STRING_VALUE, 0}, + {":ascent", IMAGE_ASCENT_VALUE, 0}, + {":margin", IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR, 0}, + {":relief", IMAGE_INTEGER_VALUE, 0}, + {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":background", IMAGE_STRING_OR_NIL_VALUE, 0}, + {":index", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0} +}; + +/* Return true if OBJECT is a valid native API image specification. */ + +static bool +native_image_p (Lisp_Object object) +{ + struct image_keyword fmt[NATIVE_IMAGE_LAST]; + memcpy (fmt, native_image_format, sizeof fmt); + + if (!parse_image_spec (object, fmt, 10, Qnative_image)) + return 0; + + /* Must specify either the :data or :file keyword. */ + return fmt[NATIVE_IMAGE_FILE].count + fmt[NATIVE_IMAGE_DATA].count == 1; +} + +static bool +native_image_load (struct frame *f, struct image *img) +{ + Lisp_Object image_file = image_spec_value (img->spec, QCfile, NULL); + + if (STRINGP (image_file)) + image_file = image_find_image_file (image_file); + +# ifdef HAVE_NTGUI + return w32_load_image (f, img, image_file, + image_spec_value (img->spec, QCdata, NULL)); +# elif defined HAVE_NS + return ns_load_image (f, img, image_file, + image_spec_value (img->spec, QCdata, NULL)); +# else + return 0; +# endif +} + +#endif /* HAVE_NATIVE_IMAGE_API */ + + +/*********************************************************************** PNG ***********************************************************************/ -#if defined (HAVE_PNG) || defined (HAVE_NS) +#if defined (HAVE_PNG) /* Indices of image specification fields in png_format, below. */ @@ -6286,10 +6382,10 @@ png_image_p (Lisp_Object object) return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1; } -#endif /* HAVE_PNG || HAVE_NS */ +#endif /* HAVE_PNG */ -#if defined HAVE_PNG && !defined HAVE_NS +#ifdef HAVE_PNG # ifdef WINDOWSNT /* PNG library details. */ @@ -6879,18 +6975,7 @@ png_load (struct frame *f, struct image *img) return png_load_body (f, img, &c); } -#elif defined HAVE_NS - -static bool -png_load (struct frame *f, struct image *img) -{ - return ns_load_image (f, img, - image_spec_value (img->spec, QCfile, NULL), - image_spec_value (img->spec, QCdata, NULL)); -} - - -#endif /* HAVE_NS */ +#endif /* HAVE_PNG */ @@ -6898,7 +6983,7 @@ png_load (struct frame *f, struct image *img) JPEG ***********************************************************************/ -#if defined (HAVE_JPEG) || defined (HAVE_NS) +#if defined (HAVE_JPEG) /* Indices of image specification fields in gs_format, below. */ @@ -6950,7 +7035,7 @@ jpeg_image_p (Lisp_Object object) return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1; } -#endif /* HAVE_JPEG || HAVE_NS */ +#endif /* HAVE_JPEG */ #ifdef HAVE_JPEG @@ -7452,18 +7537,6 @@ jpeg_load (struct frame *f, struct image *img) return jpeg_load_body (f, img, &mgr); } -#else /* HAVE_JPEG */ - -#ifdef HAVE_NS -static bool -jpeg_load (struct frame *f, struct image *img) -{ - return ns_load_image (f, img, - image_spec_value (img->spec, QCfile, NULL), - image_spec_value (img->spec, QCdata, NULL)); -} -#endif /* HAVE_NS */ - #endif /* !HAVE_JPEG */ @@ -7472,7 +7545,7 @@ jpeg_load (struct frame *f, struct image *img) TIFF ***********************************************************************/ -#if defined (HAVE_TIFF) || defined (HAVE_NS) +#if defined (HAVE_TIFF) /* Indices of image specification fields in tiff_format, below. */ @@ -7525,7 +7598,7 @@ tiff_image_p (Lisp_Object object) return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1; } -#endif /* HAVE_TIFF || HAVE_NS */ +#endif /* HAVE_TIFF */ #ifdef HAVE_TIFF @@ -7893,16 +7966,6 @@ tiff_load (struct frame *f, struct image *img) return 1; } -#elif defined HAVE_NS - -static bool -tiff_load (struct frame *f, struct image *img) -{ - return ns_load_image (f, img, - image_spec_value (img->spec, QCfile, NULL), - image_spec_value (img->spec, QCdata, NULL)); -} - #endif @@ -7911,7 +7974,7 @@ tiff_load (struct frame *f, struct image *img) GIF ***********************************************************************/ -#if defined (HAVE_GIF) || defined (HAVE_NS) +#if defined (HAVE_GIF) /* Indices of image specification fields in gif_format, below. */ @@ -8490,18 +8553,6 @@ gif_load (struct frame *f, struct image *img) return 1; } -#else /* !HAVE_GIF */ - -#ifdef HAVE_NS -static bool -gif_load (struct frame *f, struct image *img) -{ - return ns_load_image (f, img, - image_spec_value (img->spec, QCfile, NULL), - image_spec_value (img->spec, QCdata, NULL)); -} -#endif /* HAVE_NS */ - #endif /* HAVE_GIF */ @@ -10132,6 +10183,12 @@ initialize_image_type (struct image_type const *type) { #ifdef WINDOWSNT Lisp_Object typesym = builtin_lisp_symbol (type->type); + +# if HAVE_NATIVE_IMAGE_API + if (image_can_use_native_api (typesym)) + return true; +# endif + Lisp_Object tested = Fassq (typesym, Vlibrary_cache); /* If we failed to load the library before, don't try again. */ if (CONSP (tested)) @@ -10164,19 +10221,19 @@ static struct image_type const image_types[] = { SYMBOL_INDEX (Qsvg), svg_image_p, svg_load, image_clear_image, IMAGE_TYPE_INIT (init_svg_functions) }, #endif -#if defined HAVE_PNG || defined HAVE_NS +#if defined HAVE_PNG { SYMBOL_INDEX (Qpng), png_image_p, png_load, image_clear_image, IMAGE_TYPE_INIT (init_png_functions) }, #endif -#if defined HAVE_GIF || defined HAVE_NS +#if defined HAVE_GIF { SYMBOL_INDEX (Qgif), gif_image_p, gif_load, gif_clear_image, IMAGE_TYPE_INIT (init_gif_functions) }, #endif -#if defined HAVE_TIFF || defined HAVE_NS +#if defined HAVE_TIFF { SYMBOL_INDEX (Qtiff), tiff_image_p, tiff_load, image_clear_image, IMAGE_TYPE_INIT (init_tiff_functions) }, #endif -#if defined HAVE_JPEG || defined HAVE_NS +#if defined HAVE_JPEG { SYMBOL_INDEX (Qjpeg), jpeg_image_p, jpeg_load, image_clear_image, IMAGE_TYPE_INIT (init_jpeg_functions) }, #endif @@ -10188,12 +10245,23 @@ static struct image_type const image_types[] = { SYMBOL_INDEX (Qpbm), pbm_image_p, pbm_load, image_clear_image }, }; +#if HAVE_NATIVE_IMAGE_API +struct image_type native_image_type = + { SYMBOL_INDEX (Qnative_image), native_image_p, native_image_load, + image_clear_image }; +#endif + /* Look up image type TYPE, and return a pointer to its image_type structure. Return 0 if TYPE is not a known image type. */ static struct image_type const * lookup_image_type (Lisp_Object type) { +#if HAVE_NATIVE_IMAGE_API + if (image_can_use_native_api (type)) + return &native_image_type; +#endif + for (int i = 0; i < ARRAYELTS (image_types); i++) { struct image_type const *r = &image_types[i]; @@ -10315,22 +10383,22 @@ non-numeric, there is no explicit limit on the size of images. */); add_image_type (Qxpm); #endif -#if defined (HAVE_JPEG) || defined (HAVE_NS) +#if defined (HAVE_JPEG) || defined (HAVE_NATIVE_IMAGE_API) DEFSYM (Qjpeg, "jpeg"); add_image_type (Qjpeg); #endif -#if defined (HAVE_TIFF) || defined (HAVE_NS) +#if defined (HAVE_TIFF) || defined (HAVE_NATIVE_IMAGE_API) DEFSYM (Qtiff, "tiff"); add_image_type (Qtiff); #endif -#if defined (HAVE_GIF) || defined (HAVE_NS) +#if defined (HAVE_GIF) || defined (HAVE_NATIVE_IMAGE_API) DEFSYM (Qgif, "gif"); add_image_type (Qgif); #endif -#if defined (HAVE_PNG) || defined (HAVE_NS) +#if defined (HAVE_PNG) || defined (HAVE_NATIVE_IMAGE_API) DEFSYM (Qpng, "png"); add_image_type (Qpng); #endif @@ -10354,6 +10422,14 @@ non-numeric, there is no explicit limit on the size of images. */); #endif /* HAVE_NTGUI */ #endif /* HAVE_RSVG */ +#if HAVE_NATIVE_IMAGE_API + DEFSYM (Qnative_image, "native-image"); +# ifdef HAVE_NTGUI + DEFSYM (Qgdiplus, "gdiplus"); + DEFSYM (Qshlwapi, "shlwapi"); +# endif +#endif + defsubr (&Sinit_image_library); #ifdef HAVE_IMAGEMAGICK defsubr (&Simagemagick_types); diff --git a/src/indent.c b/src/indent.c index f7db42783c1..c0b4c13b2c5 100644 --- a/src/indent.c +++ b/src/indent.c @@ -285,9 +285,7 @@ skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p, ptrdiff_t to, Lisp_Ob #define MULTIBYTE_BYTES_WIDTH(p, dp, bytes, width) \ do { \ - int ch; \ - \ - ch = STRING_CHAR_AND_LENGTH (p, bytes); \ + int ch = string_char_and_length (p, &(bytes)); \ if (BYTES_BY_CHAR_HEAD (*p) != bytes) \ width = bytes * 4; \ else \ @@ -942,7 +940,7 @@ position_indentation (ptrdiff_t pos_byte) if (CHAR_HAS_CATEGORY (c, ' ')) { column++; - INC_POS (pos_byte); + pos_byte += next_char_len (pos_byte); p = BYTE_POS_ADDR (pos_byte); } else @@ -961,7 +959,7 @@ indented_beyond_p (ptrdiff_t pos, ptrdiff_t pos_byte, EMACS_INT column) { while (pos > BEGV && FETCH_BYTE (pos_byte) == '\n') { - DEC_BOTH (pos, pos_byte); + dec_both (&pos, &pos_byte); pos = find_newline (pos, pos_byte, BEGV, BEGV_BYTE, -1, NULL, &pos_byte, 0); } @@ -1010,7 +1008,7 @@ The return value is the current column. */) int c; ptrdiff_t pos_byte = PT_BYTE; - DEC_POS (pos_byte); + pos_byte -= prev_char_len (pos_byte); c = FETCH_CHAR (pos_byte); if (c == '\t' && prev_col < goal) { @@ -1605,7 +1603,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, { pos = find_before_next_newline (pos, to, 1, &pos_byte); if (pos < to) - INC_BOTH (pos, pos_byte); + inc_both (&pos, &pos_byte); rarely_quit (++quit_count); } while (pos < to @@ -1618,7 +1616,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, if (hpos >= width) hpos = width; } - DEC_BOTH (pos, pos_byte); + dec_both (&pos, &pos_byte); /* We have skipped the invis text, but not the newline after. */ } @@ -1820,8 +1818,8 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */) static struct position val_vmotion; struct position * -vmotion (register ptrdiff_t from, register ptrdiff_t from_byte, - register EMACS_INT vtarget, struct window *w) +vmotion (ptrdiff_t from, ptrdiff_t from_byte, + EMACS_INT vtarget, struct window *w) { ptrdiff_t hscroll = w->hscroll; struct position pos; @@ -1862,7 +1860,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte, Lisp_Object propval; prevline = from; - DEC_BOTH (prevline, bytepos); + dec_both (&prevline, &bytepos); prevline = find_newline_no_quit (prevline, bytepos, -1, &bytepos); while (prevline > BEGV @@ -1875,7 +1873,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte, text_prop_object), TEXT_PROP_MEANS_INVISIBLE (propval)))) { - DEC_BOTH (prevline, bytepos); + dec_both (&prevline, &bytepos); prevline = find_newline_no_quit (prevline, bytepos, -1, &bytepos); } pos = *compute_motion (prevline, bytepos, 0, lmargin, 0, from, @@ -1925,7 +1923,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte, text_prop_object), TEXT_PROP_MEANS_INVISIBLE (propval)))) { - DEC_BOTH (prevline, bytepos); + dec_both (&prevline, &bytepos); prevline = find_newline_no_quit (prevline, bytepos, -1, &bytepos); } pos = *compute_motion (prevline, bytepos, 0, lmargin, 0, from, @@ -2091,15 +2089,15 @@ whether or not it is currently displayed in some window. */) struct it it; struct text_pos pt; struct window *w; - Lisp_Object lcols; + Lisp_Object lcols = Qnil; void *itdata = NULL; ptrdiff_t count = SPECPDL_INDEX (); /* Allow LINES to be of the form (HPOS . VPOS) aka (COLUMNS . LINES). */ - bool lcols_given = CONSP (lines); - if (lcols_given) + if (CONSP (lines)) { lcols = XCAR (lines); + CHECK_NUMBER (lcols); lines = XCDR (lines); } @@ -2279,9 +2277,9 @@ whether or not it is currently displayed in some window. */) overshoot_handled = 1; } - if (lcols_given) + if (!NILP (lcols)) to_x = - window_column_x (w, window, extract_float (lcols), lcols) + window_column_x (w, window, XFLOATINT (lcols), lcols) + lnum_pixel_width; if (nlines <= 0) { @@ -2332,7 +2330,7 @@ whether or not it is currently displayed in some window. */) /* Move to the goal column, if one was specified. If the window was originally hscrolled, the goal column is interpreted as an addition to the hscroll amount. */ - if (lcols_given) + if (!NILP (lcols)) { move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X); /* If we find ourselves in the middle of an overlay string diff --git a/src/insdel.c b/src/insdel.c index dfa1cc311ca..c37b0710783 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -382,10 +382,10 @@ count_bytes (ptrdiff_t pos, ptrdiff_t bytepos, ptrdiff_t endpos) if (pos <= endpos) for ( ; pos < endpos; pos++) - INC_POS (bytepos); + bytepos += next_char_len (bytepos); else for ( ; pos > endpos; pos--) - DEC_POS (bytepos); + bytepos -= prev_char_len (bytepos); return bytepos; } @@ -626,8 +626,7 @@ copy_text (const unsigned char *from_addr, unsigned char *to_addr, while (bytes_left > 0) { - int thislen, c; - c = STRING_CHAR_AND_LENGTH (from_addr, thislen); + int thislen, c = string_char_and_length (from_addr, &thislen); if (! ASCII_CHAR_P (c)) c &= 0xFF; *to_addr++ = c; diff --git a/src/intervals.c b/src/intervals.c index 585ef18bd2e..d4a734c923c 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -298,7 +298,7 @@ rotate_right (INTERVAL A) set_interval_parent (c, A); /* A's total length is decreased by the length of B and its left child. */ - A->total_length -= B->total_length - TOTAL_LENGTH (c); + A->total_length -= TOTAL_LENGTH (B) - TOTAL_LENGTH0 (c); eassert (TOTAL_LENGTH (A) > 0); eassert (LENGTH (A) > 0); @@ -349,7 +349,7 @@ rotate_left (INTERVAL A) set_interval_parent (c, A); /* A's total length is decreased by the length of B and its right child. */ - A->total_length -= B->total_length - TOTAL_LENGTH (c); + A->total_length -= TOTAL_LENGTH (B) - TOTAL_LENGTH0 (c); eassert (TOTAL_LENGTH (A) > 0); eassert (LENGTH (A) > 0); @@ -723,13 +723,13 @@ previous_interval (register INTERVAL interval) i->position - LEFT_TOTAL_LENGTH (i) \ - LENGTH (INTERVAL_PARENT (i)) -/* Find the interval containing POS, given some non-NULL INTERVAL in +/* Find the interval containing POS, given some interval I in the same tree. Note that we update interval->position in each interval we traverse, assuming it is already correctly set for the argument I. We don't assume that any other interval already has a correctly set ->position. */ INTERVAL -update_interval (register INTERVAL i, ptrdiff_t pos) +update_interval (INTERVAL i, ptrdiff_t pos) { if (!i) return NULL; @@ -739,7 +739,7 @@ update_interval (register INTERVAL i, ptrdiff_t pos) if (pos < i->position) { /* Move left. */ - if (pos >= i->position - TOTAL_LENGTH (i->left)) + if (pos >= i->position - LEFT_TOTAL_LENGTH (i)) { i->left->position = i->position - TOTAL_LENGTH (i->left) + LEFT_TOTAL_LENGTH (i->left); @@ -757,7 +757,7 @@ update_interval (register INTERVAL i, ptrdiff_t pos) else if (pos >= INTERVAL_LAST_POS (i)) { /* Move right. */ - if (pos < INTERVAL_LAST_POS (i) + TOTAL_LENGTH (i->right)) + if (pos < INTERVAL_LAST_POS (i) + RIGHT_TOTAL_LENGTH (i)) { i->right->position = INTERVAL_LAST_POS (i) + LEFT_TOTAL_LENGTH (i->right); diff --git a/src/intervals.h b/src/intervals.h index a93b10e9fff..9a7ba910a10 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -96,24 +96,27 @@ struct interval /* True if this interval has both left and right children. */ #define BOTH_KIDS_P(i) ((i)->left != NULL && (i)->right != NULL) -/* The total size of all text represented by this interval and all its - children in the tree. This is zero if the interval is null. */ -#define TOTAL_LENGTH(i) ((i) == NULL ? 0 : (i)->total_length) +/* The total size of all text represented by the nonnull interval I + and all its children in the tree. */ +#define TOTAL_LENGTH(i) ((i)->total_length) + +/* Likewise, but also defined to be zero if I is null. */ +#define TOTAL_LENGTH0(i) ((i) ? TOTAL_LENGTH (i) : 0) /* The size of text represented by this interval alone. */ -#define LENGTH(i) ((i)->total_length \ - - TOTAL_LENGTH ((i)->right) \ - - TOTAL_LENGTH ((i)->left)) +#define LENGTH(i) (TOTAL_LENGTH (i) \ + - RIGHT_TOTAL_LENGTH (i) \ + - LEFT_TOTAL_LENGTH (i)) /* The position of the character just past the end of I. Note that the position cache i->position must be valid for this to work. */ #define INTERVAL_LAST_POS(i) ((i)->position + LENGTH (i)) /* The total size of the left subtree of this interval. */ -#define LEFT_TOTAL_LENGTH(i) ((i)->left ? (i)->left->total_length : 0) +#define LEFT_TOTAL_LENGTH(i) TOTAL_LENGTH0 ((i)->left) /* The total size of the right subtree of this interval. */ -#define RIGHT_TOTAL_LENGTH(i) ((i)->right ? (i)->right->total_length : 0) +#define RIGHT_TOTAL_LENGTH(i) TOTAL_LENGTH0 ((i)->right) /* These macros are for dealing with the interval properties. */ @@ -234,7 +237,7 @@ set_interval_plist (INTERVAL i, Lisp_Object plist) /* Declared in alloc.c. */ -extern INTERVAL make_interval (void); +extern INTERVAL make_interval (void) ATTRIBUTE_RETURNS_NONNULL; /* Declared in intervals.c. */ @@ -246,7 +249,8 @@ extern void traverse_intervals (INTERVAL, ptrdiff_t, Lisp_Object); extern void traverse_intervals_noorder (INTERVAL, void (*) (INTERVAL, void *), void *); -extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t); +extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t); extern INTERVAL find_interval (INTERVAL, ptrdiff_t); extern INTERVAL next_interval (INTERVAL); 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) DEFSYM (Qstring_without_embedded_nulls_p, "string-without-embedded-nulls-p"); DEFSYM (Qjson_value_p, "json-value-p"); - DEFSYM (Qutf_8_string_p, "utf-8-string-p"); DEFSYM (Qjson_error, "json-error"); DEFSYM (Qjson_out_of_memory, "json-out-of-memory"); diff --git a/src/keyboard.c b/src/keyboard.c index bf1f5da22d3..c94d794b013 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2279,7 +2279,7 @@ read_decoded_event_from_main_queue (struct timespec *end_time, eassert (coding->carryover_bytes == 0); n = 0; while (n < coding->produced_char) - events[n++] = make_fixnum (STRING_CHAR_ADVANCE (p)); + events[n++] = make_fixnum (string_char_advance (&p)); } } } @@ -2901,6 +2901,12 @@ read_char (int commandflag, Lisp_Object map, example banishing the mouse under mouse-avoidance-mode. */ timer_resume_idle (); +#ifdef HAVE_NS + if (CONSP (c) + && (EQ (XCAR (c), intern ("ns-unput-working-text")))) + input_was_pending = input_pending; +#endif + if (current_buffer != prev_buffer) { /* The command may have changed the keymaps. Pretend there @@ -2921,13 +2927,11 @@ read_char (int commandflag, Lisp_Object map, goto exit; if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) - && UNSIGNED_CMP (XFIXNAT (c), <, - SCHARS (KVAR (current_kboard, - Vkeyboard_translate_table)))) + && XFIXNAT (c) < SCHARS (KVAR (current_kboard, + Vkeyboard_translate_table))) || (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table)) - && UNSIGNED_CMP (XFIXNAT (c), <, - ASIZE (KVAR (current_kboard, - Vkeyboard_translate_table)))) + && XFIXNAT (c) < ASIZE (KVAR (current_kboard, + Vkeyboard_translate_table))) || (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table)) && CHARACTERP (c))) { @@ -5992,24 +5996,14 @@ make_lispy_event (struct input_event *event) return list2 (Qselect_window, list1 (event->frame_or_window)); case TAB_BAR_EVENT: - if (EQ (event->arg, event->frame_or_window)) - /* This is the prefix key. We translate this to - `(tab_bar)' because the code in keyboard.c for tab bar - events, which we use, relies on this. */ - return list1 (Qtab_bar); - else if (SYMBOLP (event->arg)) - return apply_modifiers (event->modifiers, event->arg); - return event->arg; - case TOOL_BAR_EVENT: - if (EQ (event->arg, event->frame_or_window)) - /* This is the prefix key. We translate this to - `(tool_bar)' because the code in keyboard.c for tool bar - events, which we use, relies on this. */ - return list1 (Qtool_bar); - else if (SYMBOLP (event->arg)) - return apply_modifiers (event->modifiers, event->arg); - return event->arg; + { + Lisp_Object res = event->arg; + Lisp_Object location + = event->kind == TAB_BAR_EVENT ? Qtab_bar : Qtool_bar; + if (SYMBOLP (res)) res = apply_modifiers (event->modifiers, res); + return list2 (res, list2 (event->frame_or_window, location)); + } case USER_SIGNAL_EVENT: /* A user signal. */ @@ -10472,9 +10466,8 @@ Internal use only. */) this_command_key_count = 0; this_single_command_key_start = 0; - int charidx = 0, byteidx = 0; - int key0; - FETCH_STRING_CHAR_ADVANCE (key0, keys, charidx, byteidx); + ptrdiff_t charidx = 0, byteidx = 0; + int key0 = fetch_string_char_advance (keys, &charidx, &byteidx); if (CHAR_BYTE8_P (key0)) key0 = CHAR_TO_BYTE8 (key0); @@ -10486,8 +10479,7 @@ Internal use only. */) add_command_key (make_fixnum (key0)); for (ptrdiff_t i = 1; i < SCHARS (keys); i++) { - int key_i; - FETCH_STRING_CHAR_ADVANCE (key_i, keys, charidx, byteidx); + int key_i = fetch_string_char_advance (keys, &charidx, &byteidx); if (CHAR_BYTE8_P (key_i)) key_i = CHAR_TO_BYTE8 (key_i); add_command_key (make_fixnum (key_i)); diff --git a/src/keymap.c b/src/keymap.c index cfba98c72f2..d98b27b7a1b 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1949,8 +1949,7 @@ then the value includes only maps for prefixes that start with PREFIX. */) for (ptrdiff_t i = 0; i < SCHARS (prefix); ) { ptrdiff_t i_before = i; - int c; - FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte); + int c = fetch_string_char_advance (prefix, &i, &i_byte); if (SINGLE_BYTE_CHAR_P (c) && (c & 0200)) c ^= 0200 | meta_modifier; ASET (copy, i_before, make_fixnum (c)); @@ -2006,23 +2005,16 @@ For an approximate inverse of this, see `kbd'. */) (Lisp_Object keys, Lisp_Object prefix) { ptrdiff_t len = 0; - EMACS_INT i; - ptrdiff_t i_byte; Lisp_Object *args; - EMACS_INT size = XFIXNUM (Flength (keys)); - Lisp_Object list; + EMACS_INT nkeys = XFIXNUM (Flength (keys)); + EMACS_INT nprefix = XFIXNUM (Flength (prefix)); Lisp_Object sep = build_string (" "); - Lisp_Object key; - Lisp_Object result; - bool add_meta = 0; + bool add_meta = false; USE_SAFE_ALLOCA; - if (!NILP (prefix)) - size += XFIXNUM (Flength (prefix)); - /* This has one extra element at the end that we don't pass to Fconcat. */ - EMACS_INT size4; - if (INT_MULTIPLY_WRAPV (size, 4, &size4)) + ptrdiff_t size4; + if (INT_MULTIPLY_WRAPV (nkeys + nprefix, 4, &size4)) memory_full (SIZE_MAX); SAFE_ALLOCA_LISP (args, size4); @@ -2030,82 +2022,76 @@ For an approximate inverse of this, see `kbd'. */) (mapconcat 'single-key-description keys " ") but we shouldn't use mapconcat because it can do GC. */ - next_list: - if (!NILP (prefix)) - list = prefix, prefix = Qnil; - else if (!NILP (keys)) - list = keys, keys = Qnil; - else + Lisp_Object lists[2] = { prefix, keys }; + ptrdiff_t listlens[2] = { nprefix, nkeys }; + for (int li = 0; li < ARRAYELTS (lists); li++) { - if (add_meta) - { - args[len] = Fsingle_key_description (meta_prefix_char, Qnil); - result = Fconcat (len + 1, args); - } - else if (len == 0) - result = empty_unibyte_string; - else - result = Fconcat (len - 1, args); - SAFE_FREE (); - return result; - } + Lisp_Object list = lists[li]; + ptrdiff_t listlen = listlens[li], i_byte = 0; - if (STRINGP (list)) - size = SCHARS (list); - else if (VECTORP (list)) - size = ASIZE (list); - else if (CONSP (list)) - size = list_length (list); - else - wrong_type_argument (Qarrayp, list); + if (! (NILP (list) || STRINGP (list) || VECTORP (list) || CONSP (list))) + wrong_type_argument (Qarrayp, list); - i = i_byte = 0; - - while (i < size) - { - if (STRINGP (list)) + for (ptrdiff_t i = 0; i < listlen; ) { - int c; - FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte); - if (SINGLE_BYTE_CHAR_P (c) && (c & 0200)) - c ^= 0200 | meta_modifier; - XSETFASTINT (key, c); - } - else if (VECTORP (list)) - { - key = AREF (list, i); i++; - } - else - { - key = XCAR (list); - list = XCDR (list); - i++; - } - - if (add_meta) - { - if (!FIXNUMP (key) - || EQ (key, meta_prefix_char) - || (XFIXNUM (key) & meta_modifier)) + Lisp_Object key; + if (STRINGP (list)) { - args[len++] = Fsingle_key_description (meta_prefix_char, Qnil); - args[len++] = sep; - if (EQ (key, meta_prefix_char)) - continue; + int c = fetch_string_char_advance (list, &i, &i_byte); + if (SINGLE_BYTE_CHAR_P (c) && (c & 0200)) + c ^= 0200 | meta_modifier; + key = make_fixnum (c); + } + else if (VECTORP (list)) + { + key = AREF (list, i); + i++; } else - XSETINT (key, XFIXNUM (key) | meta_modifier); - add_meta = 0; - } - else if (EQ (key, meta_prefix_char)) - { - add_meta = 1; - continue; + { + key = XCAR (list); + list = XCDR (list); + i++; + } + + if (add_meta) + { + if (!FIXNUMP (key) + || EQ (key, meta_prefix_char) + || (XFIXNUM (key) & meta_modifier)) + { + args[len++] = Fsingle_key_description (meta_prefix_char, + Qnil); + args[len++] = sep; + if (EQ (key, meta_prefix_char)) + continue; + } + else + key = make_fixnum (XFIXNUM (key) | meta_modifier); + add_meta = false; + } + else if (EQ (key, meta_prefix_char)) + { + add_meta = true; + continue; + } + args[len++] = Fsingle_key_description (key, Qnil); + args[len++] = sep; } - args[len++] = Fsingle_key_description (key, Qnil); - args[len++] = sep; } - goto next_list; + + Lisp_Object result; + if (add_meta) + { + args[len] = Fsingle_key_description (meta_prefix_char, Qnil); + result = Fconcat (len + 1, args); + } + else if (len == 0) + result = empty_unibyte_string; + else + result = Fconcat (len - 1, args); + SAFE_FREE (); + return result; } @@ -2282,12 +2268,6 @@ See `text-char-description' for describing character codes. */) static char * push_text_char_description (register unsigned int c, register char *p) { - if (c >= 0200) - { - *p++ = 'M'; - *p++ = '-'; - c -= 0200; - } if (c < 040) { *p++ = '^'; @@ -2316,23 +2296,22 @@ characters into "C-char", and uses the 2**27 bit for Meta. See Info node `(elisp)Describing Characters' for examples. */) (Lisp_Object character) { - /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */ - char str[6]; - int c; - CHECK_CHARACTER (character); - c = XFIXNUM (character); + int c = XFIXNUM (character); if (!ASCII_CHAR_P (c)) { + char str[MAX_MULTIBYTE_LENGTH]; int len = CHAR_STRING (c, (unsigned char *) str); return make_multibyte_string (str, 1, len); } - - *push_text_char_description (c & 0377, str) = 0; - - return build_string (str); + else + { + char desc[4]; + int len = push_text_char_description (c, desc) - desc; + return make_string (desc, len); + } } static int where_is_preferred_modifier; diff --git a/src/lcms.c b/src/lcms.c index a74c5539860..924bdd299dc 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -254,8 +254,7 @@ parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp, #define PARSE_VIEW_CONDITION_INT(field) \ if (CONSP (view) && FIXNATP (XCAR (view))) \ { \ - CHECK_RANGED_INTEGER (XCAR (view), 1, 4); \ - vc->field = XFIXNUM (XCAR (view)); \ + vc->field = check_integer_range (XCAR (view), 1, 4); \ view = XCDR (view); \ } \ else \ @@ -317,7 +316,7 @@ jab_to_jch (const lcmsJab_t *jab, cmsJCh *jch, double FL, double c1, double c2) } DEFUN ("lcms-xyz->jch", Flcms_xyz_to_jch, Slcms_xyz_to_jch, 1, 3, 0, - doc: /* Convert CIE CAM02 JCh to CIE XYZ. + doc: /* Convert CIE XYZ to CIE CAM02 JCh. COLOR is a list (X Y Z), with Y scaled about unity. Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs', which see. */) @@ -353,7 +352,7 @@ which see. */) } DEFUN ("lcms-jch->xyz", Flcms_jch_to_xyz, Slcms_jch_to_xyz, 1, 3, 0, - doc: /* Convert CIE XYZ to CIE CAM02 JCh. + doc: /* Convert CIE CAM02 JCh to CIE XYZ. COLOR is a list (J C h), where lightness of white is equal to 100, and hue is given in degrees. Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs', diff --git a/src/lisp.h b/src/lisp.h index 92294ac1d33..b4ac017dcf5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -331,8 +331,8 @@ typedef EMACS_INT Lisp_Word; used elsewhere. FIXME: Remove the lisp_h_OP macros, and define just the inline OP - functions, once "gcc -Og" (new to GCC 4.8) works well enough for - Emacs developers. Maybe in the year 2020. See Bug#11935. + functions, once "gcc -Og" (new to GCC 4.8) or equivalent works well + enough for Emacs developers. Maybe in the year 2025. See Bug#11935. For the macros that have corresponding functions (defined later), see these functions for commentary. */ @@ -411,15 +411,19 @@ typedef EMACS_INT Lisp_Word; # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) #endif -/* When compiling via gcc -O0, define the key operations as macros, as - Emacs is too slow otherwise. To disable this optimization, compile - with -DINLINING=false. */ -#if (defined __NO_INLINE__ \ - && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ - && ! (defined INLINING && ! INLINING)) -# define DEFINE_KEY_OPS_AS_MACROS true -#else -# define DEFINE_KEY_OPS_AS_MACROS false +/* When DEFINE_KEY_OPS_AS_MACROS, define key operations as macros to + cajole the compiler into inlining them; otherwise define them as + inline functions as this is cleaner and can be more efficient. + The default is true if the compiler is GCC-like and if function + inlining is disabled because the compiler is not optimizing or is + optimizing for size. Otherwise the default is false. */ +#ifndef DEFINE_KEY_OPS_AS_MACROS +# if (defined __NO_INLINE__ \ + && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__) +# define DEFINE_KEY_OPS_AS_MACROS true +# else +# define DEFINE_KEY_OPS_AS_MACROS false +# endif #endif #if DEFINE_KEY_OPS_AS_MACROS @@ -481,6 +485,7 @@ enum Lisp_Type Lisp_Symbol = 0, /* Type 1 is currently unused. */ + Lisp_Type_Unused0 = 1, /* Fixnum. XFIXNUM (obj) is the integer value. */ Lisp_Int0 = 2, @@ -584,15 +589,19 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, Lisp_Object); /* Defined in bignum.c. */ -extern double bignum_to_double (Lisp_Object); +extern int check_int_nonnegative (Lisp_Object); +extern intmax_t check_integer_range (Lisp_Object, intmax_t, intmax_t); +extern double bignum_to_double (Lisp_Object) ATTRIBUTE_CONST; extern Lisp_Object make_bigint (intmax_t); extern Lisp_Object make_biguint (uintmax_t); +extern uintmax_t check_uinteger_max (Lisp_Object, uintmax_t); /* Defined in chartab.c. */ -extern Lisp_Object char_table_ref (Lisp_Object, int); +extern Lisp_Object char_table_ref (Lisp_Object, int) ATTRIBUTE_PURE; extern void char_table_set (Lisp_Object, int, Lisp_Object); /* Defined in data.c. */ +extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object); extern Lisp_Object default_value (Lisp_Object symbol); @@ -1070,7 +1079,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG) with PVEC_TYPE_MASK to indicate the actual type. */ enum pvec_type { - PVEC_NORMAL_VECTOR, + PVEC_NORMAL_VECTOR, /* Should be first, for sxhash_obj. */ PVEC_FREE, PVEC_BIGNUM, PVEC_MARKER, @@ -1095,7 +1104,7 @@ enum pvec_type PVEC_CONDVAR, PVEC_MODULE_FUNCTION, - /* These should be last, check internal_equal to see why. */ + /* These should be last, for internal_equal and sxhash_obj. */ PVEC_COMPILED, PVEC_CHAR_TABLE, PVEC_SUB_CHAR_TABLE, @@ -1914,18 +1923,12 @@ memclear (void *p, ptrdiff_t nbytes) (offsetof (type, lastlispfield) + word_size < header_size \ ? 0 : (offsetof (type, lastlispfield) + word_size - header_size) / word_size) -/* Compute A OP B, using the unsigned comparison operator OP. A and B - should be integer expressions. This is not the same as - mathematical comparison; for example, UNSIGNED_CMP (0, <, -1) - returns true. For efficiency, prefer plain unsigned comparison if A - and B's sizes both fit (after integer promotion). */ -#define UNSIGNED_CMP(a, op, b) \ - (max (sizeof ((a) + 0), sizeof ((b) + 0)) <= sizeof (unsigned) \ - ? ((a) + (unsigned) 0) op ((b) + (unsigned) 0) \ - : ((a) + (uintmax_t) 0) op ((b) + (uintmax_t) 0)) - /* True iff C is an ASCII character. */ -#define ASCII_CHAR_P(c) UNSIGNED_CMP (c, <, 0x80) +INLINE bool +ASCII_CHAR_P (intmax_t c) +{ + return 0 <= c && c < 0x80; +} /* A char-table is a kind of vectorlike, with contents are like a vector but with a few other slots. For some purposes, it makes @@ -2997,28 +3000,6 @@ CHECK_FIXNAT (Lisp_Object x) CHECK_TYPE (FIXNATP (x), Qwholenump, x); } -#define CHECK_RANGED_INTEGER(x, lo, hi) \ - do { \ - CHECK_FIXNUM (x); \ - if (! ((lo) <= XFIXNUM (x) && XFIXNUM (x) <= (hi))) \ - args_out_of_range_3 (x, INT_TO_INTEGER (lo), INT_TO_INTEGER (hi)); \ - } while (false) -#define CHECK_TYPE_RANGED_INTEGER(type, x) \ - do { \ - if (TYPE_SIGNED (type)) \ - CHECK_RANGED_INTEGER (x, TYPE_MINIMUM (type), TYPE_MAXIMUM (type)); \ - else \ - CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ - } while (false) - -#define CHECK_FIXNUM_COERCE_MARKER(x) \ - do { \ - if (MARKERP ((x))) \ - XSETFASTINT (x, marker_position (x)); \ - else \ - CHECK_TYPE (FIXNUMP (x), Qinteger_or_marker_p, x); \ - } while (false) - INLINE double XFLOATINT (Lisp_Object n) { @@ -3038,22 +3019,6 @@ CHECK_INTEGER (Lisp_Object x) { CHECK_TYPE (INTEGERP (x), Qnumberp, x); } - -#define CHECK_NUMBER_COERCE_MARKER(x) \ - do { \ - if (MARKERP (x)) \ - XSETFASTINT (x, marker_position (x)); \ - else \ - CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \ - } while (false) - -#define CHECK_INTEGER_COERCE_MARKER(x) \ - do { \ - if (MARKERP (x)) \ - XSETFASTINT (x, marker_position (x)); \ - else \ - CHECK_TYPE (INTEGERP (x), Qnumber_or_marker_p, x); \ - } while (false) /* If we're not dumping using the legacy dumper and we might be using @@ -3507,9 +3472,9 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) /* Defined in bignum.c. This part of bignum.c's API does not require the caller to access bignum internals; see bignum.h for that. */ -extern intmax_t bignum_to_intmax (Lisp_Object); -extern uintmax_t bignum_to_uintmax (Lisp_Object); -extern ptrdiff_t bignum_bufsize (Lisp_Object, int); +extern intmax_t bignum_to_intmax (Lisp_Object) ATTRIBUTE_CONST; +extern uintmax_t bignum_to_uintmax (Lisp_Object) ATTRIBUTE_CONST; +extern ptrdiff_t bignum_bufsize (Lisp_Object, int) ATTRIBUTE_CONST; extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int); extern Lisp_Object bignum_to_string (Lisp_Object, int); extern Lisp_Object make_bignum_str (char const *, int); @@ -3600,7 +3565,6 @@ extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t); extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *); extern AVOID args_out_of_range (Lisp_Object, Lisp_Object); -extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID circular_list (Lisp_Object); extern Lisp_Object do_symval_forwarding (lispfwd); enum Set_Internal_Bind { @@ -3653,7 +3617,7 @@ extern bool sweep_weak_table (struct Lisp_Hash_Table *, bool); extern void hexbuf_digest (char *, void const *, int); extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); -EMACS_UINT sxhash (Lisp_Object, int); +EMACS_UINT sxhash (Lisp_Object); Lisp_Object hashfn_eql (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object hashfn_equal (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *); @@ -3813,7 +3777,7 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, /* Defined in alloc.c. */ extern void *my_heap_start (void); extern void check_pure_size (void); -extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); +unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int); extern void malloc_warning (const char *); extern AVOID memory_full (size_t); extern AVOID buffer_memory_full (ptrdiff_t); @@ -3943,6 +3907,7 @@ extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); extern void make_byte_code (struct Lisp_Vector *); extern struct Lisp_Vector *allocate_vector (ptrdiff_t); +extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); /* Make an uninitialized vector for SIZE objects. NOTE: you must be sure that GC cannot happen until the vector is completely @@ -3978,9 +3943,7 @@ make_uninit_sub_char_table (int depth, int min_char) INLINE Lisp_Object make_nil_vector (ptrdiff_t size) { - Lisp_Object vec = make_uninit_vector (size); - memclear (XVECTOR (vec)->contents, size * word_size); - return vec; + return make_lisp_ptr (allocate_nil_vector (size), Lisp_Vectorlike); } extern struct Lisp_Vector *allocate_pseudovector (int, int, int, @@ -4246,6 +4209,8 @@ extern Lisp_Object module_function_documentation (struct Lisp_Module_Function const *); extern module_funcptr module_function_address (struct Lisp_Module_Function const *); +extern void *module_function_data (const struct Lisp_Module_Function *); +extern void module_finalize_function (const struct Lisp_Module_Function *); extern void mark_modules (void); extern void init_module_assertions (bool); extern void syms_of_module (void); @@ -4605,6 +4570,8 @@ extern void seed_random (void *, ptrdiff_t); extern void init_random (void); extern void emacs_backtrace (int); extern AVOID emacs_abort (void) NO_INLINE; +extern int emacs_fstatat (int, char const *, void *, int); +extern int emacs_openat (int, char const *, int, int); extern int emacs_open (const char *, int, int); extern int emacs_pipe (int[2]); extern int emacs_close (int); diff --git a/src/lread.c b/src/lread.c index f9a8cb3e1a0..59bf529f45c 100644 --- a/src/lread.c +++ b/src/lread.c @@ -152,12 +152,6 @@ static ptrdiff_t prev_saved_doc_string_length; /* This is the file position that string came from. */ static file_offset prev_saved_doc_string_position; -/* True means inside a new-style backquote with no surrounding - parentheses. Fread initializes this to the value of - `force_new_style_backquotes', so we need not specbind it or worry - about what happens to it when there is an error. */ -static bool new_backquote_flag; - /* A list of file names for files being loaded in Fload. Used to check for recursive loads. */ @@ -231,8 +225,9 @@ readchar (Lisp_Object readcharfun, bool *multibyte) { /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte); - BUF_INC_POS (inbuffer, pt_byte); - c = STRING_CHAR (p); + int clen; + c = string_char_and_length (p, &clen); + pt_byte += clen; if (multibyte) *multibyte = 1; } @@ -260,8 +255,9 @@ readchar (Lisp_Object readcharfun, bool *multibyte) { /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos); - BUF_INC_POS (inbuffer, bytepos); - c = STRING_CHAR (p); + int clen; + c = string_char_and_length (p, &clen); + bytepos += clen; if (multibyte) *multibyte = 1; } @@ -300,9 +296,10 @@ readchar (Lisp_Object readcharfun, bool *multibyte) { if (multibyte) *multibyte = 1; - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun, - read_from_string_index, - read_from_string_index_byte); + c = (fetch_string_char_advance_no_check + (readcharfun, + &read_from_string_index, + &read_from_string_index_byte)); } else { @@ -433,7 +430,7 @@ unreadchar (Lisp_Object readcharfun, int c) ptrdiff_t bytepos = BUF_PT_BYTE (b); if (! NILP (BVAR (b, enable_multibyte_characters))) - BUF_DEC_POS (b, bytepos); + bytepos -= buf_prev_char_len (b, bytepos); else bytepos--; @@ -446,7 +443,7 @@ unreadchar (Lisp_Object readcharfun, int c) XMARKER (readcharfun)->charpos--; if (! NILP (BVAR (b, enable_multibyte_characters))) - BUF_DEC_POS (b, bytepos); + bytepos -= buf_prev_char_len (b, bytepos); else bytepos--; @@ -532,13 +529,11 @@ readbyte_from_string (int c, Lisp_Object readcharfun) = string_char_to_byte (string, read_from_string_index); } - if (read_from_string_index >= read_from_string_limit) - c = -1; - else - FETCH_STRING_CHAR_ADVANCE (c, string, - read_from_string_index, - read_from_string_index_byte); - return c; + return (read_from_string_index < read_from_string_limit + ? fetch_string_char_advance (string, + &read_from_string_index, + &read_from_string_index_byte) + : -1); } @@ -985,9 +980,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) /* Value is a version number of byte compiled code if the file associated with file descriptor FD is a compiled Lisp file that's - safe to load. Only files compiled with Emacs are safe to load. - Files compiled with XEmacs can lead to a crash in Fbyte_code - because of an incompatible change in the byte compiler. */ + safe to load. Only files compiled with Emacs can be loaded. */ static int safe_to_load_version (int fd) @@ -1035,22 +1028,16 @@ load_error_handler (Lisp_Object data) return Qnil; } -static AVOID -load_error_old_style_backquotes (void) -{ - if (NILP (Vload_file_name)) - xsignal1 (Qerror, build_string ("Old-style backquotes detected!")); - else - { - AUTO_STRING (format, "Loading `%s': old-style backquotes detected!"); - xsignal1 (Qerror, CALLN (Fformat_message, format, Vload_file_name)); - } -} - static void load_warn_unescaped_character_literals (Lisp_Object file) { - Lisp_Object warning = call0 (Qbyte_run_unescaped_character_literals_warning); + Lisp_Object function + = Fsymbol_function (Qbyte_run_unescaped_character_literals_warning); + /* If byte-run.el is being loaded, + `byte-run--unescaped-character-literals-warning' isn't yet + defined. Since it'll be byte-compiled later, ignore potential + unescaped character literals. */ + Lisp_Object warning = NILP (function) ? Qnil : call0 (function); if (!NILP (warning)) { AUTO_STRING (format, "Loading `%s': %s"); @@ -1153,7 +1140,6 @@ Return t if the file exists and loads successfully. */) /* True means we are loading a compiled file. */ bool compiled = 0; Lisp_Object handler; - bool safe_p = 1; const char *fmode = "r" FOPEN_TEXT; int version; @@ -1199,6 +1185,9 @@ Return t if the file exists and loads successfully. */) || suffix_p (file, ".elc") #ifdef HAVE_MODULES || suffix_p (file, MODULES_SUFFIX) +#ifdef MODULES_SECONDARY_SUFFIX + || suffix_p (file, MODULES_SECONDARY_SUFFIX) +#endif #endif ) must_suffix = Qnil; @@ -1268,7 +1257,12 @@ Return t if the file exists and loads successfully. */) } #ifdef HAVE_MODULES - bool is_module = suffix_p (found, MODULES_SUFFIX); + bool is_module = + suffix_p (found, MODULES_SUFFIX) +#ifdef MODULES_SECONDARY_SUFFIX + || suffix_p (found, MODULES_SECONDARY_SUFFIX) +#endif + ; #else bool is_module = false; #endif @@ -1328,11 +1322,7 @@ Return t if the file exists and loads successfully. */) if (version < 0 && ! (version = safe_to_load_version (fd))) { - safe_p = 0; - if (!load_dangerous_libraries) - error ("File `%s' was not compiled in Emacs", SDATA (found)); - else if (!NILP (nomessage) && !force_load_messages) - message_with_string ("File `%s' not compiled in Emacs", found, 1); + error ("File `%s' was not compiled in Emacs", SDATA (found)); } compiled = 1; @@ -1345,11 +1335,11 @@ Return t if the file exists and loads successfully. */) ignores suffix order due to load_prefer_newer. */ if (!load_prefer_newer && is_elc) { - result = stat (SSDATA (efound), &s1); + result = emacs_fstatat (AT_FDCWD, SSDATA (efound), &s1, 0); if (result == 0) { SSET (efound, SBYTES (efound) - 1, 0); - result = stat (SSDATA (efound), &s2); + result = emacs_fstatat (AT_FDCWD, SSDATA (efound), &s2, 0); SSET (efound, SBYTES (efound) - 1, 'c'); } @@ -1439,10 +1429,7 @@ Return t if the file exists and loads successfully. */) if (NILP (nomessage) || force_load_messages) { - if (!safe_p) - message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...", - file, 1); - else if (is_module) + if (is_module) message_with_string ("Loading %s (module)...", file, 1); else if (!compiled) message_with_string ("Loading %s (source)...", file, 1); @@ -1502,10 +1489,7 @@ Return t if the file exists and loads successfully. */) if (!noninteractive && (NILP (nomessage) || force_load_messages)) { - if (!safe_p) - message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done", - file, 1); - else if (is_module) + if (is_module) message_with_string ("Loading %s (module)...done", file, 1); else if (!compiled) message_with_string ("Loading %s (source)...done", file, 1); @@ -2275,7 +2259,6 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) Lisp_Object retval; readchar_count = 0; - new_backquote_flag = force_new_style_backquotes; /* We can get called from readevalloop which may have set these already. */ if (! HASH_TABLE_P (read_objects_map) @@ -2985,6 +2968,24 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) vec = XVECTOR (tmp); if (vec->header.size == 0) invalid_syntax ("Empty byte-code object"); + + if (COMPILED_DOC_STRING < vec->header.size + && EQ (AREF (tmp, COMPILED_DOC_STRING), make_fixnum (0))) + { + /* read_list found a docstring like '(#$ . 5521)' and treated it + as 0. This placeholder 0 would lead to accidental sharing in + purecopy's hash-consing, so replace it with a (hopefully) + unique integer placeholder, which is negative so that it is + not confused with a DOC file offset (the USE_LSB_TAG shift + relies on the fact that VALMASK is one bit narrower than + INTMASK). Eventually Snarf-documentation should replace the + placeholder with the actual docstring. */ + verify (INTMASK & ~VALMASK); + EMACS_UINT hash = ((XHASH (tmp) >> USE_LSB_TAG) + | (INTMASK - INTMASK / 2)); + ASET (tmp, COMPILED_DOC_STRING, make_ufixnum (hash)); + } + make_byte_code (vec); return tmp; } @@ -3263,70 +3264,24 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) return list2 (Qquote, read0 (readcharfun)); case '`': - { - int next_char = READCHAR; - UNREAD (next_char); - /* Transition from old-style to new-style: - If we see "(`" it used to mean old-style, which usually works - fine because ` should almost never appear in such a position - for new-style. But occasionally we need "(`" to mean new - style, so we try to distinguish the two by the fact that we - can either write "( `foo" or "(` foo", where the first - intends to use new-style whereas the second intends to use - old-style. For Emacs-25, we should completely remove this - first_in_list exception (old-style can still be obtained via - "(\`" anyway). */ - if (!new_backquote_flag && first_in_list && next_char == ' ') - load_error_old_style_backquotes (); - else - { - Lisp_Object value; - bool saved_new_backquote_flag = new_backquote_flag; + return list2 (Qbackquote, read0 (readcharfun)); - new_backquote_flag = 1; - value = read0 (readcharfun); - new_backquote_flag = saved_new_backquote_flag; - - return list2 (Qbackquote, value); - } - } case ',': { - int next_char = READCHAR; - UNREAD (next_char); - /* Transition from old-style to new-style: - It used to be impossible to have a new-style , other than within - a new-style `. This is sufficient when ` and , are used in the - normal way, but ` and , can also appear in args to macros that - will not interpret them in the usual way, in which case , may be - used without any ` anywhere near. - So we now use the same heuristic as for backquote: old-style - unquotes are only recognized when first on a list, and when - followed by a space. - Because it's more difficult to peek 2 chars ahead, a new-style - ,@ can still not be used outside of a `, unless it's in the middle - of a list. */ - if (new_backquote_flag - || !first_in_list - || (next_char != ' ' && next_char != '@')) - { - Lisp_Object comma_type = Qnil; - Lisp_Object value; - int ch = READCHAR; + Lisp_Object comma_type = Qnil; + Lisp_Object value; + int ch = READCHAR; - if (ch == '@') - comma_type = Qcomma_at; - else - { - if (ch >= 0) UNREAD (ch); - comma_type = Qcomma; - } - - value = read0 (readcharfun); - return list2 (comma_type, value); - } + if (ch == '@') + comma_type = Qcomma_at; else - load_error_old_style_backquotes (); + { + if (ch >= 0) UNREAD (ch); + comma_type = Qcomma; + } + + value = read0 (readcharfun); + return list2 (comma_type, value); } case '?': { @@ -4856,9 +4811,16 @@ This list should not include the empty string. `load' and related functions try to append these suffixes, in order, to the specified file name if a suffix is allowed or required. */); #ifdef HAVE_MODULES +#ifdef MODULES_SECONDARY_SUFFIX + Vload_suffixes = list4 (build_pure_c_string (".elc"), + build_pure_c_string (".el"), + build_pure_c_string (MODULES_SUFFIX), + build_pure_c_string (MODULES_SECONDARY_SUFFIX)); +#else Vload_suffixes = list3 (build_pure_c_string (".elc"), build_pure_c_string (".el"), build_pure_c_string (MODULES_SUFFIX)); +#endif #else Vload_suffixes = list2 (build_pure_c_string (".elc"), build_pure_c_string (".el")); @@ -5007,7 +4969,7 @@ This overrides the value of the NOMESSAGE argument to `load'. */); When Emacs loads a compiled Lisp file, it reads the first 512 bytes from the file, and matches them against this regular expression. When the regular expression matches, the file is considered to be safe -to load. See also `load-dangerous-libraries'. */); +to load. */); Vbytecomp_version_regexp = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); @@ -5050,17 +5012,6 @@ Note that if you customize this, obviously it will not affect files that are loaded before your customizations are read! */); load_prefer_newer = 0; - DEFVAR_BOOL ("force-new-style-backquotes", force_new_style_backquotes, - doc: /* Non-nil means to always use the current syntax for backquotes. -If nil, `load' and `read' raise errors when encountering some -old-style variants of backquote and comma. If non-nil, these -constructs are always interpreted as described in the Info node -`(elisp)Backquote', even if that interpretation is incompatible with -previous versions of Emacs. Setting this variable to non-nil makes -Emacs compatible with the behavior planned for Emacs 28. In Emacs 28, -this variable will become obsolete. */); - force_new_style_backquotes = false; - /* Vsource_directory was initialized in init_lread. */ DEFSYM (Qcurrent_load_list, "current-load-list"); diff --git a/src/macfont.m b/src/macfont.m index c589b6685eb..21bc7dde5b3 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -1126,7 +1126,8 @@ struct macfont_metrics }; #define METRICS_VALUE(metrics, member) \ - (((metrics)->member##_high << 8) | (metrics)->member##_low) + ((int) (((unsigned int) (metrics)->member##_high << 8) \ + | (metrics)->member##_low)) #define METRICS_SET_VALUE(metrics, member, value) \ do {short tmp = (value); (metrics)->member##_low = tmp & 0xff; \ (metrics)->member##_high = tmp >> 8;} while (0) diff --git a/src/marker.c b/src/marker.c index 684b7509c51..64f210db88b 100644 --- a/src/marker.c +++ b/src/marker.c @@ -221,7 +221,7 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos) while (best_below != charpos) { best_below++; - BUF_INC_POS (b, best_below_byte); + best_below_byte += buf_next_char_len (b, best_below_byte); } /* If this position is quite far from the nearest known position, @@ -246,7 +246,7 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos) while (best_above != charpos) { best_above--; - BUF_DEC_POS (b, best_above_byte); + best_above_byte -= buf_prev_char_len (b, best_above_byte); } /* If this position is quite far from the nearest known position, @@ -372,7 +372,7 @@ buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos) while (best_below_byte < bytepos) { best_below++; - BUF_INC_POS (b, best_below_byte); + best_below_byte += buf_next_char_len (b, best_below_byte); } /* If this position is quite far from the nearest known position, @@ -399,7 +399,7 @@ buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos) while (best_above_byte > bytepos) { best_above--; - BUF_DEC_POS (b, best_above_byte); + best_above_byte -= buf_prev_char_len (b, best_above_byte); } /* If this position is quite far from the nearest known position, @@ -804,7 +804,7 @@ verify_bytepos (ptrdiff_t charpos) while (below != charpos) { below++; - BUF_INC_POS (current_buffer, below_byte); + below_byte += buf_next_char_len (current_buffer, below_byte); } return below_byte; diff --git a/src/menu.c b/src/menu.c index 28bfcae05d6..e4fda572cd8 100644 --- a/src/menu.c +++ b/src/menu.c @@ -1036,9 +1036,7 @@ menu_item_width (const unsigned char *str) for (len = 0, p = str; *p; ) { - int ch_len; - int ch = STRING_CHAR_AND_LENGTH (p, ch_len); - + int ch_len, ch = string_char_and_length (p, &ch_len); len += CHARACTER_WIDTH (ch); p += ch_len; } @@ -1253,18 +1251,16 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) but I don't want to make one now. */ CHECK_WINDOW (window); - CHECK_RANGED_INTEGER (x, - (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM - ? (EMACS_INT) INT_MIN - xpos - : MOST_NEGATIVE_FIXNUM), - INT_MAX - xpos); - CHECK_RANGED_INTEGER (y, - (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM - ? (EMACS_INT) INT_MIN - ypos - : MOST_NEGATIVE_FIXNUM), - INT_MAX - ypos); - xpos += XFIXNUM (x); - ypos += XFIXNUM (y); + xpos += check_integer_range (x, + (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM + ? (EMACS_INT) INT_MIN - xpos + : MOST_NEGATIVE_FIXNUM), + INT_MAX - xpos); + ypos += check_integer_range (y, + (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM + ? (EMACS_INT) INT_MIN - ypos + : MOST_NEGATIVE_FIXNUM), + INT_MAX - ypos); XSETFRAME (Vmenu_updating_frame, f); } 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/. */ #define gmp_clz(count, x) do { \ mp_limb_t __clz_x = (x); \ - unsigned __clz_c; \ - for (__clz_c = 0; \ - (__clz_x & ((mp_limb_t) 0xff << (GMP_LIMB_BITS - 8))) == 0; \ - __clz_c += 8) \ - __clz_x <<= 8; \ + unsigned __clz_c = 0; \ + int LOCAL_SHIFT_BITS = 8; \ + if (GMP_LIMB_BITS > LOCAL_SHIFT_BITS) \ + for (; \ + (__clz_x & ((mp_limb_t) 0xff << (GMP_LIMB_BITS - 8))) == 0; \ + __clz_c += 8) \ + { __clz_x <<= LOCAL_SHIFT_BITS; } \ for (; (__clz_x & GMP_LIMB_HIGHBIT) == 0; __clz_c++) \ __clz_x <<= 1; \ (count) = __clz_c; \ @@ -143,27 +145,27 @@ see https://www.gnu.org/licenses/. */ w1 = (mp_limb_t) (__ww >> LOCAL_GMP_LIMB_BITS); \ } \ else { \ - mp_limb_t __x0, __x1, __x2, __x3; \ - unsigned __ul, __vl, __uh, __vh; \ - mp_limb_t __u = (u), __v = (v); \ + mp_limb_t __x0, __x1, __x2, __x3; \ + unsigned __ul, __vl, __uh, __vh; \ + mp_limb_t __u = (u), __v = (v); \ \ - __ul = __u & GMP_LLIMB_MASK; \ - __uh = __u >> (GMP_LIMB_BITS / 2); \ - __vl = __v & GMP_LLIMB_MASK; \ - __vh = __v >> (GMP_LIMB_BITS / 2); \ + __ul = __u & GMP_LLIMB_MASK; \ + __uh = __u >> (GMP_LIMB_BITS / 2); \ + __vl = __v & GMP_LLIMB_MASK; \ + __vh = __v >> (GMP_LIMB_BITS / 2); \ \ - __x0 = (mp_limb_t) __ul * __vl; \ - __x1 = (mp_limb_t) __ul * __vh; \ - __x2 = (mp_limb_t) __uh * __vl; \ - __x3 = (mp_limb_t) __uh * __vh; \ + __x0 = (mp_limb_t) __ul * __vl; \ + __x1 = (mp_limb_t) __ul * __vh; \ + __x2 = (mp_limb_t) __uh * __vl; \ + __x3 = (mp_limb_t) __uh * __vh; \ \ - __x1 += __x0 >> (GMP_LIMB_BITS / 2);/* this can't give carry */ \ - __x1 += __x2; /* but this indeed can */ \ - if (__x1 < __x2) /* did we get it? */ \ - __x3 += GMP_HLIMB_BIT; /* yes, add it in the proper pos. */ \ + __x1 += __x0 >> (GMP_LIMB_BITS / 2);/* this can't give carry */ \ + __x1 += __x2; /* but this indeed can */ \ + if (__x1 < __x2) /* did we get it? */ \ + __x3 += GMP_HLIMB_BIT; /* yes, add it in the proper pos. */ \ \ - (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \ - (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \ + (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \ + (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \ } \ } while (0) @@ -768,91 +770,81 @@ mpn_neg (mp_ptr rp, mp_srcptr up, mp_size_t n) mp_limb_t mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0) { - int GMP_LIMB_BITS_MUL_3 = GMP_LIMB_BITS * 3; - if (sizeof (unsigned) * CHAR_BIT > GMP_LIMB_BITS * 3) - { - return (((unsigned) 1 << GMP_LIMB_BITS_MUL_3) - 1) / - (((unsigned) u1 << GMP_LIMB_BITS_MUL_3 / 3) + u0); - } - else if (GMP_ULONG_BITS > GMP_LIMB_BITS * 3) - { - return (((unsigned long) 1 << GMP_LIMB_BITS_MUL_3) - 1) / - (((unsigned long) u1 << GMP_LIMB_BITS_MUL_3 / 3) + u0); - } - else { - mp_limb_t r, p, m, ql; - unsigned ul, uh, qh; + mp_limb_t r, m; - assert (u1 >= GMP_LIMB_HIGHBIT); + { + mp_limb_t p, ql; + unsigned ul, uh, qh; - /* For notation, let b denote the half-limb base, so that B = b^2. - Split u1 = b uh + ul. */ - ul = u1 & GMP_LLIMB_MASK; - uh = u1 >> (GMP_LIMB_BITS / 2); + /* For notation, let b denote the half-limb base, so that B = b^2. + Split u1 = b uh + ul. */ + ul = u1 & GMP_LLIMB_MASK; + uh = u1 >> (GMP_LIMB_BITS / 2); - /* Approximation of the high half of quotient. Differs from the 2/1 - inverse of the half limb uh, since we have already subtracted - u0. */ - qh = ~u1 / uh; + /* Approximation of the high half of quotient. Differs from the 2/1 + inverse of the half limb uh, since we have already subtracted + u0. */ + qh = (u1 ^ GMP_LIMB_MAX) / uh; - /* Adjust to get a half-limb 3/2 inverse, i.e., we want + /* Adjust to get a half-limb 3/2 inverse, i.e., we want - qh' = floor( (b^3 - 1) / u) - b = floor ((b^3 - b u - 1) / u - = floor( (b (~u) + b-1) / u), + qh' = floor( (b^3 - 1) / u) - b = floor ((b^3 - b u - 1) / u + = floor( (b (~u) + b-1) / u), - and the remainder + and the remainder - r = b (~u) + b-1 - qh (b uh + ul) + r = b (~u) + b-1 - qh (b uh + ul) = b (~u - qh uh) + b-1 - qh ul - Subtraction of qh ul may underflow, which implies adjustments. - But by normalization, 2 u >= B > qh ul, so we need to adjust by - at most 2. - */ + Subtraction of qh ul may underflow, which implies adjustments. + But by normalization, 2 u >= B > qh ul, so we need to adjust by + at most 2. + */ - r = ((~u1 - (mp_limb_t) qh * uh) << (GMP_LIMB_BITS / 2)) | GMP_LLIMB_MASK; + r = ((~u1 - (mp_limb_t) qh * uh) << (GMP_LIMB_BITS / 2)) | GMP_LLIMB_MASK; - p = (mp_limb_t) qh * ul; - /* Adjustment steps taken from udiv_qrnnd_c */ - if (r < p) - { - qh--; - r += u1; - if (r >= u1) /* i.e. we didn't get carry when adding to r */ - if (r < p) - { - qh--; - r += u1; - } - } - r -= p; + p = (mp_limb_t) qh * ul; + /* Adjustment steps taken from udiv_qrnnd_c */ + if (r < p) + { + qh--; + r += u1; + if (r >= u1) /* i.e. we didn't get carry when adding to r */ + if (r < p) + { + qh--; + r += u1; + } + } + r -= p; - /* Low half of the quotient is + /* Low half of the quotient is ql = floor ( (b r + b-1) / u1). - This is a 3/2 division (on half-limbs), for which qh is a - suitable inverse. */ + This is a 3/2 division (on half-limbs), for which qh is a + suitable inverse. */ - p = (r >> (GMP_LIMB_BITS / 2)) * qh + r; - /* Unlike full-limb 3/2, we can add 1 without overflow. For this to - work, it is essential that ql is a full mp_limb_t. */ - ql = (p >> (GMP_LIMB_BITS / 2)) + 1; + p = (r >> (GMP_LIMB_BITS / 2)) * qh + r; + /* Unlike full-limb 3/2, we can add 1 without overflow. For this to + work, it is essential that ql is a full mp_limb_t. */ + ql = (p >> (GMP_LIMB_BITS / 2)) + 1; - /* By the 3/2 trick, we don't need the high half limb. */ - r = (r << (GMP_LIMB_BITS / 2)) + GMP_LLIMB_MASK - ql * u1; + /* By the 3/2 trick, we don't need the high half limb. */ + r = (r << (GMP_LIMB_BITS / 2)) + GMP_LLIMB_MASK - ql * u1; - if (r >= (p << (GMP_LIMB_BITS / 2))) - { - ql--; - r += u1; - } - m = ((mp_limb_t) qh << (GMP_LIMB_BITS / 2)) + ql; - if (r >= u1) - { - m++; - r -= u1; - } + if (r >= (GMP_LIMB_MAX & (p << (GMP_LIMB_BITS / 2)))) + { + ql--; + r += u1; + } + m = ((mp_limb_t) qh << (GMP_LIMB_BITS / 2)) + ql; + if (r >= u1) + { + m++; + r -= u1; + } + } /* Now m is the 2/1 inverse of u1. If u0 > 0, adjust it to become a 3/2 inverse. */ @@ -881,7 +873,6 @@ mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0) } return m; - } } struct gmp_div_inverse @@ -3332,7 +3323,7 @@ mpz_bin_uiui (mpz_t r, unsigned long n, unsigned long k) mpz_fac_ui (t, k); for (; k > 0; --k) - mpz_mul_ui (r, r, n--); + mpz_mul_ui (r, r, n--); mpz_divexact (r, r, t); mpz_clear (t); @@ -3990,13 +3981,18 @@ gmp_popcount_limb (mp_limb_t x) unsigned c; /* Do 16 bits at a time, to avoid limb-sized constants. */ - for (c = 0; x > 0; x >>= 16) + int LOCAL_SHIFT_BITS = 16; + for (c = 0; x > 0;) { unsigned w = x - ((x >> 1) & 0x5555); w = ((w >> 2) & 0x3333) + (w & 0x3333); w = (w >> 4) + w; w = ((w >> 8) & 0x000f) + (w & 0x000f); c += w; + if (GMP_LIMB_BITS > LOCAL_SHIFT_BITS) + x >>= LOCAL_SHIFT_BITS; + else + x = 0; } return c; } @@ -4503,10 +4499,15 @@ mpz_export (void *r, size_t *countp, int order, size_t size, int endian, limb = u->_mp_d[un-1]; assert (limb != 0); - k = 0; - do { - k++; limb >>= CHAR_BIT; - } while (limb != 0); + k = (GMP_LIMB_BITS <= CHAR_BIT); + if (!k) + { + do { + int LOCAL_CHAR_BIT = CHAR_BIT; + k++; limb >>= LOCAL_CHAR_BIT; + } while (limb != 0); + } + /* else limb = 0; */ count = (k + (un-1) * sizeof (mp_limb_t) + size - 1) / size; @@ -4535,17 +4536,28 @@ mpz_export (void *r, size_t *countp, int order, size_t size, int endian, for (bytes = 0, i = 0, k = 0; k < count; k++, p += word_step) { size_t j; - for (j = 0; j < size; j++, p -= (ptrdiff_t) endian) + for (j = 0; j < size; ++j, p -= (ptrdiff_t) endian) { - if (bytes == 0) + if (sizeof (mp_limb_t) == 1) { if (i < un) - limb = u->_mp_d[i++]; - bytes = sizeof (mp_limb_t); + *p = u->_mp_d[i++]; + else + *p = 0; + } + else + { + int LOCAL_CHAR_BIT = CHAR_BIT; + if (bytes == 0) + { + if (i < un) + limb = u->_mp_d[i++]; + bytes = sizeof (mp_limb_t); + } + *p = limb; + limb >>= LOCAL_CHAR_BIT; + bytes--; } - *p = limb; - limb >>= CHAR_BIT; - bytes--; } } 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 @@ /* mini-gmp, a minimalistic implementation of a GNU GMP subset. -Copyright 2011-2015, 2017 Free Software Foundation, Inc. +Copyright 2011-2015, 2017, 2019 Free Software Foundation, Inc. This file is part of the GNU MP Library. @@ -53,7 +53,11 @@ void mp_get_memory_functions (void *(**) (size_t), void *(**) (void *, size_t, size_t), void (**) (void *, size_t)); -typedef unsigned long mp_limb_t; +#ifndef MINI_GMP_LIMB_TYPE +#define MINI_GMP_LIMB_TYPE long +#endif + +typedef unsigned MINI_GMP_LIMB_TYPE mp_limb_t; typedef long mp_size_t; typedef unsigned long mp_bitcnt_t; diff --git a/src/minibuf.c b/src/minibuf.c index b837cc53eb9..9d870ce3640 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -414,12 +414,13 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, if (!enable_recursive_minibuffers && minibuf_level > 0) { + Lisp_Object str + = build_string ("Command attempted to use minibuffer while in minibuffer"); if (EQ (selected_window, minibuf_window)) - error ("Command attempted to use minibuffer while in minibuffer"); + Fsignal (Quser_error, (list1 (str))); else /* If we're in another window, cancel the minibuffer that's active. */ - Fthrow (Qexit, - build_string ("Command attempted to use minibuffer while in minibuffer")); + Fthrow (Qexit, str); } if ((noninteractive diff --git a/src/module-env-25.h b/src/module-env-25.h index d8f8eb68119..01ce65e9148 100644 --- a/src/module-env-25.h +++ b/src/module-env-25.h @@ -6,12 +6,10 @@ /* Memory management. */ - emacs_value (*make_global_ref) (emacs_env *env, - emacs_value any_reference) + emacs_value (*make_global_ref) (emacs_env *env, emacs_value value) EMACS_ATTRIBUTE_NONNULL(1); - void (*free_global_ref) (emacs_env *env, - emacs_value global_reference) + void (*free_global_ref) (emacs_env *env, emacs_value global_value) EMACS_ATTRIBUTE_NONNULL(1); /* Non-local exit handling. */ @@ -23,19 +21,15 @@ EMACS_ATTRIBUTE_NONNULL(1); enum emacs_funcall_exit (*non_local_exit_get) - (emacs_env *env, - emacs_value *non_local_exit_symbol_out, - emacs_value *non_local_exit_data_out) + (emacs_env *env, emacs_value *symbol, emacs_value *data) EMACS_ATTRIBUTE_NONNULL(1, 2, 3); void (*non_local_exit_signal) (emacs_env *env, - emacs_value non_local_exit_symbol, - emacs_value non_local_exit_data) + emacs_value symbol, emacs_value data) EMACS_ATTRIBUTE_NONNULL(1); void (*non_local_exit_throw) (emacs_env *env, - emacs_value tag, - emacs_value value) + emacs_value tag, emacs_value value) EMACS_ATTRIBUTE_NONNULL(1); /* Function registration. */ @@ -43,48 +37,46 @@ emacs_value (*make_function) (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, - emacs_value (*function) (emacs_env *env, - ptrdiff_t nargs, - emacs_value args[], - void *) + emacs_value (*func) (emacs_env *env, + ptrdiff_t nargs, + emacs_value* args, + void *data) EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1), - const char *documentation, + const char *docstring, void *data) EMACS_ATTRIBUTE_NONNULL(1, 4); emacs_value (*funcall) (emacs_env *env, - emacs_value function, + emacs_value func, ptrdiff_t nargs, - emacs_value args[]) + emacs_value* args) EMACS_ATTRIBUTE_NONNULL(1); - emacs_value (*intern) (emacs_env *env, - const char *symbol_name) + emacs_value (*intern) (emacs_env *env, const char *name) EMACS_ATTRIBUTE_NONNULL(1, 2); /* Type conversion. */ - emacs_value (*type_of) (emacs_env *env, - emacs_value value) + emacs_value (*type_of) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL(1); - bool (*is_not_nil) (emacs_env *env, emacs_value value) + bool (*is_not_nil) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL(1); bool (*eq) (emacs_env *env, emacs_value a, emacs_value b) EMACS_ATTRIBUTE_NONNULL(1); - intmax_t (*extract_integer) (emacs_env *env, emacs_value value) + intmax_t (*extract_integer) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL(1); - emacs_value (*make_integer) (emacs_env *env, intmax_t value) + emacs_value (*make_integer) (emacs_env *env, intmax_t n) EMACS_ATTRIBUTE_NONNULL(1); - double (*extract_float) (emacs_env *env, emacs_value value) + double (*extract_float) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL(1); - emacs_value (*make_float) (emacs_env *env, double value) + emacs_value (*make_float) (emacs_env *env, double d) EMACS_ATTRIBUTE_NONNULL(1); /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 @@ -101,13 +93,13 @@ bool (*copy_string_contents) (emacs_env *env, emacs_value value, - char *buffer, - ptrdiff_t *size_inout) + char *buf, + ptrdiff_t *len) EMACS_ATTRIBUTE_NONNULL(1, 4); /* Create a Lisp string from a utf8 encoded string. */ emacs_value (*make_string) (emacs_env *env, - const char *contents, ptrdiff_t length) + const char *str, ptrdiff_t len) EMACS_ATTRIBUTE_NONNULL(1, 2); /* Embedded pointer type. */ @@ -116,25 +108,24 @@ void *ptr) EMACS_ATTRIBUTE_NONNULL(1); - void *(*get_user_ptr) (emacs_env *env, emacs_value uptr) + void *(*get_user_ptr) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL(1); - void (*set_user_ptr) (emacs_env *env, emacs_value uptr, void *ptr) + void (*set_user_ptr) (emacs_env *env, emacs_value arg, void *ptr) EMACS_ATTRIBUTE_NONNULL(1); void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr)) (void *) EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1); - void (*set_user_finalizer) (emacs_env *env, - emacs_value uptr, + void (*set_user_finalizer) (emacs_env *env, emacs_value arg, void (*fin) (void *) EMACS_NOEXCEPT) EMACS_ATTRIBUTE_NONNULL(1); /* Vector functions. */ - emacs_value (*vec_get) (emacs_env *env, emacs_value vec, ptrdiff_t i) + emacs_value (*vec_get) (emacs_env *env, emacs_value vector, ptrdiff_t index) EMACS_ATTRIBUTE_NONNULL(1); - void (*vec_set) (emacs_env *env, emacs_value vec, ptrdiff_t i, - emacs_value val) + void (*vec_set) (emacs_env *env, emacs_value vector, ptrdiff_t index, + emacs_value value) EMACS_ATTRIBUTE_NONNULL(1); - ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vec) + ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vector) EMACS_ATTRIBUTE_NONNULL(1); diff --git a/src/module-env-27.h b/src/module-env-27.h index 0fe2557d71b..9ef3c8b33bb 100644 --- a/src/module-env-27.h +++ b/src/module-env-27.h @@ -3,7 +3,7 @@ enum emacs_process_input_result (*process_input) (emacs_env *env) EMACS_ATTRIBUTE_NONNULL (1); - struct timespec (*extract_time) (emacs_env *env, emacs_value value) + struct timespec (*extract_time) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL (1); emacs_value (*make_time) (emacs_env *env, struct timespec time) diff --git a/src/module-env-28.h b/src/module-env-28.h new file mode 100644 index 00000000000..5d884c148c4 --- /dev/null +++ b/src/module-env-28.h @@ -0,0 +1,14 @@ + /* Add module environment functions newly added in Emacs 28 here. + Before Emacs 28 is released, remove this comment and start + module-env-29.h on the master branch. */ + + void (*(*EMACS_ATTRIBUTE_NONNULL (1) + get_function_finalizer) (emacs_env *env, + emacs_value arg)) (void *) EMACS_NOEXCEPT; + + void (*set_function_finalizer) (emacs_env *env, emacs_value arg, + void (*fin) (void *) EMACS_NOEXCEPT) + EMACS_ATTRIBUTE_NONNULL (1); + + int (*open_channel) (emacs_env *env, emacs_value pipe_process) + EMACS_ATTRIBUTE_NONNULL (1); diff --git a/src/msdos.c b/src/msdos.c index 6a89178a6e9..b5f06c99c3d 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1794,7 +1794,7 @@ internal_terminal_init (void) } Vinitial_window_system = Qpc; - Vwindow_system_version = make_fixnum (27); /* RE Emacs version */ + Vwindow_system_version = make_fixnum (28); /* RE Emacs version */ tty->terminal->type = output_msdos_raw; /* If Emacs was dumped on DOS/V machine, forget the stale VRAM @@ -2905,7 +2905,7 @@ IT_menu_display (XMenu *menu, int y, int x, int pn, int *faces, int disp_help) p++; for (j = 0, q = menu->text[i]; *q; j++) { - unsigned c = STRING_CHAR_ADVANCE (q); + unsigned c = string_char_advance (&q); if (c > 26) { diff --git a/src/nsfns.m b/src/nsfns.m index 0f879fe390c..273fb5f7598 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -255,7 +255,10 @@ ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) [col getRed: &r green: &g blue: &b alpha: &alpha]; FRAME_FOREGROUND_PIXEL (f) = - ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff)); + ARGB_TO_ULONG ((unsigned long) (alpha * 0xff), + (unsigned long) (r * 0xff), + (unsigned long) (g * 0xff), + (unsigned long) (b * 0xff)); if (FRAME_NS_VIEW (f)) { @@ -284,19 +287,16 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) error ("Unknown color"); } - /* Clear the frame; in some instances the NS-internal GC appears not - to update, or it does update and cannot clear old text - properly. */ - if (FRAME_VISIBLE_P (f)) - ns_clear_frame (f); - [col retain]; [f->output_data.ns->background_color release]; f->output_data.ns->background_color = col; [col getRed: &r green: &g blue: &b alpha: &alpha]; FRAME_BACKGROUND_PIXEL (f) = - ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff)); + ARGB_TO_ULONG ((unsigned long) (alpha * 0xff), + (unsigned long) (r * 0xff), + (unsigned long) (g * 0xff), + (unsigned long) (b * 0xff)); if (view != nil) { @@ -318,7 +318,10 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } if (FRAME_VISIBLE_P (f)) - SET_FRAME_GARBAGED (f); + { + SET_FRAME_GARBAGED (f); + ns_clear_frame (f); + } } unblock_input (); } @@ -703,14 +706,11 @@ static void ns_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int old_width = FRAME_INTERNAL_BORDER_WIDTH (f); + int new_width = check_int_nonnegative (arg); - CHECK_TYPE_RANGED_INTEGER (int, arg); - f->internal_border_width = XFIXNUM (arg); - if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0) - f->internal_border_width = 0; - - if (FRAME_INTERNAL_BORDER_WIDTH (f) == old_width) + if (new_width == old_width) return; + f->internal_border_width = new_width; if (FRAME_NATIVE_WINDOW (f) != 0) adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width); @@ -1271,14 +1271,20 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, #ifdef NS_IMPL_COCOA tem = gui_display_get_arg (dpyinfo, parms, Qns_appearance, NULL, NULL, RES_TYPE_SYMBOL); - FRAME_NS_APPEARANCE (f) = EQ (tem, Qdark) - ? ns_appearance_vibrant_dark : ns_appearance_aqua; - store_frame_param (f, Qns_appearance, tem); + if (EQ (tem, Qdark)) + FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark; + else if (EQ (tem, Qlight)) + FRAME_NS_APPEARANCE (f) = ns_appearance_aqua; + else + FRAME_NS_APPEARANCE (f) = ns_appearance_system_default; + store_frame_param (f, Qns_appearance, + (!NILP (tem) && !EQ (tem, Qunbound)) ? tem : Qnil); tem = gui_display_get_arg (dpyinfo, parms, Qns_transparent_titlebar, NULL, NULL, RES_TYPE_BOOLEAN); FRAME_NS_TRANSPARENT_TITLEBAR (f) = !NILP (tem) && !EQ (tem, Qunbound); - store_frame_param (f, Qns_transparent_titlebar, tem); + store_frame_param (f, Qns_transparent_titlebar, + FRAME_NS_TRANSPARENT_TITLEBAR (f) ? Qt : Qnil); #endif parent_frame = gui_display_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL, @@ -2947,16 +2953,16 @@ The coordinates X and Y are interpreted in pixels relative to a position if (FRAME_INITIAL_P (f) || !FRAME_NS_P (f)) return Qnil; - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); - mouse_x = screen_frame.origin.x + XFIXNUM (x); + mouse_x = screen_frame.origin.x + xval; if (screen == primary_screen) - mouse_y = screen_frame.origin.y + XFIXNUM (y); + mouse_y = screen_frame.origin.y + yval; else mouse_y = (primary_screen_height - screen_frame.size.height - - screen_frame.origin.y) + XFIXNUM (y); + - screen_frame.origin.y) + yval; CGPoint mouse_pos = CGPointMake(mouse_x, mouse_y); CGWarpMouseCursorPosition (mouse_pos); @@ -3003,80 +3009,6 @@ DEFUN ("ns-show-character-palette", ========================================================================== */ -/* - Handle arrow/function/control keys and copy/paste/cut in file dialogs. - Return YES if handled, NO if not. - */ -static BOOL -handlePanelKeys (NSSavePanel *panel, NSEvent *theEvent) -{ - NSString *s; - int i; - BOOL ret = NO; - - if ([theEvent type] != NSEventTypeKeyDown) return NO; - s = [theEvent characters]; - - for (i = 0; i < [s length]; ++i) - { - int ch = (int) [s characterAtIndex: i]; - switch (ch) - { - case NSHomeFunctionKey: - case NSDownArrowFunctionKey: - case NSUpArrowFunctionKey: - case NSLeftArrowFunctionKey: - case NSRightArrowFunctionKey: - case NSPageUpFunctionKey: - case NSPageDownFunctionKey: - case NSEndFunctionKey: - /* Don't send command modified keys, as those are handled in the - performKeyEquivalent method of the super class. */ - if (! ([theEvent modifierFlags] & NSEventModifierFlagCommand)) - { - [panel sendEvent: theEvent]; - ret = YES; - } - break; - /* As we don't have the standard key commands for - copy/paste/cut/select-all in our edit menu, we must handle - them here. TODO: handle Emacs key bindings for copy/cut/select-all - here, paste works, because we have that in our Edit menu. - I.e. refactor out code in nsterm.m, keyDown: to figure out the - correct modifier. */ - case 'x': // Cut - case 'c': // Copy - case 'v': // Paste - case 'a': // Select all - if ([theEvent modifierFlags] & NSEventModifierFlagCommand) - { - [NSApp sendAction: - (ch == 'x' - ? @selector(cut:) - : (ch == 'c' - ? @selector(copy:) - : (ch == 'v' - ? @selector(paste:) - : @selector(selectAll:)))) - to:nil from:panel]; - ret = YES; - } - default: - // Send all control keys, as the text field supports C-a, C-f, C-e - // C-b and more. - if ([theEvent modifierFlags] & NSEventModifierFlagControl) - { - [panel sendEvent: theEvent]; - ret = YES; - } - break; - } - } - - - return ret; -} - @implementation EmacsFileDelegate /* -------------------------------------------------------------------------- Delegate methods for Open/Save panels @@ -3112,6 +3044,7 @@ syms_of_nsfns (void) DEFSYM (Qframe_title_format, "frame-title-format"); DEFSYM (Qicon_title_format, "icon-title-format"); DEFSYM (Qdark, "dark"); + DEFSYM (Qlight, "light"); DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist, doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames. diff --git a/src/nsfont.m b/src/nsfont.m index 9bec3691786..691becda6da 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -1043,7 +1043,7 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, r.origin.x = s->x; if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) - r.origin.x += abs (s->face->box_line_width); + r.origin.x += max (s->face->box_vertical_line_width, 0); r.origin.y = s->y; r.size.height = FONT_HEIGHT (font); @@ -1090,7 +1090,7 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, twidth += cwidth; #ifdef NS_IMPL_GNUSTEP *adv++ = cwidth; - CHAR_STRING_ADVANCE (*t, c); /* This converts the char to UTF-8. */ + c += CHAR_STRING (*t, c); /* This converts the char to UTF-8. */ #else (*adv++).width = cwidth; #endif @@ -1105,7 +1105,7 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, { NSRect br = r; int fibw = FRAME_INTERNAL_BORDER_WIDTH (s->f); - int mbox_line_width = max (s->face->box_line_width, 0); + int mbox_line_width = max (s->face->box_vertical_line_width, 0); if (s->row->full_width_p) { @@ -1129,9 +1129,10 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, } else { - int correction = abs (s->face->box_line_width)+1; + int correction = abs (s->face->box_horizontal_line_width)+1; br.origin.y += correction; br.size.height -= 2*correction; + correction = abs (s->face->box_vertical_line_width)+1; br.origin.x += correction; br.size.width -= 2*correction; } diff --git a/src/nsimage.m b/src/nsimage.m index fa1e98b8848..07750de95fe 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -45,6 +45,55 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) ========================================================================== */ +bool +ns_can_use_native_image_api (Lisp_Object type) +{ + NSString *imageType = @"unknown"; + NSArray *types; + + NSTRACE ("ns_can_use_native_image_api"); + + if (EQ (type, Qnative_image)) + return YES; + +#ifdef NS_IMPL_COCOA + /* Work out the UTI of the image type. */ + if (EQ (type, Qjpeg)) + imageType = @"public.jpeg"; + else if (EQ (type, Qpng)) + imageType = @"public.png"; + else if (EQ (type, Qgif)) + imageType = @"com.compuserve.gif"; + else if (EQ (type, Qtiff)) + imageType = @"public.tiff"; + else if (EQ (type, Qsvg)) + imageType = @"public.svg-image"; + + /* NSImage also supports a host of other types such as PDF and BMP, + but we don't yet support these in image.c. */ + + types = [NSImage imageTypes]; +#else + /* Work out the image type. */ + if (EQ (type, Qjpeg)) + imageType = @"jpeg"; + else if (EQ (type, Qpng)) + imageType = @"png"; + else if (EQ (type, Qgif)) + imageType = @"gif"; + else if (EQ (type, Qtiff)) + imageType = @"tiff"; + + types = [NSImage imageFileTypes]; +#endif + + /* Check if the type is supported on this system. */ + if ([types indexOfObject:imageType] != NSNotFound) + return YES; + else + return NO; +} + void * ns_image_from_XBM (char *bits, int width, int height, unsigned long fg, unsigned long bg) @@ -407,9 +456,10 @@ ns_set_alpha (void *img, int x, int y, unsigned char a) if (pixmapData[0] != NULL) { int loc = x + y * [self size].width; - return (pixmapData[3][loc] << 24) /* alpha */ - | (pixmapData[0][loc] << 16) | (pixmapData[1][loc] << 8) - | (pixmapData[2][loc]); + return (((unsigned long) pixmapData[3][loc] << 24) /* alpha */ + | ((unsigned long) pixmapData[0][loc] << 16) + | ((unsigned long) pixmapData[1][loc] << 8) + | (unsigned long) pixmapData[2][loc]); } else { diff --git a/src/nsmenu.m b/src/nsmenu.m index 67f9a45a401..b7e4cbd5654 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -1141,8 +1141,6 @@ update_frame_tool_bar (struct frame *f) } #endif - if (oldh != FRAME_TOOLBAR_HEIGHT (f)) - [view updateFrameSize:YES]; if (view->wait_for_tool_bar && FRAME_TOOLBAR_HEIGHT (f) > 0) { view->wait_for_tool_bar = NO; diff --git a/src/nsterm.h b/src/nsterm.h index f68c3246a70..8d5371c8f24 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -339,6 +339,16 @@ typedef id instancetype; #endif +/* macOS 10.14 and above cannot draw directly "to the glass" and + therefore we draw to an offscreen buffer and swap it in when the + toolkit wants to draw the frame. GNUstep and macOS 10.7 and below + do not support this method, so we revert to drawing directly to the + glass. */ +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101400 +#define NS_DRAW_TO_BUFFER 1 +#endif + + /* ========================================================================== NSColor, EmacsColor category. @@ -417,9 +427,12 @@ typedef id instancetype; int maximized_width, maximized_height; NSWindow *nonfs_window; BOOL fs_is_native; + BOOL in_fullscreen_transition; +#ifdef NS_DRAW_TO_BUFFER + CGContextRef drawingBuffer; +#endif @public struct frame *emacsframe; - int rows, cols; int scrollbarsNeedingUpdate; EmacsToolbar *toolbar; NSRect ns_userRect; @@ -438,16 +451,16 @@ typedef id instancetype; /* Emacs-side interface */ - (instancetype) initFrameFromEmacs: (struct frame *) f; - (void) createToolbar: (struct frame *)f; -- (void) setRows: (int) r andColumns: (int) c; - (void) setWindowClosing: (BOOL)closing; - (EmacsToolbar *) toolbar; - (void) deleteWorkingText; -- (void) updateFrameSize: (BOOL) delay; - (void) handleFS; - (void) setFSValue: (int)value; - (void) toggleFullScreen: (id) sender; - (BOOL) fsIsNative; - (BOOL) isFullscreen; +- (BOOL) inFullScreenTransition; +- (void) waitFullScreenTransition; #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 - (void) updateCollectionBehavior; #endif @@ -457,7 +470,13 @@ typedef id instancetype; #endif - (int)fullscreenState; -/* Non-notification versions of NSView methods. Used for direct calls. */ +#ifdef NS_DRAW_TO_BUFFER +- (void)focusOnDrawingBuffer; +- (void)createDrawingBuffer; +#endif +- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect; + +/* Non-notification versions of NSView methods. Used for direct calls. */ - (void)windowWillEnterFullScreen; - (void)windowDidEnterFullScreen; - (void)windowWillExitFullScreen; @@ -471,6 +490,8 @@ typedef id instancetype; { NSPoint grabOffset; } + +- (void)setAppearance; @end @@ -1054,18 +1075,6 @@ struct x_output (FRAME_SCROLL_BAR_LINES (f) * FRAME_LINE_HEIGHT (f) \ - NS_SCROLL_BAR_HEIGHT (f)) : 0) -/* Calculate system coordinates of the left and top of the parent - window or, if there is no parent window, the screen. */ -#define NS_PARENT_WINDOW_LEFT_POS(f) \ - (FRAME_PARENT_FRAME (f) != NULL \ - ? [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window].frame.origin.x : 0) -#define NS_PARENT_WINDOW_TOP_POS(f) \ - (FRAME_PARENT_FRAME (f) != NULL \ - ? ([FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window].frame.origin.y \ - + [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window].frame.size.height \ - - FRAME_NS_TITLEBAR_HEIGHT (FRAME_PARENT_FRAME (f))) \ - : [[[NSScreen screens] objectAtIndex: 0] frame].size.height) - #define FRAME_NS_FONT_TABLE(f) (FRAME_DISPLAY_INFO (f)->font_table) #define FRAME_FONTSET(f) ((f)->output_data.ns->fontset) @@ -1180,6 +1189,7 @@ extern void syms_of_nsselect (void); /* From nsimage.m, needed in image.c */ struct image; +extern bool ns_can_use_native_image_api (Lisp_Object type); extern void *ns_image_from_XBM (char *bits, int width, int height, unsigned long fg, unsigned long bg); extern void *ns_image_for_XPM (int width, int height, int depth); @@ -1259,6 +1269,7 @@ extern char gnustep_base_version[]; /* version tracking */ #if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_7) #define NSFullScreenWindowMask (1 << 14) #define NSWindowCollectionBehaviorFullScreenPrimary (1 << 7) +#define NSWindowCollectionBehaviorFullScreenAuxiliary (1 << 8) #define NSApplicationPresentationFullScreen (1 << 10) #define NSApplicationPresentationAutoHideToolbar (1 << 11) #define NSAppKitVersionNumber10_7 1138 diff --git a/src/nsterm.m b/src/nsterm.m index ac467840a25..19531389545 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -287,7 +287,10 @@ struct ns_display_info *x_display_list; /* Chain of existing displays */ long context_menu_value = 0; /* display update */ +static struct frame *ns_updating_frame; +static NSView *focus_view = NULL; static int ns_window_num = 0; +static BOOL gsaved = NO; static BOOL ns_fake_keydown = NO; #ifdef NS_IMPL_COCOA static BOOL ns_menu_bar_is_hidden = NO; @@ -840,6 +843,32 @@ ns_menu_bar_height (NSScreen *screen) } +/* Get the frame rect, in system coordinates, of the parent window or, + if there is no parent window, the main screen. */ +static inline NSRect +ns_parent_window_rect (struct frame *f) +{ + NSRect parentRect; + + if (FRAME_PARENT_FRAME (f) != NULL) + { + EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)); + parentRect = [parentView convertRect:[parentView frame] + toView:nil]; + parentRect = [[parentView window] convertRectToScreen:parentRect]; + } + else + parentRect = [[[NSScreen screens] objectAtIndex:0] frame]; + + return parentRect; +} + +/* Calculate system coordinates of the left and top of the parent + window or, if there is no parent window, the main screen. */ +#define NS_PARENT_WINDOW_LEFT_POS(f) NSMinX (ns_parent_window_rect (f)) +#define NS_PARENT_WINDOW_TOP_POS(f) NSMaxY (ns_parent_window_rect (f)) + + static NSRect ns_row_rect (struct window *w, struct glyph_row *row, enum glyph_row_area area) @@ -1097,13 +1126,12 @@ ns_update_begin (struct frame *f) external (RIF) call; whole frame, called before gui_update_window_begin -------------------------------------------------------------------------- */ { -#ifdef NS_IMPL_COCOA EmacsView *view = FRAME_NS_VIEW (f); - NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_begin"); ns_update_auto_hide_menu_bar (); +#ifdef NS_IMPL_COCOA if ([view isFullscreen] && [view fsIsNative]) { // Fix reappearing tool bar in fullscreen for Mac OS X 10.7 @@ -1113,6 +1141,28 @@ ns_update_begin (struct frame *f) [toolbar setVisible: tbar_visible]; } #endif + + ns_updating_frame = f; +#ifdef NS_DRAW_TO_BUFFER +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + if ([FRAME_NS_VIEW (f) wantsUpdateLayer]) + { +#endif + [view focusOnDrawingBuffer]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + } + else + { +#endif +#endif /* NS_DRAW_TO_BUFFER */ + +#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + [view lockFocus]; +#endif +#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + } +#endif + } @@ -1123,57 +1173,149 @@ ns_update_end (struct frame *f) external (RIF) call; for whole frame, called after gui_update_window_end -------------------------------------------------------------------------- */ { + EmacsView *view = FRAME_NS_VIEW (f); + NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end"); /* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */ MOUSE_HL_INFO (f)->mouse_face_defer = 0; -} +#ifdef NS_DRAW_TO_BUFFER +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + if ([FRAME_NS_VIEW (f) wantsUpdateLayer]) + { +#endif + [NSGraphicsContext setCurrentContext:nil]; + [view setNeedsDisplay:YES]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + } + else + { +#endif +#endif /* NS_DRAW_TO_BUFFER */ + +#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + block_input (); + + [view unlockFocus]; + [[view window] flushWindow]; -static BOOL -ns_clip_to_rect (struct frame *f, NSRect *r, int n) + unblock_input (); +#endif +#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + } +#endif + ns_updating_frame = NULL; +} + +static void +ns_focus (struct frame *f, NSRect *r, int n) /* -------------------------------------------------------------------------- - Clip the drawing area to rectangle r in frame f. If drawing is not - currently possible mark r as dirty and return NO, otherwise return - YES. + Internal: Focus on given frame. During small local updates this is used to + draw, however during large updates, ns_update_begin and ns_update_end are + called to wrap the whole thing, in which case these calls are stubbed out. + Except, on GNUstep, we accumulate the rectangle being drawn into, because + the back end won't do this automatically, and will just end up flushing + the entire window. -------------------------------------------------------------------------- */ { - NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_clip_to_rect"); - if (r) + EmacsView *view = FRAME_NS_VIEW (f); + + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus"); + if (r != NULL) { NSTRACE_RECT ("r", *r); + } - if ([NSView focusView] == FRAME_NS_VIEW (f)) + if (f != ns_updating_frame) + { +#ifdef NS_DRAW_TO_BUFFER +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + if ([FRAME_NS_VIEW (f) wantsUpdateLayer]) { - [[NSGraphicsContext currentContext] saveGraphicsState]; - if (n == 2) - NSRectClipList (r, 2); - else - NSRectClip (*r); - - return YES; +#endif + [view focusOnDrawingBuffer]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 } else { - NSView *view = FRAME_NS_VIEW (f); - int i; - for (i = 0 ; i < n ; i++) - [view setNeedsDisplayInRect:r[i]]; +#endif +#endif /* NS_DRAW_TO_BUFFER */ + +#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + if (view != focus_view) + { + if (focus_view != NULL) + { + [focus_view unlockFocus]; + [[focus_view window] flushWindow]; + } + + if (view) + [view lockFocus]; + focus_view = view; + } +#endif +#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 } +#endif } - return NO; + + /* clipping */ + if (r) + { + [[NSGraphicsContext currentContext] saveGraphicsState]; + if (n == 2) + NSRectClipList (r, 2); + else + NSRectClip (*r); + gsaved = YES; + } } static void -ns_reset_clipping (struct frame *f) -/* Internal: Restore the previous graphics state, unsetting any - clipping areas. */ +ns_unfocus (struct frame *f) +/* -------------------------------------------------------------------------- + Internal: Remove focus on given frame + -------------------------------------------------------------------------- */ { - NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_reset_clipping"); + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_unfocus"); - [[NSGraphicsContext currentContext] restoreGraphicsState]; + if (gsaved) + { + [[NSGraphicsContext currentContext] restoreGraphicsState]; + gsaved = NO; + } + +#ifdef NS_DRAW_TO_BUFFER + #if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + if ([FRAME_NS_VIEW (f) wantsUpdateLayer]) + { +#endif + [FRAME_NS_VIEW (f) setNeedsDisplay:YES]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + } + else + { +#endif +#endif /* NS_DRAW_TO_BUFFER */ + +#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + if (f != ns_updating_frame) + { + if (focus_view != NULL) + { + [focus_view unlockFocus]; + [[focus_view window] flushWindow]; + focus_view = NULL; + } + } +#endif +#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + } +#endif } @@ -1513,9 +1655,12 @@ ns_make_frame_visible (struct frame *f) /* Making a new frame from a fullscreen frame will make the new frame fullscreen also. So skip handleFS as this will print an error. */ - if ([view fsIsNative] && f->want_fullscreen == FULLSCREEN_BOTH - && [view isFullscreen]) - return; + if ([view fsIsNative] && [view isFullscreen]) + { + // maybe it is not necessary to wait + [view waitFullScreenTransition]; + return; + } if (f->want_fullscreen != FULLSCREEN_NONE) { @@ -1680,61 +1825,64 @@ ns_set_offset (struct frame *f, int xoff, int yoff, int change_grav) -------------------------------------------------------------------------- */ { NSView *view = FRAME_NS_VIEW (f); - NSScreen *screen = [[view window] screen]; + NSRect windowFrame = [[view window] frame]; + NSPoint topLeft; NSTRACE ("ns_set_offset"); block_input (); - f->left_pos = xoff; - f->top_pos = yoff; + if (FRAME_PARENT_FRAME (f)) + { + /* Convert the parent frame's view rectangle into screen + coords. */ + EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)); + NSRect parentRect = [parentView convertRect:[parentView frame] + toView:nil]; + parentRect = [[parentView window] convertRectToScreen:parentRect]; + + if (f->size_hint_flags & XNegative) + topLeft.x = NSMaxX (parentRect) - NSWidth (windowFrame) + xoff; + else + topLeft.x = NSMinX (parentRect) + xoff; - if (view != nil) + if (f->size_hint_flags & YNegative) + topLeft.y = NSMinY (parentRect) + NSHeight (windowFrame) - yoff; + else + topLeft.y = NSMaxY (parentRect) - yoff; + } + else { - if (FRAME_PARENT_FRAME (f) == NULL && screen) - { - f->left_pos = f->size_hint_flags & XNegative - ? [screen visibleFrame].size.width + f->left_pos - FRAME_PIXEL_WIDTH (f) - : f->left_pos; - /* We use visibleFrame here to take menu bar into account. - Ideally we should also adjust left/top with visibleFrame.origin. */ - - f->top_pos = f->size_hint_flags & YNegative - ? ([screen visibleFrame].size.height + f->top_pos - - FRAME_PIXEL_HEIGHT (f) - FRAME_NS_TITLEBAR_HEIGHT (f) - - FRAME_TOOLBAR_HEIGHT (f)) - : f->top_pos; -#ifdef NS_IMPL_GNUSTEP - if (f->left_pos < 100) - f->left_pos = 100; /* don't overlap menu */ -#endif - } - else if (FRAME_PARENT_FRAME (f) != NULL) - { - struct frame *parent = FRAME_PARENT_FRAME (f); + /* If there is no parent frame then just convert to screen + coordinates, UNLESS we have negative values, in which case I + think it's best to position from the bottom and right of the + current screen rather than the main screen or whole + display. */ + NSRect screenFrame = [[[view window] screen] frame]; - /* On X negative values for child frames always result in - positioning relative to the bottom right corner of the - parent frame. */ - if (f->left_pos < 0) - f->left_pos = FRAME_PIXEL_WIDTH (parent) - FRAME_PIXEL_WIDTH (f) + f->left_pos; + if (f->size_hint_flags & XNegative) + topLeft.x = NSMaxX (screenFrame) - NSWidth (windowFrame) + xoff; + else + topLeft.x = xoff; - if (f->top_pos < 0) - f->top_pos = FRAME_PIXEL_HEIGHT (parent) + FRAME_TOOLBAR_HEIGHT (parent) - - FRAME_PIXEL_HEIGHT (f) + f->top_pos; - } + if (f->size_hint_flags & YNegative) + topLeft.y = NSMinY (screenFrame) + NSHeight (windowFrame) - yoff; + else + topLeft.y = NSMaxY ([[[NSScreen screens] objectAtIndex:0] frame]) - yoff; + +#ifdef NS_IMPL_GNUSTEP + /* Don't overlap the menu. - /* Constrain the setFrameTopLeftPoint so we don't move behind the - menu bar. */ - NSPoint pt = NSMakePoint (SCREENMAXBOUND (f->left_pos - + NS_PARENT_WINDOW_LEFT_POS (f)), - SCREENMAXBOUND (NS_PARENT_WINDOW_TOP_POS (f) - - f->top_pos)); - NSTRACE_POINT ("setFrameTopLeftPoint", pt); - [[view window] setFrameTopLeftPoint: pt]; - f->size_hint_flags &= ~(XNegative|YNegative); + FIXME: Surely there's a better way than just hardcoding 100 + in here? */ + topLeft.x = 100; +#endif } + NSTRACE_POINT ("setFrameTopLeftPoint", topLeft); + [[view window] setFrameTopLeftPoint:topLeft]; + f->size_hint_flags &= ~(XNegative|YNegative); + unblock_input (); } @@ -1801,9 +1949,16 @@ ns_set_window_size (struct frame *f, make_fixnum (FRAME_NS_TITLEBAR_HEIGHT (f)), make_fixnum (FRAME_TOOLBAR_HEIGHT (f)))); - [window setFrame: wr display: YES]; + /* Usually it seems safe to delay changing the frame size, but when a + series of actions are taken with no redisplay between them then we + can end up using old values so don't delay here. */ + change_frame_size (f, + FRAME_PIXEL_TO_TEXT_WIDTH (f, pixelwidth), + FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixelheight), + 0, NO, 0, 1); + + [window setFrame:wr display:NO]; - [view updateFrameSize: NO]; unblock_input (); } @@ -1852,7 +2007,6 @@ ns_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu so some key presses (TAB) are swallowed by the system. */ [window makeFirstResponder: view]; - [view updateFrameSize: NO]; unblock_input (); } } @@ -1901,8 +2055,16 @@ ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_val block_input (); child = [FRAME_NS_VIEW (f) window]; +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 + EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); +#endif + if ([child parentWindow] != nil) { +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 + parent = [child parentWindow]; +#endif + [[child parentWindow] removeChildWindow:child]; #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 #if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 @@ -1910,10 +2072,38 @@ ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_val #endif [child setAccessibilitySubrole:NSAccessibilityStandardWindowSubrole]; #endif +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 + if (NILP (new_value)) + { + NSTRACE ("child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary"); + [child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary]; + // if current parent in fullscreen and no new parent make child fullscreen + while (parent) { + if (([parent styleMask] & NSWindowStyleMaskFullScreen) != 0) + { + [view toggleFullScreen:child]; + break; + } + // check all parents + parent = [parent parentWindow]; + } + } +#endif } if (!NILP (new_value)) { +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 + // child frame must not be in fullscreen + if ([view fsIsNative] && [view isFullscreen]) + { + // in case child is going fullscreen + [view waitFullScreenTransition]; + [view toggleFullScreen:child]; + } + NSTRACE ("child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary"); + [child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary]; +#endif parent = [FRAME_NS_VIEW (p) window]; [parent addChildWindow: child @@ -2014,7 +2204,7 @@ ns_set_appearance (struct frame *f, Lisp_Object new_value, Lisp_Object old_value { #if MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); - NSWindow *window = [view window]; + EmacsWindow *window = (EmacsWindow *)[view window]; NSTRACE ("ns_set_appearance"); @@ -2026,17 +2216,13 @@ ns_set_appearance (struct frame *f, Lisp_Object new_value, Lisp_Object old_value return; if (EQ (new_value, Qdark)) - { - window.appearance = [NSAppearance - appearanceNamed: NSAppearanceNameVibrantDark]; - FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark; - } + FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark; + else if (EQ (new_value, Qlight)) + FRAME_NS_APPEARANCE (f) = ns_appearance_aqua; else - { - window.appearance = [NSAppearance - appearanceNamed: NSAppearanceNameAqua]; - FRAME_NS_APPEARANCE (f) = ns_appearance_aqua; - } + FRAME_NS_APPEARANCE (f) = ns_appearance_system_default; + + [window setAppearance]; #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */ } @@ -2302,8 +2488,10 @@ ns_color_index_to_rgba(int idx, struct frame *f) EmacsCGFloat r, g, b, a; [col getRed: &r green: &g blue: &b alpha: &a]; - return ARGB_TO_ULONG((int)(a*255), - (int)(r*255), (int)(g*255), (int)(b*255)); + return ARGB_TO_ULONG((unsigned long) (a * 255), + (unsigned long) (r * 255), + (unsigned long) (g * 255), + (unsigned long) (b * 255)); } void @@ -2323,8 +2511,10 @@ ns_query_color(void *col, Emacs_Color *color_def, bool setPixel) if (setPixel == YES) color_def->pixel - = ARGB_TO_ULONG((int)(a*255), - (int)(r*255), (int)(g*255), (int)(b*255)); + = ARGB_TO_ULONG((unsigned long) (a * 255), + (unsigned long) (r * 255), + (unsigned long) (g * 255), + (unsigned long) (b * 255)); } bool @@ -2478,7 +2668,7 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, id view; NSPoint view_position; Lisp_Object frame, tail; - struct frame *f; + struct frame *f = NULL; struct ns_display_info *dpyinfo; NSTRACE ("ns_mouse_position"); @@ -2770,16 +2960,16 @@ ns_clear_frame (struct frame *f) r = [view bounds]; block_input (); - if (ns_clip_to_rect (f, &r, 1)) - { - [ns_lookup_indexed_color (NS_FACE_BACKGROUND - (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set]; - NSRectFill (r); - ns_reset_clipping (f); - - /* as of 2006/11 or so this is now needed */ - ns_redraw_scroll_bars (f); - } + ns_focus (f, &r, 1); + [ns_lookup_indexed_color (NS_FACE_BACKGROUND + (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set]; + NSRectFill (r); + ns_unfocus (f); + + /* as of 2006/11 or so this is now needed */ + /* FIXME: I don't see any reason for this and removing it makes no + difference here. Do we need it for GNUstep? */ + //ns_redraw_scroll_bars (f); unblock_input (); } @@ -2800,46 +2990,15 @@ ns_clear_frame_area (struct frame *f, int x, int y, int width, int height) NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_clear_frame_area"); r = NSIntersectionRect (r, [view frame]); - if (ns_clip_to_rect (f, &r, 1)) - { - [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; + ns_focus (f, &r, 1); + [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; - NSRectFill (r); + NSRectFill (r); - ns_reset_clipping (f); - } + ns_unfocus (f); + return; } -static void -ns_copy_bits (struct frame *f, NSRect src, NSRect dest) -{ - NSSize delta = NSMakeSize (dest.origin.x - src.origin.x, - dest.origin.y - src.origin.y); - NSTRACE ("ns_copy_bits"); - - if (FRAME_NS_VIEW (f)) - { - hide_bell(); // Ensure the bell image isn't scrolled. - - /* FIXME: scrollRect:by: is deprecated in macOS 10.14. There is - no obvious replacement so we may have to come up with our own. */ - [FRAME_NS_VIEW (f) scrollRect: src by: delta]; - -#ifdef NS_IMPL_COCOA - /* As far as I can tell from the documentation, scrollRect:by:, - above, should copy the dirty rectangles from our source - rectangle to our destination, however it appears it clips the - operation to src. As a result we need to use - translateRectsNeedingDisplayInRect:by: below, and we have to - union src and dest so it can pick up the dirty rectangles, - and place them, as it also clips to the rectangle. - - FIXME: We need a GNUstep equivalent. */ - [FRAME_NS_VIEW (f) translateRectsNeedingDisplayInRect:NSUnionRect (src, dest) - by:delta]; -#endif - } -} static void ns_scroll_run (struct window *w, struct run *run) @@ -2892,8 +3051,12 @@ ns_scroll_run (struct window *w, struct run *run) { NSRect srcRect = NSMakeRect (x, from_y, width, height); NSRect dstRect = NSMakeRect (x, to_y, width, height); + EmacsView *view = FRAME_NS_VIEW (f); - ns_copy_bits (f, srcRect , dstRect); + [view copyRect:srcRect to:dstRect]; +#ifdef NS_IMPL_COCOA + [view setNeedsDisplayInRect:srcRect]; +#endif } unblock_input (); @@ -2947,20 +3110,12 @@ ns_shift_glyphs_for_insert (struct frame *f, External (RIF): copy an area horizontally, don't worry about clearing src -------------------------------------------------------------------------- */ { - //NSRect srcRect = NSMakeRect (x, y, width, height); + NSRect srcRect = NSMakeRect (x, y, width, height); NSRect dstRect = NSMakeRect (x+shift_by, y, width, height); NSTRACE ("ns_shift_glyphs_for_insert"); - /* This doesn't work now as we copy the "bits" before we've had a - chance to actually draw any changes to the screen. This means in - certain circumstances we end up with copies of the cursor all - over the place. Just mark the area dirty so it is redrawn later. - - FIXME: Work out how to do this properly. */ - // ns_copy_bits (f, srcRect, dstRect); - - [FRAME_NS_VIEW (f) setNeedsDisplayInRect:dstRect]; + [FRAME_NS_VIEW (f) copyRect:srcRect to:dstRect]; } @@ -3080,66 +3235,64 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row, /* The visible portion of imageRect will always be contained within clearRect. */ - if (ns_clip_to_rect (f, &clearRect, 1)) + ns_focus (f, &clearRect, 1); + if (! NSIsEmptyRect (clearRect)) { - if (! NSIsEmptyRect (clearRect)) - { - NSTRACE_RECT ("clearRect", clearRect); + NSTRACE_RECT ("clearRect", clearRect); - [ns_lookup_indexed_color(face->background, f) set]; - NSRectFill (clearRect); - } + [ns_lookup_indexed_color(face->background, f) set]; + NSRectFill (clearRect); + } - if (p->which) - { - EmacsImage *img = bimgs[p->which - 1]; + if (p->which) + { + EmacsImage *img = bimgs[p->which - 1]; - if (!img) - { - // Note: For "periodic" images, allocate one EmacsImage for - // the base image, and use it for all dh:s. - unsigned short *bits = p->bits; - int full_height = p->h + p->dh; - int i; - unsigned char *cbits = xmalloc (full_height); - - for (i = 0; i < full_height; i++) - cbits[i] = bits[i]; - img = [[EmacsImage alloc] initFromXBM: cbits width: 8 - height: full_height - fg: 0 bg: 0 - reverseBytes: NO]; - bimgs[p->which - 1] = img; - xfree (cbits); - } + if (!img) + { + // Note: For "periodic" images, allocate one EmacsImage for + // the base image, and use it for all dh:s. + unsigned short *bits = p->bits; + int full_height = p->h + p->dh; + int i; + unsigned char *cbits = xmalloc (full_height); + + for (i = 0; i < full_height; i++) + cbits[i] = bits[i]; + img = [[EmacsImage alloc] initFromXBM: cbits width: 8 + height: full_height + fg: 0 bg: 0 + reverseBytes: NO]; + bimgs[p->which - 1] = img; + xfree (cbits); + } - { - NSColor *bm_color; - if (!p->cursor_p) - bm_color = ns_lookup_indexed_color(face->foreground, f); - else if (p->overlay_p) - bm_color = ns_lookup_indexed_color(face->background, f); - else - bm_color = f->output_data.ns->cursor_color; - [img setXBMColor: bm_color]; - } + { + NSColor *bm_color; + if (!p->cursor_p) + bm_color = ns_lookup_indexed_color(face->foreground, f); + else if (p->overlay_p) + bm_color = ns_lookup_indexed_color(face->background, f); + else + bm_color = f->output_data.ns->cursor_color; + [img setXBMColor: bm_color]; + } - // Note: For periodic images, the full image height is "h + hd". - // By using the height h, a suitable part of the image is used. - NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h); + // Note: For periodic images, the full image height is "h + hd". + // By using the height h, a suitable part of the image is used. + NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h); - NSTRACE_RECT ("fromRect", fromRect); + NSTRACE_RECT ("fromRect", fromRect); - [img drawInRect: imageRect - fromRect: fromRect - operation: NSCompositingOperationSourceOver - fraction: 1.0 - respectFlipped: YES - hints: nil]; - } - ns_reset_clipping (f); + [img drawInRect: imageRect + fromRect: fromRect + operation: NSCompositingOperationSourceOver + fraction: 1.0 + respectFlipped: YES + hints: nil]; } + ns_unfocus (f); } @@ -3224,60 +3377,52 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, /* Prevent the cursor from being drawn outside the text area. */ r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA)); - if (ns_clip_to_rect (f, &r, 1)) + face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); + if (face && NS_FACE_BACKGROUND (face) + == ns_index_color (FRAME_CURSOR_COLOR (f), f)) { - face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); - if (face && NS_FACE_BACKGROUND (face) - == ns_index_color (FRAME_CURSOR_COLOR (f), f)) - { - [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; - hollow_color = FRAME_CURSOR_COLOR (f); - } - else - [FRAME_CURSOR_COLOR (f) set]; - - switch (cursor_type) - { - case DEFAULT_CURSOR: - case NO_CURSOR: - break; - case FILLED_BOX_CURSOR: - NSRectFill (r); - break; - case HOLLOW_BOX_CURSOR: - NSRectFill (r); - [hollow_color set]; - NSRectFill (NSInsetRect (r, 1, 1)); - [FRAME_CURSOR_COLOR (f) set]; - break; - case HBAR_CURSOR: - NSRectFill (r); - break; - case BAR_CURSOR: - s = r; - /* If the character under cursor is R2L, draw the bar cursor - on the right of its glyph, rather than on the left. */ - cursor_glyph = get_phys_cursor_glyph (w); - if ((cursor_glyph->resolved_level & 1) != 0) - s.origin.x += cursor_glyph->pixel_width - s.size.width; - - NSRectFill (s); - break; - } + [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; + hollow_color = FRAME_CURSOR_COLOR (f); + } + else + [FRAME_CURSOR_COLOR (f) set]; - /* Draw the character under the cursor. Other terms only draw - the character on top of box cursors, so do the same here. */ - if (cursor_type == FILLED_BOX_CURSOR || cursor_type == HOLLOW_BOX_CURSOR) - draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + ns_focus (f, &r, 1); - ns_reset_clipping (f); - } - else if (! redisplaying_p) + switch (cursor_type) { - /* If this function is called outside redisplay, it probably - means we need an immediate update. */ - [FRAME_NS_VIEW (f) display]; + case DEFAULT_CURSOR: + case NO_CURSOR: + break; + case FILLED_BOX_CURSOR: + NSRectFill (r); + break; + case HOLLOW_BOX_CURSOR: + NSRectFill (r); + [hollow_color set]; + NSRectFill (NSInsetRect (r, 1, 1)); + [FRAME_CURSOR_COLOR (f) set]; + break; + case HBAR_CURSOR: + NSRectFill (r); + break; + case BAR_CURSOR: + s = r; + /* If the character under cursor is R2L, draw the bar cursor + on the right of its glyph, rather than on the left. */ + cursor_glyph = get_phys_cursor_glyph (w); + if ((cursor_glyph->resolved_level & 1) != 0) + s.origin.x += cursor_glyph->pixel_width - s.size.width; + + NSRectFill (s); + break; } + ns_unfocus (f); + + /* Draw the character under the cursor. Other terms only draw + the character on top of box cursors, so do the same here. */ + if (cursor_type == FILLED_BOX_CURSOR || cursor_type == HOLLOW_BOX_CURSOR) + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); } @@ -3295,14 +3440,12 @@ ns_draw_vertical_window_border (struct window *w, int x, int y0, int y1) face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID); - if (ns_clip_to_rect (f, &r, 1)) - { - if (face) - [ns_lookup_indexed_color(face->foreground, f) set]; + ns_focus (f, &r, 1); + if (face) + [ns_lookup_indexed_color(face->foreground, f) set]; - NSRectFill(r); - ns_reset_clipping (f); - } + NSRectFill(r); + ns_unfocus (f); } @@ -3329,42 +3472,42 @@ ns_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) NSTRACE ("ns_draw_window_divider"); - if (ns_clip_to_rect (f, ÷r, 1)) - { - if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) - /* A vertical divider, at least three pixels wide: Draw first and - last pixels differently. */ - { - [ns_lookup_indexed_color(color_first, f) set]; - NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0)); - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0)); - [ns_lookup_indexed_color(color_last, f) set]; - NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0)); - } - else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) - /* A horizontal divider, at least three pixels high: Draw first and - last pixels differently. */ - { - [ns_lookup_indexed_color(color_first, f) set]; - NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1)); - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2)); - [ns_lookup_indexed_color(color_last, f) set]; - NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1)); - } - else - { - /* In any other case do not draw the first and last pixels - differently. */ - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(divider); - } + ns_focus (f, ÷r, 1); - ns_reset_clipping (f); + if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) + /* A vertical divider, at least three pixels wide: Draw first and + last pixels differently. */ + { + [ns_lookup_indexed_color(color_first, f) set]; + NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0)); + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0)); + [ns_lookup_indexed_color(color_last, f) set]; + NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0)); + } + else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) + /* A horizontal divider, at least three pixels high: Draw first and + last pixels differently. */ + { + [ns_lookup_indexed_color(color_first, f) set]; + NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1)); + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2)); + [ns_lookup_indexed_color(color_last, f) set]; + NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1)); + } + else + { + /* In any other case do not draw the first and last pixels + differently. */ + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(divider); } + + ns_unfocus (f); } + static void ns_show_hourglass (struct frame *f) { @@ -3589,8 +3732,8 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, } static void -ns_draw_box (NSRect r, CGFloat thickness, NSColor *col, - char left_p, char right_p) +ns_draw_box (NSRect r, CGFloat hthickness, CGFloat vthickness, + NSColor *col, char left_p, char right_p) /* -------------------------------------------------------------------------- Draw an unfilled rect inside r, optionally leaving left and/or right open. Note we can't just use an NSDrawRect command, because of the possibility @@ -3601,28 +3744,28 @@ ns_draw_box (NSRect r, CGFloat thickness, NSColor *col, [col set]; /* top, bottom */ - s.size.height = thickness; + s.size.height = hthickness; NSRectFill (s); - s.origin.y += r.size.height - thickness; + s.origin.y += r.size.height - hthickness; NSRectFill (s); s.size.height = r.size.height; s.origin.y = r.origin.y; /* left, right (optional) */ - s.size.width = thickness; + s.size.width = vthickness; if (left_p) NSRectFill (s); if (right_p) { - s.origin.x += r.size.width - thickness; + s.origin.x += r.size.width - vthickness; NSRectFill (s); } } static void -ns_draw_relief (NSRect r, int thickness, char raised_p, +ns_draw_relief (NSRect r, int hthickness, int vthickness, char raised_p, char top_p, char bottom_p, char left_p, char right_p, struct glyph_string *s) /* -------------------------------------------------------------------------- @@ -3672,27 +3815,27 @@ ns_draw_relief (NSRect r, int thickness, char raised_p, /* TODO: mitering. Using NSBezierPath doesn't work because of color switch. */ /* top */ - sr.size.height = thickness; + sr.size.height = hthickness; if (top_p) NSRectFill (sr); /* left */ sr.size.height = r.size.height; - sr.size.width = thickness; + sr.size.width = vthickness; if (left_p) NSRectFill (sr); [(raised_p ? darkCol : lightCol) set]; /* bottom */ sr.size.width = r.size.width; - sr.size.height = thickness; - sr.origin.y += r.size.height - thickness; + sr.size.height = hthickness; + sr.origin.y += r.size.height - hthickness; if (bottom_p) NSRectFill (sr); /* right */ sr.size.height = r.size.height; sr.origin.y = r.origin.y; - sr.size.width = thickness; - sr.origin.x += r.size.width - thickness; + sr.size.width = vthickness; + sr.origin.x += r.size.width - vthickness; if (right_p) NSRectFill (sr); } @@ -3708,7 +3851,7 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s) char left_p, right_p; struct glyph *last_glyph; NSRect r; - int thickness; + int hthickness, vthickness; struct face *face; if (s->hl == DRAW_MOUSE_FACE) @@ -3721,15 +3864,29 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s) else face = s->face; - thickness = face->box_line_width; + vthickness = face->box_vertical_line_width; + hthickness = face->box_horizontal_line_width; NSTRACE ("ns_dumpglyphs_box_or_relief"); last_x = ((s->row->full_width_p && !s->w->pseudo_window_p) ? WINDOW_RIGHT_EDGE_X (s->w) : window_box_right (s->w, s->area)); - last_glyph = (s->cmp || s->img - ? s->first_glyph : s->first_glyph + s->nchars-1); + if (s->cmp || s->img) + last_glyph = s->first_glyph; + else if (s->first_glyph->type == COMPOSITE_GLYPH + && s->first_glyph->u.cmp.automatic) + { + struct glyph *end = s->row->glyphs[s->area] + s->row->used[s->area]; + struct glyph *g = s->first_glyph; + for (last_glyph = g++; + g < end && g->u.cmp.automatic && g->u.cmp.id == s->cmp_id + && g->slice.cmp.to < s->cmp_to; + last_glyph = g++) + ; + } + else + last_glyph = s->first_glyph + s->nchars - 1; right_x = ((s->row->full_width_p && s->extends_to_end_of_line_p ? last_x - 1 : min (last_x, s->x + s->background_width) - 1)); @@ -3746,14 +3903,15 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s) /* TODO: Sometimes box_color is 0 and this seems wrong; should investigate. */ if (s->face->box == FACE_SIMPLE_BOX && s->face->box_color) { - ns_draw_box (r, abs (thickness), + ns_draw_box (r, abs (hthickness), abs (vthickness), ns_lookup_indexed_color (face->box_color, s->f), - left_p, right_p); + left_p, right_p); } else { - ns_draw_relief (r, abs (thickness), s->face->box == FACE_RAISED_BOX, - 1, 1, left_p, right_p, s); + ns_draw_relief (r, abs (hthickness), abs (vthickness), + s->face->box == FACE_RAISED_BOX, + 1, 1, left_p, right_p, s); } } @@ -3769,7 +3927,7 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p) if (!s->background_filled_p/* || s->hl == DRAW_MOUSE_FACE*/) { - int box_line_width = max (s->face->box_line_width, 0); + int box_line_width = max (s->face->box_horizontal_line_width, 0); if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width /* When xdisp.c ignores FONT_HEIGHT, we cannot trust font dimensions, since the actual glyphs might be much @@ -3820,7 +3978,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) -------------------------------------------------------------------------- */ { EmacsImage *img = s->img->pixmap; - int box_line_vwidth = max (s->face->box_line_width, 0); + int box_line_vwidth = max (s->face->box_horizontal_line_width, 0); int x = s->x, y = s->ybase - image_ascent (s->img, s->face, &s->slice); int bg_x, bg_y, bg_height; int th; @@ -3833,7 +3991,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p && s->slice.x == 0) - x += abs (s->face->box_line_width); + x += max (s->face->box_vertical_line_width, 0); bg_x = x; bg_y = s->slice.y == 0 ? s->y : s->y + box_line_vwidth; @@ -3888,15 +4046,22 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) [[NSGraphicsContext currentContext] saveGraphicsState]; - /* Because of the transforms it's far too difficult to work out - what portion of the original, untransformed, image will be - drawn, so the clipping area will ensure we draw only the - correct bit. */ + /* Because of the transforms it's difficult to work out what + portion of the original, untransformed, image will be drawn, + so the clipping area will ensure we draw only the correct + bit. */ NSRectClip (dr); [setOrigin translateXBy:x - s->slice.x yBy:y - s->slice.y]; [setOrigin concat]; - [img->transform concat]; + + NSAffineTransform *doTransform = [NSAffineTransform transform]; + + /* ImageMagick images don't have transforms. */ + if (img->transform) + [doTransform appendTransform:img->transform]; + + [doTransform concat]; [img drawInRect:ir fromRect:ir operation:NSCompositingOperationSourceOver @@ -3946,7 +4111,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) r.origin.y = y - th; r.size.width = s->slice.width + 2*th-1; r.size.height = s->slice.height + 2*th-1; - ns_draw_relief (r, th, raised_p, + ns_draw_relief (r, th, th, raised_p, s->slice.y == 0, s->slice.y + s->slice.height == s->img->height, s->slice.x == 0, @@ -3960,7 +4125,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) { int thickness = abs (s->img->relief); if (thickness == 0) thickness = 1; - ns_draw_box (br, thickness, FRAME_CURSOR_COLOR (s->f), 1, 1); + ns_draw_box (br, thickness, thickness, FRAME_CURSOR_COLOR (s->f), 1, 1); } } @@ -3969,89 +4134,65 @@ static void ns_dumpglyphs_stretch (struct glyph_string *s) { NSRect r[2]; - int n, i; + NSRect glyphRect; + int n; struct face *face; NSColor *fgCol, *bgCol; if (!s->background_filled_p) { n = ns_get_glyph_string_clip_rect (s, r); + ns_focus (s->f, r, n); - if (ns_clip_to_rect (s->f, r, n)) + if (s->hl == DRAW_MOUSE_FACE) { - /* FIXME: Why are we reusing the clipping rectangles? The - other terms don't appear to do anything like this. */ - *r = NSMakeRect (s->x, s->y, s->background_width, s->height); + face = FACE_FROM_ID_OR_NULL (s->f, + MOUSE_HL_INFO (s->f)->mouse_face_face_id); + if (!face) + face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + } + else + face = FACE_FROM_ID (s->f, s->first_glyph->face_id); - if (s->hl == DRAW_MOUSE_FACE) - { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = FACE_FROM_ID (s->f, s->first_glyph->face_id); + bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); + fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); - bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); - fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); + glyphRect = NSMakeRect (s->x, s->y, s->background_width, s->height); - for (i = 0; i < n; ++i) - { - if (!s->row->full_width_p) - { - int overrun, leftoverrun; - - /* truncate to avoid overwriting fringe and/or scrollbar */ - overrun = max (0, (s->x + s->background_width) - - (WINDOW_BOX_RIGHT_EDGE_X (s->w) - - WINDOW_RIGHT_FRINGE_WIDTH (s->w))); - r[i].size.width -= overrun; - - /* truncate to avoid overwriting to left of the window box */ - leftoverrun = (WINDOW_BOX_LEFT_EDGE_X (s->w) - + WINDOW_LEFT_FRINGE_WIDTH (s->w)) - s->x; - - if (leftoverrun > 0) - { - r[i].origin.x += leftoverrun; - r[i].size.width -= leftoverrun; - } - } + [bgCol set]; - [bgCol set]; + /* NOTE: under NS this is NOT used to draw cursors, but we must avoid + overwriting cursor (usually when cursor on a tab) */ + if (s->hl == DRAW_CURSOR) + { + CGFloat x, width; - /* NOTE: under NS this is NOT used to draw cursors, but we must avoid - overwriting cursor (usually when cursor on a tab). */ - if (s->hl == DRAW_CURSOR) - { - CGFloat x, width; + /* FIXME: This looks like it will only work for left to + right languages. */ + x = NSMinX (glyphRect); + width = s->w->phys_cursor_width; + glyphRect.size.width -= width; + glyphRect.origin.x += width; - x = r[i].origin.x; - width = s->w->phys_cursor_width; - r[i].size.width -= width; - r[i].origin.x += width; + NSRectFill (glyphRect); - NSRectFill (r[i]); + /* Draw overlining, etc. on the cursor. */ + if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) + ns_draw_text_decoration (s, face, bgCol, width, x); + else + ns_draw_text_decoration (s, face, fgCol, width, x); + } + else + { + NSRectFill (glyphRect); + } - /* Draw overlining, etc. on the cursor. */ - if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) - ns_draw_text_decoration (s, face, bgCol, width, x); - else - ns_draw_text_decoration (s, face, fgCol, width, x); - } - else - { - NSRectFill (r[i]); - } + /* Draw overlining, etc. on the stretch glyph (or the part + of the stretch glyph after the cursor). */ + ns_draw_text_decoration (s, face, fgCol, NSWidth (glyphRect), + NSMinX (glyphRect)); - /* Draw overlining, etc. on the stretch glyph (or the part - of the stretch glyph after the cursor). */ - ns_draw_text_decoration (s, face, fgCol, r[i].size.width, - r[i].origin.x); - } - ns_reset_clipping (s->f); - } + ns_unfocus (s->f); s->background_filled_p = 1; } } @@ -4067,7 +4208,7 @@ ns_draw_glyph_string_foreground (struct glyph_string *s) of S to the right of that box line. */ if (s->face && s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) - x = s->x + eabs (s->face->box_line_width); + x = s->x + max (s->face->box_vertical_line_width, 0); else x = s->x; @@ -4093,7 +4234,7 @@ ns_draw_composite_glyph_string_foreground (struct glyph_string *s) of S to the right of that box line. */ if (s->face && s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) - x = s->x + eabs (s->face->box_line_width); + x = s->x + max (s->face->box_vertical_line_width, 0); else x = s->x; @@ -4109,7 +4250,7 @@ ns_draw_composite_glyph_string_foreground (struct glyph_string *s) if (s->cmp_from == 0) { NSRect r = NSMakeRect (s->x, s->y, s->width-1, s->height -1); - ns_draw_box (r, 1, FRAME_CURSOR_COLOR (s->f), 1, 1); + ns_draw_box (r, 1, 1, FRAME_CURSOR_COLOR (s->f), 1, 1); } } else if (! s->first_glyph->u.cmp.automatic) @@ -4201,11 +4342,9 @@ ns_draw_glyph_string (struct glyph_string *s) if (next->first_glyph->type != STRETCH_GLYPH) { n = ns_get_glyph_string_clip_rect (s->next, r); - if (ns_clip_to_rect (s->f, r, n)) - { - ns_maybe_dumpglyphs_background (s->next, 1); - ns_reset_clipping (s->f); - } + ns_focus (s->f, r, n); + ns_maybe_dumpglyphs_background (s->next, 1); + ns_unfocus (s->f); } else { @@ -4220,12 +4359,10 @@ ns_draw_glyph_string (struct glyph_string *s) || s->first_glyph->type == COMPOSITE_GLYPH)) { n = ns_get_glyph_string_clip_rect (s, r); - if (ns_clip_to_rect (s->f, r, n)) - { - ns_maybe_dumpglyphs_background (s, 1); - ns_dumpglyphs_box_or_relief (s); - ns_reset_clipping (s->f); - } + ns_focus (s->f, r, n); + ns_maybe_dumpglyphs_background (s, 1); + ns_dumpglyphs_box_or_relief (s); + ns_unfocus (s->f); box_drawn_p = 1; } @@ -4234,11 +4371,9 @@ ns_draw_glyph_string (struct glyph_string *s) case IMAGE_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - if (ns_clip_to_rect (s->f, r, n)) - { - ns_dumpglyphs_image (s, r[0]); - ns_reset_clipping (s->f); - } + ns_focus (s->f, r, n); + ns_dumpglyphs_image (s, r[0]); + ns_unfocus (s->f); break; case STRETCH_GLYPH: @@ -4248,68 +4383,66 @@ ns_draw_glyph_string (struct glyph_string *s) case CHAR_GLYPH: case COMPOSITE_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - if (ns_clip_to_rect (s->f, r, n)) - { - if (s->for_overlaps || (s->cmp_from > 0 - && ! s->first_glyph->u.cmp.automatic)) - s->background_filled_p = 1; - else - ns_maybe_dumpglyphs_background - (s, s->first_glyph->type == COMPOSITE_GLYPH); + ns_focus (s->f, r, n); - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; - } + if (s->for_overlaps || (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic)) + s->background_filled_p = 1; + else + ns_maybe_dumpglyphs_background + (s, s->first_glyph->type == COMPOSITE_GLYPH); - { - BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; + if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) + { + unsigned long tmp = NS_FACE_BACKGROUND (s->face); + NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); + NS_FACE_FOREGROUND (s->face) = tmp; + } - if (isComposite) - ns_draw_composite_glyph_string_foreground (s); - else - ns_draw_glyph_string_foreground (s); - } + { + BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; - { - NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 - ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), - s->f) - : FRAME_FOREGROUND_COLOR (s->f)); - [col set]; - - /* Draw underline, overline, strike-through. */ - ns_draw_text_decoration (s, s->face, col, s->width, s->x); - } + if (isComposite) + ns_draw_composite_glyph_string_foreground (s); + else + ns_draw_glyph_string_foreground (s); + } - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; - } + { + NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 + ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), + s->f) + : FRAME_FOREGROUND_COLOR (s->f)); + [col set]; + + /* Draw underline, overline, strike-through. */ + ns_draw_text_decoration (s, s->face, col, s->width, s->x); + } - ns_reset_clipping (s->f); + if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) + { + unsigned long tmp = NS_FACE_BACKGROUND (s->face); + NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); + NS_FACE_FOREGROUND (s->face) = tmp; } + + ns_unfocus (s->f); break; case GLYPHLESS_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - if (ns_clip_to_rect (s->f, r, n)) - { - if (s->for_overlaps || (s->cmp_from > 0 - && ! s->first_glyph->u.cmp.automatic)) - s->background_filled_p = 1; - else - ns_maybe_dumpglyphs_background - (s, s->first_glyph->type == COMPOSITE_GLYPH); - /* ... */ - /* Not yet implemented. */ - /* ... */ - ns_reset_clipping (s->f); - } + ns_focus (s->f, r, n); + + if (s->for_overlaps || (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic)) + s->background_filled_p = 1; + else + ns_maybe_dumpglyphs_background + (s, s->first_glyph->type == COMPOSITE_GLYPH); + /* ... */ + /* Not yet implemented. */ + /* ... */ + ns_unfocus (s->f); break; default: @@ -4320,11 +4453,9 @@ ns_draw_glyph_string (struct glyph_string *s) if (!s->for_overlaps && !box_drawn_p && s->face->box != FACE_NO_BOX) { n = ns_get_glyph_string_clip_rect (s, r); - if (ns_clip_to_rect (s->f, r, n)) - { - ns_dumpglyphs_box_or_relief (s); - ns_reset_clipping (s->f); - } + ns_focus (s->f, r, n); + ns_dumpglyphs_box_or_relief (s); + ns_unfocus (s->f); } s->num_clips = 0; @@ -5001,9 +5132,6 @@ ns_judge_scroll_bars (struct frame *f) if ([view judge]) removed = YES; } - - if (removed) - [eview updateFrameSize: NO]; } /* ========================================================================== @@ -5396,7 +5524,7 @@ ns_term_init (Lisp_Object display_name) } /* FIXME: Report any errors writing the color file below. */ -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101100 +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101100 #if MAC_OS_X_VERSION_MIN_REQUIRED < 101100 if ([cl respondsToSelector:@selector(writeToURL:error:)]) #endif @@ -6190,6 +6318,17 @@ not_in_argv (NSString *arg) - (void)dealloc { NSTRACE ("[EmacsView dealloc]"); + + /* Clear the view resize notification. */ + [[NSNotificationCenter defaultCenter] + removeObserver:self + name:NSViewFrameDidChangeNotification + object:nil]; + +#ifdef NS_DRAW_TO_BUFFER + CGContextRelease (drawingBuffer); +#endif + [toolbar release]; if (fs_state == FULLSCREEN_BOTH) [nonfs_window release]; @@ -6606,13 +6745,18 @@ not_in_argv (NSString *arg) { NSRect rect; NSPoint pt; - struct window *win = XWINDOW (FRAME_SELECTED_WINDOW (emacsframe)); + struct window *win; NSTRACE ("[EmacsView firstRectForCharacterRange:]"); if (NS_KEYLOG) NSLog (@"firstRectForCharRange request"); + if (WINDOWP (echo_area_window) && ! NILP (call0 (intern ("ns-in-echo-area")))) + win = XWINDOW (echo_area_window); + else + win = XWINDOW (FRAME_SELECTED_WINDOW (emacsframe)); + rect.size.width = theRange.length * FRAME_COLUMN_WIDTH (emacsframe); rect.size.height = FRAME_LINE_HEIGHT (emacsframe); pt.x = WINDOW_TEXT_TO_FRAME_PIXEL_X (win, win->phys_cursor.x); @@ -6719,8 +6863,6 @@ not_in_argv (NSString *arg) NSTRACE ("[EmacsView mouseDown:]"); - [self deleteWorkingText]; - if (!emacs_event) return; @@ -7028,105 +7170,12 @@ not_in_argv (NSString *arg) return NO; } -- (void) updateFrameSize: (BOOL) delay -{ - NSWindow *window = [self window]; - NSRect wr = [window frame]; - int extra = 0; - int oldc = cols, oldr = rows; - int oldw = FRAME_PIXEL_WIDTH (emacsframe); - int oldh = FRAME_PIXEL_HEIGHT (emacsframe); - int neww, newh; - - NSTRACE ("[EmacsView updateFrameSize:]"); - NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh)); - NSTRACE_RECT ("Original frame", wr); - NSTRACE_MSG ("Original columns: %d", cols); - NSTRACE_MSG ("Original rows: %d", rows); - - if (! [self isFullscreen]) - { - int toolbar_height; -#ifdef NS_IMPL_GNUSTEP - // GNUstep does not always update the tool bar height. Force it. - if (toolbar && [toolbar isVisible]) - update_frame_tool_bar (emacsframe); -#endif - - toolbar_height = FRAME_TOOLBAR_HEIGHT (emacsframe); - if (toolbar_height < 0) - toolbar_height = 35; - - extra = FRAME_NS_TITLEBAR_HEIGHT (emacsframe) - + toolbar_height; - } - - if (wait_for_tool_bar) - { - /* The toolbar height is always 0 in fullscreen and undecorated - frames, so don't wait for it to become available. */ - if (FRAME_TOOLBAR_HEIGHT (emacsframe) == 0 - && FRAME_UNDECORATED (emacsframe) == false - && ! [self isFullscreen]) - { - NSTRACE_MSG ("Waiting for toolbar"); - return; - } - wait_for_tool_bar = NO; - } - - neww = (int)wr.size.width - emacsframe->border_width; - newh = (int)wr.size.height - extra; - - NSTRACE_SIZE ("New size", NSMakeSize (neww, newh)); - NSTRACE_MSG ("FRAME_TOOLBAR_HEIGHT: %d", FRAME_TOOLBAR_HEIGHT (emacsframe)); - NSTRACE_MSG ("FRAME_NS_TITLEBAR_HEIGHT: %d", FRAME_NS_TITLEBAR_HEIGHT (emacsframe)); - - cols = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (emacsframe, neww); - rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (emacsframe, newh); - - if (cols < MINWIDTH) - cols = MINWIDTH; - - if (rows < MINHEIGHT) - rows = MINHEIGHT; - - NSTRACE_MSG ("New columns: %d", cols); - NSTRACE_MSG ("New rows: %d", rows); - - if (oldr != rows || oldc != cols || neww != oldw || newh != oldh) - { - NSView *view = FRAME_NS_VIEW (emacsframe); - - change_frame_size (emacsframe, - FRAME_PIXEL_TO_TEXT_WIDTH (emacsframe, neww), - FRAME_PIXEL_TO_TEXT_HEIGHT (emacsframe, newh), - 0, delay, 0, 1); - SET_FRAME_GARBAGED (emacsframe); - cancel_mouse_face (emacsframe); - - /* The next two lines set the frame to the same size as we've - already set above. We need to do this when we switch back - from non-native fullscreen, in other circumstances it appears - to be a noop. (bug#28872) */ - wr = NSMakeRect (0, 0, neww, newh); - [view setFrame: wr]; - - // To do: consider using [NSNotificationCenter postNotificationName:]. - [self windowDidMove: // Update top/left. - [NSNotification notificationWithName:NSWindowDidMoveNotification - object:[view window]]]; - } - else - { - NSTRACE_MSG ("No change"); - } -} - (NSSize)windowWillResize: (NSWindow *)sender toSize: (NSSize)frameSize /* Normalize frame to gridded text size. */ { int extra = 0; + int cols, rows; NSTRACE ("[EmacsView windowWillResize:toSize: " NSTRACE_FMT_SIZE "]", NSTRACE_ARG_SIZE (frameSize)); @@ -7192,6 +7241,7 @@ not_in_argv (NSString *arg) size_title = xmalloc (strlen (old_title) + 40); esprintf (size_title, "%s — (%d x %d)", old_title, cols, rows); [window setTitle: [NSString stringWithUTF8String: size_title]]; + [window display]; xfree (size_title); } } @@ -7262,11 +7312,6 @@ not_in_argv (NSString *arg) sz = [self windowWillResize: theWindow toSize: sz]; #endif /* NS_IMPL_GNUSTEP */ - if (cols > 0 && rows > 0) - { - [self updateFrameSize: YES]; - } - ns_send_appdefined (-1); } @@ -7287,6 +7332,55 @@ not_in_argv (NSString *arg) #endif /* NS_IMPL_COCOA */ +- (void)viewDidResize:(NSNotification *)notification +{ + NSRect frame = [self frame]; + int neww, newh; + + if (! FRAME_LIVE_P (emacsframe)) + return; + + NSTRACE ("[EmacsView viewDidResize]"); + + neww = (int)NSWidth (frame); + newh = (int)NSHeight (frame); + NSTRACE_SIZE ("New size", NSMakeSize (neww, newh)); + +#ifdef NS_DRAW_TO_BUFFER + if ([self wantsUpdateLayer]) + { + CGFloat scale = [[self window] backingScaleFactor]; + int oldw = (CGFloat)CGBitmapContextGetWidth (drawingBuffer) / scale; + int oldh = (CGFloat)CGBitmapContextGetHeight (drawingBuffer) / scale; + + NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh)); + + /* Don't want to do anything when the view size hasn't changed. */ + if ((oldh == newh && oldw == neww)) + { + NSTRACE_MSG ("No change"); + return; + } + } +#endif + + /* I'm not sure if it's safe to call this every time the view + changes size, as Emacs may already know about the change. + Unfortunately there doesn't seem to be a bullet-proof method of + determining whether we need to call it or not. */ + change_frame_size (emacsframe, + FRAME_PIXEL_TO_TEXT_WIDTH (emacsframe, neww), + FRAME_PIXEL_TO_TEXT_HEIGHT (emacsframe, newh), + 0, YES, 0, 1); + +#ifdef NS_DRAW_TO_BUFFER + [self createDrawingBuffer]; +#endif + SET_FRAME_GARBAGED (emacsframe); + cancel_mouse_face (emacsframe); +} + + - (void)windowDidBecomeKey: (NSNotification *)notification /* cf. x_detect_focus_change(), x_focus_changed(), x_new_focus_frame() */ { @@ -7345,7 +7439,6 @@ not_in_argv (NSString *arg) if (emacs_event && is_focus_frame) { - [self deleteWorkingText]; emacs_event->kind = FOCUS_OUT_EVENT; EV_TRAILER ((id)nil); } @@ -7411,7 +7504,7 @@ not_in_argv (NSString *arg) { NSRect r, wr; Lisp_Object tem; - NSWindow *win; + EmacsWindow *win; NSColor *col; NSString *name; @@ -7431,6 +7524,7 @@ not_in_argv (NSString *arg) #endif fs_is_native = ns_use_native_fullscreen; #endif + in_fullscreen_transition = NO; maximized_width = maximized_height = -1; nonfs_window = nil; @@ -7460,7 +7554,10 @@ not_in_argv (NSString *arg) #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) #endif - [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary]; + if (FRAME_PARENT_FRAME (f)) + [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary]; + else + [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary]; #endif wr = [win frame]; @@ -7489,16 +7586,8 @@ not_in_argv (NSString *arg) if (! FRAME_UNDECORATED (f)) [self createToolbar: f]; -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 -#ifndef NSAppKitVersionNumber10_10 -#define NSAppKitVersionNumber10_10 1343 -#endif - if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_10 - && FRAME_NS_APPEARANCE (f) != ns_appearance_aqua) - win.appearance = [NSAppearance - appearanceNamed: NSAppearanceNameVibrantDark]; -#endif + [win setAppearance]; #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 if ([win respondsToSelector: @selector(titlebarAppearsTransparent)]) @@ -7558,6 +7647,17 @@ not_in_argv (NSString *arg) [NSApp registerServicesMenuSendTypes: ns_send_types returnTypes: [NSArray array]]; +#ifdef NS_DRAW_TO_BUFFER + [self createDrawingBuffer]; +#endif + + /* Set up view resize notifications. */ + [self setPostsFrameChangedNotifications:YES]; + [[NSNotificationCenter defaultCenter] + addObserver:self + selector:@selector (viewDidResize:) + name:NSViewFrameDidChangeNotification object:nil]; + /* macOS Sierra automatically enables tabbed windows. We can't allow this to be enabled until it's available on a Free system. Currently it only happens by accident and is buggy anyway. */ @@ -7587,15 +7687,15 @@ not_in_argv (NSString *arg) return; if (screen != nil) { - emacsframe->left_pos = r.origin.x - NS_PARENT_WINDOW_LEFT_POS (emacsframe); - emacsframe->top_pos = - NS_PARENT_WINDOW_TOP_POS (emacsframe) - (r.origin.y + r.size.height); + emacsframe->left_pos = NSMinX (r) - NS_PARENT_WINDOW_LEFT_POS (emacsframe); + emacsframe->top_pos = NS_PARENT_WINDOW_TOP_POS (emacsframe) - NSMaxY (r); - if (emacs_event) - { - emacs_event->kind = MOVE_FRAME_EVENT; - EV_TRAILER ((id)nil); - } + // FIXME: after event part below didExitFullScreen is not received + // if (emacs_event) + // { + // emacs_event->kind = MOVE_FRAME_EVENT; + // EV_TRAILER ((id)nil); + // } } } @@ -7795,6 +7895,7 @@ not_in_argv (NSString *arg) - (void)windowWillEnterFullScreen:(NSNotification *)notification { NSTRACE ("[EmacsView windowWillEnterFullScreen:]"); + in_fullscreen_transition = YES; [self windowWillEnterFullScreen]; } - (void)windowWillEnterFullScreen /* provided for direct calls */ @@ -7807,6 +7908,7 @@ not_in_argv (NSString *arg) { NSTRACE ("[EmacsView windowDidEnterFullScreen:]"); [self windowDidEnterFullScreen]; + in_fullscreen_transition = NO; } - (void)windowDidEnterFullScreen /* provided for direct calls */ @@ -7845,6 +7947,7 @@ not_in_argv (NSString *arg) - (void)windowWillExitFullScreen:(NSNotification *)notification { NSTRACE ("[EmacsView windowWillExitFullScreen:]"); + in_fullscreen_transition = YES; [self windowWillExitFullScreen]; } @@ -7864,6 +7967,7 @@ not_in_argv (NSString *arg) { NSTRACE ("[EmacsView windowDidExitFullScreen:]"); [self windowDidExitFullScreen]; + in_fullscreen_transition = NO; } - (void)windowDidExitFullScreen /* provided for direct calls */ @@ -7883,7 +7987,6 @@ not_in_argv (NSString *arg) { [toolbar setVisible:YES]; update_frame_tool_bar (emacsframe); - [self updateFrameSize:YES]; [[self window] display]; } else @@ -7893,6 +7996,22 @@ not_in_argv (NSString *arg) [[self window] performZoom:self]; } +- (BOOL)inFullScreenTransition +{ + return in_fullscreen_transition; +} + +- (void)waitFullScreenTransition +{ +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 + while ([self inFullScreenTransition]) + { + NSTRACE ("wait for fullscreen"); + wait_reading_process_output (0, 300000000, 0, 1, Qnil, NULL, 0); + } +#endif +} + - (BOOL)fsIsNative { return fs_is_native; @@ -7931,9 +8050,22 @@ not_in_argv (NSString *arg) NSWindow *win = [self window]; NSWindowCollectionBehavior b = [win collectionBehavior]; if (ns_use_native_fullscreen) - b |= NSWindowCollectionBehaviorFullScreenPrimary; + { + if ([win parentWindow]) + { + b &= ~NSWindowCollectionBehaviorFullScreenPrimary; + b |= NSWindowCollectionBehaviorFullScreenAuxiliary; + } + else + { + b |= NSWindowCollectionBehaviorFullScreenPrimary; + b &= ~NSWindowCollectionBehaviorFullScreenAuxiliary; + } + } else - b &= ~NSWindowCollectionBehaviorFullScreenPrimary; + { + b &= ~NSWindowCollectionBehaviorFullScreenPrimary; + } [win setCollectionBehavior: b]; #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 @@ -7959,8 +8091,14 @@ not_in_argv (NSString *arg) #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 if ([[self window] respondsToSelector: @selector(toggleFullScreen:)]) + { +#endif + [[self window] toggleFullScreen:sender]; + // wait for fullscreen animation complete (bug#28496) + [self waitFullScreenTransition]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + } #endif - [[self window] toggleFullScreen:sender]; #endif return; } @@ -8061,11 +8199,11 @@ not_in_argv (NSString *arg) // send notifications. [self windowWillExitFullScreen]; - [fw setFrame: [w frame] display:YES animate:ns_use_fullscreen_animation]; + [fw setFrame:[[w contentView] frame] + display:YES animate:ns_use_fullscreen_animation]; [fw close]; [w makeKeyAndOrderFront:NSApp]; [self windowDidExitFullScreen]; - [self updateFrameSize:YES]; } } @@ -8209,13 +8347,8 @@ not_in_argv (NSString *arg) if (!emacs_event) return self; - /* Send first event (for some reason two needed). */ theEvent = [[self window] currentEvent]; emacs_event->kind = TOOL_BAR_EVENT; - XSETFRAME (emacs_event->arg, emacsframe); - EV_TRAILER (theEvent); - - emacs_event->kind = TOOL_BAR_EVENT; /* XSETINT (emacs_event->code, 0); */ emacs_event->arg = AREF (emacsframe->tool_bar_items, idx + TOOL_BAR_ITEM_KEY); @@ -8239,55 +8372,173 @@ not_in_argv (NSString *arg) } -- (void)viewWillDraw +#ifdef NS_DRAW_TO_BUFFER +- (void)createDrawingBuffer + /* Create and store a new CGGraphicsContext for Emacs to draw into. + + We can't do this in GNUstep as there's no equivalent, so under + GNUstep we retain the old method of drawing direct to the + EmacsView. */ { - /* If the frame has been garbaged there's no point in redrawing - anything. */ - if (FRAME_GARBAGED_P (emacsframe)) - [self setNeedsDisplay:NO]; + NSTRACE ("EmacsView createDrawingBuffer]"); + + if (! [self wantsUpdateLayer]) + return; + + NSGraphicsContext *screen; + CGColorSpaceRef colorSpace = [[[self window] colorSpace] CGColorSpace]; + CGFloat scale = [[self window] backingScaleFactor]; + NSRect frame = [self frame]; + + if (drawingBuffer != nil) + CGContextRelease (drawingBuffer); + + drawingBuffer = CGBitmapContextCreate (nil, NSWidth (frame) * scale, NSHeight (frame) * scale, + 8, 0, colorSpace, + kCGImageAlphaPremultipliedFirst | kCGBitmapByteOrder32Host); + + /* This fixes the scale to match the backing scale factor, and flips the image. */ + CGContextTranslateCTM(drawingBuffer, 0, NSHeight (frame) * scale); + CGContextScaleCTM(drawingBuffer, scale, -scale); } -- (void)drawRect: (NSRect)rect + +- (void)focusOnDrawingBuffer { - const NSRect *rectList; - NSInteger numRects; + NSTRACE ("EmacsView focusOnDrawingBuffer]"); - NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]", - NSTRACE_ARG_RECT(rect)); + NSGraphicsContext *buf = + [NSGraphicsContext + graphicsContextWithCGContext:drawingBuffer flipped:YES]; - if (!emacsframe || !emacsframe->output_data.ns) + [NSGraphicsContext setCurrentContext:buf]; +} + + +- (void)windowDidChangeBackingProperties:(NSNotification *)notification + /* Update the drawing buffer when the backing scale factor changes. */ +{ + NSTRACE ("EmacsView windowDidChangeBackingProperties:]"); + + if (! [self wantsUpdateLayer]) return; - block_input (); + CGFloat old = [[[notification userInfo] + objectForKey:@"NSBackingPropertyOldScaleFactorKey"] + doubleValue]; + CGFloat new = [[self window] backingScaleFactor]; + + if (old != new) + { + NSRect frame = [self frame]; + [self createDrawingBuffer]; + ns_clear_frame (emacsframe); + expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame)); + } +} +#endif /* NS_DRAW_TO_BUFFER */ - /* Get only the precise dirty rectangles to avoid redrawing - potentially large areas of the frame that haven't changed. - I'm not sure this actually provides much of a performance benefit - as it's hard to benchmark, but it certainly doesn't seem to - hurt. */ - [self getRectsBeingDrawn:&rectList count:&numRects]; - for (int i = 0 ; i < numRects ; i++) +- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect +{ + NSTRACE ("[EmacsView copyRect:To:]"); + NSTRACE_RECT ("Source", srcRect); + NSTRACE_RECT ("Destination", dstRect); + +#ifdef NS_DRAW_TO_BUFFER +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + if ([self wantsUpdateLayer]) { - NSRect r = rectList[i]; +#endif + CGImageRef copy; + NSRect frame = [self frame]; + NSAffineTransform *setOrigin = [NSAffineTransform transform]; + + [[NSGraphicsContext currentContext] saveGraphicsState]; + + /* Set the clipping before messing with the buffer's + orientation. */ + NSRectClip (dstRect); - NSTRACE_RECT ("r", r); + /* Unflip the buffer as the copied image will be unflipped, and + offset the top left so when we draw back into the buffer the + correct part of the image is drawn. */ + CGContextScaleCTM(drawingBuffer, 1, -1); + CGContextTranslateCTM(drawingBuffer, + NSMinX (dstRect) - NSMinX (srcRect), + -NSHeight (frame) - (NSMinY (dstRect) - NSMinY (srcRect))); + + /* Take a copy of the buffer and then draw it back to the buffer, + limited by the clipping rectangle. */ + copy = CGBitmapContextCreateImage (drawingBuffer); + CGContextDrawImage (drawingBuffer, frame, copy); + + CGImageRelease (copy); + + [[NSGraphicsContext currentContext] restoreGraphicsState]; + [self setNeedsDisplayInRect:dstRect]; - expose_frame (emacsframe, - NSMinX (r), NSMinY (r), - NSWidth (r), NSHeight (r)); +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 } + else + { +#endif +#endif /* NS_DRAW_TO_BUFFER */ - unblock_input (); +#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + hide_bell(); // Ensure the bell image isn't scrolled. - /* - drawRect: may be called (at least in Mac OS X 10.5) for invisible - views as well for some reason. Thus, do not infer visibility - here. + ns_focus (emacsframe, &dstRect, 1); + [self scrollRect: srcRect + by: NSMakeSize (dstRect.origin.x - srcRect.origin.x, + dstRect.origin.y - srcRect.origin.y)]; + ns_unfocus (emacsframe); +#endif +#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + } +#endif +} + + +#ifdef NS_DRAW_TO_BUFFER +- (BOOL)wantsUpdateLayer +{ +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + if (NSAppKitVersionNumber < 1671) + return NO; +#endif - emacsframe->async_visible = 1; - emacsframe->async_iconified = 0; - */ + /* Running on macOS 10.14 or above. */ + return YES; +} + + +- (void)updateLayer +{ + NSTRACE ("[EmacsView updateLayer]"); + + CGImageRef contentsImage = CGBitmapContextCreateImage(drawingBuffer); + [[self layer] setContents:(id)contentsImage]; + CGImageRelease(contentsImage); +} +#endif + + +- (void)drawRect: (NSRect)rect +{ + NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]", + NSTRACE_ARG_RECT(rect)); + + if (!emacsframe || !emacsframe->output_data.ns) + return; + + int x = NSMinX (rect), y = NSMinY (rect); + int width = NSWidth (rect), height = NSHeight (rect); + + ns_clear_frame_area (emacsframe, x, y, width, height); + block_input (); + expose_frame (emacsframe, x, y, width, height); + unblock_input (); } @@ -8488,13 +8739,6 @@ not_in_argv (NSString *arg) } -- (void) setRows: (int) r andColumns: (int) c -{ - NSTRACE ("[EmacsView setRows:%d andColumns:%d]", r, c); - rows = r; - cols = c; -} - - (int) fullscreenState { return fs_state; @@ -8748,6 +8992,32 @@ not_in_argv (NSString *arg) #endif } +- (void)setAppearance +{ +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 + struct frame *f = ((EmacsView *)[self delegate])->emacsframe; + NSAppearance *appearance = nil; + + NSTRACE ("[EmacsWindow setAppearance]"); + +#ifndef NSAppKitVersionNumber10_10 +#define NSAppKitVersionNumber10_10 1343 +#endif + + if (NSAppKitVersionNumber < NSAppKitVersionNumber10_10) + return; + + if (FRAME_NS_APPEARANCE (f) == ns_appearance_vibrant_dark) + appearance = + [NSAppearance appearanceNamed:NSAppearanceNameVibrantDark]; + else if (FRAME_NS_APPEARANCE (f) == ns_appearance_aqua) + appearance = + [NSAppearance appearanceNamed:NSAppearanceNameAqua]; + + [self setAppearance:appearance]; +#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */ +} + - (void)setFrame:(NSRect)windowFrame display:(BOOL)displayViews { diff --git a/src/pdumper.c b/src/pdumper.c index 3ee11460405..63424c5734a 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2769,7 +2769,7 @@ dump_hash_table (struct dump_context *ctx, static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_375A10F5E5 +#if CHECK_STRUCTS && !defined HASH_buffer_5DC36DBD42 # error "buffer changed. See CHECK_STRUCTS comment in config.h." #endif struct buffer munged_buffer = *in_buffer; @@ -2845,8 +2845,6 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) ctx->obj_offset + dump_offsetof (struct buffer, text), base_offset + dump_offsetof (struct buffer, own_text)); - dump_field_lv_rawptr (ctx, out, buffer, &buffer->next, - Lisp_Vectorlike, WEIGHT_NORMAL); DUMP_FIELD_COPY (out, buffer, pt); DUMP_FIELD_COPY (out, buffer, pt_byte); DUMP_FIELD_COPY (out, buffer, begv); @@ -2961,7 +2959,7 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_pvec_type_E55BD36F8E +#if CHECK_STRUCTS && !defined HASH_pvec_type_A4A6E9984D # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Vector *v = XVECTOR (lv); @@ -3069,7 +3067,7 @@ dump_vectorlike (struct dump_context *ctx, static dump_off dump_object (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Type_E2AD97D3F7) +#if CHECK_STRUCTS && !defined (HASH_Lisp_Type_45F0582FD7) # error "Lisp_Type changed. See CHECK_STRUCTS comment in config.h." #endif eassert (!EQ (object, dead_object ())); @@ -3604,14 +3602,12 @@ dump_unwind_cleanup (void *data) Vprocess_environment = ctx->old_process_environment; } -/* Return DUMP_OFFSET, making sure it is within the heap. */ -static dump_off +/* Check that DUMP_OFFSET is within the heap. */ +static void dump_check_dump_off (struct dump_context *ctx, dump_off dump_offset) { eassert (dump_offset > 0); - if (ctx) - eassert (dump_offset < ctx->end_heap); - return dump_offset; + eassert (!ctx || dump_offset < ctx->end_heap); } static void @@ -3734,6 +3730,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc) } else { + eassume (ctx); /* Pacify GCC 9.2.1 -O3 -Wnull-dereference. */ eassert (!dump_object_emacs_ptr (target_value)); reloc.u.dump_offset = dump_recall_object (ctx, target_value); if (reloc.u.dump_offset <= 0) diff --git a/src/print.c b/src/print.c index 425b0dc4ee3..bd1769144e0 100644 --- a/src/print.c +++ b/src/print.c @@ -368,8 +368,8 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte, int len; for (ptrdiff_t i = 0; i < size_byte; i += len) { - int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i, - len); + int ch = string_char_and_length ((const unsigned char *) ptr + i, + &len); printchar_to_stream (ch, stdout); } } @@ -400,8 +400,8 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte, int len; for (i = 0; i < size_byte; i += len) { - int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i, - len); + int ch = string_char_and_length ((const unsigned char *) ptr + i, + &len); insert_char (ch); } } @@ -426,9 +426,8 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte, /* Here, we must convert each multi-byte form to the corresponding character code before handing it to PRINTCHAR. */ - int len; - int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i, - len); + int len, ch = (string_char_and_length + ((const unsigned char *) ptr + i, &len)); printchar (ch, printcharfun); i += len; } @@ -510,8 +509,7 @@ print_string (Lisp_Object string, Lisp_Object printcharfun) { /* Here, we must convert each multi-byte form to the corresponding character code before handing it to PRINTCHAR. */ - int len; - int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i, len); + int len, ch = string_char_and_length (SDATA (string) + i, &len); printchar (ch, printcharfun); i += len; } @@ -1307,15 +1305,13 @@ print_check_string_charset_prop (INTERVAL interval, Lisp_Object string) } if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) { - int i, c; ptrdiff_t charpos = interval->position; ptrdiff_t bytepos = string_char_to_byte (string, charpos); - Lisp_Object charset; + Lisp_Object charset = XCAR (XCDR (val)); - charset = XCAR (XCDR (val)); - for (i = 0; i < LENGTH (interval); i++) + for (ptrdiff_t i = 0; i < LENGTH (interval); i++) { - FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos); + int c = fetch_string_char_advance (string, &charpos, &bytepos); if (! ASCII_CHAR_P (c) && ! EQ (CHARSET_NAME (CHAR_CHARSET (c)), charset)) { @@ -1365,6 +1361,22 @@ data_from_funcptr (void (*funcptr) (void)) interchangeably, so it's OK to assume that here too. */ return (void const *) funcptr; } + +/* Print the value of the pointer PTR. */ + +static void +print_pointer (Lisp_Object printcharfun, char *buf, const char *prefix, + const void *ptr) +{ + uintptr_t ui = (uintptr_t) ptr; + + /* In theory this assignment could lose info on pre-C99 hosts, but + in practice it doesn't. */ + uintmax_t up = ui; + + int len = sprintf (buf, "%s 0x%" PRIxMAX, prefix, up); + strout (buf, len, len, printcharfun); +} #endif static bool @@ -1796,26 +1808,22 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, case PVEC_MODULE_FUNCTION: { print_c_string ("#<module function ", printcharfun); - module_funcptr ptr = module_function_address (XMODULE_FUNCTION (obj)); + const struct Lisp_Module_Function *function = XMODULE_FUNCTION (obj); + module_funcptr ptr = module_function_address (function); char const *file; char const *symbol; dynlib_addr (ptr, &file, &symbol); if (symbol == NULL) - { - uintptr_t ui = (uintptr_t) data_from_funcptr (ptr); - - /* In theory this assignment could lose info on pre-C99 - hosts, but in practice it doesn't. */ - uintmax_t up = ui; - - int len = sprintf (buf, "at 0x%"PRIxMAX, up); - strout (buf, len, len, printcharfun); - } - else + print_pointer (printcharfun, buf, "at", data_from_funcptr (ptr)); + else print_c_string (symbol, printcharfun); - if (file != NULL) + void *data = module_function_data (function); + if (data != NULL) + print_pointer (printcharfun, buf, " with data", data); + + if (file != NULL) { print_c_string (" from ", printcharfun); print_c_string (file, printcharfun); @@ -1838,7 +1846,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT), max (sizeof " . #" + INT_STRLEN_BOUND (intmax_t), - max ((sizeof "at 0x" + max ((sizeof " with data 0x" + (sizeof (uintmax_t) * CHAR_BIT + 4 - 1) / 4), 40)))]; current_thread->stack_top = buf; @@ -1931,9 +1939,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { /* Here, we must convert each multi-byte form to the corresponding character code before handing it to printchar. */ - int c; - - FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte); + int c = fetch_string_char_advance (obj, &i, &i_byte); maybe_quit (); @@ -2024,8 +2030,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { /* Here, we must convert each multi-byte form to the corresponding character code before handing it to PRINTCHAR. */ - int c; - FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte); + int c = fetch_string_char_advance (name, &i, &i_byte); maybe_quit (); if (escapeflag) diff --git a/src/process.c b/src/process.c index 91d426103d8..6e5bcf307ab 100644 --- a/src/process.c +++ b/src/process.c @@ -1392,14 +1392,12 @@ nil otherwise. */) CHECK_PROCESS (process); /* All known platforms store window sizes as 'unsigned short'. */ - CHECK_RANGED_INTEGER (height, 0, USHRT_MAX); - CHECK_RANGED_INTEGER (width, 0, USHRT_MAX); + unsigned short h = check_uinteger_max (height, USHRT_MAX); + unsigned short w = check_uinteger_max (width, USHRT_MAX); if (NETCONN_P (process) || XPROCESS (process)->infd < 0 - || (set_window_size (XPROCESS (process)->infd, - XFIXNUM (height), XFIXNUM (width)) - < 0)) + || set_window_size (XPROCESS (process)->infd, h, w) < 0) return Qnil; else return Qt; @@ -3188,14 +3186,12 @@ usage: (make-serial-process &rest ARGS) */) BUF_ZV_BYTE (XBUFFER (buffer))); } - tem = Fplist_member (contact, QCcoding); - if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem)))) - tem = Qnil; + tem = Fplist_get (contact, QCcoding); val = Qnil; if (!NILP (tem)) { - val = XCAR (XCDR (tem)); + val = tem; if (CONSP (val)) val = XCAR (val); } @@ -3209,7 +3205,7 @@ usage: (make-serial-process &rest ARGS) */) val = Qnil; if (!NILP (tem)) { - val = XCAR (XCDR (tem)); + val = tem; if (CONSP (val)) val = XCDR (val); } @@ -3244,16 +3240,14 @@ set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host, Lisp_Object coding_systems = Qt; Lisp_Object val; - tem = Fplist_member (contact, QCcoding); - if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem)))) - tem = Qnil; /* No error message (too late!). */ + tem = Fplist_get (contact, QCcoding); /* Setup coding systems for communicating with the network stream. */ /* Qt denotes we have not yet called Ffind_operation_coding_system. */ if (!NILP (tem)) { - val = XCAR (XCDR (tem)); + val = tem; if (CONSP (val)) val = XCAR (val); } @@ -3287,7 +3281,7 @@ set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host, if (!NILP (tem)) { - val = XCAR (XCDR (tem)); + val = tem; if (CONSP (val)) val = XCDR (val); } @@ -7079,10 +7073,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) } if (FIXNUMP (sigcode)) - { - CHECK_TYPE_RANGED_INTEGER (int, sigcode); - signo = XFIXNUM (sigcode); - } + signo = check_integer_range (sigcode, INT_MIN, INT_MAX); else { char *name; @@ -8200,6 +8191,17 @@ restore_nofile_limit (void) #endif } +int +open_channel_for_module (Lisp_Object process) +{ + CHECK_PROCESS (process); + CHECK_TYPE (PIPECONN_P (process), Qpipe_process_p, process); + int fd = dup (XPROCESS (process)->open_fd[SUBPROCESS_STDOUT]); + if (fd == -1) + report_file_error ("Cannot duplicate file descriptor", Qnil); + return fd; +} + /* This is not called "init_process" because that is the name of a Mach system call, so it would cause problems on Darwin systems. */ @@ -8277,19 +8279,6 @@ init_process_emacs (int sockfd) memset (datagram_address, 0, sizeof datagram_address); #endif -#if defined (DARWIN_OS) - /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive - processes. As such, we only change the default value. */ - if (initialized) - { - char const *release = (STRINGP (Voperating_system_release) - ? SSDATA (Voperating_system_release) - : 0); - if (!release || !release[0] || (release[0] < '7' && release[1] == '.')) { - Vprocess_connection_type = Qnil; - } - } -#endif #endif /* subprocesses */ kbd_is_on_hold = 0; } @@ -8459,6 +8448,7 @@ amounts of data in one go. */); DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions"); DEFSYM (Qnull, "null"); + DEFSYM (Qpipe_process_p, "pipe-process-p"); defsubr (&Sprocessp); defsubr (&Sget_process); diff --git a/src/process.h b/src/process.h index 7884efc5494..a783a31cb86 100644 --- a/src/process.h +++ b/src/process.h @@ -300,6 +300,8 @@ extern Lisp_Object remove_slash_colon (Lisp_Object); extern void update_processes_for_thread_death (Lisp_Object); extern void dissociate_controlling_tty (void); +extern int open_channel_for_module (Lisp_Object); + INLINE_HEADER_END #endif /* EMACS_PROCESS_H */ diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 5e23fc94e4f..ba7f3cef64b 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -58,7 +58,7 @@ #define RE_STRING_CHAR(p, multibyte) \ (multibyte ? STRING_CHAR (p) : *(p)) #define RE_STRING_CHAR_AND_LENGTH(p, len, multibyte) \ - (multibyte ? STRING_CHAR_AND_LENGTH (p, len) : ((len) = 1, *(p))) + (multibyte ? string_char_and_length (p, &(len)) : ((len) = 1, *(p))) #define RE_CHAR_TO_MULTIBYTE(c) UNIBYTE_TO_CHAR (c) @@ -89,7 +89,7 @@ #define GET_CHAR_AFTER(c, p, len) \ do { \ if (target_multibyte) \ - (c) = STRING_CHAR_AND_LENGTH (p, len); \ + (c) = string_char_and_length (p, &(len)); \ else \ { \ (c) = *p; \ @@ -2113,17 +2113,20 @@ regex_compile (re_char *pattern, ptrdiff_t size, if (CHAR_BYTE8_P (c1)) c = BYTE8_TO_CHAR (128); } - if (CHAR_BYTE8_P (c)) - { - c = CHAR_TO_BYTE8 (c); - c1 = CHAR_TO_BYTE8 (c1); - for (; c <= c1; c++) - SET_LIST_BIT (c); - } - else if (multibyte) - SETUP_MULTIBYTE_RANGE (range_table_work, c, c1); - else - SETUP_UNIBYTE_RANGE (range_table_work, c, c1); + if (c <= c1) + { + if (CHAR_BYTE8_P (c)) + { + c = CHAR_TO_BYTE8 (c); + c1 = CHAR_TO_BYTE8 (c1); + for (; c <= c1; c++) + SET_LIST_BIT (c); + } + else if (multibyte) + SETUP_MULTIBYTE_RANGE (range_table_work, c, c1); + else + SETUP_UNIBYTE_RANGE (range_table_work, c, c1); + } } } @@ -3164,10 +3167,6 @@ re_search (struct re_pattern_buffer *bufp, const char *string, ptrdiff_t size, regs, size); } -/* Head address of virtual concatenation of string. */ -#define HEAD_ADDR_VSTRING(P) \ - (((P) >= size1 ? string2 : string1)) - /* Address of POS in the concatenation of virtual string. */ #define POS_ADDR_VSTRING(POS) \ (((POS) >= size1 ? string2 - size1 : string1) + (POS)) @@ -3297,7 +3296,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, ptrdiff_t size1, { int buf_charlen; - buf_ch = STRING_CHAR_AND_LENGTH (d, buf_charlen); + buf_ch = string_char_and_length (d, &buf_charlen); buf_ch = RE_TRANSLATE (translate, buf_ch); if (fastmap[CHAR_LEADING_CODE (buf_ch)]) break; @@ -3327,7 +3326,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, ptrdiff_t size1, { int buf_charlen; - buf_ch = STRING_CHAR_AND_LENGTH (d, buf_charlen); + buf_ch = string_char_and_length (d, &buf_charlen); if (fastmap[CHAR_LEADING_CODE (buf_ch)]) break; range -= buf_charlen; @@ -3410,16 +3409,12 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, ptrdiff_t size1, if (multibyte) { re_char *p = POS_ADDR_VSTRING (startpos) + 1; - re_char *p0 = p; - re_char *phead = HEAD_ADDR_VSTRING (startpos); + int len = raw_prev_char_len (p); - /* Find the head of multibyte form. */ - PREV_CHAR_BOUNDARY (p, phead); - range += p0 - 1 - p; + range += len - 1; if (range > 0) break; - - startpos -= p0 - 1 - p; + startpos -= len - 1; } } } @@ -4238,13 +4233,13 @@ re_match_2_internal (struct re_pattern_buffer *bufp, PREFETCH (); if (multibyte) - pat_ch = STRING_CHAR_AND_LENGTH (p, pat_charlen); + pat_ch = string_char_and_length (p, &pat_charlen); else { pat_ch = RE_CHAR_TO_MULTIBYTE (*p); pat_charlen = 1; } - buf_ch = STRING_CHAR_AND_LENGTH (d, buf_charlen); + buf_ch = string_char_and_length (d, &buf_charlen); if (TRANSLATE (buf_ch) != pat_ch) { @@ -4266,7 +4261,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, PREFETCH (); if (multibyte) { - pat_ch = STRING_CHAR_AND_LENGTH (p, pat_charlen); + pat_ch = string_char_and_length (p, &pat_charlen); pat_ch = RE_CHAR_TO_UNIBYTE (pat_ch); } else diff --git a/src/search.c b/src/search.c index 818bb4af246..ec076c18035 100644 --- a/src/search.c +++ b/src/search.c @@ -353,8 +353,8 @@ data if you want to preserve them. */) } DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0, - doc: /* Return t if text after point matches regular expression REGEXP. -Find the longest match, in accord with Posix regular expression rules. + doc: /* Return t if text after point matches REGEXP according to Posix rules. +Find the longest match, in accordance with Posix regular expression rules. This function modifies the match data that `match-beginning', `match-end' and `match-data' access; save and restore the match data if you want to preserve them. */) @@ -449,7 +449,7 @@ matched by the parenthesis constructions in REGEXP. */) } DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0, - doc: /* Return index of start of first match for REGEXP in STRING, or nil. + doc: /* Return index of start of first match for Posix REGEXP in STRING, or nil. Find the longest match, in accord with Posix regular expression rules. Case is ignored if `case-fold-search' is non-nil in the current buffer. If third arg START is non-nil, start search at that index in STRING. @@ -994,7 +994,7 @@ find_before_next_newline (ptrdiff_t from, ptrdiff_t to, if (counted == cnt) { if (bytepos) - DEC_BOTH (pos, *bytepos); + dec_both (&pos, &*bytepos); else pos--; } @@ -1028,8 +1028,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, } else { - CHECK_FIXNUM_COERCE_MARKER (bound); - lim = XFIXNUM (bound); + lim = fix_position (bound); if (n > 0 ? lim < PT : lim > PT) error ("Invalid search bound (wrong side of point)"); if (lim > ZV) @@ -1354,8 +1353,8 @@ search_buffer_non_re (Lisp_Object string, ptrdiff_t pos, while (--len >= 0) { unsigned char str_base[MAX_MULTIBYTE_LENGTH], *str; - int c, translated, inverse; - int in_charlen, charlen; + int translated, inverse; + int charlen; /* If we got here and the RE flag is set, it's because we're dealing with a regexp known to be trivial, so the backslash @@ -1368,7 +1367,7 @@ search_buffer_non_re (Lisp_Object string, ptrdiff_t pos, base_pat++; } - c = STRING_CHAR_AND_LENGTH (base_pat, in_charlen); + int in_charlen, c = string_char_and_length (base_pat, &in_charlen); if (NILP (trt)) { @@ -1551,12 +1550,10 @@ simple_search (EMACS_INT n, unsigned char *pat, while (this_len > 0) { - int charlen, buf_charlen; - int pat_ch, buf_ch; - - pat_ch = STRING_CHAR_AND_LENGTH (p, charlen); - buf_ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (this_pos_byte), - buf_charlen); + int charlen, pat_ch = string_char_and_length (p, &charlen); + int buf_charlen, buf_ch + = string_char_and_length (BYTE_POS_ADDR (this_pos_byte), + &buf_charlen); TRANSLATE (buf_ch, trt, buf_ch); if (buf_ch != pat_ch) @@ -1577,7 +1574,7 @@ simple_search (EMACS_INT n, unsigned char *pat, break; } - INC_BOTH (pos, pos_byte); + inc_both (&pos, &pos_byte); } n--; @@ -1639,8 +1636,8 @@ simple_search (EMACS_INT n, unsigned char *pat, { int pat_ch, buf_ch; - DEC_BOTH (this_pos, this_pos_byte); - PREV_CHAR_BOUNDARY (p, pat); + dec_both (&this_pos, &this_pos_byte); + p -= raw_prev_char_len (p); pat_ch = STRING_CHAR (p); buf_ch = STRING_CHAR (BYTE_POS_ADDR (this_pos_byte)); TRANSLATE (buf_ch, trt, buf_ch); @@ -1659,7 +1656,7 @@ simple_search (EMACS_INT n, unsigned char *pat, break; } - DEC_BOTH (pos, pos_byte); + dec_both (&pos, &pos_byte); } n++; @@ -2279,7 +2276,7 @@ and `replace-match'. */) DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, 1, 4, "sPosix search backward: ", - doc: /* Search backward from point for match for regular expression REGEXP. + doc: /* Search backward from point for match for REGEXP according to Posix rules. Find the longest match in accord with Posix regular expression rules. Set point to the beginning of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. @@ -2307,7 +2304,7 @@ and `replace-match'. */) DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, 4, "sPosix search: ", - doc: /* Search forward from point for regular expression REGEXP. + doc: /* Search forward from point for REGEXP according to Posix rules. Find the longest match in accord with Posix regular expression rules. Set point to the end of the occurrence found, and return point. An optional second argument bounds the search; it is a buffer position. @@ -2393,14 +2390,7 @@ since only regular expressions have distinguished subexpressions. */) if (num_regs <= 0) error ("`replace-match' called before any match found"); - if (NILP (subexp)) - sub = 0; - else - { - CHECK_RANGED_INTEGER (subexp, 0, num_regs - 1); - sub = XFIXNUM (subexp); - } - + sub = !NILP (subexp) ? check_integer_range (subexp, 0, num_regs - 1) : 0; ptrdiff_t sub_start = search_regs.start[sub]; ptrdiff_t sub_end = search_regs.end[sub]; eassert (sub_start <= sub_end); @@ -2445,10 +2435,11 @@ since only regular expressions have distinguished subexpressions. */) if (NILP (string)) { c = FETCH_CHAR_AS_MULTIBYTE (pos_byte); - INC_BOTH (pos, pos_byte); + inc_both (&pos, &pos_byte); } else - FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, pos, pos_byte); + c = fetch_string_char_as_multibyte_advance (string, + &pos, &pos_byte); if (lowercasep (c)) { @@ -2521,11 +2512,11 @@ since only regular expressions have distinguished subexpressions. */) ptrdiff_t subend = 0; bool delbackslash = 0; - FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte); + c = fetch_string_char_advance (newtext, &pos, &pos_byte); if (c == '\\') { - FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte); + c = fetch_string_char_advance (newtext, &pos, &pos_byte); if (c == '&') { @@ -2633,7 +2624,8 @@ since only regular expressions have distinguished subexpressions. */) if (str_multibyte) { - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, pos, pos_byte); + c = fetch_string_char_advance_no_check (newtext, + &pos, &pos_byte); if (!buf_multibyte) c = CHAR_TO_BYTE8 (c); } @@ -2642,7 +2634,7 @@ since only regular expressions have distinguished subexpressions. */) /* Note that we don't have to increment POS. */ c = SREF (newtext, pos_byte++); if (buf_multibyte) - MAKE_CHAR_MULTIBYTE (c); + c = make_char_multibyte (c); } /* Either set ADD_STUFF and ADD_LEN to the text to put in SUBSTED, @@ -2655,8 +2647,8 @@ since only regular expressions have distinguished subexpressions. */) if (str_multibyte) { - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, - pos, pos_byte); + c = fetch_string_char_advance_no_check (newtext, + &pos, &pos_byte); if (!buf_multibyte && !ASCII_CHAR_P (c)) c = CHAR_TO_BYTE8 (c); } @@ -2664,7 +2656,7 @@ since only regular expressions have distinguished subexpressions. */) { c = SREF (newtext, pos_byte++); if (buf_multibyte) - MAKE_CHAR_MULTIBYTE (c); + c = make_char_multibyte (c); } if (c == '&') diff --git a/src/syntax.c b/src/syntax.c index a79ab863367..a03202d386c 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -535,7 +535,7 @@ char_quoted (ptrdiff_t charpos, ptrdiff_t bytepos) while (charpos > beg) { int c; - DEC_BOTH (charpos, bytepos); + dec_both (&charpos, &bytepos); UPDATE_SYNTAX_TABLE_BACKWARD (charpos); c = FETCH_CHAR_AS_MULTIBYTE (bytepos); @@ -556,11 +556,9 @@ char_quoted (ptrdiff_t charpos, ptrdiff_t bytepos) static ptrdiff_t dec_bytepos (ptrdiff_t bytepos) { - if (NILP (BVAR (current_buffer, enable_multibyte_characters))) - return bytepos - 1; - - DEC_POS (bytepos); - return bytepos; + return (bytepos + - (!NILP (BVAR (current_buffer, enable_multibyte_characters)) + ? prev_char_len (bytepos) : 1)); } /* Return a defun-start position before POS and not too far before. @@ -667,7 +665,7 @@ prev_char_comend_first (ptrdiff_t pos, ptrdiff_t pos_byte) int c; bool val; - DEC_BOTH (pos, pos_byte); + dec_both (&pos, &pos_byte); UPDATE_SYNTAX_TABLE_BACKWARD (pos); c = FETCH_CHAR (pos_byte); val = SYNTAX_COMEND_FIRST (c); @@ -738,7 +736,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, bool com2start, com2end, comstart; /* Move back and examine a character. */ - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); prev_syntax = syntax; @@ -773,7 +771,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, { ptrdiff_t next = from, next_byte = from_byte; int next_c, next_syntax; - DEC_BOTH (next, next_byte); + dec_both (&next, &next_byte); UPDATE_SYNTAX_TABLE_BACKWARD (next); next_c = FETCH_CHAR_AS_MULTIBYTE (next_byte); next_syntax = SYNTAX_WITH_FLAGS (next_c); @@ -1150,8 +1148,7 @@ the value of a `syntax-table' text property. */) if (*p) { - int len; - int character = STRING_CHAR_AND_LENGTH (p, len); + int len, character = string_char_and_length (p, &len); XSETINT (match, character); if (XFIXNAT (match) == ' ') match = Qnil; @@ -1444,7 +1441,7 @@ scan_words (ptrdiff_t from, EMACS_INT count) int ch0, ch1; Lisp_Object func, pos; - SETUP_SYNTAX_TABLE (from, count); + SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count, PTRDIFF_MAX)); while (count > 0) { @@ -1455,7 +1452,7 @@ scan_words (ptrdiff_t from, EMACS_INT count) UPDATE_SYNTAX_TABLE_FORWARD (from); ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte); code = SYNTAX (ch0); - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); if (words_include_escapes && (code == Sescape || code == Scharquote)) break; @@ -1488,7 +1485,7 @@ scan_words (ptrdiff_t from, EMACS_INT count) || (code != Sescape && code != Scharquote))) || word_boundary_p (ch0, ch1)) break; - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); ch0 = ch1; rarely_quit (from); } @@ -1501,7 +1498,7 @@ scan_words (ptrdiff_t from, EMACS_INT count) { if (from == beg) return 0; - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); code = SYNTAX (ch1); @@ -1530,7 +1527,7 @@ scan_words (ptrdiff_t from, EMACS_INT count) { if (from == beg) break; - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte); code = SYNTAX (ch0); @@ -1539,7 +1536,7 @@ scan_words (ptrdiff_t from, EMACS_INT count) || (code != Sescape && code != Scharquote))) || word_boundary_p (ch0, ch1)) { - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); break; } ch1 = ch0; @@ -1818,7 +1815,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, leading_code = str[i_byte]; } - c = STRING_CHAR_AND_LENGTH (str + i_byte, len); + c = string_char_and_length (str + i_byte, &len); i_byte += len; @@ -1834,14 +1831,14 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, /* Get the end of the range. */ leading_code2 = str[i_byte]; - c2 = STRING_CHAR_AND_LENGTH (str + i_byte, len); + c2 = string_char_and_length (str + i_byte, &len); i_byte += len; if (c2 == '\\' && i_byte < size_byte) { leading_code2 = str[i_byte]; - c2 = STRING_CHAR_AND_LENGTH (str + i_byte, len); + c2 = string_char_and_length (str + i_byte, &len); i_byte += len; } @@ -1953,7 +1950,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, p = GAP_END_ADDR; stop = endp; } - c = STRING_CHAR_AND_LENGTH (p, nbytes); + c = string_char_and_length (p, &nbytes); if (! NILP (iso_classes) && in_classes (c, iso_classes)) { if (negate) @@ -2175,7 +2172,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) stop = endp; } if (multibyte) - c = STRING_CHAR_AND_LENGTH (p, nbytes); + c = string_char_and_length (p, &nbytes); else c = *p, nbytes = 1; if (! fastmap[SYNTAX (c)]) @@ -2357,7 +2354,7 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, /* We have encountered a nested comment of the same style as the comment sequence which began this comment section. */ nesting++; - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); forw_incomment: @@ -2378,7 +2375,7 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, break; else { - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); } } @@ -2395,7 +2392,7 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, as the comment sequence which began this comment section. */ { syntax = Smax; /* So that "#|#" isn't also a comment ender. */ - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); nesting++; } @@ -2437,7 +2434,7 @@ between them, return t; otherwise return nil. */) from = PT; from_byte = PT_BYTE; - SETUP_SYNTAX_TABLE (from, count1); + SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count1, PTRDIFF_MAX)); while (count1 > 0) { do @@ -2456,7 +2453,7 @@ between them, return t; otherwise return nil. */) comstart_first = SYNTAX_FLAGS_COMSTART_FIRST (syntax); comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0); - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); if (from < stop && comstart_first && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte), @@ -2471,7 +2468,7 @@ between them, return t; otherwise return nil. */) code = Scomment; comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax); comnested |= SYNTAX_FLAGS_COMMENT_NESTED (other_syntax); - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); } rarely_quit (++quit_count); @@ -2482,7 +2479,7 @@ between them, return t; otherwise return nil. */) comstyle = ST_COMMENT_STYLE; else if (code != Scomment) { - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); SET_PT_BOTH (from, from_byte); return Qnil; } @@ -2495,7 +2492,7 @@ between them, return t; otherwise return nil. */) SET_PT_BOTH (from, from_byte); return Qnil; } - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); /* We have skipped one comment. */ count1--; @@ -2511,7 +2508,7 @@ between them, return t; otherwise return nil. */) return Qnil; } - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ bool quoted = char_quoted (from, from_byte); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); @@ -2529,7 +2526,7 @@ between them, return t; otherwise return nil. */) /* We must record the comment style encountered so that later, we can match only the proper comment begin sequence of the same style. */ - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); code = Sendcomment; /* Calling char_quoted, above, set up global syntax position at the new value of FROM. */ @@ -2547,7 +2544,7 @@ between them, return t; otherwise return nil. */) while (1) { - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); if (SYNTAX (c) == Scomment_fence @@ -2572,8 +2569,9 @@ between them, return t; otherwise return nil. */) } else if (code == Sendcomment) { - found = back_comment (from, from_byte, stop, comnested, comstyle, - &out_charpos, &out_bytepos); + found = (!quoted || !Vcomment_end_can_be_escaped) + && back_comment (from, from_byte, stop, comnested, comstyle, + &out_charpos, &out_bytepos); if (!found) { if (c == '\n') @@ -2587,7 +2585,7 @@ between them, return t; otherwise return nil. */) not-quite-endcomment. */ if (SYNTAX (c) != code) /* It was a two-char Sendcomment. */ - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); goto leave; } } @@ -2601,7 +2599,7 @@ between them, return t; otherwise return nil. */) else if (code != Swhitespace || quoted) { leave: - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); SET_PT_BOTH (from, from_byte); return Qnil; } @@ -2626,7 +2624,7 @@ syntax_multibyte (int c, bool multibyte_symbol_p) } static Lisp_Object -scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) +scan_lists (EMACS_INT from0, EMACS_INT count, EMACS_INT depth, bool sexpflag) { Lisp_Object val; ptrdiff_t stop = count > 0 ? ZV : BEGV; @@ -2639,7 +2637,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) int comstyle = 0; /* Style of comment encountered. */ bool comnested = 0; /* Whether the comment is nestable or not. */ ptrdiff_t temp_pos; - EMACS_INT last_good = from; + EMACS_INT last_good = from0; bool found; ptrdiff_t from_byte; ptrdiff_t out_bytepos, out_charpos; @@ -2650,14 +2648,13 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if (depth > 0) min_depth = 0; - if (from > ZV) from = ZV; - if (from < BEGV) from = BEGV; + ptrdiff_t from = clip_to_bounds (BEGV, from0, ZV); from_byte = CHAR_TO_BYTE (from); maybe_quit (); - SETUP_SYNTAX_TABLE (from, count); + SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count, PTRDIFF_MAX)); while (count > 0) { while (from < stop) @@ -2675,7 +2672,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) prefix = SYNTAX_FLAGS_PREFIX (syntax); if (depth == min_depth) last_good = from; - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); if (from < stop && comstart_first && (c = FETCH_CHAR_AS_MULTIBYTE (from_byte), @@ -2691,7 +2688,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) code = Scomment; comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax); comnested |= SYNTAX_FLAGS_COMMENT_NESTED (other_syntax); - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); } @@ -2704,7 +2701,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) case Scharquote: if (from == stop) goto lose; - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); /* Treat following character as a word constituent. */ FALLTHROUGH; case Sword: @@ -2720,7 +2717,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) { case Scharquote: case Sescape: - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); if (from == stop) goto lose; break; @@ -2731,7 +2728,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) default: goto done; } - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); rarely_quit (++quit_count); } goto done; @@ -2753,7 +2750,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) goto done; goto lose; } - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); break; @@ -2762,7 +2759,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) break; if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (from_byte)) { - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); } if (mathexit) { @@ -2802,11 +2799,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) break; if (c_code == Scharquote || c_code == Sescape) - INC_BOTH (from, from_byte); - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); + inc_both (&from, &from_byte); rarely_quit (++quit_count); } - INC_BOTH (from, from_byte); + inc_both (&from, &from_byte); if (!depth && sexpflag) goto done; break; default: @@ -2831,7 +2828,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) while (from > stop) { rarely_quit (++quit_count); - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); int syntax = SYNTAX_WITH_FLAGS (c); @@ -2850,7 +2847,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) later, we can match only the proper comment begin sequence of the same style. */ int c2, other_syntax; - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); code = Sendcomment; c2 = FETCH_CHAR_AS_MULTIBYTE (from_byte); @@ -2864,7 +2861,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) if we decremented FROM in the if-statement above. */ if (code != Sendcomment && char_quoted (from, from_byte)) { - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); code = Sword; } else if (SYNTAX_FLAGS_PREFIX (syntax)) @@ -2881,11 +2878,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) after passing it. */ while (from > stop) { - temp_pos = from_byte; - if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) - DEC_POS (temp_pos); - else - temp_pos--; + temp_pos = dec_bytepos (from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from - 1); c1 = FETCH_CHAR_AS_MULTIBYTE (temp_pos); /* Don't allow comment-end to be quoted. */ @@ -2894,7 +2887,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) quoted = char_quoted (from - 1, temp_pos); if (quoted) { - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); temp_pos = dec_bytepos (temp_pos); UPDATE_SYNTAX_TABLE_BACKWARD (from - 1); } @@ -2905,7 +2898,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) case Sword: case Ssymbol: case Squote: break; default: goto done2; } - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); rarely_quit (++quit_count); } goto done2; @@ -2918,7 +2911,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) temp_pos = dec_bytepos (from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from - 1); if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (temp_pos)) - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); } if (mathexit) { @@ -2961,7 +2954,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) { if (from == stop) goto lose; - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); if (!char_quoted (from, from_byte)) { @@ -2980,7 +2973,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag) { if (from == stop) goto lose; - DEC_BOTH (from, from_byte); + dec_both (&from, &from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); if (!char_quoted (from, from_byte)) { @@ -3090,7 +3083,7 @@ the prefix syntax flag (p). */) SETUP_SYNTAX_TABLE (pos, -1); - DEC_BOTH (pos, pos_byte); + dec_both (&pos, &pos_byte); while (!char_quoted (pos, pos_byte) /* Previous statement updates syntax table. */ @@ -3102,7 +3095,7 @@ the prefix syntax flag (p). */) if (pos <= beg) break; - DEC_BOTH (pos, pos_byte); + dec_both (&pos, &pos_byte); rarely_quit (pos); } @@ -3179,7 +3172,7 @@ scan_sexps_forward (struct lisp_parse_state *state, prev_from = from; prev_from_byte = from_byte; if (from != BEGV) - DEC_BOTH (prev_from, prev_from_byte); + dec_both (&prev_from, &prev_from_byte); /* Use this macro instead of `from++'. */ #define INC_FROM \ @@ -3188,7 +3181,7 @@ do { prev_from = from; \ temp = FETCH_CHAR_AS_MULTIBYTE (prev_from_byte); \ prev_prev_from_syntax = prev_from_syntax; \ prev_from_syntax = SYNTAX_WITH_FLAGS (temp); \ - INC_BOTH (from, from_byte); \ + inc_both (&from, &from_byte); \ if (from < end) \ UPDATE_SYNTAX_TABLE_FORWARD (from); \ } while (0) diff --git a/src/sysdep.c b/src/sysdep.c index cb2f7f2f23c..86e7c20cd01 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -135,11 +135,6 @@ int _cdecl _spawnlp (int, const char *, const char *, ...); # include <sys/socket.h> #endif -/* ULLONG_MAX is missing on Red Hat Linux 7.3; see Bug#11781. */ -#ifndef ULLONG_MAX -#define ULLONG_MAX TYPE_MAXIMUM (unsigned long long int) -#endif - /* Declare here, including term.h is problematic on some systems. */ extern void tputs (const char *, int, int (*)(int)); @@ -317,8 +312,8 @@ get_current_dir_name_or_unreachable (void) if (pwd && (pwdlen = strnlen (pwd, bufsize_max)) < bufsize_max && IS_DIRECTORY_SEP (pwd[pwdlen && IS_DEVICE_SEP (pwd[1]) ? 2 : 0]) - && stat (pwd, &pwdstat) == 0 - && stat (".", &dotstat) == 0 + && emacs_fstatat (AT_FDCWD, pwd, &pwdstat, 0) == 0 + && emacs_fstatat (AT_FDCWD, ".", &dotstat, 0) == 0 && dotstat.st_ino == pwdstat.st_ino && dotstat.st_dev == pwdstat.st_dev) { @@ -2454,7 +2449,27 @@ emacs_abort (void) } #endif -/* Open FILE for Emacs use, using open flags OFLAG and mode MODE. +/* Assuming the directory DIRFD, store information about FILENAME into *ST, + using FLAGS to control how the status is obtained. + Do not fail merely because fetching info was interrupted by a signal. + Allow the user to quit. + + The type of ST is void * instead of struct stat * because the + latter type would be problematic in lisp.h. Some platforms may + play tricks like "#define stat stat64" in <sys/stat.h>, and lisp.h + does not include <sys/stat.h>. */ + +int +emacs_fstatat (int dirfd, char const *filename, void *st, int flags) +{ + int r; + while ((r = fstatat (dirfd, filename, st, flags)) != 0 && errno == EINTR) + maybe_quit (); + return r; +} + +/* Assuming the directory DIRFD, open FILE for Emacs use, + using open flags OFLAGS and mode MODE. Use binary I/O on systems that care about text vs binary I/O. Arrange for subprograms to not inherit the file descriptor. Prefer a method that is multithread-safe, if available. @@ -2462,17 +2477,23 @@ emacs_abort (void) Allow the user to quit. */ int -emacs_open (const char *file, int oflags, int mode) +emacs_openat (int dirfd, char const *file, int oflags, int mode) { int fd; if (! (oflags & O_TEXT)) oflags |= O_BINARY; oflags |= O_CLOEXEC; - while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR) + while ((fd = openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR) maybe_quit (); return fd; } +int +emacs_open (char const *file, int oflags, int mode) +{ + return emacs_openat (AT_FDCWD, file, oflags, mode); +} + /* Open FILE as a stream for Emacs use, with mode MODE. Act like emacs_open with respect to threads, signals, and quits. */ @@ -2731,21 +2752,6 @@ emacs_perror (char const *message) errno = err; } -/* Set the access and modification time stamps of FD (a.k.a. FILE) to be - ATIME and MTIME, respectively. - FD must be either negative -- in which case it is ignored -- - or a file descriptor that is open on FILE. - If FD is nonnegative, then FILE can be NULL. */ -int -set_file_times (int fd, const char *filename, - struct timespec atime, struct timespec mtime) -{ - struct timespec timespec[2]; - timespec[0] = atime; - timespec[1] = mtime; - return fdutimens (fd, filename, timespec); -} - /* Rename directory SRCFD's entry SRC to directory DSTFD's entry DST. This is like renameat except that it fails if DST already exists, or if this operation is not supported atomically. Return 0 if @@ -3141,7 +3147,7 @@ make_lisp_timeval (struct timeval t) #endif -#if defined GNU_LINUX && defined HAVE_LONG_LONG_INT +#ifdef GNU_LINUX static struct timespec time_from_jiffies (unsigned long long tval, long hz) { @@ -4127,14 +4133,20 @@ str_collate (Lisp_Object s1, Lisp_Object s2, len = SCHARS (s1); i = i_byte = 0; SAFE_NALLOCA (p1, 1, len + 1); while (i < len) - FETCH_STRING_CHAR_ADVANCE (*(p1+i-1), s1, i, i_byte); - *(p1+len) = 0; + { + wchar_t *p = &p1[i]; + *p = fetch_string_char_advance (s1, &i, &i_byte); + } + p1[len] = 0; len = SCHARS (s2); i = i_byte = 0; SAFE_NALLOCA (p2, 1, len + 1); while (i < len) - FETCH_STRING_CHAR_ADVANCE (*(p2+i-1), s2, i, i_byte); - *(p2+len) = 0; + { + wchar_t *p = &p2[i]; + *p = fetch_string_char_advance (s2, &i, &i_byte); + } + p2[len] = 0; if (STRINGP (locale)) { diff --git a/src/systhread.h b/src/systhread.h index 005388fd5a4..73c764a9401 100644 --- a/src/systhread.h +++ b/src/systhread.h @@ -21,12 +21,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <stdbool.h> -#if __has_attribute (warn_unused_result) -# define ATTRIBUTE_WARN_UNUSED_RESULT __attribute__ ((warn_unused_result)) -#else -# define ATTRIBUTE_WARN_UNUSED_RESULT -#endif - #ifdef THREADS_ENABLED #ifdef HAVE_PTHREAD @@ -108,13 +102,13 @@ extern void sys_cond_broadcast (sys_cond_t *); extern void sys_cond_destroy (sys_cond_t *); extern sys_thread_t sys_thread_self (void) - ATTRIBUTE_WARN_UNUSED_RESULT; + NODISCARD; extern bool sys_thread_equal (sys_thread_t, sys_thread_t) - ATTRIBUTE_WARN_UNUSED_RESULT; + NODISCARD; extern bool sys_thread_create (sys_thread_t *, thread_creation_function *, void *) - ATTRIBUTE_WARN_UNUSED_RESULT; + NODISCARD; extern void sys_thread_yield (void); extern void sys_thread_set_name (const char *); diff --git a/src/systime.h b/src/systime.h index 00ca4a1c58d..b59a3d1c690 100644 --- a/src/systime.h +++ b/src/systime.h @@ -67,9 +67,6 @@ timespec_valid_p (struct timespec t) return t.tv_nsec >= 0; } -/* defined in sysdep.c */ -extern int set_file_times (int, const char *, struct timespec, struct timespec); - /* defined in keyboard.c */ extern void set_waiting_for_input (struct timespec *); diff --git a/src/textprop.c b/src/textprop.c index ee048336ac0..0876badc873 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -131,6 +131,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, { INTERVAL i; ptrdiff_t searchpos; + Lisp_Object begin0 = *begin, end0 = *end; CHECK_STRING_OR_BUFFER (object); CHECK_FIXNUM_COERCE_MARKER (*begin); @@ -155,7 +156,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) && XFIXNUM (*end) <= BUF_ZV (b))) - args_out_of_range (*begin, *end); + args_out_of_range (begin0, end0); i = buffer_intervals (b); /* If there's no text, there are no properties. */ @@ -170,7 +171,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) && XFIXNUM (*end) <= len)) - args_out_of_range (*begin, *end); + args_out_of_range (begin0, end0); i = string_intervals (object); if (len == 0) @@ -611,7 +612,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, { struct window *w = 0; - CHECK_FIXNUM_COERCE_MARKER (position); + EMACS_INT pos = fix_position (position); if (NILP (object)) XSETBUFFER (object, current_buffer); @@ -628,14 +629,14 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object *overlay_vec; struct buffer *obuf = current_buffer; - if (XFIXNUM (position) < BUF_BEGV (XBUFFER (object)) - || XFIXNUM (position) > BUF_ZV (XBUFFER (object))) + if (! (BUF_BEGV (XBUFFER (object)) <= pos + && pos <= BUF_ZV (XBUFFER (object)))) xsignal1 (Qargs_out_of_range, position); set_buffer_temp (XBUFFER (object)); USE_SAFE_ALLOCA; - GET_OVERLAYS_AT (XFIXNUM (position), overlay_vec, noverlays, NULL, false); + GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false); noverlays = sort_overlays (overlay_vec, noverlays, w); set_buffer_temp (obuf); @@ -662,7 +663,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, /* Not a buffer, or no appropriate overlay, so fall through to the simpler case. */ - return Fget_text_property (position, prop, object); + return Fget_text_property (make_fixnum (pos), prop, object); } DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0, @@ -765,14 +766,13 @@ the current buffer), POSITION is a buffer position (integer or marker). If OBJECT is a string, POSITION is a 0-based index into it. In a string, scan runs to the end of the string, unless LIMIT is non-nil. -In a buffer, if LIMIT is nil or omitted, it runs to (point-max), and the -value cannot exceed that. +In a buffer, scan runs to end of buffer, unless LIMIT is non-nil. If the optional fourth argument LIMIT is non-nil, don't search past position LIMIT; return LIMIT if nothing is found before LIMIT. +However, if OBJECT is a buffer and LIMIT is beyond the end of the +buffer, this function returns `point-max', not LIMIT. -The property values are compared with `eq'. -If the property is constant all the way to the end of OBJECT, return the -last valid position in OBJECT. */) +The property values are compared with `eq'. */) (Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object limit) { if (STRINGP (object)) @@ -831,6 +831,9 @@ last valid position in OBJECT. */) value = Fget_char_property (position, prop, object); if (!EQ (value, initial_value)) break; + + if (XFIXNAT (position) >= ZV) + break; } position = unbind_to (count, position); diff --git a/src/thread.c b/src/thread.c index c7fe0614269..df1a7053826 100644 --- a/src/thread.c +++ b/src/thread.c @@ -1114,9 +1114,6 @@ syms_of_threads (void) staticpro (&last_thread_error); last_thread_error = Qnil; - Fdefalias (intern_c_string ("thread-alive-p"), - intern_c_string ("thread-live-p"), Qnil); - Fprovide (intern_c_string ("threads"), Qnil); } diff --git a/src/timefns.c b/src/timefns.c index 553daf6e6a9..7bcc37d7c1e 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -593,31 +593,29 @@ timespec_to_lisp (struct timespec t) } /* Return NUMERATOR / DENOMINATOR, rounded to the nearest double. - Arguments must be Lisp integers, and DENOMINATOR must be nonzero. */ + Arguments must be Lisp integers, and DENOMINATOR must be positive. */ static double frac_to_double (Lisp_Object numerator, Lisp_Object denominator) { - intmax_t intmax_numerator; - if (FASTER_TIMEFNS && EQ (denominator, make_fixnum (1)) - && integer_to_intmax (numerator, &intmax_numerator)) - return intmax_numerator; + intmax_t intmax_numerator, intmax_denominator; + if (FASTER_TIMEFNS + && integer_to_intmax (numerator, &intmax_numerator) + && integer_to_intmax (denominator, &intmax_denominator) + && intmax_numerator % intmax_denominator == 0) + return intmax_numerator / intmax_denominator; /* Compute number of base-FLT_RADIX digits in numerator and denominator. */ mpz_t const *n = bignum_integer (&mpz[0], numerator); mpz_t const *d = bignum_integer (&mpz[1], denominator); - ptrdiff_t nbits = mpz_sizeinbase (*n, 2); - ptrdiff_t dbits = mpz_sizeinbase (*d, 2); - eassume (0 < nbits); - eassume (0 < dbits); - ptrdiff_t ndig = (nbits + LOG2_FLT_RADIX - 1) / LOG2_FLT_RADIX; - ptrdiff_t ddig = (dbits + LOG2_FLT_RADIX - 1) / LOG2_FLT_RADIX; + ptrdiff_t ndig = mpz_sizeinbase (*n, FLT_RADIX); + ptrdiff_t ddig = mpz_sizeinbase (*d, FLT_RADIX); /* Scale with SCALE when doing integer division. That is, compute (N * FLT_RADIX**SCALE) / D [or, if SCALE is negative, N / (D * FLT_RADIX**-SCALE)] as a bignum, convert the bignum to double, then divide the double by FLT_RADIX**SCALE. First scale N (or scale D, if SCALE is negative) ... */ - ptrdiff_t scale = ddig - ndig + DBL_MANT_DIG + 1; + ptrdiff_t scale = ddig - ndig + DBL_MANT_DIG; if (scale < 0) { mpz_mul_2exp (mpz[1], *d, - (scale * LOG2_FLT_RADIX)); @@ -645,7 +643,7 @@ frac_to_double (Lisp_Object numerator, Lisp_Object denominator) round to the nearest integer; otherwise, it is less than FLT_RADIX ** (DBL_MANT_DIG + 1) and round it to the nearest multiple of FLT_RADIX. Break ties to even. */ - if (mpz_sizeinbase (*q, 2) < DBL_MANT_DIG * LOG2_FLT_RADIX) + if (mpz_sizeinbase (*q, FLT_RADIX) <= DBL_MANT_DIG) { /* Converting to double will use the whole quotient so add 1 to its absolute value as per round-to-even; i.e., if the doubled @@ -770,44 +768,48 @@ decode_time_components (enum timeform form, /* Normalize out-of-range lower-order components by carrying each overflow into the next higher-order component. */ us += ps / 1000000 - (ps % 1000000 < 0); - mpz_set_intmax (mpz[0], us / 1000000 - (us % 1000000 < 0)); - mpz_add (mpz[0], mpz[0], *bignum_integer (&mpz[1], low)); - mpz_addmul_ui (mpz[0], *bignum_integer (&mpz[1], high), 1 << LO_TIME_BITS); + mpz_t *s = &mpz[1]; + mpz_set_intmax (*s, us / 1000000 - (us % 1000000 < 0)); + mpz_add (*s, *s, *bignum_integer (&mpz[0], low)); + mpz_addmul_ui (*s, *bignum_integer (&mpz[0], high), 1 << LO_TIME_BITS); ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); us = us % 1000000 + 1000000 * (us % 1000000 < 0); - if (result) + Lisp_Object hz; + switch (form) { - switch (form) - { - case TIMEFORM_HI_LO: - /* Floats and nil were handled above, so it was an integer. */ - result->hz = make_fixnum (1); - break; - - case TIMEFORM_HI_LO_US: - mpz_mul_ui (mpz[0], mpz[0], 1000000); - mpz_add_ui (mpz[0], mpz[0], us); - result->hz = make_fixnum (1000000); - break; - - case TIMEFORM_HI_LO_US_PS: - mpz_mul_ui (mpz[0], mpz[0], 1000000); - mpz_add_ui (mpz[0], mpz[0], us); - mpz_mul_ui (mpz[0], mpz[0], 1000000); - mpz_add_ui (mpz[0], mpz[0], ps); - result->hz = trillion; - break; - - default: - eassume (false); - } - result->ticks = make_integer_mpz (); + case TIMEFORM_HI_LO: + /* Floats and nil were handled above, so it was an integer. */ + mpz_swap (mpz[0], *s); + hz = make_fixnum (1); + break; + + case TIMEFORM_HI_LO_US: + mpz_set_ui (mpz[0], us); + mpz_addmul_ui (mpz[0], *s, 1000000); + hz = make_fixnum (1000000); + break; + + case TIMEFORM_HI_LO_US_PS: + { + #if FASTER_TIMEFNS && TRILLION <= ULONG_MAX + unsigned long i = us; + mpz_set_ui (mpz[0], i * 1000000 + ps); + mpz_addmul_ui (mpz[0], *s, TRILLION); + #else + intmax_t i = us; + mpz_set_intmax (mpz[0], i * 1000000 + ps); + mpz_addmul (mpz[0], *s, ztrillion); + #endif + hz = trillion; + } + break; + + default: + eassume (false); } - else - *dresult = mpz_get_d (mpz[0]) + (us * 1e6L + ps) / 1e12L; - return 0; + return decode_ticks_hz (make_integer_mpz (), hz, result, dresult); } enum { DECODE_SECS_ONLY = WARN_OBSOLETE_TIMESTAMPS + 1 }; diff --git a/src/w32.c b/src/w32.c index 62c53fd7711..0f69e652a57 100644 --- a/src/w32.c +++ b/src/w32.c @@ -2370,6 +2370,26 @@ srandom (int seed) iz = rand () % RAND_MAX_Z; } +/* Emulate explicit_bzero. This is to avoid using the Gnulib version, + because it calls SecureZeroMemory at will, disregarding systems + older than Windows XP, which didn't have that function. We want to + avoid having that function as dependency in builds that need to + support systems older than Windows XP, otherwise Emacs will refuse + to start on those systems. */ +void +explicit_bzero (void *buf, size_t len) +{ +#if _WIN32_WINNT >= 0x0501 + /* We are compiling for XP or newer, most probably with MinGW64. + We can use SecureZeroMemory. */ + SecureZeroMemory (buf, len); +#else + memset (buf, 0, len); + /* Compiler barrier. */ + asm volatile ("" ::: "memory"); +#endif +} + /* Return the maximum length in bytes of a multibyte character sequence encoded in the current ANSI codepage. This is required to correctly walk the encoded file names one character at a time. */ @@ -3178,18 +3198,9 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2]) return _futime (fd, &_ut); } else - { - struct utimbuf ut; - - ut.actime = timespec[0].tv_sec; - ut.modtime = timespec[1].tv_sec; - /* Call 'utime', which is implemented below, not the MS library - function, which fails on directories. */ - return utime (file, &ut); - } + return utimensat (fd, file, timespec, 0); } - /* ------------------------------------------------------------------------- */ /* IO support and wrapper functions for the Windows API. */ /* ------------------------------------------------------------------------- */ @@ -3450,8 +3461,6 @@ is_fat_volume (const char * name, const char ** pPath) /* Convert all slashes in a filename to backslashes, and map filename to a valid 8.3 name if necessary. The result is a pointer to a static buffer, so CAVEAT EMPTOR! */ -const char *map_w32_filename (const char *, const char **); - const char * map_w32_filename (const char * name, const char ** pPath) { @@ -4320,10 +4329,9 @@ sys_chdir (const char * path) } } -int -sys_chmod (const char * path, int mode) +static int +chmod_worker (const char * path, int mode) { - path = chase_symlinks (map_w32_filename (path, NULL)); if (w32_unicode_filenames) { wchar_t path_w[MAX_PATH]; @@ -4341,6 +4349,20 @@ sys_chmod (const char * path, int mode) } int +sys_chmod (const char * path, int mode) +{ + path = chase_symlinks (map_w32_filename (path, NULL)); + return chmod_worker (path, mode); +} + +int +lchmod (const char * path, mode_t mode) +{ + path = map_w32_filename (path, NULL); + return chmod_worker (path, mode); +} + +int sys_creat (const char * path, int mode) { path = map_w32_filename (path, NULL); @@ -4592,12 +4614,55 @@ sys_open (const char * path, int oflag, int mode) } int +openat (int fd, const char * path, int oflag, int mode) +{ + /* Rely on a hack: an open directory is modeled as file descriptor 0, + as in fstatat. FIXME: Add proper support for openat. */ + char fullname[MAX_UTF8_PATH]; + + if (fd != AT_FDCWD) + { + if (_snprintf (fullname, sizeof fullname, "%s/%s", dir_pathname, path) + < 0) + { + errno = ENAMETOOLONG; + return -1; + } + path = fullname; + } + + return sys_open (path, oflag, mode); +} + +int fchmod (int fd, mode_t mode) { return 0; } int +fchmodat (int fd, char const *path, mode_t mode, int flags) +{ + /* Rely on a hack: an open directory is modeled as file descriptor 0, + as in fstatat. FIXME: Add proper support for fchmodat. */ + char fullname[MAX_UTF8_PATH]; + + if (fd != AT_FDCWD) + { + if (_snprintf (fullname, sizeof fullname, "%s/%s", dir_pathname, path) + < 0) + { + errno = ENAMETOOLONG; + return -1; + } + path = fullname; + } + + return + flags == AT_SYMLINK_NOFOLLOW ? lchmod (path, mode) : sys_chmod (path, mode); +} + +int sys_rename_replace (const char *oldname, const char *newname, BOOL force) { BOOL result; @@ -4914,7 +4979,7 @@ convert_time (FILETIME ft) } static void -convert_from_time_t (time_t time, FILETIME * pft) +convert_from_timespec (struct timespec time, FILETIME * pft) { ULARGE_INTEGER tmp; @@ -4925,7 +4990,8 @@ convert_from_time_t (time_t time, FILETIME * pft) } /* time in 100ns units since 1-Jan-1601 */ - tmp.QuadPart = (ULONGLONG) time * 10000000L + utc_base; + tmp.QuadPart = + (ULONGLONG) time.tv_sec * 10000000L + time.tv_nsec / 100 + utc_base; pft->dwHighDateTime = tmp.HighPart; pft->dwLowDateTime = tmp.LowPart; } @@ -5592,8 +5658,8 @@ fstatat (int fd, char const *name, struct stat *st, int flags) return stat_worker (name, st, ! (flags & AT_SYMLINK_NOFOLLOW)); } -/* Provide fstat and utime as well as stat for consistent handling of - file timestamps. */ +/* Provide fstat and utimensat as well as stat for consistent handling + of file timestamps. */ int fstat (int desc, struct stat * buf) { @@ -5704,23 +5770,65 @@ fstat (int desc, struct stat * buf) return 0; } -/* A version of 'utime' which handles directories as well as - files. */ +/* Emulate utimensat. */ int -utime (const char *name, struct utimbuf *times) +utimensat (int fd, const char *name, const struct timespec times[2], int flag) { - struct utimbuf deftime; + struct timespec ltimes[2]; HANDLE fh; FILETIME mtime; FILETIME atime; + DWORD flags_and_attrs = FILE_FLAG_BACKUP_SEMANTICS; + + /* Rely on a hack: an open directory is modeled as file descriptor 0. + This is good enough for the current usage in Emacs, but is fragile. + + FIXME: Add proper support for utimensat. + Gnulib does this and can serve as a model. */ + char fullname[MAX_UTF8_PATH]; + + if (fd != AT_FDCWD) + { + char lastc = dir_pathname[strlen (dir_pathname) - 1]; + + if (_snprintf (fullname, sizeof fullname, "%s%s%s", + dir_pathname, IS_DIRECTORY_SEP (lastc) ? "" : "/", name) + < 0) + { + errno = ENAMETOOLONG; + return -1; + } + name = fullname; + } if (times == NULL) { - deftime.modtime = deftime.actime = time (NULL); - times = &deftime; + memset (ltimes, 0, sizeof (ltimes)); + ltimes[0] = ltimes[1] = current_timespec (); + } + else + { + if (times[0].tv_nsec == UTIME_OMIT && times[1].tv_nsec == UTIME_OMIT) + return 0; /* nothing to do */ + if ((times[0].tv_nsec != UTIME_NOW && times[0].tv_nsec != UTIME_OMIT + && !(0 <= times[0].tv_nsec && times[0].tv_nsec < 1000000000)) + || (times[1].tv_nsec != UTIME_NOW && times[1].tv_nsec != UTIME_OMIT + && !(0 <= times[1].tv_nsec && times[1].tv_nsec < 1000000000))) + { + errno = EINVAL; /* reject invalid timespec values */ + return -1; + } + + memcpy (ltimes, times, sizeof (ltimes)); + if (ltimes[0].tv_nsec == UTIME_NOW) + ltimes[0] = current_timespec (); + if (ltimes[1].tv_nsec == UTIME_NOW) + ltimes[1] = current_timespec (); } + if (flag == AT_SYMLINK_NOFOLLOW) + flags_and_attrs |= FILE_FLAG_OPEN_REPARSE_POINT; if (w32_unicode_filenames) { wchar_t name_utf16[MAX_PATH]; @@ -5734,7 +5842,7 @@ utime (const char *name, struct utimbuf *times) allows other processes to delete files inside it, while we have the directory open. */ FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, - 0, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); + 0, OPEN_EXISTING, flags_and_attrs, NULL); } else { @@ -5745,13 +5853,26 @@ utime (const char *name, struct utimbuf *times) fh = CreateFileA (name_ansi, FILE_WRITE_ATTRIBUTES, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, - 0, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); + 0, OPEN_EXISTING, flags_and_attrs, NULL); } if (fh != INVALID_HANDLE_VALUE) { - convert_from_time_t (times->actime, &atime); - convert_from_time_t (times->modtime, &mtime); - if (!SetFileTime (fh, NULL, &atime, &mtime)) + FILETIME *patime, *pmtime; + if (ltimes[0].tv_nsec == UTIME_OMIT) + patime = NULL; + else + { + convert_from_timespec (ltimes[0], &atime); + patime = &atime; + } + if (ltimes[1].tv_nsec == UTIME_OMIT) + pmtime = NULL; + else + { + convert_from_timespec (ltimes[1], &mtime); + pmtime = &mtime; + } + if (!SetFileTime (fh, NULL, patime, pmtime)) { CloseHandle (fh); errno = EACCES; @@ -6670,16 +6791,16 @@ w32_copy_file (const char *from, const char *to, FIXME? */ else if (!keep_time) { - struct timespec now; + struct timespec tnow[2]; DWORD attributes; + tnow[0] = tnow[1] = current_timespec (); if (w32_unicode_filenames) { /* Ensure file is writable while its times are set. */ attributes = GetFileAttributesW (to_w); SetFileAttributesW (to_w, attributes & ~FILE_ATTRIBUTE_READONLY); - now = current_timespec (); - if (set_file_times (-1, to, now, now)) + if (utimensat (AT_FDCWD, to, tnow, 0)) { /* Restore original attributes. */ SetFileAttributesW (to_w, attributes); @@ -6694,8 +6815,7 @@ w32_copy_file (const char *from, const char *to, { attributes = GetFileAttributesA (to_a); SetFileAttributesA (to_a, attributes & ~FILE_ATTRIBUTE_READONLY); - now = current_timespec (); - if (set_file_times (-1, to, now, now)) + if (utimensat (AT_FDCWD, to, tnow, 0)) { SetFileAttributesA (to_a, attributes); if (acl) @@ -10123,6 +10243,10 @@ term_ntproc (int ignored) term_winsock (); term_w32select (); + +#if HAVE_NATIVE_IMAGE_API + w32_gdiplus_shutdown (); +#endif } void diff --git a/src/w32.h b/src/w32.h index b8655ec788c..1afb8ad0873 100644 --- a/src/w32.h +++ b/src/w32.h @@ -194,6 +194,7 @@ extern void syms_of_ntproc (void); extern void syms_of_ntterm (void); extern void dostounix_filename (register char *); extern void unixtodos_filename (register char *); +extern const char *map_w32_filename (const char *, const char **); extern int filename_from_ansi (const char *, char *); extern int filename_to_ansi (const char *, char *); extern int filename_from_utf16 (const wchar_t *, char *); @@ -221,6 +222,9 @@ extern void register_child (pid_t, int); extern void sys_sleep (int); extern int sys_link (const char *, const char *); +extern int openat (int, const char *, int, int); +extern int fchmodat (int, char const *, mode_t, int); +extern int lchmod (char const *, mode_t); /* Return total and free memory info. */ extern int w32_memory_info (unsigned long long *, unsigned long long *, diff --git a/src/w32fns.c b/src/w32fns.c index 2f01fb52e92..e595b0285a7 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -80,7 +80,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ extern int w32_console_toggle_lock_key (int, Lisp_Object); extern void w32_menu_display_help (HWND, HMENU, UINT, UINT); extern void w32_free_menu_strings (HWND); -extern const char *map_w32_filename (const char *, const char **); #ifndef IDC_HAND #define IDC_HAND MAKEINTRESOURCE(32649) @@ -166,6 +165,10 @@ typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window); typedef BOOL (WINAPI * ImmReleaseContext_Proc) (IN HWND wnd, IN HIMC context); typedef BOOL (WINAPI * ImmSetCompositionWindow_Proc) (IN HIMC context, IN COMPOSITIONFORM *form); +/* For toggling IME status. */ +typedef BOOL (WINAPI * ImmGetOpenStatus_Proc) (IN HIMC); +typedef BOOL (WINAPI * ImmSetOpenStatus_Proc) (IN HIMC, IN BOOL); + typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags); typedef BOOL (WINAPI * GetMonitorInfo_Proc) (IN HMONITOR monitor, OUT struct MONITOR_INFO* info); @@ -185,6 +188,8 @@ typedef HRESULT (WINAPI *SetThreadDescription_Proc) TrackMouseEvent_Proc track_mouse_event_fn = NULL; ImmGetCompositionString_Proc get_composition_string_fn = NULL; ImmGetContext_Proc get_ime_context_fn = NULL; +ImmGetOpenStatus_Proc get_ime_open_status_fn = NULL; +ImmSetOpenStatus_Proc set_ime_open_status_fn = NULL; ImmReleaseContext_Proc release_ime_context_fn = NULL; ImmSetCompositionWindow_Proc set_ime_composition_window_fn = NULL; MonitorFromPoint_Proc monitor_from_point_fn = NULL; @@ -1700,10 +1705,8 @@ w32_clear_under_internal_border (struct frame *f) static void w32_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - int border; - - CHECK_TYPE_RANGED_INTEGER (int, arg); - border = max (XFIXNUM (arg), 0); + int argval = check_integer_range (arg, INT_MIN, INT_MAX); + int border = max (argval, 0); if (border != FRAME_INTERNAL_BORDER_WIDTH (f)) { @@ -3307,6 +3310,7 @@ w32_name_of_message (UINT msg) M (WM_EMACS_SETCURSOR), M (WM_EMACS_SHOWCURSOR), M (WM_EMACS_PAINT), + M (WM_EMACS_IME_STATUS), M (WM_CHAR), #undef M { 0, 0 } @@ -3444,6 +3448,21 @@ w32_msg_pump (deferred_msg * msg_buf) emacs_abort (); } break; + case WM_EMACS_IME_STATUS: + { + focus_window = GetFocus (); + if (!set_ime_open_status_fn || !focus_window) + break; + + HIMC context = get_ime_context_fn (focus_window); + if (!context) + break; + + set_ime_open_status_fn (context, msg.wParam != 0); + release_ime_context_fn (focus_window, context); + break; + } + #ifdef MSG_DEBUG /* Broadcast messages make it here, so you need to be looking for something in particular for this to be useful. */ @@ -8260,7 +8279,6 @@ a ShowWindow flag: /* Encode filename, current directory and parameters. */ current_dir = GUI_ENCODE_FILE (current_dir); document = GUI_ENCODE_FILE (document); - doc_w = GUI_SDATA (document); if (STRINGP (parameters)) { parameters = GUI_ENCODE_SYSTEM (parameters); @@ -8271,6 +8289,7 @@ a ShowWindow flag: operation = GUI_ENCODE_SYSTEM (operation); ops_w = GUI_SDATA (operation); } + doc_w = GUI_SDATA (document); result = (intptr_t) ShellExecuteW (NULL, ops_w, doc_w, params_w, GUI_SDATA (current_dir), (FIXNUMP (show_flag) @@ -8355,7 +8374,7 @@ a ShowWindow flag: handler = Ffind_file_name_handler (absdoc, Qfile_exists_p); if (NILP (handler)) { - Lisp_Object absdoc_encoded = ENCODE_FILE (absdoc); + Lisp_Object absdoc_encoded = Fcopy_sequence (ENCODE_FILE (absdoc)); if (faccessat (AT_FDCWD, SSDATA (absdoc_encoded), F_OK, AT_EACCESS) == 0) { @@ -9203,8 +9222,8 @@ The coordinates X and Y are interpreted in pixels relative to a position UINT trail_num = 0; BOOL ret = false; - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); block_input (); /* When "mouse trails" are in effect, moving the mouse cursor @@ -9213,7 +9232,7 @@ The coordinates X and Y are interpreted in pixels relative to a position if (os_subtype == OS_NT && w32_major_version + w32_minor_version >= 6) ret = SystemParametersInfo (SPI_GETMOUSETRAILS, 0, &trail_num, 0); - SetCursorPos (XFIXNUM (x), XFIXNUM (y)); + SetCursorPos (xval, yval); if (ret) SystemParametersInfo (SPI_SETMOUSETRAILS, trail_num, NULL, 0); unblock_input (); @@ -10220,6 +10239,51 @@ DEFUN ("w32-notification-close", #endif /* WINDOWSNT && !HAVE_DBUS */ +DEFUN ("w32-get-ime-open-status", + Fw32_get_ime_open_status, Sw32_get_ime_open_status, + 0, 0, 0, + doc: /* Return non-nil if IME is active, otherwise return nil. + +IME, the MS-Windows Input Method Editor, can be active or inactive. +This function returns non-nil if the IME is active, otherwise nil. */) + (void) +{ + struct frame *sf = + FRAMEP (selected_frame) && FRAME_LIVE_P (XFRAME (selected_frame)) + ? XFRAME (selected_frame) + : NULL; + + if (sf) + { + HWND current_window = FRAME_W32_WINDOW (sf); + HIMC context = get_ime_context_fn (current_window); + if (context) + { + BOOL retval = get_ime_open_status_fn (context); + release_ime_context_fn (current_window, context); + + return retval ? Qt : Qnil; + } + } + + return Qnil; +} + +DEFUN ("w32-set-ime-open-status", + Fw32_set_ime_open_status, Sw32_set_ime_open_status, + 1, 1, 0, + doc: /* Open or close the IME according to STATUS. + +This function activates the IME, the MS-Windows Input Method Editor, +if STATUS is non-nil, otherwise it deactivates the IME. */) + (Lisp_Object status) +{ + unsigned ime_status = NILP (status) ? 0 : 1; + + PostThreadMessage (dwWindowsThreadId, WM_EMACS_IME_STATUS, ime_status, 0); + return Qnil; +} + #ifdef WINDOWSNT /*********************************************************************** @@ -10746,6 +10810,8 @@ tip frame. */); defsubr (&Sw32_notification_notify); defsubr (&Sw32_notification_close); #endif + defsubr (&Sw32_get_ime_open_status); + defsubr (&Sw32_set_ime_open_status); #ifdef WINDOWSNT defsubr (&Sw32_read_registry); @@ -11034,6 +11100,11 @@ globals_of_w32fns (void) get_proc_addr (imm32_lib, "ImmReleaseContext"); set_ime_composition_window_fn = (ImmSetCompositionWindow_Proc) get_proc_addr (imm32_lib, "ImmSetCompositionWindow"); + + get_ime_open_status_fn = (ImmGetOpenStatus_Proc) + get_proc_addr (imm32_lib, "ImmGetOpenStatus"); + set_ime_open_status_fn = (ImmSetOpenStatus_Proc) + get_proc_addr (imm32_lib, "ImmSetOpenStatus"); } HMODULE hm_kernel32 = GetModuleHandle ("kernel32.dll"); diff --git a/src/w32gui.h b/src/w32gui.h index 5cc64287291..dfec1f08617 100644 --- a/src/w32gui.h +++ b/src/w32gui.h @@ -41,6 +41,12 @@ typedef struct _XImage /* Optional RGBQUAD array for palette follows (see BITMAPINFO docs). */ } XImage; +struct image; +extern int w32_load_image (struct frame *f, struct image *img, + Lisp_Object spec_file, Lisp_Object spec_data); +extern bool w32_can_use_native_image_api (Lisp_Object); +extern void w32_gdiplus_shutdown (void); + #define FACE_DEFAULT (~0) extern HINSTANCE hinst; 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) } } +void * +sys_calloc (size_t number, size_t size) +{ + size_t nbytes = number * size; + void *ptr = (*the_malloc_fn) (nbytes); + if (ptr) + memset (ptr, 0, nbytes); + return ptr; +} + #if defined HAVE_UNEXEC && defined ENABLE_CHECKING void report_temacs_memory_usage (void) diff --git a/src/w32image.c b/src/w32image.c new file mode 100644 index 00000000000..70b2eb29b87 --- /dev/null +++ b/src/w32image.c @@ -0,0 +1,477 @@ +/* Implementation of MS-Windows native image API via the GDI+ library. + +Copyright (C) 2020 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +/* Written by Juan Jose Garcia-Ripoll <juanjose.garciaripoll@gmail.com>. */ + +#include <config.h> +#include "lisp.h" +#include "dispextern.h" +#define COBJMACROS +#ifdef MINGW_W64 +/* FIXME: Do we need to include objidl.h? */ +#include <objidl.h> +#endif +#include <wtypes.h> +#include <gdiplus.h> +#include <shlwapi.h> +#include "w32common.h" +#include "w32term.h" +#ifdef WINDOWSNT +#include "w32.h" /* for map_w32_filename, filename_to_utf16 */ +#endif +#include "frame.h" +#include "coding.h" + +#ifdef WINDOWSNT + +typedef GpStatus (WINGDIPAPI *GdiplusStartup_Proc) + (ULONG_PTR *, GdiplusStartupInput *, GdiplusStartupOutput *); +typedef VOID (WINGDIPAPI *GdiplusShutdown_Proc) (ULONG_PTR); +typedef GpStatus (WINGDIPAPI *GdipGetPropertyItemSize_Proc) + (GpImage *, PROPID, UINT *); +typedef GpStatus (WINGDIPAPI *GdipGetPropertyItem_Proc) + (GpImage *, PROPID, UINT, PropertyItem *); +typedef GpStatus (WINGDIPAPI *GdipImageGetFrameDimensionsCount_Proc) + (GpImage *, UINT *); +typedef GpStatus (WINGDIPAPI *GdipImageGetFrameDimensionsList_Proc) + (GpImage *, GUID *, UINT); +typedef GpStatus (WINGDIPAPI *GdipImageGetFrameCount_Proc) + (GpImage *, GDIPCONST GUID *, UINT *); +typedef GpStatus (WINGDIPAPI *GdipImageSelectActiveFrame_Proc) + (GpImage*, GDIPCONST GUID *, UINT); +typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromFile_Proc) + (WCHAR *, GpBitmap **); +typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromStream_Proc) + (IStream *, GpBitmap **); +typedef IStream * (WINAPI *SHCreateMemStream_Proc) (const BYTE *, UINT); +typedef GpStatus (WINGDIPAPI *GdipCreateHBITMAPFromBitmap_Proc) + (GpBitmap *, HBITMAP *, ARGB); +typedef GpStatus (WINGDIPAPI *GdipDisposeImage_Proc) (GpImage *); +typedef GpStatus (WINGDIPAPI *GdipGetImageHeight_Proc) (GpImage *, UINT *); +typedef GpStatus (WINGDIPAPI *GdipGetImageWidth_Proc) (GpImage *, UINT *); + +GdiplusStartup_Proc fn_GdiplusStartup; +GdiplusShutdown_Proc fn_GdiplusShutdown; +GdipGetPropertyItemSize_Proc fn_GdipGetPropertyItemSize; +GdipGetPropertyItem_Proc fn_GdipGetPropertyItem; +GdipImageGetFrameDimensionsCount_Proc fn_GdipImageGetFrameDimensionsCount; +GdipImageGetFrameDimensionsList_Proc fn_GdipImageGetFrameDimensionsList; +GdipImageGetFrameCount_Proc fn_GdipImageGetFrameCount; +GdipImageSelectActiveFrame_Proc fn_GdipImageSelectActiveFrame; +GdipCreateBitmapFromFile_Proc fn_GdipCreateBitmapFromFile; +GdipCreateBitmapFromStream_Proc fn_GdipCreateBitmapFromStream; +SHCreateMemStream_Proc fn_SHCreateMemStream; +GdipCreateHBITMAPFromBitmap_Proc fn_GdipCreateHBITMAPFromBitmap; +GdipDisposeImage_Proc fn_GdipDisposeImage; +GdipGetImageHeight_Proc fn_GdipGetImageHeight; +GdipGetImageWidth_Proc fn_GdipGetImageWidth; + +static bool +gdiplus_init (void) +{ + HANDLE gdiplus_lib, shlwapi_lib; + + if (!((gdiplus_lib = w32_delayed_load (Qgdiplus)) + && (shlwapi_lib = w32_delayed_load (Qshlwapi)))) + return false; + + fn_GdiplusStartup = (GdiplusStartup_Proc) + get_proc_addr (gdiplus_lib, "GdiplusStartup"); + if (!fn_GdiplusStartup) + return false; + fn_GdiplusShutdown = (GdiplusShutdown_Proc) + get_proc_addr (gdiplus_lib, "GdiplusShutdown"); + if (!fn_GdiplusShutdown) + return false; + fn_GdipGetPropertyItemSize = (GdipGetPropertyItemSize_Proc) + get_proc_addr (gdiplus_lib, "GdipGetPropertyItemSize"); + if (!fn_GdipGetPropertyItemSize) + return false; + fn_GdipGetPropertyItem = (GdipGetPropertyItem_Proc) + get_proc_addr (gdiplus_lib, "GdipGetPropertyItem"); + if (!fn_GdipGetPropertyItem) + return false; + fn_GdipImageGetFrameDimensionsCount = (GdipImageGetFrameDimensionsCount_Proc) + get_proc_addr (gdiplus_lib, "GdipImageGetFrameDimensionsCount"); + if (!fn_GdipImageGetFrameDimensionsCount) + return false; + fn_GdipImageGetFrameDimensionsList = (GdipImageGetFrameDimensionsList_Proc) + get_proc_addr (gdiplus_lib, "GdipImageGetFrameDimensionsList"); + if (!fn_GdipImageGetFrameDimensionsList) + return false; + fn_GdipImageGetFrameCount = (GdipImageGetFrameCount_Proc) + get_proc_addr (gdiplus_lib, "GdipImageGetFrameCount"); + if (!fn_GdipImageGetFrameCount) + return false; + fn_GdipImageSelectActiveFrame = (GdipImageSelectActiveFrame_Proc) + get_proc_addr (gdiplus_lib, "GdipImageSelectActiveFrame"); + if (!fn_GdipImageSelectActiveFrame) + return false; + fn_GdipCreateBitmapFromFile = (GdipCreateBitmapFromFile_Proc) + get_proc_addr (gdiplus_lib, "GdipCreateBitmapFromFile"); + if (!fn_GdipCreateBitmapFromFile) + return false; + fn_GdipCreateBitmapFromStream = (GdipCreateBitmapFromStream_Proc) + get_proc_addr (gdiplus_lib, "GdipCreateBitmapFromStream"); + if (!fn_GdipCreateBitmapFromStream) + return false; + fn_GdipCreateHBITMAPFromBitmap = (GdipCreateHBITMAPFromBitmap_Proc) + get_proc_addr (gdiplus_lib, "GdipCreateHBITMAPFromBitmap"); + if (!fn_GdipCreateHBITMAPFromBitmap) + return false; + fn_GdipDisposeImage = (GdipDisposeImage_Proc) + get_proc_addr (gdiplus_lib, "GdipDisposeImage"); + if (!fn_GdipDisposeImage) + return false; + fn_GdipGetImageHeight = (GdipGetImageHeight_Proc) + get_proc_addr (gdiplus_lib, "GdipGetImageHeight"); + if (!fn_GdipGetImageHeight) + return false; + fn_GdipGetImageWidth = (GdipGetImageWidth_Proc) + get_proc_addr (gdiplus_lib, "GdipGetImageWidth"); + if (!fn_GdipGetImageWidth) + return false; + /* LOAD_DLL_FN (shlwapi_lib, SHCreateMemStream); */ + + /* The following terrible kludge is required to use native image API + on Windows before Vista, because SHCreateMemStream was not + exported by name in those versions, only by ordinal number. */ + fn_SHCreateMemStream = (SHCreateMemStream_Proc) + get_proc_addr (shlwapi_lib, "SHCreateMemStream"); + if (!fn_SHCreateMemStream) + { + fn_SHCreateMemStream = (SHCreateMemStream_Proc) + get_proc_addr (shlwapi_lib, MAKEINTRESOURCEA (12)); + if (!fn_SHCreateMemStream) + return false; + } + + return true; +} + +# undef GdiplusStartup +# undef GdiplusShutdown +# undef GdipGetPropertyItemSize +# undef GdipGetPropertyItem +# undef GdipImageGetFrameDimensionsCount +# undef GdipImageGetFrameDimensionsList +# undef GdipImageGetFrameCount +# undef GdipImageSelectActiveFrame +# undef GdipCreateBitmapFromFile +# undef GdipCreateBitmapFromStream +# undef SHCreateMemStream +# undef GdipCreateHBITMAPFromBitmap +# undef GdipDisposeImage +# undef GdipGetImageHeight +# undef GdipGetImageWidth + +# define GdiplusStartup fn_GdiplusStartup +# define GdiplusShutdown fn_GdiplusShutdown +# define GdipGetPropertyItemSize fn_GdipGetPropertyItemSize +# define GdipGetPropertyItem fn_GdipGetPropertyItem +# define GdipImageGetFrameDimensionsCount fn_GdipImageGetFrameDimensionsCount +# define GdipImageGetFrameDimensionsList fn_GdipImageGetFrameDimensionsList +# define GdipImageGetFrameCount fn_GdipImageGetFrameCount +# define GdipImageSelectActiveFrame fn_GdipImageSelectActiveFrame +# define GdipCreateBitmapFromFile fn_GdipCreateBitmapFromFile +# define GdipCreateBitmapFromStream fn_GdipCreateBitmapFromStream +# define SHCreateMemStream fn_SHCreateMemStream +# define GdipCreateHBITMAPFromBitmap fn_GdipCreateHBITMAPFromBitmap +# define GdipDisposeImage fn_GdipDisposeImage +# define GdipGetImageHeight fn_GdipGetImageHeight +# define GdipGetImageWidth fn_GdipGetImageWidth + +#endif /* WINDOWSNT */ + +static int gdip_initialized; +static bool gdiplus_started; +static ULONG_PTR token; +static GdiplusStartupInput input; +static GdiplusStartupOutput output; + + +/* Initialize GDI+, return true if successful. */ +static bool +gdiplus_startup (void) +{ + GpStatus status; + + if (gdiplus_started) + return true; +#ifdef WINDOWSNT + if (!gdip_initialized) + gdip_initialized = gdiplus_init () ? 1 : -1; +#else + gdip_initialized = 1; +#endif + if (gdip_initialized > 0) + { + input.GdiplusVersion = 1; + input.DebugEventCallback = NULL; + input.SuppressBackgroundThread = FALSE; + input.SuppressExternalCodecs = FALSE; + + status = GdiplusStartup (&token, &input, &output); + if (status == Ok) + gdiplus_started = true; + return (status == Ok); + } + return false; +} + +/* This is called from term_ntproc. */ +void +w32_gdiplus_shutdown (void) +{ + if (gdiplus_started) + GdiplusShutdown (token); + gdiplus_started = false; +} + +bool +w32_can_use_native_image_api (Lisp_Object type) +{ + if (!w32_use_native_image_api) + return false; + if (!(EQ (type, Qjpeg) + || EQ (type, Qpng) + || EQ (type, Qgif) + || EQ (type, Qtiff) + || EQ (type, Qnative_image))) + { + /* GDI+ can also display BMP, Exif, ICON, WMF, and EMF images. + But we don't yet support these in image.c. */ + return false; + } + return gdiplus_startup (); +} + +enum PropertyItem_type { + PI_BYTE = 1, + PI_ASCIIZ = 2, + PI_USHORT = 3, + PI_ULONG = 4, + PI_ULONG_PAIR = 5, + PI_BYTE_ANY = 6, + PI_LONG = 7, + PI_LONG_PAIR = 10 +}; + +static double +decode_delay (PropertyItem *propertyItem, int frame) +{ + enum PropertyItem_type type = propertyItem[0].type; + unsigned long udelay; + double retval; + + switch (type) + { + case PI_BYTE: + case PI_BYTE_ANY: + udelay = ((unsigned char *)propertyItem[0].value)[frame]; + retval = udelay; + break; + case PI_USHORT: + udelay = ((unsigned short *)propertyItem[0].value)[frame]; + retval = udelay; + break; + case PI_ULONG: + case PI_LONG: /* delay should always be positive */ + udelay = ((unsigned long *)propertyItem[0].value)[frame]; + retval = udelay; + break; + default: + /* This negative value will cause the caller to disregard the + delay if we cannot determine it reliably. */ + add_to_log ("Invalid or unknown propertyItem type in w32image.c"); + retval = -1.0; + } + + return retval; +} + +static double +w32_frame_delay (GpBitmap *pBitmap, int frame) +{ + UINT size; + PropertyItem *propertyItem; + double delay = -1.0; + + /* Assume that the image has a property item of type PropertyItemEquipMake. + Get the size of that property item. This can fail for multi-frame TIFF + images. */ + GpStatus status = GdipGetPropertyItemSize (pBitmap, PropertyTagFrameDelay, + &size); + + if (status == Ok) + { + /* Allocate a buffer to receive the property item. */ + propertyItem = malloc (size); + if (propertyItem != NULL) + { + /* Get the property item. */ + GdipGetPropertyItem (pBitmap, PropertyTagFrameDelay, size, + propertyItem); + delay = decode_delay (propertyItem, frame); + if (delay <= 0) + { + /* In GIF files, unfortunately, delay is only specified + for the first frame. */ + delay = decode_delay (propertyItem, 0); + } + delay /= 100.0; + free (propertyItem); + } + } + return delay; +} + +static GpStatus +w32_select_active_frame (GpBitmap *pBitmap, int frame, int *nframes, + double *delay) +{ + UINT count, frameCount; + GUID pDimensionIDs[1]; + GpStatus status = Ok; + + status = GdipImageGetFrameDimensionsCount (pBitmap, &count); + frameCount = *nframes = 0; + *delay = -1.0; + if (count) + { + /* The following call will fill pDimensionIDs[0] with the + FrameDimensionTime GUID for GIF images, and + FrameDimensionPage GUID for other image types. Multi-page + GIF and TIFF images expect these values in the + GdipImageSelectActiveFrame call below. */ + status = GdipImageGetFrameDimensionsList (pBitmap, pDimensionIDs, 1); + status = GdipImageGetFrameCount (pBitmap, &pDimensionIDs[0], &frameCount); + if (status == Ok && frameCount > 1) + { + if (frame < 0 || frame >= frameCount) + status = GenericError; + else + { + status = GdipImageSelectActiveFrame (pBitmap, &pDimensionIDs[0], + frame); + *delay = w32_frame_delay (pBitmap, frame); + *nframes = frameCount; + } + } + } + return status; +} + +static ARGB +w32_image_bg_color (struct frame *f, struct image *img) +{ + Lisp_Object specified_bg = Fplist_get (XCDR (img->spec), QCbackground); + Emacs_Color color; + + /* If the user specified a color, try to use it; if not, use the + current frame background, ignoring any default background + color set by the image. */ + if (STRINGP (specified_bg) + ? w32_defined_color (f, SSDATA (specified_bg), &color, false, false) + : (w32_query_frame_background_color (f, &color), true)) + /* The user specified ':background', use that. */ + { + DWORD red = (((DWORD) color.red) & 0xff00) << 8; + DWORD green = ((DWORD) color.green) & 0xff00; + DWORD blue = ((DWORD) color.blue) >> 8; + return (ARGB) (red | green | blue); + } + return (ARGB) 0xff000000; +} + +int +w32_load_image (struct frame *f, struct image *img, + Lisp_Object spec_file, Lisp_Object spec_data) +{ + GpStatus status = GenericError; + GpBitmap *pBitmap; + Lisp_Object metadata; + + eassert (valid_image_p (img->spec)); + + /* This function only gets called if w32_gdiplus_startup was invoked + and succeeded. We have a valid token and GDI+ is active. */ + if (STRINGP (spec_file)) + { + const char *fn = map_w32_filename (SSDATA (spec_file), NULL); + wchar_t filename_w[MAX_PATH]; + filename_to_utf16 (fn, filename_w); + status = GdipCreateBitmapFromFile (filename_w, &pBitmap); + } + else if (STRINGP (spec_data)) + { + IStream *pStream = SHCreateMemStream ((BYTE *) SDATA (spec_data), + SBYTES (spec_data)); + if (pStream != NULL) + { + status = GdipCreateBitmapFromStream (pStream, &pBitmap); + IStream_Release (pStream); + } + } + + metadata = Qnil; + if (status == Ok) + { + /* In multiframe pictures, select the first frame. */ + Lisp_Object lisp_index = Fplist_get (XCDR (img->spec), QCindex); + int index = FIXNATP (lisp_index) ? XFIXNAT (lisp_index) : 0; + int nframes; + double delay; + status = w32_select_active_frame (pBitmap, index, &nframes, &delay); + if (status == Ok) + { + if (nframes > 1) + metadata = Fcons (Qcount, Fcons (make_fixnum (nframes), metadata)); + if (delay >= 0) + metadata = Fcons (Qdelay, Fcons (make_float (delay), metadata)); + } + } + + if (status == Ok) + { + ARGB bg_color = w32_image_bg_color (f, img); + Emacs_Pixmap pixmap; + + status = GdipCreateHBITMAPFromBitmap (pBitmap, &pixmap, bg_color); + if (status == Ok) + { + UINT width, height; + GdipGetImageWidth (pBitmap, &width); + GdipGetImageHeight (pBitmap, &height); + img->width = width; + img->height = height; + img->pixmap = pixmap; + img->lisp_data = metadata; + } + + GdipDisposeImage (pBitmap); + } + + if (status != Ok) + { + add_to_log ("Unable to load image %s", img->spec); + return 0; + } + return 1; +} diff --git a/src/w32proc.c b/src/w32proc.c index de337269050..16e32e4c58d 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -3231,7 +3231,7 @@ such programs cannot be invoked by Emacs anyway. */) char *progname, progname_a[MAX_PATH]; program = Fexpand_file_name (program, Qnil); - encoded_progname = ENCODE_FILE (program); + encoded_progname = Fcopy_sequence (ENCODE_FILE (program)); progname = SSDATA (encoded_progname); unixtodos_filename (progname); filename_to_ansi (progname, progname_a); diff --git a/src/w32term.c b/src/w32term.c index 76cf6bd6964..1766b32514f 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -888,10 +888,10 @@ static void w32_draw_image_foreground_1 (struct glyph_string *, HBITMAP); static void w32_clear_glyph_string_rect (struct glyph_string *, int, int, int, int); static void w32_draw_relief_rect (struct frame *, int, int, int, int, - int, int, int, int, int, int, + int, int, int, int, int, int, int, RECT *); static void w32_draw_box_rect (struct glyph_string *, int, int, int, int, - int, bool, bool, RECT *); + int, int, bool, bool, RECT *); /* Set S->gc to a suitable GC for drawing glyph string S in cursor @@ -1101,19 +1101,28 @@ w32_set_glyph_string_clipping_exactly (struct glyph_string *src, static void w32_compute_glyph_string_overhangs (struct glyph_string *s) { - if (s->cmp == NULL - && s->first_glyph->type == CHAR_GLYPH - && !s->font_not_found_p) + if (s->cmp == NULL) { - struct font *font = s->font; struct font_metrics metrics; + if (s->first_glyph->type == CHAR_GLYPH && !s->font_not_found_p) + { + struct font *font = s->font; + font->driver->text_extents (font, s->char2b, s->nchars, &metrics); + s->right_overhang = (metrics.rbearing > metrics.width + ? metrics.rbearing - metrics.width : 0); + s->left_overhang = metrics.lbearing < 0 ? -metrics.lbearing : 0; + } + else if (s->first_glyph->type == COMPOSITE_GLYPH) + { + Lisp_Object gstring = composition_gstring_from_id (s->cmp_id); - font->driver->text_extents (font, s->char2b, s->nchars, &metrics); - s->right_overhang = (metrics.rbearing > metrics.width - ? metrics.rbearing - metrics.width : 0); - s->left_overhang = metrics.lbearing < 0 ? -metrics.lbearing : 0; + composition_gstring_width (gstring, s->cmp_from, s->cmp_to, &metrics); + s->right_overhang = (metrics.rbearing > metrics.width + ? metrics.rbearing - metrics.width : 0); + s->left_overhang = metrics.lbearing < 0 ? -metrics.lbearing : 0; + } } - else if (s->cmp) + else { s->right_overhang = s->cmp->rbearing - s->cmp->pixel_width; s->left_overhang = -s->cmp->lbearing; @@ -1160,7 +1169,7 @@ w32_draw_glyph_string_background (struct glyph_string *s, bool force_p) shouldn't be drawn in the first place. */ if (!s->background_filled_p) { - int box_line_width = max (s->face->box_line_width, 0); + int box_line_width = max (s->face->box_horizontal_line_width, 0); #if 0 /* TODO: stipple */ if (s->stippled_p) @@ -1206,7 +1215,7 @@ w32_draw_glyph_string_foreground (struct glyph_string *s) of S to the right of that box line. */ if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) - x = s->x + eabs (s->face->box_line_width); + x = s->x + max (s->face->box_vertical_line_width, 0); else x = s->x; @@ -1264,7 +1273,7 @@ w32_draw_composite_glyph_string_foreground (struct glyph_string *s) of S to the right of that box line. */ if (s->face && s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) - x = s->x + eabs (s->face->box_line_width); + x = s->x + max (s->face->box_vertical_line_width, 0); else x = s->x; @@ -1361,7 +1370,7 @@ w32_draw_glyphless_glyph_string_foreground (struct glyph_string *s) of S to the right of that box line. */ if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) - x = s->x + eabs (s->face->box_line_width); + x = s->x + max (s->face->box_vertical_line_width, 0); else x = s->x; @@ -1529,7 +1538,7 @@ w32_query_colors (struct frame *f, Emacs_Color *colors, int ncolors) /* Store F's background color into *BGCOLOR. */ -static void +void w32_query_frame_background_color (struct frame *f, Emacs_Color *bgcolor) { bgcolor->pixel = FRAME_BACKGROUND_PIXEL (f); @@ -1617,7 +1626,7 @@ w32_setup_relief_colors (struct glyph_string *s) static void w32_draw_relief_rect (struct frame *f, int left_x, int top_y, int right_x, int bottom_y, - int width, int raised_p, + int hwidth, int vwidth, int raised_p, int top_p, int bot_p, int left_p, int right_p, RECT *clip_rect) { @@ -1634,14 +1643,14 @@ w32_draw_relief_rect (struct frame *f, /* Top. */ if (top_p) - for (i = 0; i < width; ++i) + for (i = 0; i < hwidth; ++i) w32_fill_area (f, hdc, gc.foreground, left_x + i * left_p, top_y + i, right_x - left_x - i * (left_p + right_p ) + 1, 1); /* Left. */ if (left_p) - for (i = 0; i < width; ++i) + for (i = 0; i < vwidth; ++i) w32_fill_area (f, hdc, gc.foreground, left_x + i, top_y + (i + 1) * top_p, 1, bottom_y - top_y - (i + 1) * (bot_p + top_p) + 1); @@ -1653,14 +1662,14 @@ w32_draw_relief_rect (struct frame *f, /* Bottom. */ if (bot_p) - for (i = 0; i < width; ++i) + for (i = 0; i < hwidth; ++i) w32_fill_area (f, hdc, gc.foreground, left_x + i * left_p, bottom_y - i, right_x - left_x - i * (left_p + right_p) + 1, 1); /* Right. */ if (right_p) - for (i = 0; i < width; ++i) + for (i = 0; i < vwidth; ++i) w32_fill_area (f, hdc, gc.foreground, right_x - i, top_y + (i + 1) * top_p, 1, bottom_y - top_y - (i + 1) * (bot_p + top_p) + 1); @@ -1680,31 +1689,31 @@ w32_draw_relief_rect (struct frame *f, static void w32_draw_box_rect (struct glyph_string *s, - int left_x, int top_y, int right_x, int bottom_y, int width, - bool left_p, bool right_p, RECT *clip_rect) + int left_x, int top_y, int right_x, int bottom_y, int hwidth, + int vwidth, bool left_p, bool right_p, RECT *clip_rect) { w32_set_clip_rectangle (s->hdc, clip_rect); /* Top. */ w32_fill_area (s->f, s->hdc, s->face->box_color, - left_x, top_y, right_x - left_x + 1, width); + left_x, top_y, right_x - left_x + 1, hwidth); /* Left. */ if (left_p) { w32_fill_area (s->f, s->hdc, s->face->box_color, - left_x, top_y, width, bottom_y - top_y + 1); + left_x, top_y, vwidth, bottom_y - top_y + 1); } /* Bottom. */ w32_fill_area (s->f, s->hdc, s->face->box_color, - left_x, bottom_y - width + 1, right_x - left_x + 1, width); + left_x, bottom_y - hwidth + 1, right_x - left_x + 1, hwidth); /* Right. */ if (right_p) { w32_fill_area (s->f, s->hdc, s->face->box_color, - right_x - width + 1, top_y, width, bottom_y - top_y + 1); + right_x - vwidth + 1, top_y, vwidth, bottom_y - top_y + 1); } w32_set_clip_rectangle (s->hdc, NULL); @@ -1716,7 +1725,7 @@ w32_draw_box_rect (struct glyph_string *s, static void w32_draw_glyph_string_box (struct glyph_string *s) { - int width, left_x, right_x, top_y, bottom_y, last_x; + int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x; bool left_p, right_p, raised_p; struct glyph *last_glyph; RECT clip_rect; @@ -1725,12 +1734,29 @@ w32_draw_glyph_string_box (struct glyph_string *s) ? WINDOW_RIGHT_EDGE_X (s->w) : window_box_right (s->w, s->area)); - /* The glyph that may have a right box line. */ - last_glyph = (s->cmp || s->img - ? s->first_glyph - : s->first_glyph + s->nchars - 1); + /* The glyph that may have a right box line. For static + compositions and images, the right-box flag is on the first glyph + of the glyph string; for other types it's on the last glyph. */ + if (s->cmp || s->img) + last_glyph = s->first_glyph; + else if (s->first_glyph->type == COMPOSITE_GLYPH + && s->first_glyph->u.cmp.automatic) + { + /* For automatic compositions, we need to look up the last glyph + in the composition. */ + struct glyph *end = s->row->glyphs[s->area] + s->row->used[s->area]; + struct glyph *g = s->first_glyph; + for (last_glyph = g++; + g < end && g->u.cmp.automatic && g->u.cmp.id == s->cmp_id + && g->slice.cmp.to < s->cmp_to; + last_glyph = g++) + ; + } + else + last_glyph = s->first_glyph + s->nchars - 1; - width = eabs (s->face->box_line_width); + vwidth = eabs (s->face->box_vertical_line_width); + hwidth = eabs (s->face->box_horizontal_line_width); raised_p = s->face->box == FACE_RAISED_BOX; left_x = s->x; right_x = ((s->row->full_width_p && s->extends_to_end_of_line_p @@ -1751,13 +1777,13 @@ w32_draw_glyph_string_box (struct glyph_string *s) get_glyph_string_clip_rect (s, &clip_rect); if (s->face->box == FACE_SIMPLE_BOX) - w32_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width, - left_p, right_p, &clip_rect); + w32_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, left_p, right_p, &clip_rect); else { w32_setup_relief_colors (s); - w32_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, - width, raised_p, 1, 1, left_p, right_p, &clip_rect); + w32_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, raised_p, 1, 1, left_p, right_p, &clip_rect); } } @@ -1795,7 +1821,7 @@ w32_draw_image_foreground (struct glyph_string *s) if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p && s->slice.x == 0) - x += eabs (s->face->box_line_width); + x += max (s->face->box_vertical_line_width, 0); /* If there is a margin around the image, adjust x- and y-position by that margin. */ @@ -1982,7 +2008,7 @@ w32_draw_image_relief (struct glyph_string *s) if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p && s->slice.x == 0) - x += eabs (s->face->box_line_width); + x += max (s->face->box_vertical_line_width, 0); /* If there is a margin around the image, adjust x- and y-position by that margin. */ @@ -2034,7 +2060,7 @@ w32_draw_image_relief (struct glyph_string *s) w32_setup_relief_colors (s); get_glyph_string_clip_rect (s, &r); - w32_draw_relief_rect (s->f, x, y, x1, y1, thick, raised_p, + w32_draw_relief_rect (s->f, x, y, x1, y1, thick, thick, raised_p, top_p, bot_p, left_p, right_p, &r); } @@ -2054,7 +2080,7 @@ w32_draw_image_foreground_1 (struct glyph_string *s, HBITMAP pixmap) if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p && s->slice.x == 0) - x += eabs (s->face->box_line_width); + x += max (s->face->box_vertical_line_width, 0); /* If there is a margin around the image, adjust x- and y-position by that margin. */ @@ -2167,8 +2193,8 @@ static void w32_draw_image_glyph_string (struct glyph_string *s) { int x, y; - int box_line_hwidth = eabs (s->face->box_line_width); - int box_line_vwidth = max (s->face->box_line_width, 0); + int box_line_hwidth = max (s->face->box_vertical_line_width, 0); + int box_line_vwidth = max (s->face->box_horizontal_line_width, 0); int height, width; HBITMAP pixmap = 0; @@ -7657,6 +7683,25 @@ Windows 8. It is set to nil on Windows 9X. */); else w32_unicode_filenames = 1; + DEFVAR_BOOL ("w32-use-native-image-API", + w32_use_native_image_api, + doc: /* Non-nil means use the native MS-Windows image API to display images. + +A value of nil means displaying images other than PBM and XBM requires +optional supporting libraries to be installed. +The native image API library used is GDI+ via GDIPLUS.DLL. This +library is available only since W2K, therefore this variable is +unconditionally set to nil on older systems. */); + + /* For now, disabled by default, since this is an experimental feature. */ +#if 0 && HAVE_NATIVE_IMAGE_API + if (os_subtype == OS_9X) + w32_use_native_image_api = 0; + else + w32_use_native_image_api = 1; +#else + w32_use_native_image_api = 0; +#endif /* FIXME: The following variable will be (hopefully) removed before Emacs 25.1 gets released. */ diff --git a/src/w32term.h b/src/w32term.h index f8a8a727e8a..8ba248013c7 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -75,7 +75,6 @@ struct w32_palette_entry { extern void w32_regenerate_palette (struct frame *f); extern void w32_fullscreen_rect (HWND hwnd, int fsmode, RECT normal, RECT *rect); - /* For each display (currently only one on w32), we have a structure that records information about it. */ @@ -248,6 +247,8 @@ extern int w32_display_pixel_height (struct w32_display_info *); extern int w32_display_pixel_width (struct w32_display_info *); extern void initialize_frame_menubar (struct frame *); extern void w32_dialog_in_progress (Lisp_Object in_progress); +extern void w32_query_frame_background_color (struct frame *f, + Emacs_Color *bgcolor); extern void w32_make_frame_visible (struct frame *f); extern void w32_make_frame_invisible (struct frame *f); @@ -670,7 +671,8 @@ do { \ #define WM_EMACS_BRINGTOTOP (WM_EMACS_START + 23) #define WM_EMACS_INPUT_READY (WM_EMACS_START + 24) #define WM_EMACS_FILENOTIFY (WM_EMACS_START + 25) -#define WM_EMACS_END (WM_EMACS_START + 26) +#define WM_EMACS_IME_STATUS (WM_EMACS_START + 26) +#define WM_EMACS_END (WM_EMACS_START + 27) #define WND_FONTWIDTH_INDEX (0) #define WND_LINEHEIGHT_INDEX (4) diff --git a/src/window.c b/src/window.c index ff17cd88f38..e2dea8b70ef 100644 --- a/src/window.c +++ b/src/window.c @@ -1895,10 +1895,7 @@ POS, ROWH is the visible height of that row, and VPOS is the row number if (EQ (pos, Qt)) posint = -1; else if (!NILP (pos)) - { - CHECK_FIXNUM_COERCE_MARKER (pos); - posint = XFIXNUM (pos); - } + posint = fix_position (pos); else if (w == XWINDOW (selected_window)) posint = PT; else @@ -2111,30 +2108,20 @@ though when run from an idle timer with a delay of zero seconds. */) || window_outdated (w)) return Qnil; - if (NILP (first)) - row = (NILP (body) - ? MATRIX_ROW (w->current_matrix, 0) - : MATRIX_FIRST_TEXT_ROW (w->current_matrix)); - else if (FIXNUMP (first)) - { - CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows); - row = MATRIX_ROW (w->current_matrix, XFIXNUM (first)); - } - else - error ("Invalid specification of first line"); - - if (NILP (last)) - - end_row = (NILP (body) - ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows) - : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)); - else if (FIXNUMP (last)) - { - CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows); - end_row = MATRIX_ROW (w->current_matrix, XFIXNUM (last)); - } - else - error ("Invalid specification of last line"); + row = (!NILP (first) + ? MATRIX_ROW (w->current_matrix, + check_integer_range (first, 0, + w->current_matrix->nrows)) + : NILP (body) + ? MATRIX_ROW (w->current_matrix, 0) + : MATRIX_FIRST_TEXT_ROW (w->current_matrix)); + end_row = (!NILP (last) + ? MATRIX_ROW (w->current_matrix, + check_integer_range (last, 0, + w->current_matrix->nrows)) + : NILP (body) + ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows) + : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)); while (row <= end_row && row->enabled_p && row->y + row->height < max_y) @@ -4328,11 +4315,11 @@ Note: This function does not operate on any child windows of WINDOW. */) EMACS_INT size_min = NILP (add) ? 0 : - XFIXNUM (w->new_pixel); EMACS_INT size_max = size_min + min (INT_MAX, MOST_POSITIVE_FIXNUM); - CHECK_RANGED_INTEGER (size, size_min, size_max); + int checked_size = check_integer_range (size, size_min, size_max); if (NILP (add)) wset_new_pixel (w, size); else - wset_new_pixel (w, make_fixnum (XFIXNUM (w->new_pixel) + XFIXNUM (size))); + wset_new_pixel (w, make_fixnum (XFIXNUM (w->new_pixel) + checked_size)); return w->new_pixel; } @@ -7509,8 +7496,7 @@ extract_dimension (Lisp_Object dimension) { if (NILP (dimension)) return -1; - CHECK_RANGED_INTEGER (dimension, 0, INT_MAX); - return XFIXNUM (dimension); + return check_integer_range (dimension, 0, INT_MAX); } static struct window * @@ -7976,19 +7962,17 @@ foreach_window_1 (struct window *w, bool (*fn) (struct window *, void *), /* Return true if window configurations CONFIGURATION1 and CONFIGURATION2 describe the same state of affairs. This is used by Fequal. - IGNORE_POSITIONS means ignore non-matching scroll positions - and the like. + Ignore non-matching scroll positions and the like. This ignores a couple of things like the dedication status of window, combination_limit and the like. This might have to be fixed. */ -bool +static bool compare_window_configurations (Lisp_Object configuration1, - Lisp_Object configuration2, - bool ignore_positions) + Lisp_Object configuration2) { - register struct save_window_data *d1, *d2; + struct save_window_data *d1, *d2; struct Lisp_Vector *sws1, *sws2; ptrdiff_t i; @@ -8006,9 +7990,6 @@ compare_window_configurations (Lisp_Object configuration1, || d1->frame_menu_bar_lines != d2->frame_menu_bar_lines || !EQ (d1->selected_frame, d2->selected_frame) || !EQ (d1->f_current_buffer, d2->f_current_buffer) - || (!ignore_positions - && (!EQ (d1->minibuf_scroll_window, d2->minibuf_scroll_window) - || !EQ (d1->minibuf_selected_window, d2->minibuf_selected_window))) || !EQ (d1->focus_frame, d2->focus_frame) /* Verify that the two configurations have the same number of windows. */ || sws1->header.size != sws2->header.size) @@ -8041,12 +8022,6 @@ compare_window_configurations (Lisp_Object configuration1, equality. */ || !EQ (sw1->parent, sw2->parent) || !EQ (sw1->prev, sw2->prev) - || (!ignore_positions - && (!EQ (sw1->hscroll, sw2->hscroll) - || !EQ (sw1->min_hscroll, sw2->min_hscroll) - || !EQ (sw1->start_at_line_beg, sw2->start_at_line_beg) - || NILP (Fequal (sw1->start, sw2->start)) - || NILP (Fequal (sw1->pointm, sw2->pointm)))) || !EQ (sw1->left_margin_cols, sw2->left_margin_cols) || !EQ (sw1->right_margin_cols, sw2->right_margin_cols) || !EQ (sw1->left_fringe_width, sw2->left_fringe_width) @@ -8071,7 +8046,7 @@ This function ignores details such as the values of point and scrolling positions. */) (Lisp_Object x, Lisp_Object y) { - if (compare_window_configurations (x, y, true)) + if (compare_window_configurations (x, y)) return Qt; return Qnil; } 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); extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter); extern struct window *decode_live_window (Lisp_Object); extern struct window *decode_any_window (Lisp_Object); -extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool); extern void mark_window_cursors_off (struct window *); extern bool window_wants_mode_line (struct window *); extern bool window_wants_header_line (struct window *); diff --git a/src/xdisp.c b/src/xdisp.c index b0fbc9936fb..3ff4365ea61 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -896,11 +896,6 @@ static struct props it_props[] = {0, 0, NULL} }; -/* Value is the position described by X. If X is a marker, value is - the marker_position of X. Otherwise, value is X. */ - -#define COERCE_MARKER(X) (MARKERP ((X)) ? Fmarker_position (X) : (X)) - /* Enumeration returned by some move_it_.* functions internally. */ enum move_it_result @@ -1101,6 +1096,7 @@ static Lisp_Object calc_line_height_property (struct it *, Lisp_Object, static void produce_special_glyphs (struct it *, enum display_element_type); static void show_mouse_face (Mouse_HLInfo *, enum draw_glyphs_face); static bool coords_in_mouse_face_p (struct window *, int, int); +static void reset_box_start_end_flags (struct it *); @@ -1516,6 +1512,29 @@ window_hscroll_limited (struct window *w, struct frame *f) return window_hscroll; } +/* Reset the box-face start and end flags in the iterator. This is + called after producing glyphs, such that we reset these flags only + after producing a glyph with the flag set. */ + +static void +reset_box_start_end_flags (struct it *it) +{ + /* Don't reset if we've drawn the glyph in the display margins -- + those don't count as "produced glyphs". */ + if (it->area == TEXT_AREA + /* Don't reset if we displayed a fringe bitmap. */ + && !(it->what == IT_IMAGE && it->image_id < 0)) + { + /* Don't reset if the face is not a box face: that might mean we + are iterating some overlay or display string, and the first + character to have the box face is yet to be seen, when we pop + the iterator stack. */ + if (it->face_box_p) + it->start_of_box_run_p = false; + it->end_of_box_run_p = false; + } +} + /* Return true if position CHARPOS is visible in window W. CHARPOS < 0 means return info about WINDOW_END position. If visible, set *X and *Y to pixel coordinates of top left corner. @@ -1963,16 +1982,14 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, /* Return the next character from STR. Return in *LEN the length of - the character. This is like STRING_CHAR_AND_LENGTH but never + the character. This is like string_char_and_length but never returns an invalid character. If we find one, we return a `?', but with the length of the invalid character. */ static int -string_char_and_length (const unsigned char *str, int *len) +check_char_and_length (const unsigned char *str, int *len) { - int c; - - c = STRING_CHAR_AND_LENGTH (str, *len); + int c = string_char_and_length (str, len); if (!CHAR_VALID_P (c)) /* We may not change the length here because other places in Emacs don't use this function, i.e. they silently accept invalid @@ -1995,11 +2012,10 @@ string_pos_nchars_ahead (struct text_pos pos, Lisp_Object string, ptrdiff_t ncha if (STRING_MULTIBYTE (string)) { const unsigned char *p = SDATA (string) + BYTEPOS (pos); - int len; while (nchars--) { - string_char_and_length (p, &len); + int len = BYTES_BY_CHAR_HEAD (*p); p += len; CHARPOS (pos) += 1; BYTEPOS (pos) += len; @@ -2040,12 +2056,10 @@ c_string_pos (ptrdiff_t charpos, const char *s, bool multibyte_p) if (multibyte_p) { - int len; - SET_TEXT_POS (pos, 0, 0); while (charpos--) { - string_char_and_length ((const unsigned char *) s, &len); + int len = BYTES_BY_CHAR_HEAD (*s); s += len; CHARPOS (pos) += 1; BYTEPOS (pos) += len; @@ -2069,12 +2083,11 @@ number_of_chars (const char *s, bool multibyte_p) if (multibyte_p) { ptrdiff_t rest = strlen (s); - int len; const unsigned char *p = (const unsigned char *) s; for (nchars = 0; rest > 0; ++nchars) { - string_char_and_length (p, &len); + int len = BYTES_BY_CHAR_HEAD (*p); rest -= len, p += len; } } @@ -2123,8 +2136,8 @@ estimate_mode_line_height (struct frame *f, enum face_id face_id) { if (face->font) height = normal_char_height (face->font, -1); - if (face->box_line_width > 0) - height += 2 * face->box_line_width; + if (face->box_horizontal_line_width > 0) + height += 2 * face->box_horizontal_line_width; } } @@ -3280,7 +3293,10 @@ init_iterator (struct it *it, struct window *w, with a left box line. */ face = FACE_FROM_ID_OR_NULL (it->f, remapped_base_face_id); if (face && face->box != FACE_NO_BOX) - it->start_of_box_run_p = true; + { + it->face_box_p = true; + it->start_of_box_run_p = true; + } } /* If a buffer position was specified, set the iterator there, @@ -3878,8 +3894,7 @@ compute_stop_pos (struct it *it) ptrdiff_t bpos = CHAR_TO_BYTE (pos); while (pos < endpos) { - int ch; - FETCH_CHAR_ADVANCE_NO_CHECK (ch, pos, bpos); + int ch = fetch_char_advance_no_check (&pos, &bpos); if (ch == ' ' || ch == '\t' || ch == '\n' || ch == '\f') { found = true; @@ -4396,8 +4411,11 @@ handle_face_prop (struct it *it) this is the start of a run of characters with box face, i.e. this character has a shadow on the left side. */ it->face_id = new_face_id; - it->start_of_box_run_p = (new_face->box != FACE_NO_BOX - && (old_face == NULL || !old_face->box)); + /* Don't reset the start_of_box_run_p flag, only set it if + needed. */ + if (!(it->start_of_box_run_p && old_face && old_face->box)) + it->start_of_box_run_p = (new_face->box != FACE_NO_BOX + && (old_face == NULL || !old_face->box)); it->face_box_p = new_face->box != FACE_NO_BOX; } @@ -4535,10 +4553,8 @@ face_before_or_after_it_pos (struct it *it, bool before_p) { struct text_pos pos1 = string_pos (charpos, it->string); const unsigned char *p = SDATA (it->string) + BYTEPOS (pos1); - int c, len; struct face *face = FACE_FROM_ID (it->f, face_id); - - c = string_char_and_length (p, &len); + int len, c = check_char_and_length (p, &len); face_id = FACE_FOR_CHAR (it->f, face, c, charpos, it->string); } } @@ -6538,7 +6554,16 @@ pop_it (struct it *it) it->object = p->u.stretch.object; break; case GET_FROM_BUFFER: - it->object = it->w->contents; + { + struct face *face = FACE_FROM_ID_OR_NULL (it->f, it->face_id); + + /* Restore the face_box_p flag, since it could have been + overwritten by the face of the object that we just finished + displaying. */ + if (face) + it->face_box_p = face->box != FACE_NO_BOX; + it->object = it->w->contents; + } break; case GET_FROM_STRING: { @@ -6624,7 +6649,7 @@ back_to_previous_line_start (struct it *it) { ptrdiff_t cp = IT_CHARPOS (*it), bp = IT_BYTEPOS (*it); - DEC_BOTH (cp, bp); + dec_both (&cp, &bp); IT_CHARPOS (*it) = find_newline_no_quit (cp, bp, -1, &IT_BYTEPOS (*it)); } @@ -7667,14 +7692,19 @@ get_next_display_element (struct it *it) /* If the box comes from face properties in a display string, check faces in that string. */ int string_face_id = face_after_it_pos (it); - it->end_of_box_run_p - = (FACE_FROM_ID (it->f, string_face_id)->box - == FACE_NO_BOX); + if (FACE_FROM_ID (it->f, string_face_id)->box == FACE_NO_BOX) + it->end_of_box_run_p = true; } /* Otherwise, the box comes from the underlying face. If this is the last string character displayed, check the next buffer location. */ - else if ((IT_STRING_CHARPOS (*it) >= SCHARS (it->string) - 1) + else if (((IT_STRING_CHARPOS (*it) >= SCHARS (it->string) - 1) + /* For a composition, see if the string ends + at the last character included in the + composition. */ + || (it->what == IT_COMPOSITION + && (IT_STRING_CHARPOS (*it) + it->cmp_it.nchars + >= SCHARS (it->string)))) /* n_overlay_strings is unreliable unless overlay_string_index is non-negative. */ && ((it->current.overlay_string_index >= 0 @@ -7738,9 +7768,9 @@ get_next_display_element (struct it *it) CHARPOS (pos), 0, &ignore, face_id, false, 0); - it->end_of_box_run_p - = (FACE_FROM_ID (it->f, next_face_id)->box - == FACE_NO_BOX); + if (FACE_FROM_ID (it->f, next_face_id)->box + == FACE_NO_BOX) + it->end_of_box_run_p = true; } } else if (CHARPOS (pos) >= ZV) @@ -7753,9 +7783,9 @@ get_next_display_element (struct it *it) CHARPOS (pos) + TEXT_PROP_DISTANCE_LIMIT, false, -1, 0); - it->end_of_box_run_p - = (FACE_FROM_ID (it->f, next_face_id)->box - == FACE_NO_BOX); + if (FACE_FROM_ID (it->f, next_face_id)->box + == FACE_NO_BOX) + it->end_of_box_run_p = true; } } } @@ -7765,9 +7795,9 @@ get_next_display_element (struct it *it) else if (it->method != GET_FROM_DISPLAY_VECTOR) { int face_id = face_after_it_pos (it); - it->end_of_box_run_p - = (face_id != it->face_id - && FACE_FROM_ID (it->f, face_id)->box == FACE_NO_BOX); + if (face_id != it->face_id + && FACE_FROM_ID (it->f, face_id)->box == FACE_NO_BOX) + it->end_of_box_run_p = true; } } /* If we reached the end of the object we've been iterating (e.g., a @@ -7804,10 +7834,6 @@ get_next_display_element (struct it *it) void set_iterator_to_next (struct it *it, bool reseat_p) { - /* Reset flags indicating start and end of a sequence of characters - with box. Reset them at the start of this function because - moving the iterator to a new position might set them. */ - it->start_of_box_run_p = it->end_of_box_run_p = false; switch (it->method) { @@ -8219,9 +8245,9 @@ next_element_from_display_vector (struct it *it) } } next_face = FACE_FROM_ID_OR_NULL (it->f, next_face_id); - it->end_of_box_run_p = (this_face && this_face->box != FACE_NO_BOX - && (!next_face - || next_face->box == FACE_NO_BOX)); + if (this_face && this_face->box != FACE_NO_BOX + && (!next_face || next_face->box == FACE_NO_BOX)) + it->end_of_box_run_p = true; it->face_box_p = this_face && this_face->box != FACE_NO_BOX; } else @@ -8443,7 +8469,7 @@ next_element_from_string (struct it *it) { const unsigned char *s = (SDATA (it->string) + IT_STRING_BYTEPOS (*it)); - it->c = string_char_and_length (s, &it->len); + it->c = check_char_and_length (s, &it->len); } else { @@ -8481,7 +8507,7 @@ next_element_from_string (struct it *it) { const unsigned char *s = (SDATA (it->string) + IT_STRING_BYTEPOS (*it)); - it->c = string_char_and_length (s, &it->len); + it->c = check_char_and_length (s, &it->len); } else { @@ -8539,7 +8565,7 @@ next_element_from_c_string (struct it *it) BYTEPOS (it->position) = CHARPOS (it->position) = -1; } else if (it->multibyte_p) - it->c = string_char_and_length (it->s + IT_BYTEPOS (*it), &it->len); + it->c = check_char_and_length (it->s + IT_BYTEPOS (*it), &it->len); else it->c = it->s[IT_BYTEPOS (*it)], it->len = 1; @@ -8654,7 +8680,7 @@ compute_stop_pos_backwards (struct it *it) position before that. This is called when we bump into a stop position while reordering bidirectional text. CHARPOS should be the last previously processed stop_pos (or BEGV/0, if none were - processed yet) whose position is less that IT's current + processed yet) whose position is less than IT's current position. */ static void @@ -8836,7 +8862,7 @@ next_element_from_buffer (struct it *it) /* Get the next character, maybe multibyte. */ p = BYTE_POS_ADDR (IT_BYTEPOS (*it)); if (it->multibyte_p && !ASCII_CHAR_P (*p)) - it->c = STRING_CHAR_AND_LENGTH (p, it->len); + it->c = string_char_and_length (p, &it->len); else it->c = *p, it->len = 1; @@ -9714,9 +9740,13 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos int line_height, line_start_x = 0, reached = 0; int max_current_x = 0; void *backup_data = NULL; + ptrdiff_t orig_charpos = -1; + enum it_method orig_method = NUM_IT_METHODS; for (;;) { + orig_charpos = IT_CHARPOS (*it); + orig_method = it->method; if (op & MOVE_TO_VPOS) { /* If no TO_CHARPOS and no TO_X specified, stop at the @@ -9950,7 +9980,21 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos } } else - it->continuation_lines_width += it->current_x; + { + /* Make sure we do advance, otherwise we might infloop. + This could happen when the first display element is + wider than the window, or if we have a wrap-prefix + that doesn't leave enough space after it to display + even a single character. We only do this for moving + through buffer text, as with display/overlay strings + we'd need to also compare it->object's, and this is + unlikely to happen in that case anyway. */ + if (IT_CHARPOS (*it) == orig_charpos + && it->method == orig_method + && orig_method == GET_FROM_BUFFER) + set_iterator_to_next (it, false); + it->continuation_lines_width += it->current_x; + } break; default: @@ -10111,7 +10155,7 @@ move_it_vertically_backward (struct it *it, int dy) { ptrdiff_t cp = IT_CHARPOS (*it), bp = IT_BYTEPOS (*it); - DEC_BOTH (cp, bp); + dec_both (&cp, &bp); cp = find_newline_no_quit (cp, bp, -1, NULL); move_it_to (it, cp, -1, -1, -1, MOVE_TO_POS); } @@ -10481,8 +10525,7 @@ include the height of both, if present, in the return value. */) } else { - CHECK_FIXNUM_COERCE_MARKER (from); - start = min (max (XFIXNUM (from), BEGV), ZV); + start = clip_to_bounds (BEGV, fix_position (from), ZV); bpos = CHAR_TO_BYTE (start); } @@ -10509,10 +10552,7 @@ include the height of both, if present, in the return value. */) } } else - { - CHECK_FIXNUM_COERCE_MARKER (to); - end = max (start, min (XFIXNUM (to), ZV)); - } + end = clip_to_bounds (start, fix_position (to), ZV); if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX)) max_x = XFIXNUM (x_limit); @@ -10734,32 +10774,26 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) if (multibyte && NILP (BVAR (current_buffer, enable_multibyte_characters))) { - ptrdiff_t i; - int c, char_bytes; - char work[1]; - /* Convert a multibyte string to single-byte for the *Message* buffer. */ - for (i = 0; i < nbytes; i += char_bytes) + for (ptrdiff_t i = 0; i < nbytes; ) { - c = string_char_and_length (msg + i, &char_bytes); - work[0] = CHAR_TO_BYTE8 (c); - insert_1_both (work, 1, 1, true, false, false); + int char_bytes, c = check_char_and_length (msg + i, &char_bytes); + char work = CHAR_TO_BYTE8 (c); + insert_1_both (&work, 1, 1, true, false, false); + i += char_bytes; } } else if (! multibyte && ! NILP (BVAR (current_buffer, enable_multibyte_characters))) { - ptrdiff_t i; - int c, char_bytes; - unsigned char str[MAX_MULTIBYTE_LENGTH]; /* Convert a single-byte string to multibyte for the *Message* buffer. */ - for (i = 0; i < nbytes; i++) + for (ptrdiff_t i = 0; i < nbytes; i++) { - c = msg[i]; - MAKE_CHAR_MULTIBYTE (c); - char_bytes = CHAR_STRING (c, str); + int c = make_char_multibyte (msg[i]); + unsigned char str[MAX_MULTIBYTE_LENGTH]; + int char_bytes = CHAR_STRING (c, str); insert_1_both ((char *) str, 1, char_bytes, true, false, false); } } @@ -12511,7 +12545,6 @@ prepare_menu_bars (void) continue; if (!FRAME_TOOLTIP_P (f) - && !FRAME_PARENT_FRAME (f) && (FRAME_ICONIFIED_P (f) || FRAME_VISIBLE_P (f) == 1 /* Exclude TTY frames that are obscured because they @@ -12557,10 +12590,9 @@ prepare_menu_bars (void) && !XBUFFER (w->contents)->text->redisplay) continue; - if (FRAME_PARENT_FRAME (f)) - continue; + if (!FRAME_PARENT_FRAME (f)) + menu_bar_hooks_run = update_menu_bar (f, false, menu_bar_hooks_run); - menu_bar_hooks_run = update_menu_bar (f, false, menu_bar_hooks_run); update_tab_bar (f, false); #ifdef HAVE_WINDOW_SYSTEM update_tool_bar (f, false); @@ -12572,7 +12604,10 @@ prepare_menu_bars (void) else { struct frame *sf = SELECTED_FRAME (); - update_menu_bar (sf, true, false); + + if (!FRAME_PARENT_FRAME (sf)) + update_menu_bar (sf, true, false); + update_tab_bar (sf, true); #ifdef HAVE_WINDOW_SYSTEM update_tool_bar (sf, true); @@ -13462,11 +13497,6 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, XSETFRAME (frame, f); event.kind = TAB_BAR_EVENT; event.frame_or_window = frame; - event.arg = frame; - kbd_buffer_store_event (&event); - - event.kind = TAB_BAR_EVENT; - event.frame_or_window = frame; event.arg = key; event.modifiers = close_p ? ctrl_modifier | modifiers : modifiers; kbd_buffer_store_event (&event); @@ -13642,11 +13672,6 @@ tty_handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, XSETFRAME (frame, f); event->kind = TAB_BAR_EVENT; event->frame_or_window = frame; - event->arg = frame; - kbd_buffer_store_event (event); - - event->kind = TAB_BAR_EVENT; - event->frame_or_window = frame; event->arg = key; if (close_p) event->modifiers |= ctrl_modifier; @@ -14428,11 +14453,6 @@ handle_tool_bar_click (struct frame *f, int x, int y, bool down_p, XSETFRAME (frame, f); event.kind = TOOL_BAR_EVENT; event.frame_or_window = frame; - event.arg = frame; - kbd_buffer_store_event (&event); - - event.kind = TOOL_BAR_EVENT; - event.frame_or_window = frame; event.arg = key; event.modifiers = modifiers; kbd_buffer_store_event (&event); @@ -15032,7 +15052,7 @@ overlay_arrows_changed_p (bool set_redisplay) val = find_symbol_value (var); if (!MARKERP (val)) continue; - if (! EQ (COERCE_MARKER (val), + if (! EQ (Fmarker_position (val), /* FIXME: Don't we have a problem, using such a global * "last-position" if the variable is buffer-local? */ Fget (var, Qlast_arrow_position)) @@ -15075,8 +15095,7 @@ update_overlay_arrows (int up_to_date) Lisp_Object val = find_symbol_value (var); if (!MARKERP (val)) continue; - Fput (var, Qlast_arrow_position, - COERCE_MARKER (val)); + Fput (var, Qlast_arrow_position, Fmarker_position (val)); Fput (var, Qlast_arrow_string, overlay_arrow_string_or_property (var)); } @@ -21234,7 +21253,7 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string) /* Get the next character. */ if (multibyte_p) - it.c = it.char_to_display = string_char_and_length (p, &it.len); + it.c = it.char_to_display = check_char_and_length (p, &it.len); else { it.c = it.char_to_display = *p, it.len = 1; @@ -21604,6 +21623,8 @@ append_space_for_newline (struct it *it, bool default_face_p) const int indicator_column = fill_column_indicator_column (it, char_width); + int saved_end_of_box_run = it->end_of_box_run_p; + bool should_keep_end_of_box_run = false; if (it->current_x == indicator_column) { @@ -21626,14 +21647,18 @@ append_space_for_newline (struct it *it, bool default_face_p) have the end_of_box_run_p flag set for it, so there's no need for the appended newline glyph to have that flag set. */ - if (it->glyph_row->reversed_p - /* But if the appended newline glyph goes all the way to - the end of the row, there will be no stretch glyph, - so leave the box flag set. */ - && saved_x + FRAME_COLUMN_WIDTH (it->f) < it->last_visible_x) - it->end_of_box_run_p = false; + if (!(it->glyph_row->reversed_p + /* But if the appended newline glyph goes all the way to + the end of the row, there will be no stretch glyph, + so leave the box flag set. */ + && saved_x + FRAME_COLUMN_WIDTH (it->f) < it->last_visible_x)) + should_keep_end_of_box_run = true; } PRODUCE_GLYPHS (it); + /* Restore the end_of_box_run_p flag which was reset by + PRODUCE_GLYPHS. */ + if (should_keep_end_of_box_run) + it->end_of_box_run_p = saved_end_of_box_run; #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (it->f)) { @@ -22581,7 +22606,7 @@ find_row_edges (struct it *it, struct glyph_row *row, required when scanning back, because max_pos will already have a much larger value. */ if (CHARPOS (row->end.pos) > max_pos) - INC_BOTH (max_pos, max_bpos); + inc_both (&max_pos, &max_bpos); SET_TEXT_POS (row->maxpos, max_pos, max_bpos); } else if (CHARPOS (it->eol_pos) > 0) @@ -22599,7 +22624,7 @@ find_row_edges (struct it *it, struct glyph_row *row, SET_TEXT_POS (row->maxpos, max_pos, max_bpos); else { - INC_BOTH (max_pos, max_bpos); + inc_both (&max_pos, &max_bpos); SET_TEXT_POS (row->maxpos, max_pos, max_bpos); } } @@ -24009,7 +24034,7 @@ See also `bidi-paragraph-direction'. */) to make sure we are within that paragraph. To that end, find the previous non-empty line. */ if (pos >= ZV && pos > BEGV) - DEC_BOTH (pos, bytepos); + dec_both (&pos, &bytepos); AUTO_STRING (trailing_white_space, "[\f\t ]*\n"); if (fast_looking_at (trailing_white_space, pos, bytepos, ZV, ZV_BYTE, Qnil) > 0) @@ -27654,12 +27679,18 @@ fill_gstring_glyph_string (struct glyph_string *s, int face_id, s->face = FACE_FROM_ID (s->f, face_id); lgstring = composition_gstring_from_id (s->cmp_id); s->font = XFONT_OBJECT (LGSTRING_FONT (lgstring)); + /* The width of a composition glyph string is the sum of the + composition's glyph widths. */ + s->width = s->first_glyph->pixel_width; glyph++; while (glyph < last && glyph->u.cmp.automatic && glyph->u.cmp.id == s->cmp_id && s->cmp_to == glyph->slice.cmp.from) - s->cmp_to = (glyph++)->slice.cmp.to + 1; + { + s->width += glyph->pixel_width; + s->cmp_to = (glyph++)->slice.cmp.to + 1; + } for (i = s->cmp_from; i < s->cmp_to; i++) { @@ -27669,7 +27700,7 @@ fill_gstring_glyph_string (struct glyph_string *s, int face_id, /* Ensure that the code is only 2 bytes wide. */ s->char2b[i] = code & 0xFFFF; } - s->width = composition_gstring_width (lgstring, s->cmp_from, s->cmp_to, NULL); + return glyph - s->row->glyphs[s->area]; } @@ -28994,18 +29025,21 @@ produce_image_glyph (struct it *it) if (face->box != FACE_NO_BOX) { - if (face->box_line_width > 0) + if (face->box_horizontal_line_width > 0) { if (slice.y == 0) - it->ascent += face->box_line_width; + it->ascent += face->box_horizontal_line_width; if (slice.y + slice.height == img->height) - it->descent += face->box_line_width; + it->descent += face->box_horizontal_line_width; } - if (it->start_of_box_run_p && slice.x == 0) - it->pixel_width += eabs (face->box_line_width); - if (it->end_of_box_run_p && slice.x + slice.width == img->width) - it->pixel_width += eabs (face->box_line_width); + if (face->box_vertical_line_width > 0) + { + if (it->start_of_box_run_p && slice.x == 0) + it->pixel_width += face->box_vertical_line_width; + if (it->end_of_box_run_p && slice.x + slice.width == img->width) + it->pixel_width += face->box_vertical_line_width; + } } take_vertical_position_into_account (it); @@ -29103,15 +29137,18 @@ produce_xwidget_glyph (struct it *it) if (face->box != FACE_NO_BOX) { - if (face->box_line_width > 0) + if (face->box_horizontal_line_width > 0) { - it->ascent += face->box_line_width; - it->descent += face->box_line_width; + it->ascent += face->box_horizontal_line_width; + it->descent += face->box_horizontal_line_width; } - if (it->start_of_box_run_p) - it->pixel_width += eabs (face->box_line_width); - it->pixel_width += eabs (face->box_line_width); + if (face->box_vertical_line_width > 0) + { + if (it->start_of_box_run_p) + it->pixel_width += face->box_vertical_line_width; + it->pixel_width += face->box_vertical_line_width; + } } take_vertical_position_into_account (it); @@ -29334,7 +29371,7 @@ produce_stretch_glyph (struct it *it) /* Compute the width of the stretch. */ if ((prop = Fplist_get (plist, QCwidth), !NILP (prop)) - && calc_pixel_width_or_height (&tem, it, prop, font, true, 0)) + && calc_pixel_width_or_height (&tem, it, prop, font, true, NULL)) { /* Absolute width `:width WIDTH' specified and valid. */ zero_width_ok_p = true; @@ -29350,7 +29387,7 @@ produce_stretch_glyph (struct it *it) it2 = *it; if (it->multibyte_p) - it2.c = it2.char_to_display = STRING_CHAR_AND_LENGTH (p, it2.len); + it2.c = it2.char_to_display = string_char_and_length (p, &it2.len); else { it2.c = it2.char_to_display = *p, it2.len = 1; @@ -29390,7 +29427,7 @@ produce_stretch_glyph (struct it *it) int default_height = normal_char_height (font, ' '); if ((prop = Fplist_get (plist, QCheight), !NILP (prop)) - && calc_pixel_width_or_height (&tem, it, prop, font, false, 0)) + && calc_pixel_width_or_height (&tem, it, prop, font, false, NULL)) { height = (int)tem; zero_height_ok_p = true; @@ -29874,6 +29911,31 @@ produce_glyphless_glyph (struct it *it, bool for_no_font, Lisp_Object acronym) } +/* If face has a box, add the box thickness to the character + height. If character has a box line to the left and/or + right, add the box line width to the character's width. */ +#define IT_APPLY_FACE_BOX(it, face) \ + do { \ + if (face->box != FACE_NO_BOX) \ + { \ + int thick = face->box_horizontal_line_width; \ + if (thick > 0) \ + { \ + it->ascent += thick; \ + it->descent += thick; \ + } \ + \ + thick = face->box_vertical_line_width; \ + if (thick > 0) \ + { \ + if (it->start_of_box_run_p) \ + it->pixel_width += thick; \ + if (it->end_of_box_run_p) \ + it->pixel_width += thick; \ + } \ + } \ + } while (false) + /* RIF: Produce glyphs/get display metrics for the display element IT is loaded with. See the description of struct it in dispextern.h @@ -29989,26 +30051,7 @@ gui_produce_glyphs (struct it *it) if (stretched_p) it->pixel_width *= XFLOATINT (it->space_width); - /* If face has a box, add the box thickness to the character - height. If character has a box line to the left and/or - right, add the box line width to the character's width. */ - if (face->box != FACE_NO_BOX) - { - int thick = face->box_line_width; - - if (thick > 0) - { - it->ascent += thick; - it->descent += thick; - } - else - thick = -thick; - - if (it->start_of_box_run_p) - it->pixel_width += thick; - if (it->end_of_box_run_p) - it->pixel_width += thick; - } + IT_APPLY_FACE_BOX(it, face); /* If face has an overline, add the height of the overline (1 pixel) and a 1 pixel margin to the character height. */ @@ -30123,10 +30166,10 @@ gui_produce_glyphs (struct it *it) if ((it->max_ascent > 0 || it->max_descent > 0) && face->box != FACE_NO_BOX - && face->box_line_width > 0) + && face->box_horizontal_line_width > 0) { - it->ascent += face->box_line_width; - it->descent += face->box_line_width; + it->ascent += face->box_horizontal_line_width; + it->descent += face->box_horizontal_line_width; } if (!NILP (height) && XFIXNUM (height) > it->ascent + it->descent) @@ -30533,23 +30576,7 @@ gui_produce_glyphs (struct it *it) it->pixel_width = cmp->pixel_width; it->ascent = it->phys_ascent = cmp->ascent; it->descent = it->phys_descent = cmp->descent; - if (face->box != FACE_NO_BOX) - { - int thick = face->box_line_width; - - if (thick > 0) - { - it->ascent += thick; - it->descent += thick; - } - else - thick = - thick; - - if (it->start_of_box_run_p) - it->pixel_width += thick; - if (it->end_of_box_run_p) - it->pixel_width += thick; - } + IT_APPLY_FACE_BOX(it, face); /* If face has an overline, add the height of the overline (1 pixel) and a 1 pixel margin to the character height. */ @@ -30583,23 +30610,8 @@ gui_produce_glyphs (struct it *it) it->glyph_row->contains_overlapping_glyphs_p = true; it->ascent = it->phys_ascent = metrics.ascent; it->descent = it->phys_descent = metrics.descent; - if (face->box != FACE_NO_BOX) - { - int thick = face->box_line_width; - - if (thick > 0) - { - it->ascent += thick; - it->descent += thick; - } - else - thick = - thick; + IT_APPLY_FACE_BOX(it, face); - if (it->start_of_box_run_p) - it->pixel_width += thick; - if (it->end_of_box_run_p) - it->pixel_width += thick; - } /* If face has an overline, add the height of the overline (1 pixel) and a 1 pixel margin to the character height. */ if (face->overline_p) @@ -30845,14 +30857,6 @@ get_specified_cursor_type (Lisp_Object arg, int *width) return BAR_CURSOR; } - if (CONSP (arg) - && EQ (XCAR (arg), Qbar) - && RANGED_FIXNUMP (0, XCDR (arg), INT_MAX)) - { - *width = XFIXNUM (XCDR (arg)); - return BAR_CURSOR; - } - if (EQ (arg, Qhbar)) { *width = 2; @@ -30860,11 +30864,16 @@ get_specified_cursor_type (Lisp_Object arg, int *width) } if (CONSP (arg) - && EQ (XCAR (arg), Qhbar) && RANGED_FIXNUMP (0, XCDR (arg), INT_MAX)) { *width = XFIXNUM (XCDR (arg)); - return HBAR_CURSOR; + + if (EQ (XCAR (arg), Qbox)) + return FILLED_BOX_CURSOR; + else if (EQ (XCAR (arg), Qbar)) + return BAR_CURSOR; + else if (EQ (XCAR (arg), Qhbar)) + return HBAR_CURSOR; } /* Treat anything unknown as "hollow box cursor". @@ -30991,23 +31000,28 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, if (!w->cursor_off_p) { if (glyph != NULL && glyph->type == XWIDGET_GLYPH) - return NO_CURSOR; + return NO_CURSOR; if (glyph != NULL && glyph->type == IMAGE_GLYPH) { if (cursor_type == FILLED_BOX_CURSOR) { - /* Using a block cursor on large images can be very annoying. - So use a hollow cursor for "large" images. - If image is not transparent (no mask), also use hollow cursor. */ + /* Using a block cursor on large images can be very + annoying. So use a hollow cursor for "large" images. + If image is not transparent (no mask), also use + hollow cursor. */ struct image *img = IMAGE_OPT_FROM_ID (f, glyph->u.img_id); if (img != NULL && IMAGEP (img->spec)) { - /* Arbitrarily, interpret "Large" as >32x32 and >NxN - where N = size of default frame font size. - This should cover most of the "tiny" icons people may use. */ + /* Interpret "large" as >SIZExSIZE and >NxN where + SIZE is the value from cursor-type of the form + (box . SIZE), where N = size of default frame + font size. So, setting cursor-type to (box . 32) + should cover most of the "tiny" icons people may + use. */ if (!img->mask - || img->width > max (32, WINDOW_FRAME_COLUMN_WIDTH (w)) - || img->height > max (32, WINDOW_FRAME_LINE_HEIGHT (w))) + || (CONSP (BVAR (b, cursor_type)) + && img->width > max (*width, WINDOW_FRAME_COLUMN_WIDTH (w)) + && img->height > max (*width, WINDOW_FRAME_LINE_HEIGHT (w)))) cursor_type = HOLLOW_BOX_CURSOR; } } diff --git a/src/xfaces.c b/src/xfaces.c index 711ec48bbdd..bab142ade0f 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -3128,6 +3128,8 @@ FRAME 0 means change the face on all frames, and change the default valid_p = XFIXNUM (value) != 0; else if (STRINGP (value)) valid_p = SCHARS (value) > 0; + else if (CONSP (value) && FIXNUMP (XCAR (value)) && FIXNUMP (XCDR (value))) + valid_p = true; else if (CONSP (value)) { Lisp_Object tem; @@ -3146,7 +3148,9 @@ FRAME 0 means change the face on all frames, and change the default if (EQ (k, QCline_width)) { - if (!FIXNUMP (v) || XFIXNUM (v) == 0) + if ((!CONSP(v) || !FIXNUMP (XCAR (v)) || XFIXNUM (XCAR (v)) == 0 + || !FIXNUMP (XCDR (v)) || XFIXNUM (XCDR (v)) == 0) + && (!FIXNUMP (v) || XFIXNUM (v) == 0)) break; } else if (EQ (k, QCcolor)) @@ -5815,7 +5819,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] face->box_color = load_color (f, face, attrs[LFACE_BOX_INDEX], LFACE_BOX_INDEX); face->box = FACE_SIMPLE_BOX; - face->box_line_width = 1; + face->box_vertical_line_width = face->box_horizontal_line_width = 1; } else if (FIXNUMP (box)) { @@ -5823,9 +5827,19 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] face. */ eassert (XFIXNUM (box) != 0); face->box = FACE_SIMPLE_BOX; - face->box_line_width = XFIXNUM (box); + face->box_vertical_line_width = eabs(XFIXNUM (box)); + face->box_horizontal_line_width = XFIXNUM (box); + face->box_color = face->foreground; + face->box_color_defaulted_p = true; + } + else if (CONSP (box) && FIXNUMP (XCAR (box)) && FIXNUMP (XCDR (box))) + { + /* `(VWIDTH . HWIDTH)'. */ + face->box = FACE_SIMPLE_BOX; face->box_color = face->foreground; face->box_color_defaulted_p = true; + face->box_vertical_line_width = XFIXNUM (XCAR (box)); + face->box_horizontal_line_width = XFIXNUM (XCDR (box)); } else if (CONSP (box)) { @@ -5834,7 +5848,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] face->box = FACE_SIMPLE_BOX; face->box_color = face->foreground; face->box_color_defaulted_p = true; - face->box_line_width = 1; + face->box_vertical_line_width = face->box_horizontal_line_width = 1; while (CONSP (box)) { @@ -5850,8 +5864,14 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] if (EQ (keyword, QCline_width)) { - if (FIXNUMP (value) && XFIXNUM (value) != 0) - face->box_line_width = XFIXNUM (value); + if (CONSP (value) && FIXNUMP (XCAR (value)) && FIXNUMP (XCDR (value))) { + face->box_vertical_line_width = XFIXNUM (XCAR (value)); + face->box_horizontal_line_width = XFIXNUM (XCDR (value)); + } + else if (FIXNUMP (value) && XFIXNUM (value) != 0) { + face->box_vertical_line_width = eabs (XFIXNUM (value)); + face->box_horizontal_line_width = XFIXNUM (value); + } } else if (EQ (keyword, QCcolor)) { diff --git a/src/xfns.c b/src/xfns.c index a5431aa8909..1f381e2a8b0 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1236,13 +1236,10 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) for (i = 0; i < mouse_cursor_max; i++) { Lisp_Object shape_var = *mouse_cursor_types[i].shape_var_ptr; - if (!NILP (shape_var)) - { - CHECK_TYPE_RANGED_INTEGER (unsigned, shape_var); - cursor_data.cursor_num[i] = XFIXNUM (shape_var); - } - else - cursor_data.cursor_num[i] = mouse_cursor_types[i].default_shape; + cursor_data.cursor_num[i] + = (!NILP (shape_var) + ? check_uinteger_max (shape_var, UINT_MAX) + : mouse_cursor_types[i].default_shape); } block_input (); @@ -1807,10 +1804,7 @@ x_change_tool_bar_height (struct frame *f, int height) static void x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - int border; - - CHECK_TYPE_RANGED_INTEGER (int, arg); - border = max (XFIXNUM (arg), 0); + int border = check_int_nonnegative (arg); if (border != FRAME_INTERNAL_BORDER_WIDTH (f)) { @@ -3382,10 +3376,12 @@ x_icon (struct frame *f, Lisp_Object parms) = gui_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER); Lisp_Object icon_y = gui_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); + int icon_xval, icon_yval; + if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) { - CHECK_TYPE_RANGED_INTEGER (int, icon_x); - CHECK_TYPE_RANGED_INTEGER (int, icon_y); + icon_xval = check_integer_range (icon_x, INT_MIN, INT_MAX); + icon_yval = check_integer_range (icon_y, INT_MIN, INT_MAX); } else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); @@ -3393,7 +3389,7 @@ x_icon (struct frame *f, Lisp_Object parms) block_input (); if (! EQ (icon_x, Qunbound)) - x_wm_set_icon_position (f, XFIXNUM (icon_x), XFIXNUM (icon_y)); + x_wm_set_icon_position (f, icon_xval, icon_yval); #if false /* gui_display_get_arg removes the visibility parameter as a side effect, but x_create_frame still needs it. */ @@ -3884,8 +3880,6 @@ This function is an internal primitive--use `make-frame' instead. */) #ifdef HAVE_HARFBUZZ register_font_driver (&xfthbfont_driver, f); #endif -#else /* not HAVE_XFT */ - register_font_driver (&ftxfont_driver, f); #endif /* not HAVE_XFT */ #endif /* HAVE_FREETYPE */ #endif /* not USE_CAIRO */ @@ -5563,12 +5557,12 @@ The coordinates X and Y are interpreted in pixels relative to a position if (FRAME_INITIAL_P (f) || !FRAME_X_P (f)) return Qnil; - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); block_input (); XWarpPointer (FRAME_X_DISPLAY (f), None, DefaultRootWindow (FRAME_X_DISPLAY (f)), - 0, 0, 0, 0, XFIXNUM (x), XFIXNUM (y)); + 0, 0, 0, 0, xval, yval); unblock_input (); return Qnil; @@ -6375,8 +6369,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) #ifdef HAVE_HARFBUZZ register_font_driver (&xfthbfont_driver, f); #endif -#else /* not HAVE_XFT */ - register_font_driver (&ftxfont_driver, f); #endif /* not HAVE_XFT */ #endif /* HAVE_FREETYPE */ #endif /* not USE_CAIRO */ diff --git a/src/xfont.c b/src/xfont.c index f6131dcec5a..1563b43bf97 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -166,7 +166,7 @@ xfont_encode_coding_xlfd (char *xlfd) while (*p0) { - int c = STRING_CHAR_ADVANCE (p0); + int c = string_char_advance (&p0); if (c >= 0x100) return -1; diff --git a/src/xrdb.c b/src/xrdb.c index ad7155c106e..e3a1fcb15a9 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -353,7 +353,7 @@ get_environ_db (void) p = filename = xmalloc (strlen (home) + 1 + sizeof xdefaults + 1 + SBYTES (system_name)); char *e = splice_dir_file (p, home, xdefaults); - *e++ = '/'; + *e++ = '-'; lispstpcpy (e, system_name); } } diff --git a/src/xterm.c b/src/xterm.c index 44396955ed0..7989cecec7f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1750,7 +1750,7 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p) shouldn't be drawn in the first place. */ if (!s->background_filled_p) { - int box_line_width = max (s->face->box_line_width, 0); + int box_line_width = max (s->face->box_horizontal_line_width, 0); if (s->stippled_p) { @@ -1795,7 +1795,7 @@ x_draw_glyph_string_foreground (struct glyph_string *s) of S to the right of that box line. */ if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) - x = s->x + eabs (s->face->box_line_width); + x = s->x + max (s->face->box_vertical_line_width, 0); else x = s->x; @@ -1845,7 +1845,7 @@ x_draw_glyph_string_foreground (struct glyph_string *s) if (!(s->for_overlaps || (s->background_filled_p && s->hl != DRAW_CURSOR))) { - int box_line_width = max (s->face->box_line_width, 0); + int box_line_width = max (s->face->box_horizontal_line_width, 0); if (s->stippled_p) { @@ -1889,7 +1889,7 @@ x_draw_composite_glyph_string_foreground (struct glyph_string *s) of S to the right of that box line. */ if (s->face && s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) - x = s->x + eabs (s->face->box_line_width); + x = s->x + max (s->face->box_vertical_line_width, 0); else x = s->x; @@ -2000,7 +2000,7 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) of S to the right of that box line. */ if (s->face && s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) - x = s->x + eabs (s->face->box_line_width); + x = s->x + max (s->face->box_vertical_line_width, 0); else x = s->x; @@ -2765,7 +2765,7 @@ x_setup_relief_colors (struct glyph_string *s) static void x_draw_relief_rect (struct frame *f, int left_x, int top_y, int right_x, int bottom_y, - int width, bool raised_p, bool top_p, bool bot_p, + int hwidth, int vwidth, bool raised_p, bool top_p, bool bot_p, bool left_p, bool right_p, XRectangle *clip_rect) { @@ -2790,7 +2790,7 @@ x_draw_relief_rect (struct frame *f, if (left_p) { x_fill_rectangle (f, top_left_gc, left_x, top_y, - width, bottom_y + 1 - top_y); + vwidth, bottom_y + 1 - top_y); if (top_p) corners |= 1 << CORNER_TOP_LEFT; if (bot_p) @@ -2798,8 +2798,8 @@ x_draw_relief_rect (struct frame *f, } if (right_p) { - x_fill_rectangle (f, bottom_right_gc, right_x + 1 - width, top_y, - width, bottom_y + 1 - top_y); + x_fill_rectangle (f, bottom_right_gc, right_x + 1 - vwidth, top_y, + vwidth, bottom_y + 1 - top_y); if (top_p) corners |= 1 << CORNER_TOP_RIGHT; if (bot_p) @@ -2809,25 +2809,25 @@ x_draw_relief_rect (struct frame *f, { if (!right_p) x_fill_rectangle (f, top_left_gc, left_x, top_y, - right_x + 1 - left_x, width); + right_x + 1 - left_x, hwidth); else x_fill_trapezoid_for_relief (f, top_left_gc, left_x, top_y, - right_x + 1 - left_x, width, 1); + right_x + 1 - left_x, hwidth, 1); } if (bot_p) { if (!left_p) - x_fill_rectangle (f, bottom_right_gc, left_x, bottom_y + 1 - width, - right_x + 1 - left_x, width); + x_fill_rectangle (f, bottom_right_gc, left_x, bottom_y + 1 - hwidth, + right_x + 1 - left_x, hwidth); else x_fill_trapezoid_for_relief (f, bottom_right_gc, - left_x, bottom_y + 1 - width, - right_x + 1 - left_x, width, 0); + left_x, bottom_y + 1 - hwidth, + right_x + 1 - left_x, hwidth, 0); } - if (left_p && width != 1) + if (left_p && vwidth > 1) x_fill_rectangle (f, bottom_right_gc, left_x, top_y, 1, bottom_y + 1 - top_y); - if (top_p && width != 1) + if (top_p && hwidth > 1) x_fill_rectangle (f, bottom_right_gc, left_x, top_y, right_x + 1 - left_x, 1); if (corners) @@ -2861,12 +2861,12 @@ x_draw_relief_rect (struct frame *f, /* Top. */ if (top_p) { - if (width == 1) + if (hwidth == 1) XDrawLine (dpy, drawable, gc, left_x + left_p, top_y, right_x + !right_p, top_y); - for (i = 1; i < width; ++i) + for (i = 1; i < hwidth; ++i) XDrawLine (dpy, drawable, gc, left_x + i * left_p, top_y + i, right_x + 1 - i * right_p, top_y + i); @@ -2875,13 +2875,10 @@ x_draw_relief_rect (struct frame *f, /* Left. */ if (left_p) { - if (width == 1) + if (vwidth == 1) XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y); - x_clear_area(f, left_x, top_y, 1, 1); - x_clear_area(f, left_x, bottom_y, 1, 1); - - for (i = (width > 1 ? 1 : 0); i < width; ++i) + for (i = 1; i < vwidth; ++i) XDrawLine (dpy, drawable, gc, left_x + i, top_y + (i + 1) * top_p, left_x + i, bottom_y + 1 - (i + 1) * bot_p); @@ -2894,26 +2891,25 @@ x_draw_relief_rect (struct frame *f, gc = f->output_data.x->white_relief.gc; XSetClipRectangles (dpy, gc, 0, 0, clip_rect, 1, Unsorted); - if (width > 1) - { - /* Outermost top line. */ - if (top_p) - XDrawLine (dpy, drawable, gc, - left_x + left_p, top_y, - right_x + !right_p, top_y); + /* Outermost top line. */ + if (top_p && hwidth > 1) + XDrawLine (dpy, drawable, gc, + left_x + left_p, top_y, + right_x + !right_p, top_y); - /* Outermost left line. */ - if (left_p) - XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y); - } + /* Outermost left line. */ + if (left_p && vwidth > 1) + XDrawLine (dpy, drawable, gc, left_x, top_y + 1, left_x, bottom_y); /* Bottom. */ if (bot_p) { - XDrawLine (dpy, drawable, gc, - left_x + left_p, bottom_y, - right_x + !right_p, bottom_y); - for (i = 1; i < width; ++i) + if (hwidth >= 1) + XDrawLine (dpy, drawable, gc, + left_x + left_p, bottom_y, + right_x + !right_p, bottom_y); + + for (i = 1; i < hwidth; ++i) XDrawLine (dpy, drawable, gc, left_x + i * left_p, bottom_y - i, right_x + 1 - i * right_p, bottom_y - i); @@ -2922,9 +2918,7 @@ x_draw_relief_rect (struct frame *f, /* Right. */ if (right_p) { - x_clear_area(f, right_x, top_y, 1, 1); - x_clear_area(f, right_x, bottom_y, 1, 1); - for (i = 0; i < width; ++i) + for (i = 0; i < vwidth; ++i) XDrawLine (dpy, drawable, gc, right_x - i, top_y + (i + 1) * top_p, right_x - i, bottom_y + 1 - (i + 1) * bot_p); @@ -2945,8 +2939,8 @@ x_draw_relief_rect (struct frame *f, static void x_draw_box_rect (struct glyph_string *s, - int left_x, int top_y, int right_x, int bottom_y, int width, - bool left_p, bool right_p, XRectangle *clip_rect) + int left_x, int top_y, int right_x, int bottom_y, int hwidth, + int vwidth, bool left_p, bool right_p, XRectangle *clip_rect) { Display *display = FRAME_X_DISPLAY (s->f); XGCValues xgcv; @@ -2957,21 +2951,21 @@ x_draw_box_rect (struct glyph_string *s, /* Top. */ x_fill_rectangle (s->f, s->gc, - left_x, top_y, right_x - left_x + 1, width); + left_x, top_y, right_x - left_x + 1, hwidth); /* Left. */ if (left_p) x_fill_rectangle (s->f, s->gc, - left_x, top_y, width, bottom_y - top_y + 1); + left_x, top_y, vwidth, bottom_y - top_y + 1); /* Bottom. */ x_fill_rectangle (s->f, s->gc, - left_x, bottom_y - width + 1, right_x - left_x + 1, width); + left_x, bottom_y - hwidth + 1, right_x - left_x + 1, hwidth); /* Right. */ if (right_p) x_fill_rectangle (s->f, s->gc, - right_x - width + 1, top_y, width, bottom_y - top_y + 1); + right_x - vwidth + 1, top_y, vwidth, bottom_y - top_y + 1); XSetForeground (display, s->gc, xgcv.foreground); x_reset_clip_rectangles (s->f, s->gc); @@ -2983,7 +2977,7 @@ x_draw_box_rect (struct glyph_string *s, static void x_draw_glyph_string_box (struct glyph_string *s) { - int width, left_x, right_x, top_y, bottom_y, last_x; + int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x; bool raised_p, left_p, right_p; struct glyph *last_glyph; XRectangle clip_rect; @@ -2992,12 +2986,29 @@ x_draw_glyph_string_box (struct glyph_string *s) ? WINDOW_RIGHT_EDGE_X (s->w) : window_box_right (s->w, s->area)); - /* The glyph that may have a right box line. */ - last_glyph = (s->cmp || s->img - ? s->first_glyph - : s->first_glyph + s->nchars - 1); + /* The glyph that may have a right box line. For static + compositions and images, the right-box flag is on the first glyph + of the glyph string; for other types it's on the last glyph. */ + if (s->cmp || s->img) + last_glyph = s->first_glyph; + else if (s->first_glyph->type == COMPOSITE_GLYPH + && s->first_glyph->u.cmp.automatic) + { + /* For automatic compositions, we need to look up the last glyph + in the composition. */ + struct glyph *end = s->row->glyphs[s->area] + s->row->used[s->area]; + struct glyph *g = s->first_glyph; + for (last_glyph = g++; + g < end && g->u.cmp.automatic && g->u.cmp.id == s->cmp_id + && g->slice.cmp.to < s->cmp_to; + last_glyph = g++) + ; + } + else + last_glyph = s->first_glyph + s->nchars - 1; - width = eabs (s->face->box_line_width); + vwidth = eabs (s->face->box_vertical_line_width); + hwidth = eabs (s->face->box_horizontal_line_width); raised_p = s->face->box == FACE_RAISED_BOX; left_x = s->x; right_x = (s->row->full_width_p && s->extends_to_end_of_line_p @@ -3018,13 +3029,13 @@ x_draw_glyph_string_box (struct glyph_string *s) get_glyph_string_clip_rect (s, &clip_rect); if (s->face->box == FACE_SIMPLE_BOX) - x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, width, - left_p, right_p, &clip_rect); + x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, left_p, right_p, &clip_rect); else { x_setup_relief_colors (s); - x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, - width, raised_p, true, true, left_p, right_p, + x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, raised_p, true, true, left_p, right_p, &clip_rect); } } @@ -3082,7 +3093,7 @@ x_draw_image_foreground (struct glyph_string *s) if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p && s->slice.x == 0) - x += eabs (s->face->box_line_width); + x += max (s->face->box_vertical_line_width, 0); /* If there is a margin around the image, adjust x- and y-position by that margin. */ @@ -3201,7 +3212,7 @@ x_draw_image_relief (struct glyph_string *s) if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p && s->slice.x == 0) - x += eabs (s->face->box_line_width); + x += max (s->face->box_vertical_line_width, 0); /* If there is a margin around the image, adjust x- and y-position by that margin. */ @@ -3269,7 +3280,7 @@ x_draw_image_relief (struct glyph_string *s) x_setup_relief_colors (s); get_glyph_string_clip_rect (s, &r); - x_draw_relief_rect (s->f, x, y, x1, y1, thick, raised_p, + x_draw_relief_rect (s->f, x, y, x1, y1, thick, thick, raised_p, top_p, bot_p, left_p, right_p, &r); } @@ -3288,7 +3299,7 @@ x_draw_image_foreground_1 (struct glyph_string *s, Pixmap pixmap) if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p && s->slice.x == 0) - x += eabs (s->face->box_line_width); + x += max (s->face->box_vertical_line_width, 0); /* If there is a margin around the image, adjust x- and y-position by that margin. */ @@ -3390,8 +3401,8 @@ x_draw_glyph_string_bg_rect (struct glyph_string *s, int x, int y, int w, int h) static void x_draw_image_glyph_string (struct glyph_string *s) { - int box_line_hwidth = eabs (s->face->box_line_width); - int box_line_vwidth = max (s->face->box_line_width, 0); + int box_line_hwidth = max (s->face->box_vertical_line_width, 0); + int box_line_vwidth = max (s->face->box_horizontal_line_width, 0); int height; #ifndef USE_CAIRO Display *display = FRAME_X_DISPLAY (s->f); @@ -4786,6 +4797,16 @@ x_detect_focus_change (struct x_display_info *dpyinfo, struct frame *frame, case FocusIn: case FocusOut: + /* Ignore transient focus events from hotkeys, window manager + gadgets, and other odd sources. Some buggy window managers + (e.g., Muffin 4.2.4) send FocusIn events of this type without + corresponding FocusOut events even when some other window + really has focus, and these kinds of focus event don't + correspond to real user input changes. GTK+ uses the same + filtering. */ + if (event->xfocus.mode == NotifyGrab || + event->xfocus.mode == NotifyUngrab) + return; x_focus_changed (event->type, (event->xfocus.detail == NotifyPointer ? FOCUS_IMPLICIT : FOCUS_EXPLICIT), @@ -8701,7 +8722,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (nchars == nbytes) ch = copy_bufptr[i], len = 1; else - ch = STRING_CHAR_AND_LENGTH (copy_bufptr + i, len); + ch = string_char_and_length (copy_bufptr + i, &len); inev.ie.kind = (SINGLE_BYTE_CHAR_P (ch) ? ASCII_KEYSTROKE_EVENT : MULTIBYTE_CHAR_KEYSTROKE_EVENT); diff --git a/src/xwidget.c b/src/xwidget.c index ea8987f5b3b..0347f1e6483 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -750,11 +750,9 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, (Lisp_Object xwidget, Lisp_Object new_width, Lisp_Object new_height) { CHECK_XWIDGET (xwidget); - CHECK_RANGED_INTEGER (new_width, 0, INT_MAX); - CHECK_RANGED_INTEGER (new_height, 0, INT_MAX); + int w = check_integer_range (new_width, 0, INT_MAX); + int h = check_integer_range (new_height, 0, INT_MAX); struct xwidget *xw = XXWIDGET (xwidget); - int w = XFIXNAT (new_width); - int h = XFIXNAT (new_height); xw->width = w; xw->height = h; |