diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Makefile.in | 13 | ||||
| -rw-r--r-- | src/alloc.c | 280 | ||||
| -rw-r--r-- | src/buffer.c | 33 | ||||
| -rw-r--r-- | src/buffer.h | 3 | ||||
| -rw-r--r-- | src/coding.c | 6 | ||||
| -rw-r--r-- | src/comp.c | 2 | ||||
| -rw-r--r-- | src/composite.c | 16 | ||||
| -rw-r--r-- | src/composite.h | 2 | ||||
| -rw-r--r-- | src/data.c | 130 | ||||
| -rw-r--r-- | src/dispnew.c | 2 | ||||
| -rw-r--r-- | src/doc.c | 34 | ||||
| -rw-r--r-- | src/emacs-module.h.in | 15 | ||||
| -rw-r--r-- | src/emacs.c | 3 | ||||
| -rw-r--r-- | src/eval.c | 43 | ||||
| -rw-r--r-- | src/fileio.c | 174 | ||||
| -rw-r--r-- | src/floatfns.c | 7 | ||||
| -rw-r--r-- | src/fns.c | 65 | ||||
| -rw-r--r-- | src/frame.c | 51 | ||||
| -rw-r--r-- | src/frame.h | 15 | ||||
| -rw-r--r-- | src/gnutls.c | 164 | ||||
| -rw-r--r-- | src/gtkutil.c | 6 | ||||
| -rw-r--r-- | src/haikufont.c | 27 | ||||
| -rw-r--r-- | src/indent.c | 8 | ||||
| -rw-r--r-- | src/insdel.c | 38 | ||||
| -rw-r--r-- | src/itree.c | 2 | ||||
| -rw-r--r-- | src/itree.h | 9 | ||||
| -rw-r--r-- | src/lisp.h | 52 | ||||
| -rw-r--r-- | src/lread.c | 292 | ||||
| -rw-r--r-- | src/macros.c | 6 | ||||
| -rw-r--r-- | src/module-env-29.h | 3 | ||||
| -rw-r--r-- | src/module-env-30.h | 3 | ||||
| -rw-r--r-- | src/nsterm.m | 14 | ||||
| -rw-r--r-- | src/pdumper.c | 6 | ||||
| -rw-r--r-- | src/profiler.c | 145 | ||||
| -rw-r--r-- | src/regex-emacs.c | 43 | ||||
| -rw-r--r-- | src/regex-emacs.h | 3 | ||||
| -rw-r--r-- | src/syntax.c | 137 | ||||
| -rw-r--r-- | src/syntax.h | 24 | ||||
| -rw-r--r-- | src/sysdep.c | 7 | ||||
| -rw-r--r-- | src/textconv.c | 313 | ||||
| -rw-r--r-- | src/textconv.h | 109 | ||||
| -rw-r--r-- | src/treesit.c | 760 | ||||
| -rw-r--r-- | src/w32heap.c | 4 | ||||
| -rw-r--r-- | src/window.c | 15 | ||||
| -rw-r--r-- | src/xdisp.c | 120 | ||||
| -rw-r--r-- | src/xfns.c | 349 | ||||
| -rw-r--r-- | src/xftfont.c | 6 | ||||
| -rw-r--r-- | src/xselect.c | 932 | ||||
| -rw-r--r-- | src/xterm.c | 894 | ||||
| -rw-r--r-- | src/xterm.h | 84 |
50 files changed, 4048 insertions, 1421 deletions
diff --git a/src/Makefile.in b/src/Makefile.in index c29c3750e59..e08e5eead28 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -144,9 +144,10 @@ M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@ M17N_FLT_LIBS = @M17N_FLT_LIBS@ LIB_ACL=@LIB_ACL@ -LIB_CLOCK_GETTIME=@LIB_CLOCK_GETTIME@ -LIB_EACCESS=@LIB_EACCESS@ -LIB_NANOSLEEP=@LIB_NANOSLEEP@ +CLOCK_TIME_LIB=@CLOCK_TIME_LIB@ +EUIDACCESS_LIBGEN=@EUIDACCESS_LIBGEN@ +NANOSLEEP_LIB=@NANOSLEEP_LIB@ +QCOPY_ACL_LIB=@QCOPY_ACL_LIB@ LIB_TIMER_TIME=@LIB_TIMER_TIME@ DBUS_CFLAGS = @DBUS_CFLAGS@ @@ -558,9 +559,9 @@ lisp = $(addprefix ${lispsource}/,${shortlisp}) ## Construct full set of libraries to be linked. LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(PGTK_LIBS) $(LIBX_BASE) $(LIBIMAGE) \ $(LIBX_OTHER) $(LIBSOUND) \ - $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_ACL) $(LIB_CLOCK_GETTIME) \ - $(LIB_NANOSLEEP) $(WEBKIT_LIBS) \ - $(LIB_EACCESS) $(LIB_TIMER_TIME) $(DBUS_LIBS) \ + $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_ACL) $(CLOCK_TIME_LIB) \ + $(NANOSLEEP_LIB) $(QCOPY_ACL_LIB) $(WEBKIT_LIBS) \ + $(EUIDACCESS_LIBGEN) $(LIB_TIMER_TIME) $(DBUS_LIBS) \ $(LIB_EXECINFO) $(XRANDR_LIBS) $(XINERAMA_LIBS) $(XFIXES_LIBS) \ $(XDBE_LIBS) $(XSYNC_LIBS) \ $(LIBXML2_LIBS) $(LIBGPM) $(LIBS_SYSTEM) $(CAIRO_LIBS) \ diff --git a/src/alloc.c b/src/alloc.c index 7ff2cd3b100..6391ede8d0a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -80,6 +80,37 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <valgrind/memcheck.h> #endif +/* AddressSanitizer exposes additional functions for manually marking + memory as poisoned/unpoisoned. When ASan is enabled and the needed + header is available, memory is poisoned when: + + * An ablock is freed (lisp_align_free), or ablocks are initially + allocated (lisp_align_malloc). + * An interval_block is initially allocated (make_interval). + * A dead INTERVAL is put on the interval free list + (sweep_intervals). + * A sdata is marked as dead (sweep_strings, pin_string). + * An sblock is initially allocated (allocate_string_data). + * A string_block is initially allocated (allocate_string). + * A dead string is put on string_free_list (sweep_strings). + * A float_block is initially allocated (make_float). + * A dead float is put on float_free_list. + * A cons_block is initially allocated (Fcons). + * A dead cons is put on cons_free_list (sweep_cons). + * A dead vector is put on vector_free_list (setup_on_free_list), + or a new vector block is allocated (allocate_vector_from_block). + Accordingly, objects reused from the free list are unpoisoned. + + This feature can be disabled wtih the run-time flag + `allow_user_poisoning' set to zero. */ +#if ADDRESS_SANITIZER && defined HAVE_SANITIZER_ASAN_INTERFACE_H \ + && !defined GC_ASAN_POISON_OBJECTS +# define GC_ASAN_POISON_OBJECTS 1 +# include <sanitizer/asan_interface.h> +#else +# define GC_ASAN_POISON_OBJECTS 0 +#endif + /* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects. We turn that on by default when ENABLE_CHECKING is defined; define GC_CHECK_MARKED_OBJECTS to zero to disable. */ @@ -1052,7 +1083,11 @@ lisp_free (void *block) BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */ /* Byte alignment of storage blocks. */ -#define BLOCK_ALIGN (1 << 10) +#ifdef HAVE_UNEXEC +# define BLOCK_ALIGN (1 << 10) +#else /* !HAVE_UNEXEC */ +# define BLOCK_ALIGN (1 << 15) +#endif verify (POWER_OF_2 (BLOCK_ALIGN)); /* Use aligned_alloc if it or a simple substitute is available. @@ -1157,6 +1192,16 @@ struct ablocks (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void **) (abase))[-1]) #endif +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_ABLOCK(b) \ + __asan_poison_memory_region (&(b)->x, sizeof ((b)->x)) +# define ASAN_UNPOISON_ABLOCK(b) \ + __asan_unpoison_memory_region (&(b)->x, sizeof ((b)->x)) +#else +# define ASAN_POISON_ABLOCK(b) ((void) 0) +# define ASAN_UNPOISON_ABLOCK(b) ((void) 0) +#endif + /* The list of free ablock. */ static struct ablock *free_ablock; @@ -1235,6 +1280,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) { abase->blocks[i].abase = abase; abase->blocks[i].x.next_free = free_ablock; + ASAN_POISON_ABLOCK (&abase->blocks[i]); free_ablock = &abase->blocks[i]; } intptr_t ialigned = aligned; @@ -1247,6 +1293,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) eassert ((intptr_t) ABLOCKS_BUSY (abase) == aligned); } + ASAN_UNPOISON_ABLOCK (free_ablock); abase = ABLOCK_ABASE (free_ablock); ABLOCKS_BUSY (abase) = (struct ablocks *) (2 + (intptr_t) ABLOCKS_BUSY (abase)); @@ -1278,6 +1325,7 @@ lisp_align_free (void *block) #endif /* Put on free list. */ ablock->x.next_free = free_ablock; + ASAN_POISON_ABLOCK (ablock); free_ablock = ablock; /* Update busy count. */ intptr_t busy = (intptr_t) ABLOCKS_BUSY (abase) - 2; @@ -1290,9 +1338,12 @@ lisp_align_free (void *block) bool aligned = busy; struct ablock **tem = &free_ablock; struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1]; - while (*tem) { +#if GC_ASAN_POISON_OBJECTS + __asan_unpoison_memory_region (&(*tem)->x, + sizeof ((*tem)->x)); +#endif if (*tem >= (struct ablock *) abase && *tem < atop) { i++; @@ -1421,6 +1472,24 @@ static int interval_block_index = INTERVAL_BLOCK_SIZE; static INTERVAL interval_free_list; +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_INTERVAL_BLOCK(b) \ + __asan_poison_memory_region ((b)->intervals, \ + sizeof ((b)->intervals)) +# define ASAN_UNPOISON_INTERVAL_BLOCK(b) \ + __asan_unpoison_memory_region ((b)->intervals, \ + sizeof ((b)->intervals)) +# define ASAN_POISON_INTERVAL(i) \ + __asan_poison_memory_region ((i), sizeof (*(i))) +# define ASAN_UNPOISON_INTERVAL(i) \ + __asan_unpoison_memory_region ((i), sizeof (*(i))) +#else +# define ASAN_POISON_INTERVAL_BLOCK(b) ((void) 0) +# define ASAN_UNPOISON_INTERVAL_BLOCK(b) ((void) 0) +# define ASAN_POISON_INTERVAL(i) ((void) 0) +# define ASAN_UNPOISON_INTERVAL(i) ((void) 0) +#endif + /* Return a new interval. */ INTERVAL @@ -1433,6 +1502,7 @@ make_interval (void) if (interval_free_list) { val = interval_free_list; + ASAN_UNPOISON_INTERVAL (val); interval_free_list = INTERVAL_PARENT (interval_free_list); } else @@ -1443,10 +1513,12 @@ make_interval (void) = lisp_malloc (sizeof *newi, false, MEM_TYPE_NON_LISP); newi->next = interval_block; + ASAN_POISON_INTERVAL_BLOCK (newi); interval_block = newi; interval_block_index = 0; } val = &interval_block->intervals[interval_block_index++]; + ASAN_UNPOISON_INTERVAL (val); } MALLOC_UNBLOCK_INPUT; @@ -1687,6 +1759,41 @@ init_strings (void) staticpro (&empty_multibyte_string); } +#if GC_ASAN_POISON_OBJECTS +/* Prepare s for denoting a free sdata struct, i.e, poison all bytes + in the flexible array member, except the first SDATA_OFFSET bytes. + This is only effective for strings of size n where n > sdata_size(n). + */ +# define ASAN_PREPARE_DEAD_SDATA(s, size) \ + do { \ + __asan_poison_memory_region ((s), sdata_size ((size))); \ + __asan_unpoison_memory_region (&(((s))->string), \ + sizeof (struct Lisp_String *)); \ + __asan_unpoison_memory_region (&SDATA_NBYTES ((s)), \ + sizeof (SDATA_NBYTES ((s)))); \ + } while (false) +/* Prepare s for storing string data for NBYTES bytes. */ +# define ASAN_PREPARE_LIVE_SDATA(s, nbytes) \ + __asan_unpoison_memory_region ((s), sdata_size ((nbytes))) +# define ASAN_POISON_SBLOCK_DATA(b, size) \ + __asan_poison_memory_region ((b)->data, (size)) +# define ASAN_POISON_STRING_BLOCK(b) \ + __asan_poison_memory_region ((b)->strings, STRING_BLOCK_SIZE) +# define ASAN_UNPOISON_STRING_BLOCK(b) \ + __asan_unpoison_memory_region ((b)->strings, STRING_BLOCK_SIZE) +# define ASAN_POISON_STRING(s) \ + __asan_poison_memory_region ((s), sizeof (*(s))) +# define ASAN_UNPOISON_STRING(s) \ + __asan_unpoison_memory_region ((s), sizeof (*(s))) +#else +# define ASAN_PREPARE_DEAD_SDATA(s, size) ((void) 0) +# define ASAN_PREPARE_LIVE_SDATA(s, nbytes) ((void) 0) +# define ASAN_POISON_SBLOCK_DATA(b, size) ((void) 0) +# define ASAN_POISON_STRING_BLOCK(b) ((void) 0) +# define ASAN_UNPOISON_STRING_BLOCK(b) ((void) 0) +# define ASAN_POISON_STRING(s) ((void) 0) +# define ASAN_UNPOISON_STRING(s) ((void) 0) +#endif #ifdef GC_CHECK_STRING_BYTES @@ -1805,12 +1912,14 @@ allocate_string (void) NEXT_FREE_LISP_STRING (s) = string_free_list; string_free_list = s; } + ASAN_POISON_STRING_BLOCK (b); } check_string_free_list (); /* Pop a Lisp_String off the free-list. */ s = string_free_list; + ASAN_UNPOISON_STRING (s); string_free_list = NEXT_FREE_LISP_STRING (s); MALLOC_UNBLOCK_INPUT; @@ -1870,6 +1979,7 @@ allocate_string_data (struct Lisp_String *s, #endif b = lisp_malloc (size + GC_STRING_EXTRA, clearit, MEM_TYPE_NON_LISP); + ASAN_POISON_SBLOCK_DATA (b, size); #ifdef DOUG_LEA_MALLOC if (!mmap_lisp_allowed_p ()) @@ -1891,6 +2001,8 @@ allocate_string_data (struct Lisp_String *s, { /* Not enough room in the current sblock. */ b = lisp_malloc (SBLOCK_SIZE, false, MEM_TYPE_NON_LISP); + ASAN_POISON_SBLOCK_DATA (b, SBLOCK_SIZE); + data = b->data; b->next = NULL; b->next_free = data; @@ -1903,10 +2015,19 @@ allocate_string_data (struct Lisp_String *s, } data = b->next_free; + if (clearit) - memset (SDATA_DATA (data), 0, nbytes); + { +#if GC_ASAN_POISON_OBJECTS + /* We are accessing SDATA_DATA (data) before it gets + * normally unpoisoned, so do it manually. */ + __asan_unpoison_memory_region (SDATA_DATA (data), nbytes); +#endif + memset (SDATA_DATA (data), 0, nbytes); + } } + ASAN_PREPARE_LIVE_SDATA (data, nbytes); data->string = s; b->next_free = (sdata *) ((char *) data + needed + GC_STRING_EXTRA); eassert ((uintptr_t) b->next_free % alignof (sdata) == 0); @@ -1998,12 +2119,16 @@ sweep_strings (void) int i, nfree = 0; struct Lisp_String *free_list_before = string_free_list; + ASAN_UNPOISON_STRING_BLOCK (b); + next = b->next; for (i = 0; i < STRING_BLOCK_SIZE; ++i) { struct Lisp_String *s = b->strings + i; + ASAN_UNPOISON_STRING (s); + if (s->u.s.data) { /* String was not on free-list before. */ @@ -2040,6 +2165,8 @@ sweep_strings (void) /* Put the string on the free-list. */ NEXT_FREE_LISP_STRING (s) = string_free_list; + ASAN_POISON_STRING (s); + ASAN_PREPARE_DEAD_SDATA (data, SDATA_NBYTES (data)); string_free_list = s; ++nfree; } @@ -2048,6 +2175,8 @@ sweep_strings (void) { /* S was on the free-list before. Put it there again. */ NEXT_FREE_LISP_STRING (s) = string_free_list; + ASAN_POISON_STRING (s); + string_free_list = s; ++nfree; } @@ -2174,6 +2303,7 @@ compact_small_strings (void) if (from != to) { eassert (tb != b || to < from); + ASAN_PREPARE_LIVE_SDATA (to, nbytes); memmove (to, from, size + GC_STRING_EXTRA); to->string->u.s.data = SDATA_DATA (to); } @@ -2525,6 +2655,7 @@ pin_string (Lisp_Object string) memcpy (s->u.s.data, data, size); old_sdata->string = NULL; SDATA_NBYTES (old_sdata) = size; + ASAN_PREPARE_DEAD_SDATA (old_sdata, size); } s->u.s.size_byte = -3; } @@ -2582,6 +2713,24 @@ struct float_block #define XFLOAT_UNMARK(fptr) \ UNSETMARKBIT (FLOAT_BLOCK (fptr), FLOAT_INDEX ((fptr))) +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_FLOAT_BLOCK(fblk) \ + __asan_poison_memory_region ((fblk)->floats, \ + sizeof ((fblk)->floats)) +# define ASAN_UNPOISON_FLOAT_BLOCK(fblk) \ + __asan_unpoison_memory_region ((fblk)->floats, \ + sizeof ((fblk)->floats)) +# define ASAN_POISON_FLOAT(p) \ + __asan_poison_memory_region ((p), sizeof (struct Lisp_Float)) +# define ASAN_UNPOISON_FLOAT(p) \ + __asan_unpoison_memory_region ((p), sizeof (struct Lisp_Float)) +#else +# define ASAN_POISON_FLOAT_BLOCK(fblk) ((void) 0) +# define ASAN_UNPOISON_FLOAT_BLOCK(fblk) ((void) 0) +# define ASAN_POISON_FLOAT(p) ((void) 0) +# define ASAN_UNPOISON_FLOAT(p) ((void) 0) +#endif + /* Current float_block. */ static struct float_block *float_block; @@ -2606,6 +2755,7 @@ make_float (double float_value) if (float_free_list) { XSETFLOAT (val, float_free_list); + ASAN_UNPOISON_FLOAT (float_free_list); float_free_list = float_free_list->u.chain; } else @@ -2616,9 +2766,11 @@ make_float (double float_value) = lisp_align_malloc (sizeof *new, MEM_TYPE_FLOAT); new->next = float_block; memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); + ASAN_POISON_FLOAT_BLOCK (new); float_block = new; float_block_index = 0; } + ASAN_UNPOISON_FLOAT (&float_block->floats[float_block_index]); XSETFLOAT (val, &float_block->floats[float_block_index]); float_block_index++; } @@ -2690,6 +2842,19 @@ static int cons_block_index = CONS_BLOCK_SIZE; static struct Lisp_Cons *cons_free_list; +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_CONS_BLOCK(b) \ + __asan_poison_memory_region ((b)->conses, sizeof ((b)->conses)) +# define ASAN_POISON_CONS(p) \ + __asan_poison_memory_region ((p), sizeof (struct Lisp_Cons)) +# define ASAN_UNPOISON_CONS(p) \ + __asan_unpoison_memory_region ((p), sizeof (struct Lisp_Cons)) +#else +# define ASAN_POISON_CONS_BLOCK(b) ((void) 0) +# define ASAN_POISON_CONS(p) ((void) 0) +# define ASAN_UNPOISON_CONS(p) ((void) 0) +#endif + /* Explicitly free a cons cell by putting it on the free-list. */ void @@ -2700,6 +2865,7 @@ free_cons (struct Lisp_Cons *ptr) cons_free_list = ptr; ptrdiff_t nbytes = sizeof *ptr; tally_consing (-nbytes); + ASAN_POISON_CONS (ptr); } DEFUN ("cons", Fcons, Scons, 2, 2, 0, @@ -2712,6 +2878,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, if (cons_free_list) { + ASAN_UNPOISON_CONS (cons_free_list); XSETCONS (val, cons_free_list); cons_free_list = cons_free_list->u.s.u.chain; } @@ -2722,10 +2889,12 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, struct cons_block *new = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS); memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); + ASAN_POISON_CONS_BLOCK (new); new->next = cons_block; cons_block = new; cons_block_index = 0; } + ASAN_UNPOISON_CONS (&cons_block->conses[cons_block_index]); XSETCONS (val, &cons_block->conses[cons_block_index]); cons_block_index++; } @@ -2980,6 +3149,19 @@ static struct large_vector *large_vectors; Lisp_Object zero_vector; +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_VECTOR_CONTENTS(v, bytes) \ + __asan_poison_memory_region ((v)->contents, (bytes)) +# define ASAN_UNPOISON_VECTOR_CONTENTS(v, bytes) \ + __asan_unpoison_memory_region ((v)->contents, (bytes)) +# define ASAN_UNPOISON_VECTOR_BLOCK(b) \ + __asan_unpoison_memory_region ((b)->data, sizeof ((b)->data)) +#else +# define ASAN_POISON_VECTOR_CONTENTS(v, bytes) ((void) 0) +# define ASAN_UNPOISON_VECTOR_CONTENTS(v, bytes) ((void) 0) +# define ASAN_UNPOISON_VECTOR_BLOCK(b) ((void) 0) +#endif + /* Common shortcut to setup vector on a free list. */ static void @@ -2992,6 +3174,7 @@ setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes) ptrdiff_t vindex = VINDEX (nbytes); eassert (vindex < VECTOR_MAX_FREE_LIST_INDEX); set_next_vector (v, vector_free_lists[vindex]); + ASAN_POISON_VECTOR_CONTENTS (v, nbytes - header_size); vector_free_lists[vindex] = v; } @@ -3039,6 +3222,7 @@ allocate_vector_from_block (ptrdiff_t nbytes) if (vector_free_lists[index]) { vector = vector_free_lists[index]; + ASAN_UNPOISON_VECTOR_CONTENTS (vector, nbytes - header_size); vector_free_lists[index] = next_vector (vector); return vector; } @@ -3052,12 +3236,18 @@ allocate_vector_from_block (ptrdiff_t nbytes) { /* This vector is larger than requested. */ vector = vector_free_lists[index]; + ASAN_UNPOISON_VECTOR_CONTENTS (vector, nbytes - header_size); vector_free_lists[index] = next_vector (vector); /* Excess bytes are used for the smaller vector, which should be set on an appropriate free list. */ restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes; eassert (restbytes % roundup_size == 0); +#if GC_ASAN_POISON_OBJECTS + /* Ensure that accessing excess bytes does not trigger ASan. */ + __asan_unpoison_memory_region (ADVANCE (vector, nbytes), + restbytes); +#endif setup_on_free_list (ADVANCE (vector, nbytes), restbytes); return vector; } @@ -3233,6 +3423,7 @@ sweep_vectors (void) for (vector = (struct Lisp_Vector *) block->data; VECTOR_IN_BLOCK (vector, block); vector = next) { + ASAN_UNPOISON_VECTOR_BLOCK (block); if (XVECTOR_MARKED_P (vector)) { XUNMARK_VECTOR (vector); @@ -3609,6 +3800,23 @@ struct symbol_block struct symbol_block *next; }; +#if GC_ASAN_POISON_OBJECTS +# define ASAN_POISON_SYMBOL_BLOCK(s) \ + __asan_poison_memory_region ((s)->symbols, sizeof ((s)->symbols)) +# define ASAN_UNPOISON_SYMBOL_BLOCK(s) \ + __asan_unpoison_memory_region ((s)->symbols, sizeof ((s)->symbols)) +# define ASAN_POISON_SYMBOL(sym) \ + __asan_poison_memory_region ((sym), sizeof (*(sym))) +# define ASAN_UNPOISON_SYMBOL(sym) \ + __asan_unpoison_memory_region ((sym), sizeof (*(sym))) + +#else +# define ASAN_POISON_SYMBOL_BLOCK(s) ((void) 0) +# define ASAN_UNPOISON_SYMBOL_BLOCK(s) ((void) 0) +# define ASAN_POISON_SYMBOL(sym) ((void) 0) +# define ASAN_UNPOISON_SYMBOL(sym) ((void) 0) +#endif + /* Current symbol block and index of first unused Lisp_Symbol structure in it. */ @@ -3662,6 +3870,7 @@ Its value is void, and its function definition and property list are nil. */) if (symbol_free_list) { + ASAN_UNPOISON_SYMBOL (symbol_free_list); XSETSYMBOL (val, symbol_free_list); symbol_free_list = symbol_free_list->u.s.next; } @@ -3671,10 +3880,13 @@ Its value is void, and its function definition and property list are nil. */) { struct symbol_block *new = lisp_malloc (sizeof *new, false, MEM_TYPE_SYMBOL); + ASAN_POISON_SYMBOL_BLOCK (new); new->next = symbol_block; symbol_block = new; symbol_block_index = 0; } + + ASAN_UNPOISON_SYMBOL (&symbol_block->symbols[symbol_block_index]); XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); symbol_block_index++; } @@ -4562,6 +4774,11 @@ static struct Lisp_String * live_string_holding (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_STRING); +#if GC_ASAN_POISON_OBJECTS + if (__asan_address_is_poisoned (p)) + return NULL; +#endif + struct string_block *b = m->start; char *cp = p; ptrdiff_t offset = cp - (char *) &b->strings[0]; @@ -4578,6 +4795,10 @@ live_string_holding (struct mem_node *m, void *p) || off == offsetof (struct Lisp_String, u.s.data)) { struct Lisp_String *s = p = cp -= off; +#if GC_ASAN_POISON_OBJECTS + if (__asan_region_is_poisoned (s, sizeof (*s))) + return NULL; +#endif if (s->u.s.data) return s; } @@ -4599,6 +4820,11 @@ static struct Lisp_Cons * live_cons_holding (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_CONS); +#if GC_ASAN_POISON_OBJECTS + if (__asan_address_is_poisoned (p)) + return NULL; +#endif + struct cons_block *b = m->start; char *cp = p; ptrdiff_t offset = cp - (char *) &b->conses[0]; @@ -4616,6 +4842,10 @@ live_cons_holding (struct mem_node *m, void *p) || off == offsetof (struct Lisp_Cons, u.s.u.cdr)) { struct Lisp_Cons *s = p = cp -= off; +#if GC_ASAN_POISON_OBJECTS + if (__asan_region_is_poisoned (s, sizeof (*s))) + return NULL; +#endif if (!deadp (s->u.s.car)) return s; } @@ -4638,6 +4868,10 @@ static struct Lisp_Symbol * live_symbol_holding (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_SYMBOL); +#if GC_ASAN_POISON_OBJECTS + if (__asan_address_is_poisoned (p)) + return NULL; +#endif struct symbol_block *b = m->start; char *cp = p; ptrdiff_t offset = cp - (char *) &b->symbols[0]; @@ -4663,6 +4897,10 @@ live_symbol_holding (struct mem_node *m, void *p) || off == offsetof (struct Lisp_Symbol, u.s.next)) { struct Lisp_Symbol *s = p = cp -= off; +#if GC_ASAN_POISON_OBJECTS + if (__asan_region_is_poisoned (s, sizeof (*s))) + return NULL; +#endif if (!deadp (s->u.s.function)) return s; } @@ -4685,6 +4923,11 @@ static struct Lisp_Float * live_float_holding (struct mem_node *m, void *p) { eassert (m->type == MEM_TYPE_FLOAT); +#if GC_ASAN_POISON_OBJECTS + if (__asan_address_is_poisoned (p)) + return NULL; +#endif + struct float_block *b = m->start; char *cp = p; ptrdiff_t offset = cp - (char *) &b->floats[0]; @@ -4699,8 +4942,12 @@ live_float_holding (struct mem_node *m, void *p) && (b != float_block || offset / sizeof b->floats[0] < float_block_index)) { - p = cp - off; - return p; + struct Lisp_Float *f = (struct Lisp_Float *) (cp - off); +#if GC_ASAN_POISON_OBJECTS + if (__asan_region_is_poisoned (f, sizeof (*f))) + return NULL; +#endif + return f; } } return NULL; @@ -6222,6 +6469,7 @@ garbage_collect (void) #ifdef HAVE_X_WINDOWS mark_xterm (); + mark_xselect (); #endif #ifdef HAVE_NS @@ -6555,7 +6803,7 @@ mark_buffer (struct buffer *buffer) if (!BUFFER_LIVE_P (buffer)) mark_object (BVAR (buffer, undo_list)); - if (buffer->overlays) + if (!itree_empty_p (buffer->overlays)) mark_overlays (buffer->overlays->root); /* If this is an indirect buffer, mark its base buffer. */ @@ -7181,11 +7429,13 @@ sweep_conses (void) struct Lisp_Cons *acons = &cblk->conses[pos]; if (!XCONS_MARKED_P (acons)) { + ASAN_UNPOISON_CONS (&cblk->conses[pos]); this_free++; cblk->conses[pos].u.s.u.chain = cons_free_list; cons_free_list = &cblk->conses[pos]; cons_free_list->u.s.car = dead_object (); - } + ASAN_POISON_CONS (&cblk->conses[pos]); + } else { num_used++; @@ -7203,6 +7453,7 @@ sweep_conses (void) { *cprev = cblk->next; /* Unhook from the free list. */ + ASAN_UNPOISON_CONS (&cblk->conses[0]); cons_free_list = cblk->conses[0].u.s.u.chain; lisp_align_free (cblk); } @@ -7229,6 +7480,7 @@ sweep_floats (void) for (struct float_block *fblk; (fblk = *fprev); ) { int this_free = 0; + ASAN_UNPOISON_FLOAT_BLOCK (fblk); for (int i = 0; i < lim; i++) { struct Lisp_Float *afloat = &fblk->floats[i]; @@ -7236,6 +7488,7 @@ sweep_floats (void) { this_free++; fblk->floats[i].u.chain = float_free_list; + ASAN_POISON_FLOAT (&fblk->floats[i]); float_free_list = &fblk->floats[i]; } else @@ -7252,7 +7505,8 @@ sweep_floats (void) { *fprev = fblk->next; /* Unhook from the free list. */ - float_free_list = fblk->floats[0].u.chain; + ASAN_UNPOISON_FLOAT (&fblk->floats[0]); + float_free_list = fblk->floats[0].u.chain; lisp_align_free (fblk); } else @@ -7278,13 +7532,14 @@ sweep_intervals (void) for (struct interval_block *iblk; (iblk = *iprev); ) { int this_free = 0; - + ASAN_UNPOISON_INTERVAL_BLOCK (iblk); for (int i = 0; i < lim; i++) { if (!iblk->intervals[i].gcmarkbit) { set_interval_parent (&iblk->intervals[i], interval_free_list); interval_free_list = &iblk->intervals[i]; + ASAN_POISON_INTERVAL (&iblk->intervals[i]); this_free++; } else @@ -7301,6 +7556,7 @@ sweep_intervals (void) { *iprev = iblk->next; /* Unhook from the free list. */ + ASAN_UNPOISON_INTERVAL (&iblk->intervals[0]); interval_free_list = INTERVAL_PARENT (&iblk->intervals[0]); lisp_free (iblk); } @@ -7330,6 +7586,8 @@ sweep_symbols (void) for (sblk = symbol_block; sblk; sblk = *sprev) { + ASAN_UNPOISON_SYMBOL_BLOCK (sblk); + int this_free = 0; struct Lisp_Symbol *sym = sblk->symbols; struct Lisp_Symbol *end = sym + lim; @@ -7351,7 +7609,8 @@ sweep_symbols (void) sym->u.s.next = symbol_free_list; symbol_free_list = sym; symbol_free_list->u.s.function = dead_object (); - ++this_free; + ASAN_POISON_SYMBOL (sym); + ++this_free; } else { @@ -7370,6 +7629,7 @@ sweep_symbols (void) { *sprev = sblk->next; /* Unhook from the free list. */ + ASAN_UNPOISON_SYMBOL (&sblk->symbols[0]); symbol_free_list = sblk->symbols[0].u.s.next; lisp_free (sblk); } diff --git a/src/buffer.c b/src/buffer.c index 0c740775e5b..3e3be805a6d 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1307,7 +1307,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break; case SYMBOL_LOCALIZED: { /* Look in local_var_alist. */ @@ -5124,35 +5124,38 @@ A list whose car is an integer is processed by processing the cadr of negative) to the width specified by that number. A string is printed verbatim in the mode line except for %-constructs: - %b -- print buffer name. %f -- print visited file name. - %F -- print frame name. - %* -- print %, * or hyphen. %+ -- print *, % or hyphen. - %& is like %*, but ignore read-only-ness. - % means buffer is read-only and * means it is modified. - For a modified read-only buffer, %* gives % and %+ gives *. - %s -- print process status. %l -- print the current line number. + %b -- print buffer name. %c -- print the current column number (this makes editing slower). Columns are numbered starting from the left margin, and the leftmost column is displayed as zero. To make the column number update correctly in all cases, - `column-number-mode' must be non-nil. + `column-number-mode' must be non-nil. %C -- Like %c, but the leftmost column is displayed as one. + %e -- print error message about full memory. + %f -- print visited file name. + %F -- print frame name. %i -- print the size of the buffer. %I -- like %i, but use k, M, G, etc., to abbreviate. + %l -- print the current line number. + %n -- print Narrow if appropriate. %o -- print percent of window travel through buffer, or Top, Bot or All. %p -- print percent of buffer above top of window, or Top, Bot or All. %P -- print percent of buffer above bottom of window, perhaps plus Top, or print Bottom or All. %q -- print percent of buffer above both the top and the bottom of the window, separated by ‘-’, or ‘All’. - %n -- print Narrow if appropriate. + %s -- print process status. %z -- print mnemonics of keyboard, terminal, and buffer coding systems. %Z -- like %z, but including the end-of-line format. - %e -- print error message about full memory. - %@ -- print @ or hyphen. @ means that default-directory is on a - remote machine. - %[ -- print one [ for each recursive editing level. %] similar. - %% -- print %. %- -- print infinitely many dashes. + %& -- print * if the buffer is modified, otherwise hyphen. + %+ -- print *, % or hyphen (modified, read-only, neither). + %* -- print %, * or hyphen (read-only, modified, neither). + For a modified read-only buffer, %+ prints * and %* prints %. + %@ -- print @ if default-directory is on a remote machine, else hyphen. + %[ -- print one [ for each recursive editing level. + %] -- print one ] for each recursive editing level. + %- -- print enough dashes to fill the mode line. + %% -- print %. Decimal digits after the % specify field width to which to pad. */); DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode), diff --git a/src/buffer.h b/src/buffer.h index c0e38ce9659..e700297a264 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -1266,8 +1266,7 @@ set_buffer_intervals (struct buffer *b, INTERVAL i) INLINE bool buffer_has_overlays (void) { - return current_buffer->overlays - && (current_buffer->overlays->root != NULL); + return !itree_empty_p (current_buffer->overlays); } /* Functions for accessing a character or byte, diff --git a/src/coding.c b/src/coding.c index 49dcd8634f3..a2e0d7040f8 100644 --- a/src/coding.c +++ b/src/coding.c @@ -651,6 +651,12 @@ growable_destination (struct coding_system *coding) consumed_chars++; \ } while (0) +/* Suppress clang warnings about consumed_chars never being used. + Although correct, the warnings are too much trouble to code around. */ +#if 13 <= __clang_major__ - defined __apple_build_version__ +# pragma clang diagnostic ignored "-Wunused-but-set-variable" +#endif + /* Safely get two bytes from the source text pointed by SRC which ends at SRC_END, and set C1 and C2 to those bytes while skipping the heading multibyte characters. If there are not enough bytes in the diff --git a/src/comp.c b/src/comp.c index 3f72d088a66..9ff3efedbdd 100644 --- a/src/comp.c +++ b/src/comp.c @@ -535,7 +535,7 @@ load_gccjit_if_necessary (bool mandatory) #define SETJMP_NAME SETJMP /* Max number function importable by native compiled code. */ -#define F_RELOC_MAX_SIZE 1500 +#define F_RELOC_MAX_SIZE 1600 typedef struct { void *link_table[F_RELOC_MAX_SIZE]; diff --git a/src/composite.c b/src/composite.c index 164eeb39598..34f369d167a 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1040,7 +1040,9 @@ inhibit_auto_composition (void) composition closest to CHARPOS is found, set cmp_it->stop_pos to the last character of the composition. STRING, if non-nil, is the string (as opposed to a buffer) whose characters should be - tested for being composable. + tested for being composable. INCLUDE_STATIC non-zero means + consider both static and automatic compositions; if zero, look + only for potential automatic compositions. If no composition is found, set cmp_it->ch to -2. If a static composition is found, set cmp_it->ch to -1. Otherwise, set @@ -1050,7 +1052,7 @@ inhibit_auto_composition (void) void composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t endpos, - Lisp_Object string) + Lisp_Object string, bool include_static) { ptrdiff_t start, end; int c; @@ -1084,8 +1086,10 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, cmp_it->stop_pos = endpos; if (charpos == endpos) return; + /* Look for static compositions. */ /* FIXME: Bidi is not yet handled well in static composition. */ - if (charpos < endpos + if (include_static + && charpos < endpos && find_composition (charpos, endpos, &start, &end, &prop, string) && start >= charpos && composition_valid_p (start, end, prop)) @@ -1106,6 +1110,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, bytepos = string_char_to_byte (string, charpos); } + /* Look for automatic compositions. */ start = charpos; if (charpos < endpos) { @@ -1285,7 +1290,8 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos, { if (cmp_it->ch == -2) { - composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string); + composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string, + true); if (cmp_it->ch == -2 || cmp_it->stop_pos != charpos) /* The current position is not composed. */ return 0; @@ -1424,7 +1430,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos, } if (cmp_it->reversed_p) endpos = -1; - composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string); + composition_compute_stop_pos (cmp_it, charpos, bytepos, endpos, string, true); return 0; } diff --git a/src/composite.h b/src/composite.h index e81465d90cc..0f791c1ea62 100644 --- a/src/composite.h +++ b/src/composite.h @@ -348,7 +348,7 @@ extern bool find_automatic_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t, extern void composition_compute_stop_pos (struct composition_it *, ptrdiff_t, ptrdiff_t, ptrdiff_t, - Lisp_Object); + Lisp_Object, bool); extern bool composition_reseat_it (struct composition_it *, ptrdiff_t, ptrdiff_t, ptrdiff_t, struct window *, signed char, struct face *, Lisp_Object); diff --git a/src/data.c b/src/data.c index 930d476bc3f..8f9ee63e779 100644 --- a/src/data.c +++ b/src/data.c @@ -683,7 +683,7 @@ global value outside of any lexical scope. */) switch (sym->u.s.redirect) { case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break; - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); @@ -843,7 +843,9 @@ the position will be taken. */) } DEFUN ("fset", Ffset, Sfset, 2, 2, 0, - doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. */) + doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. +If the resulting chain of function definitions would contain a loop, +signal a `cyclic-function-indirection' error. */) (register Lisp_Object symbol, Lisp_Object definition) { CHECK_SYMBOL (symbol); @@ -855,6 +857,12 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, eassert (valid_lisp_object_p (definition)); + /* Ensure non-circularity. */ + for (Lisp_Object s = definition; SYMBOLP (s) && !NILP (s); + s = XSYMBOL (s)->u.s.function) + if (EQ (s, symbol)) + xsignal1 (Qcyclic_function_indirection, symbol); + #ifdef HAVE_NATIVE_COMP register Lisp_Object function = XSYMBOL (symbol)->u.s.function; @@ -1081,7 +1089,7 @@ If CMD is not a command, the return value is nil. Value, if non-nil, is a list (interactive SPEC). */) (Lisp_Object cmd) { - Lisp_Object fun = indirect_function (cmd); /* Check cycles. */ + Lisp_Object fun = indirect_function (cmd); bool genfun = false; if (NILP (fun)) @@ -1171,7 +1179,7 @@ If COMMAND is not a command, the return value is nil. The value, if non-nil, is a list of mode name symbols. */) (Lisp_Object command) { - Lisp_Object fun = indirect_function (command); /* Check cycles. */ + Lisp_Object fun = indirect_function (command); if (NILP (fun)) return Qnil; @@ -1241,51 +1249,20 @@ The value, if non-nil, is a list of mode name symbols. */) Getting and Setting Values of Symbols ***********************************************************************/ -/* Return the symbol holding SYMBOL's value. Signal - `cyclic-variable-indirection' if SYMBOL's chain of variable - indirections contains a loop. */ - -struct Lisp_Symbol * -indirect_variable (struct Lisp_Symbol *symbol) -{ - struct Lisp_Symbol *tortoise, *hare; - - hare = tortoise = symbol; - - while (hare->u.s.redirect == SYMBOL_VARALIAS) - { - hare = SYMBOL_ALIAS (hare); - if (hare->u.s.redirect != SYMBOL_VARALIAS) - break; - - hare = SYMBOL_ALIAS (hare); - tortoise = SYMBOL_ALIAS (tortoise); - - if (hare == tortoise) - { - Lisp_Object tem; - XSETSYMBOL (tem, symbol); - xsignal1 (Qcyclic_variable_indirection, tem); - } - } - - return hare; -} - - DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0, doc: /* Return the variable at the end of OBJECT's variable chain. If OBJECT is a symbol, follow its variable indirections (if any), and return the variable at the end of the chain of aliases. See Info node `(elisp)Variable Aliases'. -If OBJECT is not a symbol, just return it. If there is a loop in the -chain of aliases, signal a `cyclic-variable-indirection' error. */) +If OBJECT is not a symbol, just return it. */) (Lisp_Object object) { if (SYMBOLP (object)) { - struct Lisp_Symbol *sym = indirect_variable (XSYMBOL (object)); + struct Lisp_Symbol *sym = XSYMBOL (object); + while (sym->u.s.redirect == SYMBOL_VARALIAS) + sym = SYMBOL_ALIAS (sym); XSETSYMBOL (object, sym); } return object; @@ -1574,7 +1551,7 @@ find_symbol_value (Lisp_Object symbol) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); case SYMBOL_LOCALIZED: { @@ -1663,7 +1640,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return; case SYMBOL_LOCALIZED: { @@ -1917,7 +1894,7 @@ default_value (Lisp_Object symbol) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); case SYMBOL_LOCALIZED: { @@ -2011,7 +1988,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value, start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return; case SYMBOL_LOCALIZED: { @@ -2149,7 +2126,7 @@ See also `defvar-local'. */) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: forwarded = 0; valcontents.value = SYMBOL_VAL (sym); if (BASE_EQ (valcontents.value, Qunbound)) @@ -2217,7 +2194,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: forwarded = 0; valcontents.value = SYMBOL_VAL (sym); break; case SYMBOL_LOCALIZED: @@ -2303,7 +2280,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return variable; case SYMBOL_FORWARDED: { @@ -2370,7 +2347,7 @@ Also see `buffer-local-boundp'.*/) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return Qnil; case SYMBOL_LOCALIZED: { @@ -2420,7 +2397,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return Qnil; case SYMBOL_LOCALIZED: { @@ -2455,7 +2432,7 @@ If the current binding is global (the default), the value is nil. */) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return Qnil; case SYMBOL_FORWARDED: { @@ -2485,55 +2462,22 @@ If the current binding is global (the default), the value is nil. */) /* If OBJECT is a symbol, find the end of its function chain and return the value found there. If OBJECT is not a symbol, just - return it. If there is a cycle in the function chain, signal a - cyclic-function-indirection error. - - This is like Findirect_function, except that it doesn't signal an - error if the chain ends up unbound. */ + return it. */ Lisp_Object -indirect_function (register Lisp_Object object) +indirect_function (Lisp_Object object) { - Lisp_Object tortoise, hare; - - hare = tortoise = object; - - for (;;) - { - if (!SYMBOLP (hare) || NILP (hare)) - break; - hare = XSYMBOL (hare)->u.s.function; - if (!SYMBOLP (hare) || NILP (hare)) - break; - hare = XSYMBOL (hare)->u.s.function; - - tortoise = XSYMBOL (tortoise)->u.s.function; - - if (EQ (hare, tortoise)) - xsignal1 (Qcyclic_function_indirection, object); - } - - return hare; + while (SYMBOLP (object) && !NILP (object)) + object = XSYMBOL (object)->u.s.function; + return object; } DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0, doc: /* Return the function at the end of OBJECT's function chain. If OBJECT is not a symbol, just return it. Otherwise, follow all -function indirections to find the final function binding and return it. -Signal a cyclic-function-indirection error if there is a loop in the -function chain of symbols. */) - (register Lisp_Object object, Lisp_Object noerror) +function indirections to find the final function binding and return it. */) + (Lisp_Object object, Lisp_Object noerror) { - Lisp_Object result; - - /* Optimize for no indirection. */ - result = object; - if (SYMBOLP (result) && !NILP (result) - && (result = XSYMBOL (result)->u.s.function, SYMBOLP (result))) - result = indirect_function (result); - if (!NILP (result)) - return result; - - return Qnil; + return indirect_function (object); } /* Extract and set vector and string elements. */ @@ -2622,6 +2566,7 @@ bool-vector. IDX starts at 0. */) } else if (RECORDP (array)) { + CHECK_IMPURE (array, XVECTOR (array)); if (idxval < 0 || idxval >= PVSIZE (array)) args_out_of_range (array, idx); ASET (array, idxval, newelt); @@ -4241,10 +4186,11 @@ syms_of_data (void) Fput (Qrecursion_error, Qerror_message, build_pure_c_string ("Excessive recursive calling error")); - PUT_ERROR (Qexcessive_variable_binding, recursion_tail, - "Variable binding depth exceeds max-specpdl-size"); PUT_ERROR (Qexcessive_lisp_nesting, recursion_tail, "Lisp nesting exceeds `max-lisp-eval-depth'"); + /* Error obsolete (from 29.1), kept for compatibility. */ + PUT_ERROR (Qexcessive_variable_binding, recursion_tail, + "Variable binding depth exceeds max-specpdl-size"); /* Types that type-of returns. */ DEFSYM (Qinteger, "integer"); diff --git a/src/dispnew.c b/src/dispnew.c index 65d9cf9b4e1..fe661579daf 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3188,7 +3188,7 @@ DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "", Lisp_Object tail, frame; FOR_EACH_FRAME (tail, frame) - if (FRAME_VISIBLE_P (XFRAME (frame))) + if (FRAME_REDISPLAY_P (XFRAME (frame))) redraw_frame (XFRAME (frame)); return Qnil; diff --git a/src/doc.c b/src/doc.c index df57f84603e..174341523d7 100644 --- a/src/doc.c +++ b/src/doc.c @@ -330,19 +330,7 @@ string is passed through `substitute-command-keys'. */) xsignal1 (Qvoid_function, function); if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) fun = XCDR (fun); -#ifdef HAVE_NATIVE_COMP - if (!NILP (Fsubr_native_elisp_p (fun))) - doc = native_function_doc (fun); - else -#endif - if (SUBRP (fun)) - doc = make_fixnum (XSUBR (fun)->doc); -#ifdef HAVE_MODULES - else if (MODULE_FUNCTIONP (fun)) - doc = module_function_documentation (XMODULE_FUNCTION (fun)); -#endif - else - doc = call1 (Qfunction_documentation, fun); + doc = call1 (Qfunction_documentation, fun); /* If DOC is 0, it's typically because of a dumped file missing from the DOC file (bug in src/Makefile.in). */ @@ -371,6 +359,25 @@ string is passed through `substitute-command-keys'. */) return doc; } +DEFUN ("internal-subr-documentation", Fsubr_documentation, Ssubr_documentation, 1, 1, 0, + doc: /* Return the raw documentation info of a C primitive. */) + (Lisp_Object function) +{ +#ifdef HAVE_NATIVE_COMP + if (!NILP (Fsubr_native_elisp_p (function))) + return native_function_doc (function); + else +#endif + if (SUBRP (function)) + return make_fixnum (XSUBR (function)->doc); +#ifdef HAVE_MODULES + else if (MODULE_FUNCTIONP (function)) + return module_function_documentation (XMODULE_FUNCTION (function)); +#endif + else + return Qt; +} + DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 3, 0, doc: /* Return the documentation string that is SYMBOL's PROP property. @@ -713,6 +720,7 @@ compute the correct value for the current terminal in the nil case. */); /* Initialized by ‘main’. */ defsubr (&Sdocumentation); + defsubr (&Ssubr_documentation); defsubr (&Sdocumentation_property); defsubr (&Ssnarf_documentation); defsubr (&Stext_quoting_style); diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index 6a23aa708e4..a455c41a5f1 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -183,6 +183,21 @@ struct emacs_env_29 @module_env_snippet_29@ }; +struct emacs_env_30 +{ +@module_env_snippet_25@ + +@module_env_snippet_26@ + +@module_env_snippet_27@ + +@module_env_snippet_28@ + +@module_env_snippet_29@ + +@module_env_snippet_30@ +}; + /* Every module should define a function as follows. */ extern int emacs_module_init (struct emacs_runtime *runtime) EMACS_NOEXCEPT diff --git a/src/emacs.c b/src/emacs.c index e63b0924282..80a013b68df 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2447,7 +2447,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #ifdef HAVE_DBUS init_dbusbind (); #endif -#if defined(USE_GTK) && !defined(HAVE_PGTK) + +#ifdef HAVE_X_WINDOWS init_xterm (); #endif diff --git a/src/eval.c b/src/eval.c index 2dd0c356e88..cd3eb0a3676 100644 --- a/src/eval.c +++ b/src/eval.c @@ -571,11 +571,12 @@ omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE, or of the variable at the end of the chain of aliases, if BASE-VARIABLE is itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not, then the value of BASE-VARIABLE is set to that of NEW-ALIAS. -The return value is BASE-VARIABLE. */) +The return value is BASE-VARIABLE. + +If the resulting chain of variable definitions would contain a loop, +signal a `cyclic-variable-indirection' error. */) (Lisp_Object new_alias, Lisp_Object base_variable, Lisp_Object docstring) { - struct Lisp_Symbol *sym; - CHECK_SYMBOL (new_alias); CHECK_SYMBOL (base_variable); @@ -584,7 +585,18 @@ The return value is BASE-VARIABLE. */) error ("Cannot make a constant an alias: %s", SDATA (SYMBOL_NAME (new_alias))); - sym = XSYMBOL (new_alias); + struct Lisp_Symbol *sym = XSYMBOL (new_alias); + + /* Ensure non-circularity. */ + struct Lisp_Symbol *s = XSYMBOL (base_variable); + for (;;) + { + if (s == sym) + xsignal1 (Qcyclic_variable_indirection, base_variable); + if (s->u.s.redirect != SYMBOL_VARALIAS) + break; + s = SYMBOL_ALIAS (s); + } switch (sym->u.s.redirect) { @@ -1367,7 +1379,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, error ("Invalid condition handler: %s", SDATA (Fprin1_to_string (tem, Qt, Qnil))); if (CONSP (tem) && EQ (XCAR (tem), QCsuccess)) - success_handler = XCDR (tem); + success_handler = tem; else clausenb++; } @@ -1430,7 +1442,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, if (!NILP (success_handler)) { if (NILP (var)) - return Fprogn (success_handler); + return Fprogn (XCDR (success_handler)); Lisp_Object handler_var = var; if (!NILP (Vinternal_interpreter_environment)) @@ -1442,7 +1454,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, specpdl_ref count = SPECPDL_INDEX (); specbind (handler_var, result); - return unbind_to (count, Fprogn (success_handler)); + return unbind_to (count, Fprogn (XCDR (success_handler))); } return result; } @@ -2116,7 +2128,7 @@ then strings and vectors are not accepted. */) fun = function; - fun = indirect_function (fun); /* Check cycles. */ + fun = indirect_function (fun); if (NILP (fun)) return Qnil; @@ -2348,6 +2360,8 @@ it defines a macro. */) } +static Lisp_Object list_of_t; /* Never-modified constant containing (t). */ + DEFUN ("eval", Feval, Seval, 1, 2, 0, doc: /* Evaluate FORM and return its value. If LEXICAL is t, evaluate using lexical scoping. @@ -2357,7 +2371,7 @@ alist mapping symbols to their value. */) { specpdl_ref count = SPECPDL_INDEX (); specbind (Qinternal_interpreter_environment, - CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt)); + CONSP (lexical) || NILP (lexical) ? lexical : list_of_t); return unbind_to (count, eval_sub (form)); } @@ -2371,8 +2385,7 @@ grow_specpdl_allocation (void) union specbinding *pdlvec = specpdl - 1; ptrdiff_t size = specpdl_end - specpdl; ptrdiff_t pdlvecsize = size + 1; - if (max_size <= size) - xsignal0 (Qexcessive_variable_binding); /* Can't happen, essentially. */ + eassert (max_size > size); pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); specpdl = pdlvec + 1; specpdl_end = specpdl + pdlvecsize - 1; @@ -3398,7 +3411,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, return object; } -/* Return true if SYMBOL currently has a let-binding +/* Return true if SYMBOL's default currently has a let-binding which was made in the buffer that is now current. */ bool @@ -3413,6 +3426,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p)); eassert (let_bound_symbol->u.s.redirect != SYMBOL_VARALIAS); if (symbol == let_bound_symbol + && p->kind != SPECPDL_LET_LOCAL /* bug#62419 */ && EQ (specpdl_where (p), buf)) return 1; } @@ -3474,7 +3488,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: - sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start; + sym = SYMBOL_ALIAS (sym); XSETSYMBOL (symbol, sym); goto start; case SYMBOL_PLAINVAL: /* The most common case is that of a non-constant symbol with a trivial value. Make that as fast as we can. */ @@ -4392,6 +4406,9 @@ alist of active lexical bindings. */); Qcatch_all_memory_full = Fmake_symbol (build_pure_c_string ("catch-all-memory-full")); + staticpro (&list_of_t); + list_of_t = list1 (Qt); + defsubr (&Sor); defsubr (&Sand); defsubr (&Sif); diff --git a/src/fileio.c b/src/fileio.c index f00c389a520..b80f8d61de4 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -134,6 +134,7 @@ static dev_t timestamp_file_system; is added here. */ static Lisp_Object Vwrite_region_annotation_buffers; +static Lisp_Object emacs_readlinkat (int, char const *); static Lisp_Object file_name_directory (Lisp_Object); static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, Lisp_Object *, struct coding_system *); @@ -2219,7 +2220,7 @@ permissions. */) report_file_error ("Copying permissions to", newname); } #else /* not WINDOWSNT */ - ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); + ifd = emacs_open (SSDATA (encoded_file), O_RDONLY | O_NONBLOCK, 0); if (ifd < 0) report_file_error ("Opening input file", file); @@ -2705,31 +2706,19 @@ This is what happens in interactive use with M-x. */) } if (dirp) call4 (Qcopy_directory, file, newname, Qt, Qnil); - else - { - Lisp_Object symlink_target - = (S_ISLNK (file_st.st_mode) - ? check_emacs_readlinkat (AT_FDCWD, file, SSDATA (encoded_file)) - : Qnil); - if (!NILP (symlink_target)) - Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists); - else if (S_ISFIFO (file_st.st_mode)) - { - /* If it's a FIFO, calling `copy-file' will hang if it's a - inter-file system move, so do it here. (It will signal - an error in that case, but it won't hang in any case.) */ - if (!NILP (ok_if_already_exists)) - barf_or_query_if_file_exists (newname, false, - "rename to it", - FIXNUMP (ok_if_already_exists), - false); - if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) != 0) - report_file_errno ("Renaming", list2 (file, newname), errno); - return Qnil; - } + else if (S_ISREG (file_st.st_mode)) + Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt); + else if (S_ISLNK (file_st.st_mode)) + { + Lisp_Object target = emacs_readlinkat (AT_FDCWD, + SSDATA (encoded_file)); + if (!NILP (target)) + Fmake_symbolic_link (target, newname, ok_if_already_exists); else - Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt); + report_file_error ("Renaming", list2 (file, newname)); } + else + report_file_errno ("Renaming", list2 (file, newname), rename_errno); specpdl_ref count = SPECPDL_INDEX (); specbind (Qdelete_by_moving_to_trash, Qnil); @@ -3918,8 +3907,6 @@ by calling `format-decode', which see. */) struct timespec mtime; int fd; ptrdiff_t inserted = 0; - ptrdiff_t how_much; - off_t beg_offset, end_offset; int unprocessed; specpdl_ref count = SPECPDL_INDEX (); Lisp_Object handler, val, insval, orig_filename, old_undo; @@ -3932,7 +3919,8 @@ by calling `format-decode', which see. */) bool replace_handled = false; bool set_coding_system = false; Lisp_Object coding_system; - bool read_quit = false; + /* Negative if read error, 0 if OK so far, positive if quit. */ + ptrdiff_t read_quit = 0; /* If the undo log only contains the insertion, there's no point keeping it. It's typically when we first fill a file-buffer. */ bool empty_undo_list_p @@ -3981,6 +3969,17 @@ by calling `format-decode', which see. */) goto handled; } + if (!NILP (visit)) + { + if (!NILP (beg) || !NILP (end)) + error ("Attempt to visit less than an entire file"); + if (BEG < Z && NILP (replace)) + error ("Cannot do file visiting in a non-empty buffer"); + } + + off_t beg_offset = !NILP (beg) ? file_offset (beg) : 0; + off_t end_offset = !NILP (end) ? file_offset (end) : -1; + orig_filename = filename; filename = ENCODE_FILE (filename); @@ -4023,7 +4022,6 @@ by calling `format-decode', which see. */) if (!S_ISREG (st.st_mode)) { regular = false; - seekable = lseek (fd, 0, SEEK_CUR) < 0; if (! NILP (visit)) { @@ -4031,32 +4029,18 @@ by calling `format-decode', which see. */) goto notfound; } - if (!NILP (beg) && !seekable) - xsignal2 (Qfile_error, - build_string ("cannot use a start position in a non-seekable file/device"), - orig_filename); - if (!NILP (replace)) xsignal2 (Qfile_error, build_string ("not a regular file"), orig_filename); - } - if (!NILP (visit)) - { - if (!NILP (beg) || !NILP (end)) - error ("Attempt to visit less than an entire file"); - if (BEG < Z && NILP (replace)) - error ("Cannot do file visiting in a non-empty buffer"); + seekable = lseek (fd, 0, SEEK_CUR) < 0; + if (!NILP (beg) && !seekable) + xsignal2 (Qfile_error, + build_string ("cannot use a start position in a non-seekable file/device"), + orig_filename); } - if (!NILP (beg)) - beg_offset = file_offset (beg); - else - beg_offset = 0; - - if (!NILP (end)) - end_offset = file_offset (end); - else + if (end_offset < 0) { if (!regular) end_offset = TYPE_MAXIMUM (off_t); @@ -4117,7 +4101,7 @@ by calling `format-decode', which see. */) else { /* Don't try looking inside a file for a coding system - specification if it is not seekable. */ + specification if it is not a regular file. */ if (regular && !NILP (Vset_auto_coding_function)) { /* Find a coding system specified in the heading two @@ -4135,7 +4119,7 @@ by calling `format-decode', which see. */) if (nread == 1024) { int ntail; - if (lseek (fd, - (1024 * 3), SEEK_END) < 0) + if (lseek (fd, st.st_size - 1024 * 3, SEEK_CUR) < 0) report_file_error ("Setting file position", orig_filename); ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3); @@ -4420,7 +4404,7 @@ by calling `format-decode', which see. */) ptrdiff_t bufpos; unsigned char *decoded; ptrdiff_t temp; - ptrdiff_t this = 0; + ptrdiff_t this; specpdl_ref this_count = SPECPDL_INDEX (); bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); @@ -4596,8 +4580,12 @@ by calling `format-decode', which see. */) } move_gap_both (PT, PT_BYTE); - if (GAP_SIZE < total) - make_gap (total - GAP_SIZE); + + /* Ensure the gap is at least one byte larger than needed for the + estimated file size, so that in the usual case we read to EOF + without reallocating. */ + if (GAP_SIZE <= total) + make_gap (total - GAP_SIZE + 1); if (beg_offset != 0 || !NILP (replace)) { @@ -4605,12 +4593,6 @@ by calling `format-decode', which see. */) report_file_error ("Setting file position", orig_filename); } - /* In the following loop, HOW_MUCH contains the total bytes read so - far for a regular file, and not changed for a special file. But, - before exiting the loop, it is set to a negative value if I/O - error occurs. */ - how_much = 0; - /* Total bytes inserted. */ inserted = 0; @@ -4619,23 +4601,26 @@ by calling `format-decode', which see. */) { ptrdiff_t gap_size = GAP_SIZE; - while (how_much < total) + while (NILP (end) || inserted < total) { - /* `try' is reserved in some compilers (Microsoft C). */ - ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE); ptrdiff_t this; + if (gap_size == 0) + { + /* The size estimate was wrong. Make the gap 50% larger. */ + make_gap (GAP_SIZE >> 1); + gap_size = GAP_SIZE - inserted; + } + + /* 'try' is reserved in some compilers (Microsoft C). */ + ptrdiff_t trytry = min (gap_size, READ_BUF_SIZE); + if (!NILP (end)) + trytry = min (trytry, total - inserted); + if (!seekable && NILP (end)) { Lisp_Object nbytes; - /* Maybe make more room. */ - if (gap_size < trytry) - { - make_gap (trytry - gap_size); - gap_size = GAP_SIZE - inserted; - } - /* Read from the file, capturing `quit'. When an error occurs, end the loop, and arrange for a quit to be signaled after decoding the text we read. */ @@ -4646,7 +4631,7 @@ by calling `format-decode', which see. */) if (NILP (nbytes)) { - read_quit = true; + read_quit = 1; break; } @@ -4665,19 +4650,11 @@ by calling `format-decode', which see. */) if (this <= 0) { - how_much = this; + read_quit = this; break; } gap_size -= this; - - /* For a regular file, where TOTAL is the real size, - count HOW_MUCH to compare with it. - For a special file, where TOTAL is just a buffer size, - so don't bother counting in HOW_MUCH. - (INSERTED is where we count the number of characters inserted.) */ - if (seekable || !NILP (end)) - how_much += this; inserted += this; } } @@ -4698,7 +4675,7 @@ by calling `format-decode', which see. */) emacs_close (fd); clear_unwind_protect (fd_index); - if (how_much < 0) + if (read_quit < 0) report_file_error ("Read error", orig_filename); notfound: @@ -6345,24 +6322,6 @@ init_fileio (void) umask (realmask); valid_timestamp_file_system = 0; - - /* fsync can be a significant performance hit. Often it doesn't - suffice to make the file-save operation survive a crash. For - batch scripts, which are typically part of larger shell commands - that don't fsync other files, its effect on performance can be - significant so its utility is particularly questionable. - Hence, for now by default fsync is used only when interactive. - - For more on why fsync often fails to work on today's hardware, see: - Zheng M et al. Understanding the robustness of SSDs under power fault. - 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84 - https://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf - - For more on why fsync does not suffice even if it works properly, see: - Roche X. Necessary step(s) to synchronize filename operations on disk. - Austin Group Defect 672, 2013-03-19 - https://austingroupbugs.net/view.php?id=672 */ - write_region_inhibit_fsync = noninteractive; } void @@ -6620,9 +6579,22 @@ file is usually more useful if it contains the deleted text. */); DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync, doc: /* Non-nil means don't call fsync in `write-region'. This variable affects calls to `write-region' as well as save commands. -Setting this to nil may avoid data loss if the system loses power or -the operating system crashes. By default, it is non-nil in batch mode. */); - write_region_inhibit_fsync = 0; /* See also `init_fileio' above. */ +By default, it is non-nil. + +Although setting this to nil may avoid data loss if the system loses power, +it can be a significant performance hit in the usual case, and it doesn't +necessarily cause file-save operations to actually survive a crash. */); + + /* For more on why fsync often fails to work on today's hardware, see: + Zheng M et al. Understanding the robustness of SSDs under power fault. + 11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84 + https://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf + + For more on why fsync does not suffice even if it works properly, see: + Roche X. Necessary step(s) to synchronize filename operations on disk. + Austin Group Defect 672, 2013-03-19 + https://austingroupbugs.net/view.php?id=672 */ + write_region_inhibit_fsync = true; DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash, doc: /* Specifies whether to use the system's trash can. diff --git a/src/floatfns.c b/src/floatfns.c index 1d891ef3ce1..13f0ca3e129 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -27,19 +27,22 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ frexp, ldexp, log, log10 [via (log X 10)], *modf, pow, sin, *sinh, sqrt, tan, *tanh. - C99 and C11 require the following math.h functions in addition to + C99, C11 and C17 require the following math.h functions in addition to the C89 functions. Of these, Emacs currently exports only the starred ones to Lisp, since we haven't found a use for the others. Also, it uses the ones marked "+" internally: acosh, atanh, cbrt, copysign (implemented by signbit), erf, erfc, exp2, expm1, fdim, fma, fmax, fmin, fpclassify, hypot, +ilogb, - isfinite, isgreater, isgreaterequal, isinf, isless, islessequal, + +isfinite, isgreater, isgreaterequal, +isinf, isless, islessequal, islessgreater, *isnan, isnormal, isunordered, lgamma, log1p, *log2 [via (log X 2)], logb (approximately; implemented by frexp), +lrint/llrint, +lround/llround, nan, nearbyint, nextafter, nexttoward, remainder, remquo, *rint, round, scalbln, +scalbn, +signbit, tgamma, *trunc. + C23 requires many more math.h functions. Emacs does not yet export + or use them. + The C standard also requires functions for float and long double that are not listed above. Of these functions, Emacs uses only the following internally: fabsf, powf, sprintf. diff --git a/src/fns.c b/src/fns.c index e8cd6211d6d..bb6efdda655 100644 --- a/src/fns.c +++ b/src/fns.c @@ -439,21 +439,32 @@ If string STR1 is greater, the value is a positive number N; } /* Check whether the platform allows access to unaligned addresses for - size_t integers without trapping or undue penalty (a few cycles is OK). + size_t integers without trapping or undue penalty (a few cycles is OK), + and that a word-sized memcpy can be used to generate such an access. This whitelist is incomplete but since it is only used to improve performance, omitting cases is safe. */ -#if defined __x86_64__|| defined __amd64__ \ - || defined __i386__ || defined __i386 \ - || defined __arm64__ || defined __aarch64__ \ - || defined __powerpc__ || defined __powerpc \ - || defined __ppc__ || defined __ppc \ - || defined __s390__ || defined __s390x__ +#if (defined __x86_64__|| defined __amd64__ \ + || defined __i386__ || defined __i386 \ + || defined __arm64__ || defined __aarch64__ \ + || defined __powerpc__ || defined __powerpc \ + || defined __ppc__ || defined __ppc \ + || defined __s390__ || defined __s390x__) \ + && defined __OPTIMIZE__ #define HAVE_FAST_UNALIGNED_ACCESS 1 #else #define HAVE_FAST_UNALIGNED_ACCESS 0 #endif +/* Load a word from a possibly unaligned address. */ +static inline size_t +load_unaligned_size_t (const void *p) +{ + size_t x; + memcpy (&x, p, sizeof x); + return x; +} + 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. @@ -497,11 +508,11 @@ Symbols are also allowed; their print names are used instead. */) if (HAVE_FAST_UNALIGNED_ACCESS) { /* First compare entire machine words. */ - typedef size_t word_t; - int ws = sizeof (word_t); - const word_t *w1 = (const word_t *) SDATA (string1); - const word_t *w2 = (const word_t *) SDATA (string2); - while (b < nb - ws + 1 && w1[b / ws] == w2[b / ws]) + int ws = sizeof (size_t); + const char *w1 = SSDATA (string1); + const char *w2 = SSDATA (string2); + while (b < nb - ws + 1 && load_unaligned_size_t (w1 + b) + == load_unaligned_size_t (w2 + b)) b += ws; } @@ -1955,6 +1966,20 @@ assq_no_quit (Lisp_Object key, Lisp_Object alist) return Qnil; } +/* Assq but doesn't signal. Unlike assq_no_quit, this function still + detects circular lists; like assq_no_quit, this function does not + allow quits and never signals. If anything goes wrong, it returns + Qnil. */ +Lisp_Object +assq_no_signal (Lisp_Object key, Lisp_Object alist) +{ + Lisp_Object tail = alist; + FOR_EACH_TAIL_SAFE (tail) + if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) + return XCAR (tail); + return Qnil; +} + DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0, doc: /* Return non-nil if KEY is equal to the car of an element of ALIST. The value is actually the first element of ALIST whose car equals KEY. @@ -3177,13 +3202,14 @@ DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, Return t if answer is yes, and nil if the answer is no. PROMPT is the string to display to ask the question; `yes-or-no-p' -adds \"(yes or no) \" to it. +appends `yes-or-no-prompt' (default \"(yes or no) \") to it. The user must confirm the answer with RET, and can edit it until it has been confirmed. If the `use-short-answers' variable is non-nil, instead of asking for -\"yes\" or \"no\", this function will ask for \"y\" or \"n\". +\"yes\" or \"no\", this function will ask for \"y\" or \"n\" (and +ignore the value of `yes-or-no-prompt'). If dialog boxes are supported, a dialog box will be used if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) @@ -3208,8 +3234,7 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) if (use_short_answers) return call1 (intern ("y-or-n-p"), prompt); - AUTO_STRING (yes_or_no, "(yes or no) "); - prompt = CALLN (Fconcat, prompt, yes_or_no); + prompt = CALLN (Fconcat, prompt, Vyes_or_no_prompt); specpdl_ref count = SPECPDL_INDEX (); specbind (Qenable_recursive_minibuffers, Qt); @@ -6272,9 +6297,15 @@ When non-nil, `yes-or-no-p' will use `y-or-n-p' to read the answer. We recommend against setting this variable non-nil, because `yes-or-no-p' is intended to be used when users are expected not to respond too quickly, but to take their time and perhaps think about the answer. -The same variable also affects the function `read-answer'. */); +The same variable also affects the function `read-answer'. See also +`yes-or-no-prompt'. */); use_short_answers = false; + DEFVAR_LISP ("yes-or-no-prompt", Vyes_or_no_prompt, + doc: /* String to append when `yes-or-no-p' asks a question. +For best results this should end in a space. */); + Vyes_or_no_prompt = make_unibyte_string ("(yes or no) ", strlen ("(yes or no) ")); + defsubr (&Sidentity); defsubr (&Srandom); defsubr (&Slength); diff --git a/src/frame.c b/src/frame.c index 38a6583605c..2cea96d4a32 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1526,7 +1526,7 @@ do_switch_frame (Lisp_Object frame, int for_deletion, Lisp_Object norecord) if (f->select_mini_window_flag && !NILP (Fminibufferp (XWINDOW (f->minibuffer_window)->contents, Qt))) - f->selected_window = f->minibuffer_window; + fset_selected_window (f, f->minibuffer_window); f->select_mini_window_flag = false; if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame))) @@ -1892,12 +1892,61 @@ other_frames (struct frame *f, bool invisible, bool force) if (f != f1) { + /* The following code is defined out because it is + responsible for a performance drop under X connections + over a network, and its purpose is unclear. XSync does + not handle events (or call any callbacks defined by + Emacs), and as such it should not note any "recent change + in visibility". + + When writing new code, please try as hard as possible to + avoid calls that require a roundtrip to the X server. + When such calls are inevitable, use the XCB library to + handle multiple consecutive requests with a data reply in + a more asynchronous fashion. The following code + demonstrates why: + + rc = XGetWindowProperty (dpyinfo->display, window, ... + status = XGrabKeyboard (dpyinfo->display, ... + + here, `XGetWindowProperty' will wait for a reply from the + X server before returning, and thus allowing Emacs to + make the XGrabKeyboard request, which in itself also + requires waiting a reply. When XCB is available, this + code could be written: + +#ifdef HAVE_XCB + xcb_get_property_cookie_t cookie1; + xcb_get_property_reply_t *reply1; + xcb_grab_keyboard_cookie_t cookie2; + xcb_grab_keyboard_reply_t *reply2; + + cookie1 = xcb_get_property (dpyinfo->xcb_connection, window, ... + cookie2 = xcb_grab_keyboard (dpyinfo->xcb_connection, ... + reply1 = xcb_get_property_reply (dpyinfo->xcb_connection, + cookie1); + reply2 = xcb_grab_keyboard_reply (dpyinfo->xcb_connection, + cookie2); +#endif + + In this code, the GetProperty and GrabKeyboard requests + are made simultaneously, and replies are then obtained + from the server at once, avoiding the extraneous + roundtrip to the X server after the call to + `XGetWindowProperty'. + + However, please keep an alternative implementation + available for use when Emacs is built without XCB. */ + +#if 0 /* Verify that we can still talk to the frame's X window, and note any recent change in visibility. */ #ifdef HAVE_X_WINDOWS if (FRAME_WINDOW_P (f1)) x_sync (f1); #endif +#endif + if (!FRAME_TOOLTIP_P (f1) /* Tooltips and child frames count neither for invisibility nor for deletions. */ diff --git a/src/frame.h b/src/frame.h index 4a4c8c38447..b95b94c7685 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1010,6 +1010,20 @@ default_pixels_per_inch_y (void) /* True if frame F is currently visible. */ #define FRAME_VISIBLE_P(f) (f)->visible +/* True if frame F should be redisplayed. This is normally the same + as FRAME_VISIBLE_P (f). Under X, frames can continue to be + displayed to the user by the compositing manager even if they are + invisible, so this also checks whether or not the frame is reported + visible by the X server. */ + +#ifndef HAVE_X_WINDOWS +#define FRAME_REDISPLAY_P(f) (FRAME_VISIBLE_P (f)) +#else +#define FRAME_REDISPLAY_P(f) (FRAME_VISIBLE_P (f) \ + || (FRAME_X_P (f) \ + && FRAME_X_VISIBLE (f))) +#endif + /* True if frame F is currently visible but hidden. */ #define FRAME_OBSCURED_P(f) ((f)->visible > 1) @@ -1718,7 +1732,6 @@ extern void x_wm_set_icon_position (struct frame *, int, int); #if !defined USE_X_TOOLKIT extern const char *x_get_resource_string (const char *, const char *); #endif -extern void x_sync (struct frame *); #endif /* HAVE_X_WINDOWS */ #if !defined (HAVE_NS) && !defined (HAVE_PGTK) diff --git a/src/gnutls.c b/src/gnutls.c index 91e369375f2..ca7e9fc4c73 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -34,6 +34,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ # endif # if GNUTLS_VERSION_NUMBER >= 0x030200 +# define HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 # define HAVE_GNUTLS_CIPHER_GET_IV_SIZE # endif @@ -121,6 +122,11 @@ DEF_DLL_FN (int, gnutls_certificate_set_x509_crl_file, DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file, (gnutls_certificate_credentials_t, const char *, const char *, gnutls_x509_crt_fmt_t)); +# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 +DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file2, + (gnutls_certificate_credentials_t, const char *, const char *, + gnutls_x509_crt_fmt_t, const char *, unsigned int)); +# endif # ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST DEF_DLL_FN (int, gnutls_certificate_set_x509_system_trust, (gnutls_certificate_credentials_t)); @@ -314,6 +320,9 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_certificate_set_verify_flags); LOAD_DLL_FN (library, gnutls_certificate_set_x509_crl_file); LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file); +# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 + LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file2); +# endif # ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST LOAD_DLL_FN (library, gnutls_certificate_set_x509_system_trust); # endif @@ -455,6 +464,9 @@ init_gnutls_functions (void) # define gnutls_certificate_set_verify_flags fn_gnutls_certificate_set_verify_flags # define gnutls_certificate_set_x509_crl_file fn_gnutls_certificate_set_x509_crl_file # define gnutls_certificate_set_x509_key_file fn_gnutls_certificate_set_x509_key_file +# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 +# define gnutls_certificate_set_x509_key_file2 fn_gnutls_certificate_set_x509_key_file2 +# endif # define gnutls_certificate_set_x509_system_trust fn_gnutls_certificate_set_x509_system_trust # define gnutls_certificate_set_x509_trust_file fn_gnutls_certificate_set_x509_trust_file # define gnutls_certificate_type_get fn_gnutls_certificate_type_get @@ -1774,6 +1786,88 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) return gnutls_make_error (ret); } +#ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 + +/* Helper function for gnutls-boot. + + The key :flags receives a list of symbols, each of which + corresponds to a GnuTLS C flag, the ORed result is to be passed to + the function `gnutls_certificate_set_x509_key_file2' as its last + argument. */ +static unsigned int +key_file2_aux (Lisp_Object flags) +{ + unsigned int rv = 0; + Lisp_Object tail = flags; + FOR_EACH_TAIL_SAFE (tail) + { + Lisp_Object flag = XCAR (tail); + if (EQ (flag, Qgnutls_pkcs_plain)) + rv |= GNUTLS_PKCS_PLAIN; +#ifdef GNUTLS_PKCS_PKCS12_3DES + else if (EQ (flag, Qgnutls_pkcs_pkcs12_3des)) + rv |= GNUTLS_PKCS_PKCS12_3DES; +#endif +#ifdef GNUTLS_PKCS_PKCS12_ARCFOUR + else if (EQ (flag, Qgnutls_pkcs_pkcs12_arcfour)) + rv |= GNUTLS_PKCS_PKCS12_ARCFOUR; +#endif +#ifdef GNUTLS_PKCS_PKCS12_RC2_40 + else if (EQ (flag, Qgnutls_pkcs_pkcs12_rc2_40)) + rv |= GNUTLS_PKCS_PKCS12_RC2_40; +#endif +#ifdef GNUTLS_PKCS_PBES2_3DES + else if (EQ (flag, Qgnutls_pkcs_pbes2_3des)) + rv |= GNUTLS_PKCS_PBES2_3DES; +#endif +#ifdef GNUTLS_PKCS_PBES2_AES_128 + else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_128)) + rv |= GNUTLS_PKCS_PBES2_AES_128; +#endif +#ifdef GNUTLS_PKCS_PBES2_AES_192 + else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_192)) + rv |= GNUTLS_PKCS_PBES2_AES_192; +#endif +#ifdef GNUTLS_PKCS_PBES2_AES_256 + else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_256)) + rv |= GNUTLS_PKCS_PBES2_AES_256; +#endif + else if (EQ (flag, Qgnutls_pkcs_null_password)) + rv |= GNUTLS_PKCS_NULL_PASSWORD; +#ifdef GNUTLS_PKCS_PBES2_DES + else if (EQ (flag, Qgnutls_pkcs_pbes2_des)) + rv |= GNUTLS_PKCS_PBES2_DES; +#endif +#ifdef GNUTLS_PKCS_PBES1_DES_MD5 + else if (EQ (flag, Qgnutls_pkcs_pbes1_des_md5)) + rv |= GNUTLS_PKCS_PBES1_DES_MD5; +#endif +#ifdef GNUTLS_PKCS_PBES2_GOST_TC26Z + else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_tc26z)) + rv |= GNUTLS_PKCS_PBES2_GOST_TC26Z; +#endif +#ifdef GNUTLS_PKCS_PBES2_GOST_CPA + else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpa)) + rv |= GNUTLS_PKCS_PBES2_GOST_CPA; +#endif +#ifdef GNUTLS_PKCS_PBES2_GOST_CPB + else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpb)) + rv |= GNUTLS_PKCS_PBES2_GOST_CPB; +#endif +#ifdef GNUTLS_PKCS_PBES2_GOST_CPC + else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpc)) + rv |= GNUTLS_PKCS_PBES2_GOST_CPC; +#endif +#ifdef GNUTLS_PKCS_PBES2_GOST_CPD + else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpd)) + rv |= GNUTLS_PKCS_PBES2_GOST_CPD; +#endif + } + return rv; +} + +#endif /* HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 */ + DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0, doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST. Currently only client mode is supported. Return a success/failure @@ -1813,6 +1907,22 @@ accept in Diffie-Hellman key exchange. :complete-negotiation, if non-nil, will make negotiation complete before returning even on non-blocking sockets. +:pass, the password of the private key as per GnuTLS' +gnutls_certificate_set_x509_key_file2. Specify as nil to have a NULL +password. + +:flags, a list of symbols relating to :pass, each specifying a flag: +GNUTLS_PKCS_PLAIN, GNUTLS_PKCS_PKCS12_3DES, +GNUTLS_PKCS_PKCS12_ARCFOUR, GNUTLS_PKCS_PKCS12_RC2_40, +GNUTLS_PKCS_PBES2_3DES, GNUTLS_PKCS_PBES2_AES_128, +GNUTLS_PKCS_PBES2_AES_192, GNUTLS_PKCS_PBES2_AES_256, +GNUTLS_PKCS_NULL_PASSWORD, GNUTLS_PKCS_PBES2_DES, +GNUTLS_PKCS_PBES2_DES_MD5, GNUTLS_PKCS_PBES2_GOST_TC26Z, +GNUTLS_PKCS_PBES2_GOST_CPA, GNUTLS_PKCS_PBES2_GOST_CPB, +GNUTLS_PKCS_PBES2_GOST_CPC, GNUTLS_PKCS_PBES2_GOST_CPD. If not +specified, or if nil, the bitflag with value 0 is used. +Note that some of these are only supported since GnuTLS 3.6.3. + The debug level will be set for this process AND globally for GnuTLS. So if you set it higher or lower at any point, it affects global debugging. @@ -1825,6 +1935,9 @@ Processes must be initialized with this function before other GnuTLS functions are used. This function allocates resources which can only be deallocated by calling `gnutls-deinit' or by calling it again. +The :pass and :flags keys are ignored with old versions of GnuTLS, and +:flags is ignored if :pass is not specified. + The callbacks alist can have a `verify' key, associated with a verification function (UNUSED). @@ -1842,16 +1955,22 @@ one trustfile (usually a CA bundle). */) Lisp_Object global_init; char const *priority_string_ptr = "NORMAL"; /* default priority string. */ char *c_hostname; + const char *c_pass; /* Placeholders for the property list elements. */ Lisp_Object priority_string; Lisp_Object trustfiles; Lisp_Object crlfiles; Lisp_Object keylist; + Lisp_Object pass; + Lisp_Object flags; /* Lisp_Object callbacks; */ Lisp_Object loglevel; Lisp_Object hostname; Lisp_Object prime_bits; +#ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 + unsigned int aux_key_file; +#endif struct Lisp_Process *p = XPROCESS (proc); CHECK_PROCESS (proc); @@ -1877,6 +1996,13 @@ one trustfile (usually a CA bundle). */) crlfiles = plist_get (proplist, QCcrlfiles); loglevel = plist_get (proplist, QCloglevel); prime_bits = plist_get (proplist, QCmin_prime_bits); + pass = plist_get (proplist, QCpass); + flags = plist_get (proplist, QCflags); + + if (STRINGP (pass)) + c_pass = SSDATA (pass); + else + c_pass = NULL; if (!STRINGP (hostname)) { @@ -2038,6 +2164,20 @@ one trustfile (usually a CA bundle). */) keyfile = ansi_encode_filename (keyfile); certfile = ansi_encode_filename (certfile); # endif +# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 + if (!NILP (plist_member (proplist, QCpass))) + { + aux_key_file = key_file2_aux (flags); + ret + = gnutls_certificate_set_x509_key_file2 (x509_cred, + SSDATA (certfile), + SSDATA (keyfile), + file_format, + c_pass, + aux_key_file); + } + else +# endif ret = gnutls_certificate_set_x509_key_file (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format); @@ -2265,6 +2405,9 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, aead_auth_size = aend_byte - astart_byte; } + /* Only block ciphers require that ISIZE be a multiple of the block + size, and AEAD ciphers are not block ciphers. */ +#if 0 ptrdiff_t expected_remainder = encrypting ? 0 : cipher_tag_size; ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca); @@ -2274,6 +2417,7 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, "is not %"pD"d greater than a multiple of the required %"pD"d"), gnutls_cipher_get_name (gca), desc, isize, expected_remainder, cipher_block_size); +#endif ret = ((encrypting ? gnutls_aead_cipher_encrypt : gnutls_aead_cipher_decrypt) (acipher, vdata, vsize, aead_auth_data, aead_auth_size, @@ -2282,7 +2426,7 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, Lisp_Object output; if (GNUTLS_E_SUCCESS <= ret) output = make_unibyte_string (storage, storage_length); - explicit_bzero (storage, storage_length); + memset_explicit (storage, 0, storage_length); gnutls_aead_cipher_deinit (acipher); if (ret < GNUTLS_E_SUCCESS) @@ -2862,8 +3006,26 @@ level in the ones. For builds without libgnutls, the value is -1. */); DEFSYM (QCmin_prime_bits, ":min-prime-bits"); DEFSYM (QCloglevel, ":loglevel"); DEFSYM (QCcomplete_negotiation, ":complete-negotiation"); + DEFSYM (QCpass, ":pass"); + DEFSYM (QCflags, ":flags"); DEFSYM (QCverify_flags, ":verify-flags"); DEFSYM (QCverify_error, ":verify-error"); + DEFSYM (Qgnutls_pkcs_plain, "GNUTLS_PKCS_PLAIN"); + DEFSYM (Qgnutls_pkcs_pkcs12_3des, "GNUTLS_PKCS_PKCS12_3DES"); + DEFSYM (Qgnutls_pkcs_pkcs12_arcfour, "GNUTLS_PKCS_PKCS12_ARCFOUR"); + DEFSYM (Qgnutls_pkcs_pkcs12_rc2_40, "GNUTLS_PKCS_PKCS12_RC2_40"); + DEFSYM (Qgnutls_pkcs_pbes2_3des, "GNUTLS_PKCS_PBES2_3DES"); + DEFSYM (Qgnutls_pkcs_pbes2_aes_128, "GNUTLS_PKCS_PBES2_AES_128"); + DEFSYM (Qgnutls_pkcs_pbes2_aes_192, "GNUTLS_PKCS_PBES2_AES_192"); + DEFSYM (Qgnutls_pkcs_pbes2_aes_256, "GNUTLS_PKCS_PBES2_AES_256"); + DEFSYM (Qgnutls_pkcs_null_password, "GNUTLS_PKCS_NULL_PASSWORD"); + DEFSYM (Qgnutls_pkcs_pbes2_des, "GNUTLS_PKCS_PBES2_DES"); + DEFSYM (Qgnutls_pkcs_pbes1_des_md5, "GNUTLS_PKCS_PBES1_DES_MD5"); + DEFSYM (Qgnutls_pkcs_pbes2_gost_tc26z, "GNUTLS_PKCS_PBES2_GOST_TC26Z"); + DEFSYM (Qgnutls_pkcs_pbes2_gost_cpa, "GNUTLS_PKCS_PBES2_GOST_CPA"); + DEFSYM (Qgnutls_pkcs_pbes2_gost_cpb, "GNUTLS_PKCS_PBES2_GOST_CPB"); + DEFSYM (Qgnutls_pkcs_pbes2_gost_cpc, "GNUTLS_PKCS_PBES2_GOST_CPC"); + DEFSYM (Qgnutls_pkcs_pbes2_gost_cpd, "GNUTLS_PKCS_PBES2_GOST_CPD"); DEFSYM (QCcipher_id, ":cipher-id"); DEFSYM (QCcipher_aead_capable, ":cipher-aead-capable"); diff --git a/src/gtkutil.c b/src/gtkutil.c index f5e70305ead..4cc0f9f15b4 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -2103,7 +2103,7 @@ xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) gdk_window_restack (gwin1, gwin2, above_flag); #ifndef HAVE_PGTK - x_sync (f1); + XSync (FRAME_X_DISPLAY (f1), False); #else gdk_flush (); #endif @@ -4793,7 +4793,7 @@ xg_update_scrollbar_pos (struct frame *f, here to get some events. */ #ifndef HAVE_PGTK - x_sync (f); + XSync (FRAME_X_DISPLAY (f), False); #else gdk_flush (); #endif @@ -4894,7 +4894,7 @@ xg_update_horizontal_scrollbar_pos (struct frame *f, } #ifndef HAVE_PGTK - x_sync (f); + XSync (FRAME_X_DISPLAY (f), False); #else gdk_flush (); #endif diff --git a/src/haikufont.c b/src/haikufont.c index 4599ca40c47..b4c2e547247 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -754,22 +754,30 @@ haikufont_encode_char (struct font *font, int c) } static Lisp_Object -haikufont_open (struct frame *f, Lisp_Object font_entity, int x) +haikufont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) { struct haikufont_info *font_info; struct haiku_font_pattern ptn; struct font *font; void *be_font; - Lisp_Object font_object, tem, extra, indices, antialias; + Lisp_Object font_object, extra, indices, antialias; int px_size, min_width, max_width; int avg_width, height, space_width, ascent; int descent, underline_pos, underline_thickness; - if (x <= 0) + if (XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX)) != 0) + pixel_size = XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX)); + else if (pixel_size == 0) { - /* Get pixel size from frame instead. */ - tem = get_frame_param (f, Qfontsize); - x = NILP (tem) ? 0 : XFIXNAT (tem); + /* Try to resolve a suitable size for the font, if the font size + has not already been specified. First, if FRAME_FONT is set, + use its size. Otherwise, use 12, which is the default on + Haiku. */ + + if (FRAME_FONT (f)) + pixel_size = FRAME_FONT (f)->pixel_size; + else + pixel_size = 12; } extra = AREF (font_entity, FONT_EXTRA_INDEX); @@ -788,7 +796,8 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) { block_input (); be_font = be_open_font_at_index (XFIXNUM (XCAR (indices)), - XFIXNUM (XCDR (indices)), x); + XFIXNUM (XCDR (indices)), + pixel_size); unblock_input (); if (!be_font) @@ -799,7 +808,7 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) block_input (); haikufont_spec_or_entity_to_pattern (font_entity, 1, &ptn); - if (BFont_open_pattern (&ptn, &be_font, x)) + if (BFont_open_pattern (&ptn, &be_font, pixel_size)) { haikufont_done_with_query_pattern (&ptn); unblock_input (); @@ -813,7 +822,7 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) block_input (); font_object = font_make_object (VECSIZE (struct haikufont_info), - font_entity, x); + font_entity, pixel_size); ASET (font_object, FONT_TYPE_INDEX, Qhaiku); font_info = (struct haikufont_info *) XFONT_OBJECT (font_object); diff --git a/src/indent.c b/src/indent.c index 08d2bf5ea28..16285ce84e2 100644 --- a/src/indent.c +++ b/src/indent.c @@ -616,7 +616,7 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, memset (&cmp_it, 0, sizeof cmp_it); cmp_it.id = -1; - composition_compute_stop_pos (&cmp_it, scan, scan_byte, end, Qnil); + composition_compute_stop_pos (&cmp_it, scan, scan_byte, end, Qnil, true); /* Scan forward to the target position. */ while (scan < end) @@ -681,7 +681,7 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, { cmp_it.id = -1; composition_compute_stop_pos (&cmp_it, scan, scan_byte, end, - Qnil); + Qnil, true); } else cmp_it.from = cmp_it.to; @@ -1290,7 +1290,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, prev_tab_offset = tab_offset; memset (&cmp_it, 0, sizeof cmp_it); cmp_it.id = -1; - composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil); + composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil, true); unsigned short int quit_count = 0; @@ -1600,7 +1600,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, { cmp_it.id = -1; composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, - Qnil); + Qnil, true); } else cmp_it.from = cmp_it.to; diff --git a/src/insdel.c b/src/insdel.c index e459d0cfa17..b65a3fbd805 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1715,6 +1715,44 @@ del_range (ptrdiff_t from, ptrdiff_t to) del_range_1 (from, to, 1, 0); } +struct safe_del_range_context +{ + /* From and to positions. */ + ptrdiff_t from, to; +}; + +static Lisp_Object +safe_del_range_1 (void *ptr) +{ + struct safe_del_range_context *context; + + context = ptr; + del_range (context->from, context->to); + return Qnil; +} + +static Lisp_Object +safe_del_range_2 (enum nonlocal_exit type, Lisp_Object value) +{ + return Qt; +} + +/* Like del_range; however, catch all non-local exits. Value is 0 if + the buffer contents were really deleted. Otherwise, it is 1. */ + +int +safe_del_range (ptrdiff_t from, ptrdiff_t to) +{ + struct safe_del_range_context context; + + context.from = from; + context.to = to; + + return !NILP (internal_catch_all (safe_del_range_1, + &context, + safe_del_range_2)); +} + /* Like del_range; PREPARE says whether to call prepare_to_modify_buffer. RET_STRING says to return the deleted text. */ diff --git a/src/itree.c b/src/itree.c index b8db08bc74c..bd3e62a374a 100644 --- a/src/itree.c +++ b/src/itree.c @@ -1376,7 +1376,7 @@ itree_iterator_first_node (struct itree_tree *tree, return node; } -/* Start a iterator enumerating all intervals in [BEGIN,END) in the +/* Start an iterator enumerating all intervals in [BEGIN,END) in the given ORDER. */ struct itree_iterator * diff --git a/src/itree.h b/src/itree.h index 8f675fd43bc..79d03d31ce2 100644 --- a/src/itree.h +++ b/src/itree.h @@ -25,6 +25,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "lisp.h" +INLINE_HEADER_BEGIN + /* The tree and node structs are mainly here, so they can be allocated. @@ -114,6 +116,11 @@ extern void itree_node_set_region (struct itree_tree *, struct itree_node *, ptrdiff_t, ptrdiff_t); extern struct itree_tree *itree_create (void); extern void itree_destroy (struct itree_tree *); +INLINE bool +itree_empty_p (struct itree_tree *tree) +{ + return !tree || !tree->root; +} extern intmax_t itree_size (struct itree_tree *); extern void itree_clear (struct itree_tree *); extern void itree_insert (struct itree_tree *, struct itree_node *, @@ -178,4 +185,6 @@ struct itree_iterator #define ITREE_FOREACH_NARROW(beg, end) \ itree_iterator_narrow (itree_iter_, beg, end) +INLINE_HEADER_END + #endif diff --git a/src/lisp.h b/src/lisp.h index 1276285e2f2..ab66109d5df 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -22,7 +22,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <alloca.h> #include <setjmp.h> -#include <stdalign.h> #include <stdarg.h> #include <stddef.h> #include <string.h> @@ -273,7 +272,7 @@ DEFINE_GDB_SYMBOL_END (VALMASK) emacs_align_type union in alloc.c. Although these macros are reasonably portable, they are not - guaranteed on non-GCC platforms, as C11 does not require support + guaranteed on non-GCC platforms, as the C standard does not require support for alignment to GCALIGNMENT and older compilers may ignore alignment requests. For any type T where garbage collection requires alignment, use verify (GCALIGNED (T)) to verify the @@ -811,24 +810,24 @@ typedef struct { void const *fwdptr; } lispfwd; enum symbol_interned { - SYMBOL_UNINTERNED = 0, - SYMBOL_INTERNED = 1, - SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2 + SYMBOL_UNINTERNED, /* not interned anywhere */ + SYMBOL_INTERNED, /* interned but not in initial obarray */ + SYMBOL_INTERNED_IN_INITIAL_OBARRAY /* interned in initial obarray */ }; enum symbol_redirect { - SYMBOL_PLAINVAL = 4, - SYMBOL_VARALIAS = 1, - SYMBOL_LOCALIZED = 2, - SYMBOL_FORWARDED = 3 + SYMBOL_PLAINVAL, /* plain var, value is in the `value' field */ + SYMBOL_VARALIAS, /* var alias, value is really in the `alias' symbol */ + SYMBOL_LOCALIZED, /* localized var, value is in the `blv' object */ + SYMBOL_FORWARDED /* forwarding var, value is in `forward' */ }; enum symbol_trapped_write { - SYMBOL_UNTRAPPED_WRITE = 0, - SYMBOL_NOWRITE = 1, - SYMBOL_TRAPPED_WRITE = 2 + SYMBOL_UNTRAPPED_WRITE, /* normal case, just set the value */ + SYMBOL_NOWRITE, /* constant, cannot set, e.g. nil, t, :keyword */ + SYMBOL_TRAPPED_WRITE /* trap the write, call watcher functions */ }; struct Lisp_Symbol @@ -839,21 +838,13 @@ struct Lisp_Symbol { bool_bf gcmarkbit : 1; - /* Indicates where the value can be found: - 0 : it's a plain var, the value is in the `value' field. - 1 : it's a varalias, the value is really in the `alias' symbol. - 2 : it's a localized var, the value is in the `blv' object. - 3 : it's a forwarding variable, the value is in `forward'. */ - ENUM_BF (symbol_redirect) redirect : 3; + /* Indicates where the value can be found. */ + ENUM_BF (symbol_redirect) redirect : 2; - /* 0 : normal case, just set the value - 1 : constant, cannot set, e.g. nil, t, :keywords. - 2 : trap the write, call watcher functions. */ ENUM_BF (symbol_trapped_write) trapped_write : 2; - /* Interned state of the symbol. This is an enumerator from - enum symbol_interned. */ - unsigned interned : 2; + /* Interned state of the symbol. */ + ENUM_BF (symbol_interned) interned : 2; /* True means that this variable has been explicitly declared special (with `defvar' etc), and shouldn't be lexically bound. */ @@ -2963,9 +2954,10 @@ XFLOAT_DATA (Lisp_Object f) /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 representations, have infinities and NaNs, and do not trap on exceptions. Define IEEE_FLOATING_POINT to 1 if this host is one of the - typical ones. The C11 macro __STDC_IEC_559__ is close to what is + typical ones. The C23 macro __STDC_IEC_60559_BFP__ (or its + obsolescent C11 counterpart __STDC_IEC_559__) is close to what is wanted here, but is not quite right because Emacs does not require - all the features of C11 Annex F (and does not require C11 at all, + all the features of C23 Annex F (and does not require C11 or later, for that matter). */ #define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ @@ -3965,7 +3957,6 @@ extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t); 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 circular_list (Lisp_Object); extern Lisp_Object do_symval_forwarding (lispfwd); @@ -4040,6 +4031,7 @@ extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object); extern bool equal_no_quit (Lisp_Object, Lisp_Object); extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object); extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object); +extern Lisp_Object assq_no_signal (Lisp_Object, Lisp_Object); extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object); extern void clear_string_char_byte_cache (void); extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t); @@ -4116,6 +4108,7 @@ extern void del_range_byte (ptrdiff_t, ptrdiff_t); extern void del_range_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object del_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool); +extern int safe_del_range (ptrdiff_t, ptrdiff_t); extern void modify_text (ptrdiff_t, ptrdiff_t); extern void prepare_to_modify_buffer (ptrdiff_t, ptrdiff_t, ptrdiff_t *); extern void prepare_to_modify_buffer_1 (ptrdiff_t, ptrdiff_t, ptrdiff_t *); @@ -5212,6 +5205,11 @@ extern void syms_of_profiler (void); extern char *emacs_root_dir (void); #endif /* DOS_NT */ +#ifdef HAVE_TEXT_CONVERSION +/* Defined in textconv.c. */ +extern void report_selected_window_change (struct frame *); +#endif + #ifdef HAVE_NATIVE_COMP INLINE bool SUBR_NATIVE_COMPILEDP (Lisp_Object a) diff --git a/src/lread.c b/src/lread.c index d0dc85f51c8..273120315df 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2639,154 +2639,137 @@ character_name_to_code (char const *name, ptrdiff_t name_len, Unicode 9.0.0 the maximum is 83, so this should be safe. */ enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 }; -/* Read a \-escape sequence, assuming we already read the `\'. - If the escape sequence forces unibyte, return eight-bit char. */ +static AVOID +invalid_escape_syntax_error (void) +{ + error ("Invalid escape character syntax"); +} +/* Read a character escape sequence, assuming we just read a backslash + and one more character (next_char). */ static int -read_escape (Lisp_Object readcharfun) +read_char_escape (Lisp_Object readcharfun, int next_char) { - int c = READCHAR; - /* \u allows up to four hex digits, \U up to eight. Default to the - behavior for \u, and change this value in the case that \U is seen. */ - int unicode_hex_count = 4; + int modifiers = 0; + ptrdiff_t ncontrol = 0; + int chr; + + again: ; + int c = next_char; + int unicode_hex_count; + int mod; switch (c) { case -1: end_of_file_error (); - case 'a': - return '\007'; - case 'b': - return '\b'; - case 'd': - return 0177; - case 'e': - return 033; - case 'f': - return '\f'; - case 'n': - return '\n'; - case 'r': - return '\r'; - case 't': - return '\t'; - case 'v': - return '\v'; + case 'a': chr = '\a'; break; + case 'b': chr = '\b'; break; + case 'd': chr = 127; break; + case 'e': chr = 27; break; + case 'f': chr = '\f'; break; + case 'n': chr = '\n'; break; + case 'r': chr = '\r'; break; + case 't': chr = '\t'; break; + case 'v': chr = '\v'; break; case '\n': /* ?\LF is an error; it's probably a user mistake. */ error ("Invalid escape character syntax"); - case 'M': - c = READCHAR; - if (c != '-') - error ("Invalid escape character syntax"); - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - return c | meta_modifier; - - case 'S': - c = READCHAR; - if (c != '-') - error ("Invalid escape character syntax"); - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - return c | shift_modifier; - - case 'H': - c = READCHAR; - if (c != '-') - error ("Invalid escape character syntax"); - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - return c | hyper_modifier; + /* \M-x etc: set modifier bit and parse the char to which it applies, + allowing for chains such as \M-\S-\A-\H-\s-\C-q. */ + case 'M': mod = meta_modifier; goto mod_key; + case 'S': mod = shift_modifier; goto mod_key; + case 'H': mod = hyper_modifier; goto mod_key; + case 'A': mod = alt_modifier; goto mod_key; + case 's': mod = super_modifier; goto mod_key; - case 'A': - c = READCHAR; - if (c != '-') - error ("Invalid escape character syntax"); - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - return c | alt_modifier; - - case 's': - c = READCHAR; - if (c != '-') - { - UNREAD (c); - return ' '; - } - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - return c | super_modifier; + mod_key: + { + int c1 = READCHAR; + if (c1 != '-') + { + if (c == 's') + { + /* \s not followed by a hyphen is SPC. */ + UNREAD (c1); + chr = ' '; + break; + } + else + /* \M, \S, \H, \A not followed by a hyphen is an error. */ + invalid_escape_syntax_error (); + } + modifiers |= mod; + c1 = READCHAR; + if (c1 == '\\') + { + next_char = READCHAR; + goto again; + } + chr = c1; + break; + } + /* Control modifiers (\C-x or \^x) are messy and not actually idempotent. + For example, ?\C-\C-a = ?\C-\001 = 0x4000001. + Keep a count of them and apply them separately. */ case 'C': - c = READCHAR; - if (c != '-') - error ("Invalid escape character syntax"); + { + int c1 = READCHAR; + if (c1 != '-') + invalid_escape_syntax_error (); + } FALLTHROUGH; + /* The prefixes \C- and \^ are equivalent. */ case '^': - c = READCHAR; - if (c == '\\') - c = read_escape (readcharfun); - if ((c & ~CHAR_MODIFIER_MASK) == '?') - return 0177 | (c & CHAR_MODIFIER_MASK); - else if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) - return c | ctrl_modifier; - /* ASCII control chars are made from letters (both cases), - as well as the non-letters within 0100...0137. */ - else if ((c & 0137) >= 0101 && (c & 0137) <= 0132) - return (c & (037 | ~0177)); - else if ((c & 0177) >= 0100 && (c & 0177) <= 0137) - return (c & (037 | ~0177)); - else - return c | ctrl_modifier; - - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - /* An octal escape, as in ANSI C. */ { - register int i = c - '0'; - register int count = 0; - while (++count < 3) + ncontrol++; + int c1 = READCHAR; + if (c1 == '\\') { - if ((c = READCHAR) >= '0' && c <= '7') - { - i *= 8; - i += c - '0'; - } - else + next_char = READCHAR; + goto again; + } + chr = c1; + break; + } + + /* 1-3 octal digits. Values in 0x80..0xff are encoded as raw bytes. */ + case '0': case '1': case '2': case '3': + case '4': case '5': case '6': case '7': + { + int i = c - '0'; + int count = 0; + while (count < 2) + { + int c = READCHAR; + if (c < '0' || c > '7') { UNREAD (c); break; } + i = (i << 3) + (c - '0'); + count++; } if (i >= 0x80 && i < 0x100) i = BYTE8_TO_CHAR (i); - return i; + chr = i; + break; } + /* 1 or more hex digits. Values may encode modifiers. + Values in 0x80..0xff using 2 hex digits are encoded as raw bytes. */ case 'x': - /* A hex escape, as in ANSI C. */ { unsigned int i = 0; int count = 0; while (1) { - c = READCHAR; + int c = READCHAR; int digit = char_hexdigit (c); if (digit < 0) { @@ -2796,40 +2779,37 @@ read_escape (Lisp_Object readcharfun) i = (i << 4) + digit; /* Allow hex escapes as large as ?\xfffffff, because some packages use them to denote characters with modifiers. */ - if ((CHAR_META | (CHAR_META - 1)) < i) + if (i > (CHAR_META | (CHAR_META - 1))) error ("Hex character out of range: \\x%x...", i); count += count < 3; } + if (count == 0) + invalid_escape_syntax_error (); if (count < 3 && i >= 0x80) - return BYTE8_TO_CHAR (i); - return i; + i = BYTE8_TO_CHAR (i); + modifiers |= i & CHAR_MODIFIER_MASK; + chr = i & ~CHAR_MODIFIER_MASK; + break; } + /* 8-digit Unicode hex escape: \UHHHHHHHH */ case 'U': - /* Post-Unicode-2.0: Up to eight hex chars. */ unicode_hex_count = 8; - FALLTHROUGH; - case 'u': + goto unicode_hex; - /* A Unicode escape. We only permit them in strings and characters, - not arbitrarily in the source code, as in some other languages. */ + /* 4-digit Unicode hex escape: \uHHHH */ + case 'u': + unicode_hex_count = 4; + unicode_hex: { unsigned int i = 0; - int count = 0; - - while (++count <= unicode_hex_count) + for (int count = 0; count < unicode_hex_count; count++) { - c = READCHAR; + int c = READCHAR; if (c < 0) - { - if (unicode_hex_count > 4) - error ("Malformed Unicode escape: \\U%x", i); - else - error ("Malformed Unicode escape: \\u%x", i); - } - /* `isdigit' and `isalpha' may be locale-specific, which we don't - want. */ + error ("Malformed Unicode escape: \\%c%x", + unicode_hex_count == 4 ? 'u' : 'U', i); int digit = char_hexdigit (c); if (digit < 0) error ("Non-hex character used for Unicode escape: %c (%d)", @@ -2838,13 +2818,14 @@ read_escape (Lisp_Object readcharfun) } if (i > 0x10FFFF) error ("Non-Unicode character: 0x%x", i); - return i; + chr = i; + break; } + /* Named character: \N{name} */ case 'N': - /* Named character. */ { - c = READCHAR; + int c = READCHAR; if (c != '{') invalid_syntax ("Expected opening brace after \\N", readcharfun); char name[UNICODE_CHARACTER_NAME_LENGTH_BOUND + 1]; @@ -2852,12 +2833,12 @@ read_escape (Lisp_Object readcharfun) ptrdiff_t length = 0; while (true) { - c = READCHAR; + int c = READCHAR; if (c < 0) end_of_file_error (); if (c == '}') break; - if (! (0 < c && c < 0x80)) + if (c >= 0x80) { AUTO_STRING (format, "Invalid character U+%04X in character name"); @@ -2886,13 +2867,41 @@ read_escape (Lisp_Object readcharfun) name[length] = '\0'; /* character_name_to_code can invoke read0, recursively. - This is why read0's buffer is not static. */ - return character_name_to_code (name, length, readcharfun); + This is why read0 needs to be re-entrant. */ + chr = character_name_to_code (name, length, readcharfun); + break; } default: - return c; + chr = c; + break; } + eassert (chr >= 0 && chr < (1 << CHARACTERBITS)); + + /* Apply Control modifiers, using the rules: + \C-X = ascii_ctrl(nomod(X)) | mods(X) if nomod(X) is one of: + A-Z a-z ? @ [ \ ] ^ _ + + X | ctrl_modifier otherwise + + where + nomod(c) = c without modifiers + mods(c) = the modifiers of c + ascii_ctrl(c) = 127 if c = '?' + c & 0x1f otherwise + */ + while (ncontrol > 0) + { + if ((chr >= '@' && chr <= '_') || (chr >= 'a' && chr <= 'z')) + chr &= 0x1f; + else if (chr == '?') + chr = 127; + else + modifiers |= ctrl_modifier; + ncontrol--; + } + + return chr | modifiers; } /* Return the digit that CHARACTER stands for in the given BASE. @@ -3014,7 +3023,7 @@ read_char_literal (Lisp_Object readcharfun) } if (ch == '\\') - ch = read_escape (readcharfun); + ch = read_char_escape (readcharfun, READCHAR); int modifiers = ch & CHAR_MODIFIER_MASK; ch &= ~CHAR_MODIFIER_MASK; @@ -3080,8 +3089,7 @@ read_string_literal (Lisp_Object readcharfun) /* `\SPC' and `\LF' generate no characters at all. */ continue; default: - UNREAD (ch); - ch = read_escape (readcharfun); + ch = read_char_escape (readcharfun, ch); break; } diff --git a/src/macros.c b/src/macros.c index 0db0af89a71..d1541d2817f 100644 --- a/src/macros.c +++ b/src/macros.c @@ -128,9 +128,9 @@ end_kbd_macro (void) update_mode_lines = 20; kset_last_kbd_macro (current_kboard, - make_event_array ((current_kboard->kbd_macro_end - - current_kboard->kbd_macro_buffer), - current_kboard->kbd_macro_buffer)); + Fvector ((current_kboard->kbd_macro_end + - current_kboard->kbd_macro_buffer), + current_kboard->kbd_macro_buffer)); } DEFUN ("end-kbd-macro", Fend_kbd_macro, Send_kbd_macro, 0, 2, "p", diff --git a/src/module-env-29.h b/src/module-env-29.h index 6ca03773181..e69de29bb2d 100644 --- a/src/module-env-29.h +++ b/src/module-env-29.h @@ -1,3 +0,0 @@ - /* Add module environment functions newly added in Emacs 29 here. - Before Emacs 29 is released, remove this comment and start - module-env-30.h on the master branch. */ diff --git a/src/module-env-30.h b/src/module-env-30.h new file mode 100644 index 00000000000..6ca03773181 --- /dev/null +++ b/src/module-env-30.h @@ -0,0 +1,3 @@ + /* Add module environment functions newly added in Emacs 29 here. + Before Emacs 29 is released, remove this comment and start + module-env-30.h on the master branch. */ diff --git a/src/nsterm.m b/src/nsterm.m index c26528e0154..b9e3cbf81a1 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -4607,7 +4607,7 @@ ns_send_appdefined (int value) #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 static void -check_native_fs () +check_native_fs (void) { Lisp_Object frame, tail; @@ -6707,16 +6707,8 @@ ns_create_font_panel_buttons (id target, SEL select, SEL cancel_action) - (void)resetCursorRects { - NSRect visible; - NSCursor *currentCursor; - - /* On macOS 13, [resetCursorRects:] could be called even after the - window is closed. */ - if (! emacsframe || ! FRAME_OUTPUT_DATA (emacsframe)) - return; - - visible = [self visibleRect]; - currentCursor = FRAME_POINTER_TYPE (emacsframe); + NSRect visible = [self visibleRect]; + NSCursor *currentCursor = FRAME_POINTER_TYPE (emacsframe); NSTRACE ("[EmacsView resetCursorRects]"); if (currentCursor == nil) diff --git a/src/pdumper.c b/src/pdumper.c index 4809fb5dce7..339aed1f657 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2459,10 +2459,10 @@ dump_symbol (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_999DC26DEC +#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_61B174C9F4 # error "Lisp_Symbol changed. See CHECK_STRUCTS comment in config.h." #endif -#if CHECK_STRUCTS && !defined (HASH_symbol_redirect_ADB4F5B113) +#if CHECK_STRUCTS && !defined (HASH_symbol_redirect_EA72E4BFF5) # error "symbol_redirect changed. See CHECK_STRUCTS comment in config.h." #endif @@ -2862,7 +2862,7 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) DUMP_FIELD_COPY (out, buffer, inhibit_buffer_hooks); DUMP_FIELD_COPY (out, buffer, long_line_optimizations_p); - if (buffer->overlays && buffer->overlays->root != NULL) + if (!itree_empty_p (buffer->overlays)) /* We haven't implemented the code to dump overlays. */ emacs_abort (); else diff --git a/src/profiler.c b/src/profiler.c index 8247b2e90c6..6217071ef9c 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -49,7 +49,13 @@ static const struct hash_table_test hashtest_profiler = hashfn_profiler, }; -static Lisp_Object +struct profiler_log { + Lisp_Object log; + EMACS_INT gc_count; /* Samples taken during GC. */ + EMACS_INT discarded; /* Samples evicted during table overflow. */ +}; + +static struct profiler_log make_log (void) { /* We use a standard Elisp hash-table object, but we use it in @@ -60,11 +66,13 @@ make_log (void) = clip_to_bounds (0, profiler_log_size, MOST_POSITIVE_FIXNUM); ptrdiff_t max_stack_depth = clip_to_bounds (0, profiler_max_stack_depth, PTRDIFF_MAX);; - Lisp_Object log = make_hash_table (hashtest_profiler, heap_size, - DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, - Qnil, false); - struct Lisp_Hash_Table *h = XHASH_TABLE (log); + struct profiler_log log + = { make_hash_table (hashtest_profiler, heap_size, + DEFAULT_REHASH_SIZE, + DEFAULT_REHASH_THRESHOLD, + Qnil, false), + 0, 0 }; + struct Lisp_Hash_Table *h = XHASH_TABLE (log.log); /* What is special about our hash-tables is that the values are pre-filled with the vectors we'll use as keys. */ @@ -116,8 +124,9 @@ static EMACS_INT approximate_median (log_t *log, } } -static void evict_lower_half (log_t *log) +static void evict_lower_half (struct profiler_log *plog) { + log_t *log = XHASH_TABLE (plog->log); ptrdiff_t size = ASIZE (log->key_and_value) / 2; EMACS_INT median = approximate_median (log, 0, size); @@ -127,6 +136,8 @@ static void evict_lower_half (log_t *log) if (XFIXNUM (HASH_VALUE (log, i)) <= median) { Lisp_Object key = HASH_KEY (log, i); + EMACS_INT count = XFIXNUM (HASH_VALUE (log, i)); + plog->discarded = saturated_add (plog->discarded, count); { /* FIXME: we could make this more efficient. */ Lisp_Object tmp; XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */ @@ -148,12 +159,12 @@ static void evict_lower_half (log_t *log) size for memory. */ static void -record_backtrace (log_t *log, EMACS_INT count) +record_backtrace (struct profiler_log *plog, EMACS_INT count) { + eassert (HASH_TABLE_P (plog->log)); + log_t *log = XHASH_TABLE (plog->log); if (log->next_free < 0) - /* FIXME: transfer the evicted counts to a special entry rather - than dropping them on the floor. */ - evict_lower_half (log); + evict_lower_half (plog); ptrdiff_t index = log->next_free; /* Get a "working memory" vector. */ @@ -222,10 +233,10 @@ static enum profiler_cpu_running profiler_cpu_running; /* Hash-table log of CPU profiler. */ -static Lisp_Object cpu_log; +static struct profiler_log cpu; -/* Separate counter for the time spent in the GC. */ -static EMACS_INT cpu_gc_count; +/* Hash-table log of Memory profiler. */ +static struct profiler_log memory; /* The current sampling interval in nanoseconds. */ static EMACS_INT current_sampling_interval; @@ -233,30 +244,34 @@ static EMACS_INT current_sampling_interval; /* Signal handler for sampling profiler. */ static void -handle_profiler_signal (int signal) +add_sample (struct profiler_log *plog, EMACS_INT count) { - if (EQ (backtrace_top_function (), QAutomatic_GC)) + if (EQ (backtrace_top_function (), QAutomatic_GC)) /* bug#60237 */ /* Special case the time-count inside GC because the hash-table code is not prepared to be used while the GC is running. More specifically it uses ASIZE at many places where it does not expect the ARRAY_MARK_FLAG to be set. We could try and harden the hash-table code, but it doesn't seem worth the effort. */ - cpu_gc_count = saturated_add (cpu_gc_count, 1); + plog->gc_count = saturated_add (plog->gc_count, count); else - { - EMACS_INT count = 1; + record_backtrace (plog, count); +} + + +static void +handle_profiler_signal (int signal) +{ + EMACS_INT count = 1; #if defined HAVE_ITIMERSPEC && defined HAVE_TIMER_GETOVERRUN - if (profiler_timer_ok) - { - int overruns = timer_getoverrun (profiler_timer); - eassert (overruns >= 0); - count += overruns; - } -#endif - eassert (HASH_TABLE_P (cpu_log)); - record_backtrace (XHASH_TABLE (cpu_log), count); + if (profiler_timer_ok) + { + int overruns = timer_getoverrun (profiler_timer); + eassert (overruns >= 0); + count += overruns; } +#endif + add_sample (&cpu, count); } static void @@ -343,11 +358,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) if (profiler_cpu_running) error ("CPU profiler is already running"); - if (NILP (cpu_log)) - { - cpu_gc_count = 0; - cpu_log = make_log (); - } + if (NILP (cpu.log)) + cpu = make_log (); int status = setup_cpu_timer (sampling_interval); if (status < 0) @@ -409,6 +421,26 @@ DEFUN ("profiler-cpu-running-p", return profiler_cpu_running ? Qt : Qnil; } +static Lisp_Object +export_log (struct profiler_log *log) +{ + Lisp_Object result = log->log; + if (log->gc_count) + Fputhash (CALLN (Fvector, QAutomatic_GC, Qnil), + make_fixnum (log->gc_count), + result); + if (log->discarded) + Fputhash (CALLN (Fvector, QDiscarded_Samples, Qnil), + make_fixnum (log->discarded), + result); + /* Here we're making the log visible to Elisp, so it's not safe any + more for our use afterwards since we can't rely on its special + pre-allocated keys anymore. So we have to allocate a new one. */ + if (profiler_cpu_running) + *log = make_log (); + return result; +} + DEFUN ("profiler-cpu-log", Fprofiler_cpu_log, Sprofiler_cpu_log, 0, 0, 0, doc: /* Return the current cpu profiler log. @@ -418,16 +450,7 @@ of functions, where the last few elements may be nil. Before returning, a new log is allocated for future samples. */) (void) { - Lisp_Object result = cpu_log; - /* Here we're making the log visible to Elisp, so it's not safe any - more for our use afterwards since we can't rely on its special - pre-allocated keys anymore. So we have to allocate a new one. */ - cpu_log = profiler_cpu_running ? make_log () : Qnil; - Fputhash (make_vector (1, QAutomatic_GC), - make_fixnum (cpu_gc_count), - result); - cpu_gc_count = 0; - return result; + return (export_log (&cpu)); } #endif /* PROFILER_CPU_SUPPORT */ @@ -436,8 +459,6 @@ Before returning, a new log is allocated for future samples. */) /* True if memory profiler is running. */ bool profiler_memory_running; -static Lisp_Object memory_log; - DEFUN ("profiler-memory-start", Fprofiler_memory_start, Sprofiler_memory_start, 0, 0, 0, doc: /* Start/restart the memory profiler. @@ -450,8 +471,8 @@ See also `profiler-log-size' and `profiler-max-stack-depth'. */) if (profiler_memory_running) error ("Memory profiler is already running"); - if (NILP (memory_log)) - memory_log = make_log (); + if (NILP (memory.log)) + memory = make_log (); profiler_memory_running = true; @@ -490,12 +511,7 @@ of functions, where the last few elements may be nil. Before returning, a new log is allocated for future samples. */) (void) { - Lisp_Object result = memory_log; - /* Here we're making the log visible to Elisp , so it's not safe any - more for our use afterwards since we can't rely on its special - pre-allocated keys anymore. So we have to allocate a new one. */ - memory_log = profiler_memory_running ? make_log () : Qnil; - return result; + return (export_log (&memory)); } @@ -505,11 +521,7 @@ Before returning, a new log is allocated for future samples. */) void malloc_probe (size_t size) { - if (EQ (backtrace_top_function (), QAutomatic_GC)) /* bug#60237 */ - /* FIXME: We should do something like what we did with `cpu_gc_count`. */ - return; - eassert (HASH_TABLE_P (memory_log)); - record_backtrace (XHASH_TABLE (memory_log), min (size, MOST_POSITIVE_FIXNUM)); + add_sample (&memory, min (size, MOST_POSITIVE_FIXNUM)); } DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0, @@ -589,21 +601,22 @@ to make room for new entries. */); profiler_log_size = 10000; DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal"); + DEFSYM (QDiscarded_Samples, "Discarded Samples"); defsubr (&Sfunction_equal); #ifdef PROFILER_CPU_SUPPORT profiler_cpu_running = NOT_RUNNING; - cpu_log = Qnil; - staticpro (&cpu_log); + cpu.log = Qnil; + staticpro (&cpu.log); defsubr (&Sprofiler_cpu_start); defsubr (&Sprofiler_cpu_stop); defsubr (&Sprofiler_cpu_running_p); defsubr (&Sprofiler_cpu_log); #endif profiler_memory_running = false; - memory_log = Qnil; - staticpro (&memory_log); + memory.log = Qnil; + staticpro (&memory.log); defsubr (&Sprofiler_memory_start); defsubr (&Sprofiler_memory_stop); defsubr (&Sprofiler_memory_running_p); @@ -618,16 +631,16 @@ syms_of_profiler_for_pdumper (void) if (dumped_with_pdumper_p ()) { #ifdef PROFILER_CPU_SUPPORT - cpu_log = Qnil; + cpu.log = Qnil; #endif - memory_log = Qnil; + memory.log = Qnil; } else { #ifdef PROFILER_CPU_SUPPORT - eassert (NILP (cpu_log)); + eassert (NILP (cpu.log)); #endif - eassert (NILP (memory_log)); + eassert (NILP (memory.log)); } } diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 2571812cb39..746779490ad 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -47,13 +47,6 @@ /* Make syntax table lookup grant data in gl_state. */ #define SYNTAX(c) syntax_property (c, 1) -/* Convert the pointer to the char to BEG-based offset from the start. */ -#define PTR_TO_OFFSET(d) POS_AS_IN_BUFFER (POINTER_TO_OFFSET (d)) -/* Strings are 0-indexed, buffers are 1-indexed; pun on the boolean - result to get the right base index. */ -#define POS_AS_IN_BUFFER(p) \ - ((p) + (NILP (gl_state.object) || BUFFERP (gl_state.object))) - #define RE_MULTIBYTE_P(bufp) ((bufp)->multibyte) #define RE_TARGET_MULTIBYTE_P(bufp) ((bufp)->target_multibyte) #define RE_STRING_CHAR(p, multibyte) \ @@ -3258,12 +3251,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char *str1, ptrdiff_t size1, /* See whether the pattern is anchored. */ anchored_start = (bufp->buffer[0] == begline); - gl_state.object = re_match_object; /* Used by SYNTAX_TABLE_BYTE_TO_CHAR. */ - { - ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (POS_AS_IN_BUFFER (startpos)); - - SETUP_SYNTAX_TABLE_FOR_OBJECT (re_match_object, charpos, 1); - } + RE_SETUP_SYNTAX_TABLE_FOR_OBJECT (re_match_object, startpos); /* Loop through the string, looking for a place to start matching. */ for (;;) @@ -3871,10 +3859,7 @@ re_match_2 (struct re_pattern_buffer *bufp, { ptrdiff_t result; - ptrdiff_t charpos; - gl_state.object = re_match_object; /* Used by SYNTAX_TABLE_BYTE_TO_CHAR. */ - charpos = SYNTAX_TABLE_BYTE_TO_CHAR (POS_AS_IN_BUFFER (pos)); - SETUP_SYNTAX_TABLE_FOR_OBJECT (re_match_object, charpos, 1); + RE_SETUP_SYNTAX_TABLE_FOR_OBJECT (re_match_object, pos); result = re_match_2_internal (bufp, (re_char *) string1, size1, (re_char *) string2, size2, @@ -4806,8 +4791,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp, int c1, c2; int s1, s2; int dummy; - ptrdiff_t offset = PTR_TO_OFFSET (d); - ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; + ptrdiff_t offset = POINTER_TO_OFFSET (d); + ptrdiff_t charpos = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; UPDATE_SYNTAX_TABLE (charpos); GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); nchars++; @@ -4846,8 +4831,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp, int c1, c2; int s1, s2; int dummy; - ptrdiff_t offset = PTR_TO_OFFSET (d); - ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); + ptrdiff_t offset = POINTER_TO_OFFSET (d); + ptrdiff_t charpos = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset); UPDATE_SYNTAX_TABLE (charpos); PREFETCH (); GET_CHAR_AFTER (c2, d, dummy); @@ -4889,8 +4874,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp, int c1, c2; int s1, s2; int dummy; - ptrdiff_t offset = PTR_TO_OFFSET (d); - ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; + ptrdiff_t offset = POINTER_TO_OFFSET (d); + ptrdiff_t charpos = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; UPDATE_SYNTAX_TABLE (charpos); GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); nchars++; @@ -4931,8 +4916,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp, is the character at D, and S2 is the syntax of C2. */ int c1, c2; int s1, s2; - ptrdiff_t offset = PTR_TO_OFFSET (d); - ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); + ptrdiff_t offset = POINTER_TO_OFFSET (d); + ptrdiff_t charpos = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset); UPDATE_SYNTAX_TABLE (charpos); PREFETCH (); c2 = RE_STRING_CHAR (d, target_multibyte); @@ -4972,8 +4957,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp, is the character at D, and S2 is the syntax of C2. */ int c1, c2; int s1, s2; - ptrdiff_t offset = PTR_TO_OFFSET (d); - ptrdiff_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; + ptrdiff_t offset = POINTER_TO_OFFSET (d); + ptrdiff_t charpos = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset) - 1; UPDATE_SYNTAX_TABLE (charpos); GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); nchars++; @@ -5008,8 +4993,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp, mcnt); PREFETCH (); { - ptrdiff_t offset = PTR_TO_OFFSET (d); - ptrdiff_t pos1 = SYNTAX_TABLE_BYTE_TO_CHAR (offset); + ptrdiff_t offset = POINTER_TO_OFFSET (d); + ptrdiff_t pos1 = RE_SYNTAX_TABLE_BYTE_TO_CHAR (offset); UPDATE_SYNTAX_TABLE (pos1); } { diff --git a/src/regex-emacs.h b/src/regex-emacs.h index 1bc973363e9..bc357633135 100644 --- a/src/regex-emacs.h +++ b/src/regex-emacs.h @@ -187,7 +187,8 @@ typedef enum { RECC_ERROR = 0, RECC_DIGIT, RECC_XDIGIT, RECC_BLANK, RECC_SPACE, RECC_MULTIBYTE, RECC_NONASCII, - RECC_ASCII, RECC_UNIBYTE + RECC_ASCII, RECC_UNIBYTE, + RECC_NUM_CLASSES = RECC_UNIBYTE } re_wctype_t; extern bool re_iswctype (int ch, re_wctype_t cc); diff --git a/src/syntax.c b/src/syntax.c index 79e16f652f3..839ab36bb2f 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -178,14 +178,14 @@ static ptrdiff_t find_start_begv; static modiff_count find_start_modiff; -static Lisp_Object skip_chars (bool, Lisp_Object, Lisp_Object, bool); +static Lisp_Object skip_chars (bool, Lisp_Object, Lisp_Object); static Lisp_Object skip_syntaxes (bool, Lisp_Object, Lisp_Object); static Lisp_Object scan_lists (EMACS_INT, EMACS_INT, EMACS_INT, bool); static void scan_sexps_forward (struct lisp_parse_state *, ptrdiff_t, ptrdiff_t, ptrdiff_t, EMACS_INT, bool, int); static void internalize_parse_state (Lisp_Object, struct lisp_parse_state *); -static bool in_classes (int, Lisp_Object); +static bool in_classes (int c, int num_classes, const unsigned char *classes); static void parse_sexp_propertize (ptrdiff_t charpos); /* This setter is used only in this file, so it can be private. */ @@ -250,7 +250,6 @@ SETUP_SYNTAX_TABLE (ptrdiff_t from, ptrdiff_t count) gl_state.b_property = BEGV; gl_state.e_property = ZV + 1; gl_state.object = Qnil; - gl_state.offset = 0; if (parse_sexp_lookup_properties) { if (count > 0) @@ -266,46 +265,38 @@ SETUP_SYNTAX_TABLE (ptrdiff_t from, ptrdiff_t count) /* Same as above, but in OBJECT. If OBJECT is nil, use current buffer. If it is t (which is only used in fast_c_string_match_ignore_case), ignore properties altogether. - - This is meant for regex-emacs.c to use. For buffers, regex-emacs.c - passes arguments to the UPDATE_SYNTAX_TABLE functions which are - relative to BEGV. So if it is a buffer, we set the offset field to - BEGV. */ + FROMBYTE is an regexp-byteoffset. */ void -SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object object, - ptrdiff_t from, ptrdiff_t count) +RE_SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object object, + ptrdiff_t frombyte) { SETUP_BUFFER_SYNTAX_TABLE (); gl_state.object = object; if (BUFFERP (gl_state.object)) { struct buffer *buf = XBUFFER (gl_state.object); - gl_state.b_property = 1; - gl_state.e_property = BUF_ZV (buf) - BUF_BEGV (buf) + 1; - gl_state.offset = BUF_BEGV (buf) - 1; + gl_state.b_property = BEG; + gl_state.e_property = BUF_ZV (buf); } else if (NILP (gl_state.object)) { - gl_state.b_property = 1; - gl_state.e_property = ZV - BEGV + 1; - gl_state.offset = BEGV - 1; + gl_state.b_property = BEG; + gl_state.e_property = ZV; /* FIXME: Why not +1 like in SETUP_SYNTAX_TABLE? */ } else if (EQ (gl_state.object, Qt)) { gl_state.b_property = 0; gl_state.e_property = PTRDIFF_MAX; - gl_state.offset = 0; } else { gl_state.b_property = 0; gl_state.e_property = 1 + SCHARS (gl_state.object); - gl_state.offset = 0; } if (parse_sexp_lookup_properties) - update_syntax_table (from + gl_state.offset - (count <= 0), - count, 1, gl_state.object); + update_syntax_table (RE_SYNTAX_TABLE_BYTE_TO_CHAR (frombyte), + 1, 1, gl_state.object); } /* Update gl_state to an appropriate interval which contains CHARPOS. The @@ -341,8 +332,8 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init, if (!i) return; i = gl_state.forward_i; - gl_state.b_property = i->position - gl_state.offset; - gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset; + gl_state.b_property = i->position; + gl_state.e_property = INTERVAL_LAST_POS (i); } else { @@ -362,7 +353,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init, { invalidate = false; gl_state.forward_i = i; - gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset; + gl_state.e_property = INTERVAL_LAST_POS (i); } } else if (charpos >= INTERVAL_LAST_POS (i)) /* Move right. */ @@ -375,7 +366,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init, { invalidate = false; gl_state.backward_i = i; - gl_state.b_property = i->position - gl_state.offset; + gl_state.b_property = i->position; } } } @@ -391,12 +382,12 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init, if (count > 0) { gl_state.backward_i = i; - gl_state.b_property = i->position - gl_state.offset; + gl_state.b_property = i->position; } else { gl_state.forward_i = i; - gl_state.e_property = INTERVAL_LAST_POS (i) - gl_state.offset; + gl_state.e_property = INTERVAL_LAST_POS (i); } } @@ -426,13 +417,13 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init, { if (count > 0) { - gl_state.e_property = i->position - gl_state.offset; + gl_state.e_property = i->position; gl_state.forward_i = i; } else { gl_state.b_property - = i->position + LENGTH (i) - gl_state.offset; + = i->position + LENGTH (i); gl_state.backward_i = i; } return; @@ -442,7 +433,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init, if (count > 0) { gl_state.e_property - = i->position + LENGTH (i) - gl_state.offset + = i->position + LENGTH (i) /* e_property at EOB is not set to ZV but to ZV+1, so that we can do INC(from);UPDATE_SYNTAX_TABLE_FORWARD without having to check eob between the two. */ @@ -451,7 +442,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init, } else { - gl_state.b_property = i->position - gl_state.offset; + gl_state.b_property = i->position; gl_state.backward_i = i; } return; @@ -1616,7 +1607,7 @@ Char classes, e.g. `[:alpha:]', are supported. Returns the distance traveled, either zero or positive. */) (Lisp_Object string, Lisp_Object lim) { - return skip_chars (1, string, lim, 1); + return skip_chars (1, string, lim); } DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0, @@ -1625,7 +1616,7 @@ See `skip-chars-forward' for details. Returns the distance traveled, either zero or negative. */) (Lisp_Object string, Lisp_Object lim) { - return skip_chars (0, string, lim, 1); + return skip_chars (0, string, lim); } DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0, @@ -1652,8 +1643,7 @@ of this is the distance traveled. */) } static Lisp_Object -skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, - bool handle_iso_classes) +skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim) { int c; char fastmap[0400]; @@ -1670,11 +1660,9 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, ptrdiff_t size_byte; const unsigned char *str; int len; - Lisp_Object iso_classes; USE_SAFE_ALLOCA; CHECK_STRING (string); - iso_classes = Qnil; if (NILP (lim)) XSETINT (lim, forwardp ? ZV : BEGV); @@ -1709,6 +1697,8 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, If STRING contains non-ASCII characters, setup char_ranges for them and use fastmap only for their leading codes. */ + int nclasses = 0; + unsigned char classes[RECC_NUM_CLASSES]; if (! string_multibyte) { bool string_has_eight_bit = 0; @@ -1716,18 +1706,16 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, /* At first setup fastmap. */ while (i_byte < size_byte) { - if (handle_iso_classes) + const unsigned char *ch = str + i_byte; + re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte); + if (cc == 0) + error ("Invalid ISO C character class"); + if (cc != -1) { - const unsigned char *ch = str + i_byte; - re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte); - if (cc == 0) - error ("Invalid ISO C character class"); - if (cc != -1) - { - iso_classes = Fcons (make_fixnum (cc), iso_classes); - i_byte = ch - str; - continue; - } + if (!(nclasses && memchr (classes, cc, nclasses))) + classes[nclasses++] = cc; + i_byte = ch - str; + continue; } c = str[i_byte++]; @@ -1812,18 +1800,16 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, { int leading_code = str[i_byte]; - if (handle_iso_classes) + const unsigned char *ch = str + i_byte; + re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte); + if (cc == 0) + error ("Invalid ISO C character class"); + if (cc != -1) { - const unsigned char *ch = str + i_byte; - re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte); - if (cc == 0) - error ("Invalid ISO C character class"); - if (cc != -1) - { - iso_classes = Fcons (make_fixnum (cc), iso_classes); - i_byte = ch - str; - continue; - } + if (!(nclasses && memchr (classes, cc, nclasses))) + classes[nclasses++] = cc; + i_byte = ch - str; + continue; } if (leading_code== '\\') @@ -1969,7 +1955,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, stop = endp; } c = string_char_and_length (p, &nbytes); - if (! NILP (iso_classes) && in_classes (c, iso_classes)) + if (nclasses && in_classes (c, nclasses, classes)) { if (negate) break; @@ -2010,7 +1996,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, stop = endp; } - if (!NILP (iso_classes) && in_classes (*p, iso_classes)) + if (nclasses && in_classes (*p, nclasses, classes)) { if (negate) break; @@ -2044,7 +2030,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, c = STRING_CHAR (p); - if (! NILP (iso_classes) && in_classes (c, iso_classes)) + if (nclasses && in_classes (c, nclasses, classes)) { if (negate) break; @@ -2078,7 +2064,7 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim, stop = endp; } - if (! NILP (iso_classes) && in_classes (p[-1], iso_classes)) + if (nclasses && in_classes (p[-1], nclasses, classes)) { if (negate) break; @@ -2201,8 +2187,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) while (!parse_sexp_lookup_properties || pos < gl_state.e_property); - update_syntax_table_forward (pos + gl_state.offset, - false, gl_state.object); + update_syntax_table_forward (pos, false, gl_state.object); } } else @@ -2263,26 +2248,16 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim) } } -/* Return true if character C belongs to one of the ISO classes - in the list ISO_CLASSES. Each class is represented by an - integer which is its type according to re_wctype. */ +/* Return true if character C belongs to one of the ISO classes in the + array. */ static bool -in_classes (int c, Lisp_Object iso_classes) +in_classes (int c, int nclasses, const unsigned char *classes) { - bool fits_class = 0; - - while (CONSP (iso_classes)) - { - Lisp_Object elt; - elt = XCAR (iso_classes); - iso_classes = XCDR (iso_classes); - - if (re_iswctype (c, XFIXNAT (elt))) - fits_class = 1; - } - - return fits_class; + for (int i = 0; i < nclasses; i++) + if (re_iswctype (c, classes[i])) + return true; + return false; } /* Jump over a comment, assuming we are at the beginning of one. diff --git a/src/syntax.h b/src/syntax.h index 9eb8701628b..01982be25a0 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -85,8 +85,6 @@ struct gl_state_s and possibly at the intervals too, depending on: */ - /* Offset for positions specified to UPDATE_SYNTAX_TABLE. */ - ptrdiff_t offset; }; extern struct gl_state_s gl_state; @@ -147,28 +145,27 @@ extern bool syntax_prefix_flag_p (int c); extern unsigned char const syntax_spec_code[0400]; -/* Convert the byte offset BYTEPOS into a character position, - for the object recorded in gl_state with SETUP_SYNTAX_TABLE_FOR_OBJECT. +/* Convert the regexp's BYTEOFFSET into a character position, + for the object recorded in gl_state with RE_SETUP_SYNTAX_TABLE_FOR_OBJECT. The value is meant for use in code that does nothing when parse_sexp_lookup_properties is false, so return 0 in that case, for speed. */ INLINE ptrdiff_t -SYNTAX_TABLE_BYTE_TO_CHAR (ptrdiff_t bytepos) +RE_SYNTAX_TABLE_BYTE_TO_CHAR (ptrdiff_t byteoffset) { return (! parse_sexp_lookup_properties ? 0 : STRINGP (gl_state.object) - ? string_byte_to_char (gl_state.object, bytepos) + ? string_byte_to_char (gl_state.object, byteoffset) : BUFFERP (gl_state.object) ? ((buf_bytepos_to_charpos (XBUFFER (gl_state.object), - (bytepos + BUF_BEGV_BYTE (XBUFFER (gl_state.object)) - 1))) - - BUF_BEGV (XBUFFER (gl_state.object)) + 1) + (byteoffset + BUF_BEGV_BYTE (XBUFFER (gl_state.object)))))) : NILP (gl_state.object) - ? BYTE_TO_CHAR (bytepos + BEGV_BYTE - 1) - BEGV + 1 - : bytepos); + ? BYTE_TO_CHAR (byteoffset + BEGV_BYTE) + : byteoffset); } /* Make syntax table state (gl_state) good for CHARPOS, assuming it is @@ -178,8 +175,7 @@ INLINE void UPDATE_SYNTAX_TABLE_FORWARD (ptrdiff_t charpos) { /* Performs just-in-time syntax-propertization. */ if (parse_sexp_lookup_properties && charpos >= gl_state.e_property) - update_syntax_table_forward (charpos + gl_state.offset, - false, gl_state.object); + update_syntax_table_forward (charpos, false, gl_state.object); } /* Make syntax table state (gl_state) good for CHARPOS, assuming it is @@ -189,7 +185,7 @@ INLINE void UPDATE_SYNTAX_TABLE_BACKWARD (ptrdiff_t charpos) { if (parse_sexp_lookup_properties && charpos < gl_state.b_property) - update_syntax_table (charpos + gl_state.offset, -1, false, gl_state.object); + update_syntax_table (charpos, -1, false, gl_state.object); } /* Make syntax table good for CHARPOS. */ @@ -212,7 +208,7 @@ SETUP_BUFFER_SYNTAX_TABLE (void) } extern ptrdiff_t scan_words (ptrdiff_t, EMACS_INT); -extern void SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object, ptrdiff_t, ptrdiff_t); +extern void RE_SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object, ptrdiff_t); INLINE_HEADER_END diff --git a/src/sysdep.c b/src/sysdep.c index 7bac3d8935a..443602a2d6d 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2660,10 +2660,11 @@ emacs_perror (char const *message) int renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst) { -#if defined SYS_renameat2 && defined RENAME_NOREPLACE - return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE); -#elif defined CYGWIN && defined RENAME_NOREPLACE +#if HAVE_RENAMEAT2 && defined RENAME_NOREPLACE return renameat2 (srcfd, src, dstfd, dst, RENAME_NOREPLACE); +#elif defined SYS_renameat2 && defined RENAME_NOREPLACE + /* Linux kernel 3.15 (2014) or later, with glibc 2.27 (2018) or earlier. */ + return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE); #elif defined RENAME_EXCL return renameatx_np (srcfd, src, dstfd, dst, RENAME_EXCL); #else diff --git a/src/textconv.c b/src/textconv.c new file mode 100644 index 00000000000..d5db6d11717 --- /dev/null +++ b/src/textconv.c @@ -0,0 +1,313 @@ +/* String conversion support for graphics terminals. + +Copyright (C) 2023 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/>. */ + +/* String conversion support. + + Many input methods require access to text surrounding the cursor. + They may then request that the text editor remove or substitute + that text for something else, for example when providing the + ability to ``undo'' or ``edit'' previously composed text. This is + most commonly seen in input methods for CJK laguages for X Windows, + and is extensively used throughout Android by input methods for all + kinds of scripts. */ + +#include <config.h> + +#include "textconv.h" +#include "buffer.h" +#include "syntax.h" + + + +/* The window system's text conversion interface. + NULL when the window system has not set up text conversion. + + This interface will later be heavily extended on the + feature/android branch to deal with Android's much less + straightforward text conversion protocols. */ + +static struct textconv_interface *text_interface; + + + +/* Copy the portion of the current buffer described by BEG, BEG_BYTE, + END, END_BYTE to the buffer BUFFER, which is END_BYTE - BEG_BYTEs + long. */ + +static void +copy_buffer (ptrdiff_t beg, ptrdiff_t beg_byte, + ptrdiff_t end, ptrdiff_t end_byte, + char *buffer) +{ + ptrdiff_t beg0, end0, beg1, end1, size; + + if (beg_byte < GPT_BYTE && GPT_BYTE < end_byte) + { + /* Two regions, before and after the gap. */ + beg0 = beg_byte; + end0 = GPT_BYTE; + beg1 = GPT_BYTE + GAP_SIZE - BEG_BYTE; + end1 = end_byte + GAP_SIZE - BEG_BYTE; + } + else + { + /* The only region. */ + beg0 = beg_byte; + end0 = end_byte; + beg1 = -1; + end1 = -1; + } + + size = end0 - beg0; + memcpy (buffer, BYTE_POS_ADDR (beg0), size); + if (beg1 != -1) + memcpy (buffer, BEG_ADDR + beg1, end1 - beg1); +} + + + +/* Conversion query. */ + +/* Perform the text conversion operation specified in QUERY and return + the results. + + Find the text between QUERY->position from point on F's selected + window and QUERY->factor times QUERY->direction from that + position. Return it in QUERY->text. + + Then, either delete that text from the buffer if QUERY->operation + is TEXTCONV_SUBSTITUTION, or return 0. + + Value is 0 if QUERY->operation was not TEXTCONV_SUBSTITUTION + or if deleting the text was successful, and 1 otherwise. */ + +int +textconv_query (struct frame *f, struct textconv_callback_struct *query) +{ + specpdl_ref count; + ptrdiff_t pos, pos_byte, end, end_byte; + ptrdiff_t temp, temp1; + char *buffer; + + /* Save the excursion, as there will be extensive changes to the + selected window. */ + count = SPECPDL_INDEX (); + record_unwind_protect_excursion (); + + /* Inhibit quitting. */ + specbind (Qinhibit_quit, Qt); + + /* Temporarily switch to F's selected window. */ + Fselect_window (f->selected_window, Qt); + + /* Now find the appropriate text bounds for QUERY. First, move + point QUERY->position steps forward or backwards. */ + + pos = PT; + + /* If pos is outside the accessible part of the buffer or if it + overflows, move back to point or to the extremes of the + accessible region. */ + + if (INT_ADD_WRAPV (pos, query->position, &pos)) + pos = PT; + + if (pos < BEGV) + pos = BEGV; + + if (pos > ZV) + pos = ZV; + + /* Move to pos. */ + set_point (pos); + pos = PT; + pos_byte = PT_BYTE; + + /* Now scan forward or backwards according to what is in QUERY. */ + + switch (query->direction) + { + case TEXTCONV_FORWARD_CHAR: + /* Move forward by query->factor characters. */ + if (INT_ADD_WRAPV (pos, query->factor, &end) || end > ZV) + end = ZV; + + end_byte = CHAR_TO_BYTE (end); + break; + + case TEXTCONV_BACKWARD_CHAR: + /* Move backward by query->factor characters. */ + if (INT_SUBTRACT_WRAPV (pos, query->factor, &end) || end < BEGV) + end = BEGV; + + end_byte = CHAR_TO_BYTE (end); + break; + + case TEXTCONV_FORWARD_WORD: + /* Move forward by query->factor word. */ + end = scan_words (pos, (EMACS_INT) query->factor); + + if (!end) + { + end = ZV; + end_byte = ZV_BYTE; + } + else + end_byte = CHAR_TO_BYTE (end); + + break; + + case TEXTCONV_BACKWARD_WORD: + /* Move backwards by query->factor word. */ + end = scan_words (pos, 0 - (EMACS_INT) query->factor); + + if (!end) + { + end = BEGV; + end_byte = BEGV_BYTE; + } + else + end_byte = CHAR_TO_BYTE (end); + + break; + + case TEXTCONV_CARET_UP: + /* Move upwards one visual line, keeping the column intact. */ + Fvertical_motion (Fcons (Fcurrent_column (), make_fixnum (-1)), + Qnil, Qnil); + end = PT; + end_byte = PT_BYTE; + break; + + case TEXTCONV_CARET_DOWN: + /* Move downwards one visual line, keeping the column + intact. */ + Fvertical_motion (Fcons (Fcurrent_column (), make_fixnum (1)), + Qnil, Qnil); + end = PT; + end_byte = PT_BYTE; + break; + + case TEXTCONV_NEXT_LINE: + /* Move one line forward. */ + scan_newline (pos, pos_byte, ZV, ZV_BYTE, + query->factor, false); + end = PT; + end_byte = PT_BYTE; + break; + + case TEXTCONV_PREVIOUS_LINE: + /* Move one line backwards. */ + scan_newline (pos, pos_byte, BEGV, BEGV_BYTE, + 0 - (EMACS_INT) query->factor, false); + end = PT; + end_byte = PT_BYTE; + break; + + case TEXTCONV_LINE_START: + /* Move to the beginning of the line. */ + Fbeginning_of_line (Qnil); + end = PT; + end_byte = PT_BYTE; + break; + + case TEXTCONV_LINE_END: + /* Move to the end of the line. */ + Fend_of_line (Qnil); + end = PT; + end_byte = PT_BYTE; + break; + + case TEXTCONV_ABSOLUTE_POSITION: + /* How to implement this is unclear. */ + SET_PT (query->factor); + end = PT; + end_byte = PT_BYTE; + break; + + default: + unbind_to (count, Qnil); + return 1; + } + + /* Sort end and pos. */ + + if (end < pos) + { + eassert (end_byte < pos_byte); + temp = pos_byte; + temp1 = pos; + pos_byte = end_byte; + pos = end; + end = temp1; + end_byte = temp; + } + + /* Return the string first. */ + buffer = xmalloc (end_byte - pos_byte); + copy_buffer (pos, pos_byte, end, end_byte, buffer); + query->text.text = buffer; + query->text.length = end - pos; + query->text.bytes = end_byte - pos_byte; + + /* Next, perform any operation specified. */ + + switch (query->operation) + { + case TEXTCONV_SUBSTITUTION: + if (safe_del_range (pos, end)) + { + /* Undo any changes to the excursion. */ + unbind_to (count, Qnil); + return 1; + } + + default: + break; + } + + /* Undo any changes to the excursion. */ + unbind_to (count, Qnil); + return 0; +} + + + +/* Window system interface. These are called from the rest of + Emacs. */ + +/* Notice that F's selected window has been set from redisplay. + Reset F's input method state. */ + +void +report_selected_window_change (struct frame *f) +{ + if (!text_interface) + return; + + text_interface->reset (f); +} + +/* Register INTERFACE as the text conversion interface. */ + +void +register_texconv_interface (struct textconv_interface *interface) +{ + text_interface = interface; +} diff --git a/src/textconv.h b/src/textconv.h new file mode 100644 index 00000000000..f6e7eb7925f --- /dev/null +++ b/src/textconv.h @@ -0,0 +1,109 @@ +/* String conversion support for graphics terminals. + +Copyright (C) 2023 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/>. */ + +#ifndef _TEXTCONV_H_ + +#include "lisp.h" +#include "frame.h" + +/* The function pointers in this structure should be filled out by + each GUI backend interested in supporting text conversion. + + Finally, register_texconv_interface must be called at some point + during terminal initialization. */ + +struct textconv_interface +{ + /* Notice that the text conversion context has changed (which can + happen if the window is deleted or switches buffers, or an + unexpected buffer change occurs.) */ + void (*reset) (struct frame *); +}; + + + +enum textconv_caret_direction + { + TEXTCONV_FORWARD_CHAR, + TEXTCONV_BACKWARD_CHAR, + TEXTCONV_FORWARD_WORD, + TEXTCONV_BACKWARD_WORD, + TEXTCONV_CARET_UP, + TEXTCONV_CARET_DOWN, + TEXTCONV_NEXT_LINE, + TEXTCONV_PREVIOUS_LINE, + TEXTCONV_LINE_START, + TEXTCONV_LINE_END, + TEXTCONV_ABSOLUTE_POSITION, + }; + +enum textconv_operation + { + TEXTCONV_SUBSTITUTION, + TEXTCONV_RETRIEVAL, + }; + +/* Structure describing text in a buffer corresponding to a ``struct + textconv_callback_struct''. */ + +struct textconv_conversion_text +{ + /* Length of the text in characters and bytes. */ + size_t length, bytes; + + /* Pointer to the text data. This must be deallocated by the + caller. */ + char *text; +}; + +/* Structure describing a single query submitted by the input + method. */ + +struct textconv_callback_struct +{ + /* Character position, relative to the current spot location, from + where on text should be returned. */ + EMACS_INT position; + + /* The type of scanning to perform to determine either the start or + the end of the conversion. */ + enum textconv_caret_direction direction; + + /* The the number of times for which to repeat the scanning in order + to determine the starting position of the text to return. */ + unsigned short factor; + + /* The operation to perform upon the current buffer contents. + + If this is TEXTCONV_SUBSTITUTION, then the text that is returned + will be deleted from the buffer itself. + + Otherwise, the text is simply returned without modifying the + buffer contents. */ + enum textconv_operation operation; + + /* Structure that will be filled with a description of the resulting + text. */ + struct textconv_conversion_text text; +}; + +extern int textconv_query (struct frame *, struct textconv_callback_struct *); +extern void register_texconv_interface (struct textconv_interface *); + +#endif /* _TEXTCONV_H_ */ diff --git a/src/treesit.c b/src/treesit.c index 705ef6af39f..0af0e347694 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -424,10 +424,17 @@ static Lisp_Object Vtreesit_str_match; static Lisp_Object Vtreesit_str_pred; /* This is the limit on recursion levels for some tree-sitter - functions. Remember to update docstrings when changing this - value. */ -const ptrdiff_t treesit_recursion_limit = 1000; -bool treesit_initialized = false; + functions. Remember to update docstrings when changing this value. + + If we think of programs and AST, it is very rare for any program to + have a very deep AST. For example, you would need 1000+ levels of + nested if-statements, or a struct somehow nested for 1000+ levels. + It’s hard for me to imagine any hand-written or machine generated + program to be like that. So I think 1000 is already generous. If + we look at xdisp.c, its AST only have 30 levels. */ +#define TREESIT_RECURSION_LIMIT 1000 + +static bool treesit_initialized = false; static bool load_tree_sitter_if_necessary (bool required) @@ -481,40 +488,47 @@ treesit_initialize (void) static void treesit_symbol_to_c_name (char *symbol_name) { - for (int idx = 0; idx < strlen (symbol_name); idx++) + size_t len = strlen (symbol_name); + for (int idx = 0; idx < len; idx++) { if (symbol_name[idx] == '-') symbol_name[idx] = '_'; } } +/* Find the override name for LANGUAGE_SYMBOL in + treesit-load-name-override-list. Set NAME and C_SYMBOL to the + override name, and return true if there exists one, otherwise + return false. + + This function may signal if treesit-load-name-override-list is + malformed. */ static bool treesit_find_override_name (Lisp_Object language_symbol, Lisp_Object *name, Lisp_Object *c_symbol) { - Lisp_Object tem; - CHECK_LIST (Vtreesit_load_name_override_list); + Lisp_Object tail = Vtreesit_load_name_override_list; - tem = Vtreesit_load_name_override_list; - - FOR_EACH_TAIL (tem) + FOR_EACH_TAIL (tail) { - Lisp_Object lang = XCAR (XCAR (tem)); + Lisp_Object entry = XCAR (tail); + CHECK_LIST (entry); + Lisp_Object lang = XCAR (entry); CHECK_SYMBOL (lang); if (EQ (lang, language_symbol)) { - *name = Fnth (make_fixnum (1), XCAR (tem)); + *name = Fnth (make_fixnum (1), entry); CHECK_STRING (*name); - *c_symbol = Fnth (make_fixnum (2), XCAR (tem)); + *c_symbol = Fnth (make_fixnum (2), entry); CHECK_STRING (*c_symbol); return true; } } - CHECK_LIST_END (tem, Vtreesit_load_name_override_list); + CHECK_LIST_END (tail, Vtreesit_load_name_override_list); return false; } @@ -1635,6 +1649,9 @@ buffer. */) TSRange *treesit_ranges = xmalloc (sizeof (TSRange) * len); struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer); + /* We can use XFUXNUM, XCAR, XCDR freely because we have checked + the input by treesit_check_range_argument. */ + for (int idx = 0; !NILP (ranges); idx++, ranges = XCDR (ranges)) { Lisp_Object range = XCAR (ranges); @@ -1655,9 +1672,6 @@ buffer. */) } success = ts_parser_set_included_ranges (XTS_PARSER (parser)->parser, treesit_ranges, len); - /* Although XFIXNUM could signal, it should be impossible - because we have checked the input by treesit_check_range_argument. - So there is no need for unwind-protect. */ xfree (treesit_ranges); } @@ -1978,19 +1992,19 @@ live. */) TSNode treesit_node = XTS_NODE (node)->node; bool result; - if (EQ (property, Qoutdated)) + if (BASE_EQ (property, Qoutdated)) return treesit_node_uptodate_p (node) ? Qnil : Qt; treesit_check_node (node); - if (EQ (property, Qnamed)) + if (BASE_EQ (property, Qnamed)) result = ts_node_is_named (treesit_node); - else if (EQ (property, Qmissing)) + else if (BASE_EQ (property, Qmissing)) result = ts_node_is_missing (treesit_node); - else if (EQ (property, Qextra)) + else if (BASE_EQ (property, Qextra)) result = ts_node_is_extra (treesit_node); - else if (EQ (property, Qhas_error)) + else if (BASE_EQ (property, Qhas_error)) result = ts_node_has_error (treesit_node); - else if (EQ (property, Qlive)) + else if (BASE_EQ (property, Qlive)) result = treesit_parser_live_p (XTS_NODE (node)->parser); else signal_error ("Expecting `named', `missing', `extra', " @@ -2309,19 +2323,19 @@ PATTERN can be See Info node `(elisp)Pattern Matching' for detailed explanation. */) (Lisp_Object pattern) { - if (EQ (pattern, QCanchor)) + if (BASE_EQ (pattern, QCanchor)) return Vtreesit_str_dot; - if (EQ (pattern, intern_c_string (":?"))) + if (BASE_EQ (pattern, QCquestion)) return Vtreesit_str_question_mark; - if (EQ (pattern, intern_c_string (":*"))) + if (BASE_EQ (pattern, QCstar)) return Vtreesit_str_star; - if (EQ (pattern, intern_c_string (":+"))) + if (BASE_EQ (pattern, QCplus)) return Vtreesit_str_plus; - if (EQ (pattern, QCequal)) + if (BASE_EQ (pattern, QCequal)) return Vtreesit_str_pound_equal; - if (EQ (pattern, QCmatch)) + if (BASE_EQ (pattern, QCmatch)) return Vtreesit_str_pound_match; - if (EQ (pattern, QCpred)) + if (BASE_EQ (pattern, QCpred)) return Vtreesit_str_pound_pred; Lisp_Object opening_delimeter = VECTORP (pattern) @@ -2423,87 +2437,111 @@ treesit_predicates_for_pattern (TSQuery *query, uint32_t pattern_index) return Fnreverse (result); } -/* Translate a capture NAME (symbol) to a node. - Signals treesit-query-error if such node is not captured. */ -static Lisp_Object +/* Translate a capture NAME (symbol) to a node. If everything goes + fine, set NODE and return true; if error occurs (e.g., when there + is no node for the capture name), set NODE to Qnil, SIGNAL_DATA to + a suitable signal data, and return false. */ +static bool treesit_predicate_capture_name_to_node (Lisp_Object name, - struct capture_range captures) + struct capture_range captures, + Lisp_Object *node, + Lisp_Object *signal_data) { - Lisp_Object node = Qnil; + *node = Qnil; for (Lisp_Object tail = captures.start; !EQ (tail, captures.end); tail = XCDR (tail)) { if (EQ (XCAR (XCAR (tail)), name)) { - node = XCDR (XCAR (tail)); + *node = XCDR (XCAR (tail)); break; } } - if (NILP (node)) - xsignal3 (Qtreesit_query_error, - build_string ("Cannot find captured node"), - name, build_string ("A predicate can only refer" - " to captured nodes in the " - "same pattern")); - return node; + if (NILP (*node)) + { + *signal_data = list3 (build_string ("Cannot find captured node"), + name, build_string ("A predicate can only refer" + " to captured nodes in the " + "same pattern")); + return false; + } + return true; } /* Translate a capture NAME (symbol) to the text of the captured node. - Signals treesit-query-error if such node is not captured. */ -static Lisp_Object + If everything goes fine, set TEXT to the text and return true; + otherwise set TEXT to Qnil and set SIGNAL_DATA to a suitable signal + data. */ +static bool treesit_predicate_capture_name_to_text (Lisp_Object name, - struct capture_range captures) + struct capture_range captures, + Lisp_Object *text, + Lisp_Object *signal_data) { - Lisp_Object node = treesit_predicate_capture_name_to_node (name, captures); + Lisp_Object node = Qnil; + if (!treesit_predicate_capture_name_to_node (name, captures, &node, signal_data)) + return false; struct buffer *old_buffer = current_buffer; set_buffer_internal (XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer)); - Lisp_Object text = Fbuffer_substring (Ftreesit_node_start (node), - Ftreesit_node_end (node)); + *text = Fbuffer_substring (Ftreesit_node_start (node), + Ftreesit_node_end (node)); set_buffer_internal (old_buffer); - return text; + return true; } /* Handles predicate (#equal A B). Return true if A equals B; return false otherwise. A and B can be either string, or a capture name. The capture name evaluates to the text its captured node spans in - the buffer. */ + the buffer. If everything goes fine, don't touch SIGNAL_DATA; if + error occurs, set it to a suitable signal data. */ static bool -treesit_predicate_equal (Lisp_Object args, struct capture_range captures) +treesit_predicate_equal (Lisp_Object args, struct capture_range captures, + Lisp_Object *signal_data) { if (XFIXNUM (Flength (args)) != 2) - xsignal2 (Qtreesit_query_error, - build_string ("Predicate `equal' requires " - "two arguments but only given"), - Flength (args)); - + { + *signal_data = list2 (build_string ("Predicate `equal' requires " + "two arguments but only given"), + Flength (args)); + return false; + } Lisp_Object arg1 = XCAR (args); Lisp_Object arg2 = XCAR (XCDR (args)); - Lisp_Object text1 = (STRINGP (arg1) - ? arg1 - : treesit_predicate_capture_name_to_text (arg1, - captures)); - Lisp_Object text2 = (STRINGP (arg2) - ? arg2 - : treesit_predicate_capture_name_to_text (arg2, - captures)); + Lisp_Object text1 = arg1; + Lisp_Object text2 = arg2; + if (SYMBOLP (arg1)) + { + if (!treesit_predicate_capture_name_to_text (arg1, captures, &text1, + signal_data)) + return false; + } + if (SYMBOLP (arg2)) + { + if (!treesit_predicate_capture_name_to_text (arg2, captures, &text2, + signal_data)) + return false; + } return !NILP (Fstring_equal (text1, text2)); } /* Handles predicate (#match "regexp" @node). Return true if "regexp" - matches the text spanned by @node; return false otherwise. Matching - is case-sensitive. */ + matches the text spanned by @node; return false otherwise. + Matching is case-sensitive. If everything goes fine, don't touch + SIGNAL_DATA; if error occurs, set it to a suitable signal data. */ static bool -treesit_predicate_match (Lisp_Object args, struct capture_range captures) +treesit_predicate_match (Lisp_Object args, struct capture_range captures, + Lisp_Object *signal_data) { if (XFIXNUM (Flength (args)) != 2) - xsignal2 (Qtreesit_query_error, - build_string ("Predicate `match' requires two " - "arguments but only given"), - Flength (args)); - + { + *signal_data = list2 (build_string ("Predicate `match' requires two " + "arguments but only given"), + Flength (args)); + return false; + } Lisp_Object regexp = XCAR (args); Lisp_Object capture_name = XCAR (XCDR (args)); @@ -2520,12 +2558,10 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) build_string ("The second argument to `match' should " "be a capture name, not a string")); - Lisp_Object node = treesit_predicate_capture_name_to_node (capture_name, - captures); - - struct buffer *old_buffer = current_buffer; - struct buffer *buffer = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer); - set_buffer_internal (buffer); + Lisp_Object node = Qnil; + if (!treesit_predicate_capture_name_to_node (capture_name, captures, &node, + signal_data)) + return false; TSNode treesit_node = XTS_NODE (node)->node; ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; @@ -2553,61 +2589,71 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) ZV = old_zv; ZV_BYTE = old_zv_byte; - set_buffer_internal (old_buffer); - return (val > 0); } /* Handles predicate (#pred FN ARG...). Return true if FN returns non-nil; return false otherwise. The arity of FN must match the - number of ARGs */ + number of ARGs. If everything goes fine, don't touch SIGNAL_DATA; + if error occurs, set it to a suitable signal data. */ static bool -treesit_predicate_pred (Lisp_Object args, struct capture_range captures) +treesit_predicate_pred (Lisp_Object args, struct capture_range captures, + Lisp_Object *signal_data) { if (XFIXNUM (Flength (args)) < 2) - xsignal2 (Qtreesit_query_error, - build_string ("Predicate `pred' requires " - "at least two arguments, " - "but was only given"), - Flength (args)); + { + *signal_data = list2 (build_string ("Predicate `pred' requires " + "at least two arguments, " + "but was only given"), + Flength (args)); + return false; + } Lisp_Object fn = Fintern (XCAR (args), Qnil); Lisp_Object nodes = Qnil; Lisp_Object tail = XCDR (args); FOR_EACH_TAIL (tail) - nodes = Fcons (treesit_predicate_capture_name_to_node (XCAR (tail), - captures), - nodes); + { + Lisp_Object node = Qnil; + if (!treesit_predicate_capture_name_to_node (XCAR (tail), captures, &node, + signal_data)) + return false; + nodes = Fcons (node, nodes); + } nodes = Fnreverse (nodes); return !NILP (CALLN (Fapply, fn, nodes)); } /* If all predicates in PREDICATES passes, return true; otherwise - return false. */ + return false. If everything goes fine, don't touch SIGNAL_DATA; if + error occurs, set it to a suitable signal data. */ static bool -treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates) +treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates, + Lisp_Object *signal_data) { bool pass = true; /* Evaluate each predicates. */ for (Lisp_Object tail = predicates; - !NILP (tail); tail = XCDR (tail)) + pass && !NILP (tail); tail = XCDR (tail)) { Lisp_Object predicate = XCAR (tail); Lisp_Object fn = XCAR (predicate); Lisp_Object args = XCDR (predicate); if (!NILP (Fstring_equal (fn, Vtreesit_str_equal))) - pass &= treesit_predicate_equal (args, captures); + pass &= treesit_predicate_equal (args, captures, signal_data); else if (!NILP (Fstring_equal (fn, Vtreesit_str_match))) - pass &= treesit_predicate_match (args, captures); + pass &= treesit_predicate_match (args, captures, signal_data); else if (!NILP (Fstring_equal (fn, Vtreesit_str_pred))) - pass &= treesit_predicate_pred (args, captures); + pass &= treesit_predicate_pred (args, captures, signal_data); else - xsignal3 (Qtreesit_query_error, - build_string ("Invalid predicate"), - fn, build_string ("Currently Emacs only supports" - " equal, match, and pred" - " predicate")); + { + *signal_data = list3 (build_string ("Invalid predicate"), + fn, build_string ("Currently Emacs only supports" + " equal, match, and pred" + " predicates")); + pass = false; + } } /* If all predicates passed, add captures to result list. */ return pass; @@ -2647,8 +2693,8 @@ You can use `treesit-query-validate' to validate and debug a query. */) Lisp_Object signal_symbol = Qnil; Lisp_Object signal_data = Qnil; TSQuery *treesit_query = treesit_ensure_query_compiled (lisp_query, - &signal_symbol, - &signal_data); + &signal_symbol, + &signal_data); if (treesit_query == NULL) xsignal (signal_symbol, signal_data); @@ -2657,6 +2703,92 @@ You can use `treesit-query-validate' to validate and debug a query. */) } } +/* Resolve OBJ into a tree-sitter node Lisp_Object. OBJ can be a + node, a parser, or a language symbol. Note that this function can + signal. */ +static Lisp_Object treesit_resolve_node (Lisp_Object obj) +{ + if (TS_NODEP (obj)) + { + treesit_check_node (obj); /* Check if up-to-date. */ + return obj; + } + else if (TS_PARSERP (obj)) + { + treesit_check_parser (obj); /* Check if deleted. */ + return Ftreesit_parser_root_node (obj); + } + else if (SYMBOLP (obj)) + { + Lisp_Object parser + = Ftreesit_parser_create (obj, Fcurrent_buffer (), Qnil); + return Ftreesit_parser_root_node (parser); + } + else + xsignal2 (Qwrong_type_argument, + list4 (Qor, Qtreesit_node_p, Qtreesit_parser_p, Qsymbolp), + obj); +} + +/* Create and initialize QUERY. When success, initialize TS_QUERY, + CURSOR, and NEED_FREE, and return true; if failed, initialize + SIGNAL_SYMBOL and SIGNAL_DATA, and return false. If NEED_FREE is + initialized to true, the TS_QUERY and CURSOR needs to be freed + after use; otherwise they shouldn't be freed by hand. + + Basically this function looks at QUERY and check its type, if QUERY + is a compiled query, this function takes out its query and cursor; + if QUERY is a string or a cons, this function creates a new query + and cursor (so they need to be manually freed). + + This function assumes QUERY is either a compiled query, a string or + a cons, the caller should make sure QUERY is valid. + + LANG is the language to use if we need to create the query and + cursor. */ +static bool +treesit_initialize_query (Lisp_Object query, const TSLanguage *lang, + TSQuery **ts_query, TSQueryCursor **cursor, + bool *need_free, Lisp_Object *signal_symbol, + Lisp_Object *signal_data) +{ + if (TS_COMPILED_QUERY_P (query)) + { + *ts_query = treesit_ensure_query_compiled (query, signal_symbol, + signal_data); + *cursor = XTS_COMPILED_QUERY (query)->cursor; + /* We don't need to free ts_query and cursor because they + are stored in a lisp object, which is tracked by gc. */ + *need_free = false; + return (*ts_query != NULL); + } + else + { + /* Since query is not TS_COMPILED_QUERY, it can only be a string + or a cons. */ + if (CONSP (query)) + query = Ftreesit_query_expand (query); + char *query_string = SSDATA (query); + uint32_t error_offset; + TSQueryError error_type; + *ts_query = ts_query_new (lang, query_string, strlen (query_string), + &error_offset, &error_type); + if (*ts_query == NULL) + { + *signal_symbol = Qtreesit_query_error; + *signal_data = treesit_compose_query_signal_data (error_offset, + error_type, query); + return false; + } + else + { + *cursor = ts_query_cursor_new (); + *need_free = true; + return true; + } + } +} + DEFUN ("treesit-query-capture", Ftreesit_query_capture, Streesit_query_capture, 2, 5, 0, @@ -2697,35 +2829,12 @@ the query. */) treesit_initialize (); /* Resolve NODE into an actual node. */ - Lisp_Object lisp_node; - if (TS_NODEP (node)) - { - treesit_check_node (node); /* Check if up-to-date. */ - lisp_node = node; - } - else if (TS_PARSERP (node)) - { - treesit_check_parser (node); /* Check if deleted. */ - lisp_node = Ftreesit_parser_root_node (node); - } - else if (SYMBOLP (node)) - { - Lisp_Object parser - = Ftreesit_parser_create (node, Fcurrent_buffer (), Qnil); - lisp_node = Ftreesit_parser_root_node (parser); - } - else - xsignal2 (Qwrong_type_argument, - list4 (Qor, Qtreesit_node_p, Qtreesit_parser_p, Qsymbolp), - node); + Lisp_Object lisp_node = treesit_resolve_node (node); /* Extract C values from Lisp objects. */ - TSNode treesit_node - = XTS_NODE (lisp_node)->node; - Lisp_Object lisp_parser - = XTS_NODE (lisp_node)->parser; - ptrdiff_t visible_beg - = XTS_PARSER (XTS_NODE (lisp_node)->parser)->visible_beg; + TSNode treesit_node = XTS_NODE (lisp_node)->node; + Lisp_Object lisp_parser = XTS_NODE (lisp_node)->parser; + const TSLanguage *lang = ts_parser_language (XTS_PARSER (lisp_parser)->parser); @@ -2741,44 +2850,21 @@ the query. */) TSQuery *treesit_query; TSQueryCursor *cursor; bool needs_to_free_query_and_cursor; - if (TS_COMPILED_QUERY_P (query)) - { - Lisp_Object signal_symbol = Qnil; - Lisp_Object signal_data = Qnil; - treesit_query = treesit_ensure_query_compiled (query, &signal_symbol, - &signal_data); - cursor = XTS_COMPILED_QUERY (query)->cursor; - /* We don't need to free ts_query and cursor because they - are stored in a lisp object, which is tracked by gc. */ - needs_to_free_query_and_cursor = false; - if (treesit_query == NULL) - xsignal (signal_symbol, signal_data); - } - else - { - /* Since query is not TS_COMPILED_QUERY, it can only be a string - or a cons. */ - if (CONSP (query)) - query = Ftreesit_query_expand (query); - char *query_string = SSDATA (query); - uint32_t error_offset; - TSQueryError error_type; - treesit_query = ts_query_new (lang, query_string, strlen (query_string), - &error_offset, &error_type); - if (treesit_query == NULL) - xsignal (Qtreesit_query_error, - treesit_compose_query_signal_data (error_offset, - error_type, query)); - cursor = ts_query_cursor_new (); - needs_to_free_query_and_cursor = true; - } + Lisp_Object signal_symbol; + Lisp_Object signal_data; + if (!treesit_initialize_query (query, lang, &treesit_query, &cursor, + &needs_to_free_query_and_cursor, + &signal_symbol, &signal_data)) + xsignal (signal_symbol, signal_data); - /* WARN: After this point, free treesit_query and cursor before every - signal and return. */ + /* WARN: After this point, free TREESIT_QUERY and CURSOR before every + signal and return if NEEDS_TO_FREE_QUERY_AND_CURSOR is true. */ /* Set query range. */ if (!NILP (beg) && !NILP (end)) { + ptrdiff_t visible_beg + = XTS_PARSER (XTS_NODE (lisp_node)->parser)->visible_beg; ptrdiff_t beg_byte = CHAR_TO_BYTE (XFIXNUM (beg)); ptrdiff_t end_byte = CHAR_TO_BYTE (XFIXNUM (end)); /* We never let tree-sitter run on buffers too large, so these @@ -2807,11 +2893,16 @@ the query. */) Lisp_Object result = Qnil; Lisp_Object prev_result = result; Lisp_Object predicates_table = make_vector (patterns_count, Qt); + Lisp_Object predicate_signal_data = Qnil; + + struct buffer *old_buf = current_buffer; + set_buffer_internal (buf); + while (ts_query_cursor_next_match (cursor, &match)) { /* Record the checkpoint that we may roll back to. */ prev_result = result; - /* Get captured nodes. */ + /* 1. Get captured nodes. */ const TSQueryCapture *captures = match.captures; for (int idx = 0; idx < match.capture_count; idx++) { @@ -2834,9 +2925,10 @@ the query. */) result = Fcons (cap, result); } - /* Get predicates. */ + /* 2. Get predicates and check whether this match can be + included in the result list. */ Lisp_Object predicates = AREF (predicates_table, match.pattern_index); - if (EQ (predicates, Qt)) + if (BASE_EQ (predicates, Qt)) { predicates = treesit_predicates_for_pattern (treesit_query, match.pattern_index); @@ -2845,15 +2937,28 @@ the query. */) /* captures_lisp = Fnreverse (captures_lisp); */ struct capture_range captures_range = { result, prev_result }; - if (!treesit_eval_predicates (captures_range, predicates)) - /* Predicates didn't pass, roll back. */ + bool match = treesit_eval_predicates (captures_range, predicates, + &predicate_signal_data); + if (!NILP (predicate_signal_data)) + break; + + /* Predicates didn't pass, roll back. */ + if (!match) result = prev_result; } + + /* Final clean up. */ if (needs_to_free_query_and_cursor) { ts_query_delete (treesit_query); ts_query_cursor_delete (cursor); } + set_buffer_internal (old_buf); + + /* Some capture predicate signaled an error. */ + if (!NILP (predicate_signal_data)) + xsignal (Qtreesit_query_error, predicate_signal_data); + return Fnreverse (result); } @@ -2933,7 +3038,7 @@ treesit_cursor_helper (TSTreeCursor *cursor, TSNode node, Lisp_Object parser) TSNode root = ts_tree_root_node (XTS_PARSER (parser)->tree); *cursor = ts_tree_cursor_new (root); bool success = treesit_cursor_helper_1 (cursor, &node, end_pos, - treesit_recursion_limit); + TREESIT_RECURSION_LIMIT); if (!success) ts_tree_cursor_delete (cursor); return success; @@ -3064,10 +3169,136 @@ treesit_traverse_child_helper (TSTreeCursor *cursor, } } -/* Return true if the node at CURSOR matches PRED. PRED can be a - string or a function. This function assumes PRED is either a - string or a function. If NAMED is true, also check that the node - is named. */ +/* Given a symbol THING, and a language symbol LANGUAGE, find the + corresponding predicate definition in treesit-things-settings. + Don't check for the type of THING and LANGUAGE. + + If there isn't one, return Qnil. */ +static Lisp_Object +treesit_traverse_get_predicate (Lisp_Object thing, Lisp_Object language) +{ + Lisp_Object cons = assq_no_quit (language, Vtreesit_thing_settings); + if (NILP (cons)) + return Qnil; + Lisp_Object definitions = XCDR (cons); + Lisp_Object entry = assq_no_quit (thing, definitions); + if (NILP (entry)) + return Qnil; + /* ENTRY looks like (THING PRED). */ + Lisp_Object cdr = XCDR (entry); + if (!CONSP (cdr)) + return Qnil; + return XCAR (cdr); +} + +/* Validate the PRED passed to treesit_traverse_match_predicate. If + there's an error, set SIGNAL_DATA to something signal accepts, and + return false, otherwise return true. This function also check for + recusion levels: we place a arbitrary 100 level limit on recursive + predicates. RECURSION_LEVEL is the current recursion level (that + starts at 0), if it goes over 99, return false and set + SIGNAL_DATA. LANGUAGE is a LANGUAGE symbol. */ +static bool +treesit_traverse_validate_predicate (Lisp_Object pred, + Lisp_Object language, + Lisp_Object *signal_data, + ptrdiff_t recursion_level) +{ + if (recursion_level > 99) + { + *signal_data = list1 (build_string ("Predicate recursion level " + "exceeded: it must not exceed " + "100 levels")); + return false; + } + if (STRINGP (pred)) + return true; + else if (FUNCTIONP (pred)) + return true; + else if (SYMBOLP (pred)) + { + Lisp_Object definition = treesit_traverse_get_predicate (pred, + language); + if (NILP (definition)) + { + *signal_data = list2 (build_string ("Cannot find the definition " + "of the predicate in " + "`treesit-thing-settings'"), + pred); + return false; + } + return treesit_traverse_validate_predicate (definition, + language, + signal_data, + recursion_level + 1); + } + else if (CONSP (pred)) + { + Lisp_Object car = XCAR (pred); + Lisp_Object cdr = XCDR (pred); + if (BASE_EQ (car, Qnot)) + { + if (!CONSP (cdr)) + { + *signal_data = list2 (build_string ("Invalide `not' " + "predicate"), + pred); + return false; + } + /* At this point CDR must be a cons. */ + if (XFIXNUM (Flength (cdr)) != 1) + { + *signal_data = list2 (build_string ("`not' can only " + "have one argument"), + pred); + return false; + } + return treesit_traverse_validate_predicate (XCAR (cdr), + language, + signal_data, + recursion_level + 1); + } + else if (BASE_EQ (car, Qor)) + { + if (!CONSP (cdr) || NILP (cdr)) + { + *signal_data = list2 (build_string ("`or' must have a list " + "of patterns as " + "arguments "), + pred); + return false; + } + FOR_EACH_TAIL (cdr) + { + if (!treesit_traverse_validate_predicate (XCAR (cdr), + language, + signal_data, + recursion_level + 1)) + return false; + } + return true; + } + else if (STRINGP (car) && FUNCTIONP (cdr)) + return true; + } + *signal_data = list2 (build_string ("Invalid predicate, see `treesit-thing-settings' for valid forms of predicate"), + pred); + return false; +} + +/* Return true if the node at CURSOR matches PRED. PRED can be a lot + of things: + + PRED := string | function | (string . function) + | (or PRED...) | (not PRED) + + See docstring of treesit-search-forward and friends for the meaning + of each shape. + + This function assumes PRED is in one of its valid forms. If NAMED + is true, also check that the node is named. + + This function may signal if the predicate function signals. */ static bool treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred, Lisp_Object parser, bool named) @@ -3081,24 +3312,67 @@ treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred, const char *type = ts_node_type (node); return fast_c_string_match (pred, type, strlen (type)) >= 0; } - else + else if (FUNCTIONP (pred)) { Lisp_Object lisp_node = make_treesit_node (parser, node); return !NILP (CALLN (Ffuncall, pred, lisp_node)); } + else if (SYMBOLP (pred)) + { + Lisp_Object language = XTS_PARSER (parser)->language_symbol; + Lisp_Object definition = treesit_traverse_get_predicate (pred, + language); + return treesit_traverse_match_predicate (cursor, definition, + parser, named); + } + else if (CONSP (pred)) + { + Lisp_Object car = XCAR (pred); + Lisp_Object cdr = XCDR (pred); + + if (BASE_EQ (car, Qnot)) + return !treesit_traverse_match_predicate (cursor, XCAR (cdr), + parser, named); + else if (BASE_EQ (car, Qor)) + { + FOR_EACH_TAIL (cdr) + { + if (treesit_traverse_match_predicate (cursor, XCAR (cdr), + parser, named)) + return true; + } + return false; + } + else if (STRINGP (car) && FUNCTIONP (cdr)) + { + /* A bit of code duplication here, but should be fine. */ + const char *type = ts_node_type (node); + if (!(fast_c_string_match (car, type, strlen (type)) >= 0)) + return false; + + Lisp_Object lisp_node = make_treesit_node (parser, node); + if (NILP (CALLN (Ffuncall, cdr, lisp_node))) + return false; + + return true; + } + } + /* Returning false is better than UB. */ + return false; } -/* Traverse the parse tree starting from CURSOR. PRED can be a - function (takes a node and returns nil/non-nil), or a string - (treated as regexp matching the node's type, must be all single - byte characters). If the node satisfies PRED, leave CURSOR on that - node and return true. If no node satisfies PRED, move CURSOR back - to starting position and return false. +/* Traverse the parse tree starting from CURSOR. See + `treesit-thing-settings' for the shapes PRED can have. If the + node satisfies PRED, leave CURSOR on that node and return true. If + no node satisfies PRED, move CURSOR back to starting position and + return false. LIMIT is the number of levels we descend in the tree. FORWARD controls the direction in which we traverse the tree, true means forward, false backward. If SKIP_ROOT is true, don't match ROOT. - */ + + This function may signal if the predicate function signals. */ + static bool treesit_search_dfs (TSTreeCursor *cursor, Lisp_Object pred, Lisp_Object parser, @@ -3134,7 +3408,10 @@ treesit_search_dfs (TSTreeCursor *cursor, START. PRED, PARSER, NAMED, FORWARD are the same as in ts_search_subtree. If a match is found, leave CURSOR at that node, and return true, if no match is found, return false, and CURSOR's - position is undefined. */ + position is undefined. + + This function may signal if the predicate function signals. */ + static bool treesit_search_forward (TSTreeCursor *cursor, Lisp_Object pred, Lisp_Object parser, @@ -3144,8 +3421,7 @@ treesit_search_forward (TSTreeCursor *cursor, nodes. This way repeated call of this function traverses each node in the tree once and only once: - (while node (setq node (treesit-search-forward node))) - */ + (while node (setq node (treesit-search-forward node))) */ bool initial = true; while (true) { @@ -3172,11 +3448,12 @@ treesit_search_forward (TSTreeCursor *cursor, } } -/* Cleanup function for cursor. */ +/* Clean up the given tree cursor CURSOR. */ + static void -treesit_traverse_cleanup_cursor(void *cursor) +treesit_traverse_cleanup_cursor (void *cursor) { - ts_tree_cursor_delete ((TSTreeCursor *) cursor); + ts_tree_cursor_delete (cursor); } DEFUN ("treesit-search-subtree", @@ -3198,14 +3475,12 @@ Return the first matched node, or nil if none matches. */) Lisp_Object all, Lisp_Object depth) { CHECK_TS_NODE (node); - CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate), - list3 (Qor, Qstringp, Qfunctionp), predicate); CHECK_SYMBOL (all); CHECK_SYMBOL (backward); /* We use a default limit of 1000. See bug#59426 for the discussion. */ - ptrdiff_t the_limit = treesit_recursion_limit; + ptrdiff_t the_limit = TREESIT_RECURSION_LIMIT; if (!NILP (depth)) { CHECK_FIXNUM (depth); @@ -3215,6 +3490,13 @@ Return the first matched node, or nil if none matches. */) treesit_initialize (); Lisp_Object parser = XTS_NODE (node)->parser; + Lisp_Object language = XTS_PARSER (parser)->language_symbol; + + Lisp_Object signal_data = Qnil; + if (!treesit_traverse_validate_predicate (predicate, language, + &signal_data, 0)) + xsignal1 (Qtreesit_invalid_predicate, signal_data); + Lisp_Object return_value = Qnil; TSTreeCursor cursor; if (!treesit_cursor_helper (&cursor, XTS_NODE (node)->node, parser)) @@ -3267,14 +3549,19 @@ always traverse leaf nodes first, then upwards. */) Lisp_Object all) { CHECK_TS_NODE (start); - CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate), - list3 (Qor, Qstringp, Qfunctionp), predicate); CHECK_SYMBOL (all); CHECK_SYMBOL (backward); treesit_initialize (); Lisp_Object parser = XTS_NODE (start)->parser; + Lisp_Object language = XTS_PARSER (parser)->language_symbol; + + Lisp_Object signal_data = Qnil; + if (!treesit_traverse_validate_predicate (predicate, language, + &signal_data, 0)) + xsignal1 (Qtreesit_invalid_predicate, signal_data); + Lisp_Object return_value = Qnil; TSTreeCursor cursor; if (!treesit_cursor_helper (&cursor, XTS_NODE (start)->node, parser)) @@ -3296,7 +3583,9 @@ always traverse leaf nodes first, then upwards. */) /* Recursively traverse the tree under CURSOR, and append the result subtree to PARENT's cdr. See more in Ftreesit_induce_sparse_tree. Note that the top-level children list is reversed, because - reasons. */ + reasons. + + This function may signal if the predicate function signals. */ static void treesit_build_sparse_tree (TSTreeCursor *cursor, Lisp_Object parent, Lisp_Object pred, Lisp_Object process_fn, @@ -3382,15 +3671,13 @@ a regexp. */) Lisp_Object depth) { CHECK_TS_NODE (root); - CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate), - list3 (Qor, Qstringp, Qfunctionp), predicate); if (!NILP (process_fn)) CHECK_TYPE (FUNCTIONP (process_fn), Qfunctionp, process_fn); /* We use a default limit of 1000. See bug#59426 for the discussion. */ - ptrdiff_t the_limit = treesit_recursion_limit; + ptrdiff_t the_limit = TREESIT_RECURSION_LIMIT; if (!NILP (depth)) { CHECK_FIXNUM (depth); @@ -3400,6 +3687,13 @@ a regexp. */) treesit_initialize (); Lisp_Object parser = XTS_NODE (root)->parser; + Lisp_Object language = XTS_PARSER (parser)->language_symbol; + + Lisp_Object signal_data = Qnil; + if (!treesit_traverse_validate_predicate (predicate, language, + &signal_data, 0)) + xsignal1 (Qtreesit_invalid_predicate, signal_data); + Lisp_Object parent = Fcons (Qnil, Qnil); /* In this function we never traverse above NODE, so we don't need to use treesit_cursor_helper. */ @@ -3414,12 +3708,47 @@ a regexp. */) unbind_to (count, Qnil); Fsetcdr (parent, Fnreverse (Fcdr (parent))); + if (NILP (Fcdr (parent))) return Qnil; else return parent; } +DEFUN ("treesit-node-match-p", + Ftreesit_node_match_p, + Streesit_node_match_p, 2, 2, 0, + doc: /* Check whether NODE matches PREDICATE. + +PREDICATE can be a regexp matching node type, a predicate function, +and more, see `treesit-thing-settings' for detail. Return non-nil +if NODE matches PRED, nil otherwise. */) + (Lisp_Object node, Lisp_Object predicate) +{ + CHECK_TS_NODE (node); + + Lisp_Object parser = XTS_NODE (node)->parser; + Lisp_Object language = XTS_PARSER (parser)->language_symbol; + + Lisp_Object signal_data = Qnil; + if (!treesit_traverse_validate_predicate (predicate, language, + &signal_data, 0)) + xsignal1 (Qtreesit_invalid_predicate, signal_data); + + TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (node)->node); + + specpdl_ref count = SPECPDL_INDEX (); + record_unwind_protect_ptr (treesit_traverse_cleanup_cursor, &cursor); + + bool match = false; + match = treesit_traverse_match_predicate (&cursor, predicate, + parser, false); + + unbind_to (count, Qnil); + + return match ? Qt : Qnil; +} + DEFUN ("treesit-subtree-stat", Ftreesit_subtree_stat, Streesit_subtree_stat, 1, 1, 0, @@ -3514,8 +3843,12 @@ syms_of_treesit (void) DEFSYM (Qoutdated, "outdated"); DEFSYM (Qhas_error, "has-error"); DEFSYM (Qlive, "live"); + DEFSYM (Qnot, "not"); DEFSYM (QCanchor, ":anchor"); + DEFSYM (QCquestion, ":?"); + DEFSYM (QCstar, ":*"); + DEFSYM (QCplus, ":+"); DEFSYM (QCequal, ":equal"); DEFSYM (QCmatch, ":match"); DEFSYM (QCpred, ":pred"); @@ -3538,6 +3871,7 @@ syms_of_treesit (void) "user-emacs-directory"); DEFSYM (Qtreesit_parser_deleted, "treesit-parser-deleted"); DEFSYM (Qtreesit_pattern_expand, "treesit-pattern-expand"); + DEFSYM (Qtreesit_invalid_predicate, "treesit-invalid-predicate"); DEFSYM (Qor, "or"); @@ -3565,6 +3899,10 @@ syms_of_treesit (void) define_error (Qtreesit_parser_deleted, "This parser is deleted and cannot be used", Qtreesit_error); + define_error (Qtreesit_invalid_predicate, + "Invalid predicate, see `treesit-thing-settings' " + "for valid forms for a predicate", + Qtreesit_error); DEFVAR_LISP ("treesit-load-name-override-list", Vtreesit_load_name_override_list, @@ -3595,6 +3933,33 @@ then in the `tree-sitter' subdirectory of `user-emacs-directory', and then in the system default locations for dynamic libraries, in that order. */); Vtreesit_extra_load_path = Qnil; + DEFVAR_LISP ("treesit-thing-settings", + Vtreesit_thing_settings, + doc: + /* A list defining things. + +The value should be an alist of (LANGUAGE . DEFINITIONS), where +LANGUAGE is a language symbol, and DEFINITIONS is a list of + + (THING PRED) + +THING is a symbol representing the thing, like `defun', `sexp', or +`block'; PRED defines what kind of node can be qualified as THING. + +PRED can be a regexp string that matches the type of the node; it can +be a predicate function that takes the node as the sole argument and +returns t if the node is the thing; it can be a cons (REGEXP . FN), +which is a combination of a regexp and a predicate function, and the +node has to match both to qualify as the thing. + +PRED can also be recursively defined. It can be (or PRED...), meaning +satisfying anyone of the inner PREDs qualifies the node; or (not +PRED), meaning not satisfying the inner PRED qualifies the node. + +Finally, PRED can refer to other THINGs defined in this list by using +the symbol of that THING. For example, (or block sexp). */); + Vtreesit_thing_settings = Qnil; + staticpro (&Vtreesit_str_libtree_sitter); Vtreesit_str_libtree_sitter = build_pure_c_string ("libtree-sitter-"); staticpro (&Vtreesit_str_tree_sitter); @@ -3686,6 +4051,7 @@ then in the system default locations for dynamic libraries, in that order. */); defsubr (&Streesit_search_subtree); defsubr (&Streesit_search_forward); defsubr (&Streesit_induce_sparse_tree); + defsubr (&Streesit_node_match_p); defsubr (&Streesit_subtree_stat); #endif /* HAVE_TREE_SITTER */ defsubr (&Streesit_available_p); diff --git a/src/w32heap.c b/src/w32heap.c index a1975d9a975..628fc28e3c5 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -121,9 +121,9 @@ typedef struct _RTL_HEAP_PARAMETERS { # define DUMPED_HEAP_SIZE 10 #else # if defined _WIN64 || defined WIDE_EMACS_INT -# define DUMPED_HEAP_SIZE (23*1024*1024) +# define DUMPED_HEAP_SIZE (28*1024*1024) # else -# define DUMPED_HEAP_SIZE (13*1024*1024) +# define DUMPED_HEAP_SIZE (18*1024*1024) # endif #endif diff --git a/src/window.c b/src/window.c index 0efd6813f8d..f4e09f49eae 100644 --- a/src/window.c +++ b/src/window.c @@ -3876,6 +3876,9 @@ run_window_change_functions_1 (Lisp_Object symbol, Lisp_Object buffer, * * This function does not save and restore match data. Any functions * it calls are responsible for doing that themselves. + * + * Additionally, report changes to each frame's selected window to the + * input method in textconv.c. */ void run_window_change_functions (void) @@ -4035,6 +4038,18 @@ run_window_change_functions (void) run_window_change_functions_1 (Qwindow_selection_change_functions, Qnil, frame); +#if defined HAVE_TEXT_CONVERSION + + /* If the buffer or selected window has changed, also reset the + input method composition state. */ + + if ((frame_selected_window_change || frame_buffer_change) + && FRAME_LIVE_P (f) + && FRAME_WINDOW_P (f)) + report_selected_window_change (f); + +#endif + /* A frame has changed state when a size or buffer change occurred, its selected window has changed, when it was (de-)selected or its window state change flag was set. */ diff --git a/src/xdisp.c b/src/xdisp.c index e960901d5dc..28f8e8128c5 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4056,7 +4056,7 @@ compute_stop_pos (struct it *it) { register INTERVAL iv, next_iv; Lisp_Object object, limit, position; - ptrdiff_t charpos, bytepos; + ptrdiff_t charpos, bytepos, cmp_limit_pos = -1; if (STRINGP (it->string)) { @@ -4126,7 +4126,10 @@ compute_stop_pos (struct it *it) } } if (found) - pos--; + { + pos--; + cmp_limit_pos = pos; + } else if (it->stop_charpos < endpos) pos = it->stop_charpos; else @@ -4184,14 +4187,25 @@ compute_stop_pos (struct it *it) } } - if (it->cmp_it.id < 0) + if (it->cmp_it.id < 0 + && (STRINGP (it->string) + || ((!it->bidi_p || it->bidi_it.scan_dir >= 0) + && it->cmp_it.stop_pos <= IT_CHARPOS (*it)))) { ptrdiff_t stoppos = it->end_charpos; + /* If we found, above, a buffer position that cannot be part of + an automatic composition, limit the search of composable + characters to that position. */ if (it->bidi_p && it->bidi_it.scan_dir < 0) stoppos = -1; + else if (cmp_limit_pos > 0) + stoppos = cmp_limit_pos; + /* Force composition_compute_stop_pos avoid the costly search + for static compositions, since those were already found by + looking at text properties, above. */ composition_compute_stop_pos (&it->cmp_it, charpos, bytepos, - stoppos, it->string); + stoppos, it->string, false); } eassert (STRINGP (it->string) @@ -7716,7 +7730,7 @@ reseat_to_string (struct it *it, const char *s, Lisp_Object string, if (endpos > it->end_charpos) endpos = it->end_charpos; composition_compute_stop_pos (&it->cmp_it, charpos, -1, endpos, - it->string); + it->string, true); } CHECK_IT (it); } @@ -8404,7 +8418,7 @@ set_iterator_to_next (struct it *it, bool reseat_p) where to stop. */ stop = -1; composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it), - IT_BYTEPOS (*it), stop, Qnil); + IT_BYTEPOS (*it), stop, Qnil, true); } } else @@ -8435,7 +8449,8 @@ set_iterator_to_next (struct it *it, bool reseat_p) if (it->bidi_it.scan_dir < 0) stop = -1; composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it), - IT_BYTEPOS (*it), stop, Qnil); + IT_BYTEPOS (*it), stop, Qnil, + true); } } eassert (IT_BYTEPOS (*it) == CHAR_TO_BYTE (IT_CHARPOS (*it))); @@ -8591,7 +8606,7 @@ set_iterator_to_next (struct it *it, bool reseat_p) composition_compute_stop_pos (&it->cmp_it, IT_STRING_CHARPOS (*it), IT_STRING_BYTEPOS (*it), stop, - it->string); + it->string, true); } } else @@ -8628,7 +8643,7 @@ set_iterator_to_next (struct it *it, bool reseat_p) composition_compute_stop_pos (&it->cmp_it, IT_STRING_CHARPOS (*it), IT_STRING_BYTEPOS (*it), stop, - it->string); + it->string, true); } } } @@ -8879,7 +8894,7 @@ get_visually_first_element (struct it *it) if (it->bidi_it.scan_dir < 0) stop = -1; composition_compute_stop_pos (&it->cmp_it, charpos, bytepos, stop, - it->string); + it->string, true); } } @@ -12448,7 +12463,7 @@ display_echo_area (struct window *w) reset the echo_area_buffer in question to nil at the end because with_echo_area_buffer will set it to an empty buffer. */ bool i = display_last_displayed_message_p; - /* According to the C99, C11 and C++11 standards, the integral value + /* According to the C standard, the integral value of a "bool" is always 0 or 1, so this array access is safe here, if oddly typed. */ no_message_p = NILP (echo_area_buffer[i]); @@ -12946,7 +12961,7 @@ clear_garbaged_frames (void) { struct frame *f = XFRAME (frame); - if (FRAME_VISIBLE_P (f) && FRAME_GARBAGED_P (f)) + if (FRAME_REDISPLAY_P (f) && FRAME_GARBAGED_P (f)) { if (f->resized_p /* It makes no sense to redraw a non-selected TTY @@ -12995,7 +13010,7 @@ echo_area_display (bool update_frame_p) f = XFRAME (WINDOW_FRAME (w)); /* Don't display if frame is invisible or not yet initialized. */ - if (!FRAME_VISIBLE_P (f) || !f->glyphs_initialized_p) + if (!FRAME_REDISPLAY_P (f) || !f->glyphs_initialized_p) return; #ifdef HAVE_WINDOW_SYSTEM @@ -13552,7 +13567,7 @@ prepare_menu_bars (void) TTY frames to be completely redrawn, when there are more than one of them, even though nothing should be changed on display. */ - || (FRAME_VISIBLE_P (f) == 2 && FRAME_WINDOW_P (f)))) + || (FRAME_REDISPLAY_P (f) && FRAME_WINDOW_P (f)))) gui_consider_frame_title (frame); } } @@ -16441,7 +16456,7 @@ redisplay_internal (void) { struct frame *f = XFRAME (frame); - if (FRAME_VISIBLE_P (f)) + if (FRAME_REDISPLAY_P (f)) { ++number_of_visible_frames; /* Adjust matrices for visible frames only. */ @@ -16583,7 +16598,7 @@ redisplay_internal (void) && !w->update_mode_line && !current_buffer->clip_changed && !current_buffer->prevent_redisplay_optimizations_p - && FRAME_VISIBLE_P (XFRAME (w->frame)) + && FRAME_REDISPLAY_P (XFRAME (w->frame)) && !FRAME_OBSCURED_P (XFRAME (w->frame)) && !XFRAME (w->frame)->cursor_type_changed && !XFRAME (w->frame)->face_change @@ -16861,7 +16876,7 @@ redisplay_internal (void) if (gcscrollbars && FRAME_TERMINAL (f)->condemn_scroll_bars_hook) FRAME_TERMINAL (f)->condemn_scroll_bars_hook (f); - if (FRAME_VISIBLE_P (f) && !FRAME_OBSCURED_P (f)) + if (FRAME_REDISPLAY_P (f) && !FRAME_OBSCURED_P (f)) { /* Don't allow freeing images and faces for this frame as long as the frame's update wasn't @@ -16887,7 +16902,7 @@ redisplay_internal (void) if (gcscrollbars && FRAME_TERMINAL (f)->judge_scroll_bars_hook) FRAME_TERMINAL (f)->judge_scroll_bars_hook (f); - if (FRAME_VISIBLE_P (f) && !FRAME_OBSCURED_P (f)) + if (FRAME_REDISPLAY_P (f) && !FRAME_OBSCURED_P (f)) { /* If fonts changed on visible frame, display again. */ if (f->fonts_changed) @@ -16993,7 +17008,7 @@ redisplay_internal (void) } } } - else if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf)) + else if (FRAME_REDISPLAY_P (sf) && !FRAME_OBSCURED_P (sf)) { sf->inhibit_clear_image_cache = true; displayed_buffer = XBUFFER (XWINDOW (selected_window)->contents); @@ -17044,7 +17059,7 @@ redisplay_internal (void) unrequest_sigio (); STOP_POLLING; - if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf)) + if (FRAME_REDISPLAY_P (sf) && !FRAME_OBSCURED_P (sf)) { if (hscroll_retries <= MAX_HSCROLL_RETRIES && hscroll_windows (selected_window)) @@ -17143,7 +17158,7 @@ redisplay_internal (void) FOR_EACH_FRAME (tail, frame) { - if (XFRAME (frame)->visible) + if (FRAME_REDISPLAY_P (XFRAME (frame))) new_count++; } @@ -26350,16 +26365,17 @@ display_menu_bar (struct window *w) it.first_visible_x = 0; it.last_visible_x = FRAME_PIXEL_WIDTH (f); #elif defined (HAVE_X_WINDOWS) /* X without toolkit. */ + struct window *menu_window = NULL; + struct face *face = FACE_FROM_ID (f, MENU_FACE_ID); + if (FRAME_WINDOW_P (f)) { /* Menu bar lines are displayed in the desired matrix of the dummy window menu_bar_window. */ - struct window *menu_w; - menu_w = XWINDOW (f->menu_bar_window); - init_iterator (&it, menu_w, -1, -1, menu_w->desired_matrix->rows, + menu_window = XWINDOW (f->menu_bar_window); + init_iterator (&it, menu_window, -1, -1, + menu_window->desired_matrix->rows, MENU_FACE_ID); - it.first_visible_x = 0; - it.last_visible_x = FRAME_PIXEL_WIDTH (f); } else #endif /* not USE_X_TOOLKIT and not USE_GTK */ @@ -26413,6 +26429,50 @@ display_menu_bar (struct window *w) /* Compute the total height of the lines. */ compute_line_metrics (&it); + it.glyph_row->full_width_p = true; + it.glyph_row->continued_p = false; + it.glyph_row->truncated_on_left_p = false; + it.glyph_row->truncated_on_right_p = false; + +#if defined (HAVE_X_WINDOWS) && !defined (USE_X_TOOLKIT) && !defined (USE_GTK) + /* Make a 3D menu bar have a shadow at its right end. */ + extend_face_to_end_of_line (&it); + if (face->box != FACE_NO_BOX) + { + struct glyph *last = (it.glyph_row->glyphs[TEXT_AREA] + + it.glyph_row->used[TEXT_AREA] - 1); + int box_thickness = face->box_vertical_line_width; + last->right_box_line_p = true; + /* Add back the space for the right box line we subtracted in + init_iterator, since the right_box_line_p flag will make the + glyph wider. We actually add only as much space as is + available for the last glyph of the menu bar and whatever + space is left beyond it, since that glyph could be only + partially visible. */ + if (box_thickness > 0) + last->pixel_width += max (0, (box_thickness + - (it.current_x - it.last_visible_x))); + } + + /* With the non-toolkit version, modify the menu bar window height + accordingly. */ + if (FRAME_WINDOW_P (it.f) && menu_window) + { + struct glyph_row *row; + int delta_height; + + row = it.glyph_row; + delta_height + = ((row->y + row->height) + - WINDOW_BOX_HEIGHT_NO_MODE_LINE (menu_window)); + + if (delta_height != 0) + { + FRAME_MENU_BAR_HEIGHT (it.f) += delta_height; + adjust_frame_size (it.f, -1, -1, 3, false, Qmenu_bar_lines); + } + } +#endif } /* Deep copy of a glyph row, including the glyphs. */ @@ -27594,7 +27654,9 @@ static const char power_letter[] = 'P', /* peta */ 'E', /* exa */ 'Z', /* zetta */ - 'Y' /* yotta */ + 'Y', /* yotta */ + 'R', /* ronna */ + 'Q' /* quetta */ }; static void @@ -33239,7 +33301,7 @@ display_and_set_cursor (struct window *w, bool on, windows and frames; in the latter case, the frame or window may be in the midst of changing its size, and x and y may be off the window. */ - if (! FRAME_VISIBLE_P (f) + if (! FRAME_REDISPLAY_P (f) || vpos >= w->current_matrix->nrows || hpos >= w->current_matrix->matrix_w) return; @@ -33400,7 +33462,7 @@ gui_update_cursor (struct frame *f, bool on_p) void gui_clear_cursor (struct window *w) { - if (FRAME_VISIBLE_P (XFRAME (w->frame)) && w->phys_cursor_on_p) + if (FRAME_REDISPLAY_P (XFRAME (w->frame)) && w->phys_cursor_on_p) update_window_cursor (w, false); } diff --git a/src/xfns.c b/src/xfns.c index 528ae61ca32..9e004f6a678 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -37,13 +37,16 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "termhooks.h" #include "font.h" +#ifdef HAVE_X_I18N +#include "textconv.h" +#endif + #include <sys/types.h> #include <sys/stat.h> #ifdef USE_XCB #include <xcb/xcb.h> #include <xcb/xproto.h> -#include <xcb/xcb_aux.h> #endif #include "bitmaps/gray.xbm" @@ -1368,7 +1371,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) XCreateFontCursor is not a request that waits for a reply, and as such can return IDs that will not actually be used by the server. */ - x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); + x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f), 0); /* Free any successfully created cursors. */ for (i = 0; i < mouse_cursor_max; i++) @@ -2643,12 +2646,18 @@ append_wm_protocols (struct x_display_info *dpyinfo, if (existing) XFree (existing); - if (!found_wm_ping) - protos[num_protos++] = dpyinfo->Xatom_net_wm_ping; + if (!dpyinfo->untrusted) + { + /* Untrusted clients cannot use these protocols which require + communicating with the window manager. */ + + if (!found_wm_ping) + protos[num_protos++] = dpyinfo->Xatom_net_wm_ping; #if !defined HAVE_GTK3 && defined HAVE_XSYNC - if (!found_wm_sync_request && dpyinfo->xsync_supported_p) - protos[num_protos++] = dpyinfo->Xatom_net_wm_sync_request; + if (!found_wm_sync_request && dpyinfo->xsync_supported_p) + protos[num_protos++] = dpyinfo->Xatom_net_wm_sync_request; #endif + } if (num_protos) XChangeProperty (dpyinfo->display, @@ -2666,24 +2675,50 @@ append_wm_protocols (struct x_display_info *dpyinfo, #ifdef HAVE_X_I18N -static void xic_preedit_draw_callback (XIC, XPointer, XIMPreeditDrawCallbackStruct *); -static void xic_preedit_caret_callback (XIC, XPointer, XIMPreeditCaretCallbackStruct *); +static void xic_preedit_draw_callback (XIC, XPointer, + XIMPreeditDrawCallbackStruct *); +static void xic_preedit_caret_callback (XIC, XPointer, + XIMPreeditCaretCallbackStruct *); static void xic_preedit_done_callback (XIC, XPointer, XPointer); static int xic_preedit_start_callback (XIC, XPointer, XPointer); +static void xic_string_conversion_callback (XIC, XPointer, + XIMStringConversionCallbackStruct *); #ifndef HAVE_XICCALLBACK_CALLBACK #define XICCallback XIMCallback #define XICProc XIMProc #endif -static XIMCallback Xxic_preedit_draw_callback = { NULL, - (XIMProc) xic_preedit_draw_callback }; -static XIMCallback Xxic_preedit_caret_callback = { NULL, - (XIMProc) xic_preedit_caret_callback }; -static XIMCallback Xxic_preedit_done_callback = { NULL, - (XIMProc) xic_preedit_done_callback }; -static XICCallback Xxic_preedit_start_callback = { NULL, - (XICProc) xic_preedit_start_callback }; +static XIMCallback Xxic_preedit_draw_callback = + { + NULL, + (XIMProc) xic_preedit_draw_callback, + }; + +static XIMCallback Xxic_preedit_caret_callback = + { + NULL, + (XIMProc) xic_preedit_caret_callback, + }; + +static XIMCallback Xxic_preedit_done_callback = + { + NULL, + (XIMProc) xic_preedit_done_callback, + }; + +static XICCallback Xxic_preedit_start_callback = + { + NULL, + (XICProc) xic_preedit_start_callback, + }; + +static XIMCallback Xxic_string_conversion_callback = + { + /* This is actually an XICCallback! */ + NULL, + (XIMProc) xic_string_conversion_callback, + }; #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT /* Create an X fontset on frame F with base font name BASE_FONTNAME. */ @@ -3089,6 +3124,8 @@ create_frame_xic (struct frame *f) XNFocusWindow, FRAME_X_WINDOW (f), XNStatusAttributes, status_attr, XNPreeditAttributes, preedit_attr, + XNStringConversionCallback, + &Xxic_string_conversion_callback, NULL); else if (preedit_attr) xic = XCreateIC (xim, @@ -3096,6 +3133,8 @@ create_frame_xic (struct frame *f) XNClientWindow, FRAME_X_WINDOW (f), XNFocusWindow, FRAME_X_WINDOW (f), XNPreeditAttributes, preedit_attr, + XNStringConversionCallback, + &Xxic_string_conversion_callback, NULL); else if (status_attr) xic = XCreateIC (xim, @@ -3103,12 +3142,16 @@ create_frame_xic (struct frame *f) XNClientWindow, FRAME_X_WINDOW (f), XNFocusWindow, FRAME_X_WINDOW (f), XNStatusAttributes, status_attr, + XNStringConversionCallback, + &Xxic_string_conversion_callback, NULL); else xic = XCreateIC (xim, XNInputStyle, xic_style, XNClientWindow, FRAME_X_WINDOW (f), XNFocusWindow, FRAME_X_WINDOW (f), + XNStringConversionCallback, + &Xxic_string_conversion_callback, NULL); if (!xic) @@ -3372,6 +3415,7 @@ struct x_xim_text_conversion_data struct coding_system *coding; char *source; struct x_display_info *dpyinfo; + size_t size; }; static Lisp_Object @@ -3407,6 +3451,38 @@ x_xim_text_to_utf8_unix_1 (ptrdiff_t nargs, Lisp_Object *args) } static Lisp_Object +x_encode_xim_text_1 (ptrdiff_t nargs, Lisp_Object *args) +{ + struct x_xim_text_conversion_data *data; + ptrdiff_t nbytes; + Lisp_Object coding_system; + + data = xmint_pointer (args[0]); + + if (SYMBOLP (Vx_input_coding_system)) + coding_system = Vx_input_coding_system; + else if (!NILP (data->dpyinfo->xim_coding)) + coding_system = data->dpyinfo->xim_coding; + else + coding_system = Vlocale_coding_system; + + nbytes = data->size; + + data->coding->destination = NULL; + + setup_coding_system (coding_system, data->coding); + data->coding->mode |= (CODING_MODE_LAST_BLOCK + | CODING_MODE_SAFE_ENCODING); + data->coding->source = (const unsigned char *) data->source; + data->coding->dst_bytes = 2048; + data->coding->destination = xmalloc (2048); + encode_coding_object (data->coding, Qnil, 0, 0, + nbytes, nbytes, Qnil); + + return Qnil; +} + +static Lisp_Object x_xim_text_to_utf8_unix_2 (Lisp_Object val, ptrdiff_t nargs, Lisp_Object *args) { @@ -3463,6 +3539,46 @@ x_xim_text_to_utf8_unix (struct x_display_info *dpyinfo, return (char *) coding.destination; } +/* Convert SIZE bytes of the specified text from Emacs's internal + coding system to the input method coding system. Return the + result, its byte length in *LENGTH, and its character length in + *CHARS, or NULL. + + The string returned is not NULL terminated. */ + +static char * +x_encode_xim_text (struct x_display_info *dpyinfo, char *text, + size_t size, ptrdiff_t *length, + ptrdiff_t *chars) +{ + struct coding_system coding; + struct x_xim_text_conversion_data data; + Lisp_Object arg; + bool was_waiting_for_input_p; + + data.coding = &coding; + data.source = text; + data.dpyinfo = dpyinfo; + data.size = size; + + was_waiting_for_input_p = waiting_for_input; + /* Otherwise Fsignal will crash. */ + waiting_for_input = false; + + arg = make_mint_ptr (&data); + internal_condition_case_n (x_encode_xim_text_1, 1, &arg, + Qt, x_xim_text_to_utf8_unix_2); + waiting_for_input = was_waiting_for_input_p; + + if (length) + *length = coding.produced; + + if (chars) + *chars = coding.produced_char; + + return (char *) coding.destination; +} + static void xic_preedit_draw_callback (XIC xic, XPointer client_data, XIMPreeditDrawCallbackStruct *call_data) @@ -3659,6 +3775,128 @@ xic_set_xfontset (struct frame *f, const char *base_fontname) FRAME_XIC_FONTSET (f) = xfs; } + + +/* String conversion support. See textconv.c for more details. */ + +static void +xic_string_conversion_callback (XIC ic, XPointer client_data, + XIMStringConversionCallbackStruct *call_data) +{ + struct textconv_callback_struct request; + ptrdiff_t length; + struct frame *f; + int rc; + + /* Find the frame associated with this IC. */ + f = x_xic_to_frame (ic); + + if (!f) + goto failure; + + /* Fill in CALL_DATA as early as possible. */ + call_data->text->feedback = NULL; + call_data->text->encoding_is_wchar = False; + + /* Now translate the conversion request to the format understood by + textconv.c. */ + request.position = call_data->position; + + switch (call_data->direction) + { + case XIMForwardChar: + request.direction = TEXTCONV_FORWARD_CHAR; + break; + + case XIMBackwardChar: + request.direction = TEXTCONV_BACKWARD_CHAR; + break; + + case XIMForwardWord: + request.direction = TEXTCONV_FORWARD_WORD; + break; + + case XIMBackwardWord: + request.direction = TEXTCONV_BACKWARD_WORD; + break; + + case XIMCaretUp: + request.direction = TEXTCONV_CARET_UP; + break; + + case XIMCaretDown: + request.direction = TEXTCONV_CARET_DOWN; + break; + + case XIMNextLine: + request.direction = TEXTCONV_NEXT_LINE; + break; + + case XIMPreviousLine: + request.direction = TEXTCONV_PREVIOUS_LINE; + break; + + case XIMLineStart: + request.direction = TEXTCONV_LINE_START; + break; + + case XIMLineEnd: + request.direction = TEXTCONV_LINE_END; + break; + + case XIMAbsolutePosition: + request.direction = TEXTCONV_ABSOLUTE_POSITION; + break; + + default: + goto failure; + } + + /* factor is signed in call_data but is actually a CARD16. */ + request.factor = call_data->factor; + + if (call_data->operation == XIMStringConversionSubstitution) + request.operation = TEXTCONV_SUBSTITUTION; + else + request.operation = TEXTCONV_RETRIEVAL; + + /* Now perform the string conversion. */ + rc = textconv_query (f, &request); + + if (rc) + { + xfree (request.text.text); + goto failure; + } + + /* Encode the text in the locale coding system and give it back to + the input method. */ + request.text.text = NULL; + call_data->text->string.mbs + = x_encode_xim_text (FRAME_DISPLAY_INFO (f), + request.text.text, + request.text.bytes, NULL, + &length); + call_data->text->length = length; + + /* Free the encoded text. This is always set to something + valid. */ + xfree (request.text.text); + + /* Detect failure. */ + if (!call_data->text->string.mbs) + goto failure; + + return; + + failure: + /* Return a string of length 0 using the C library malloc. This + assumes XFree is able to free data allocated with our malloc + wrapper. */ + call_data->text->length = 0; + call_data->text->string.mbs = malloc (0); +} + #endif /* HAVE_X_I18N */ @@ -4736,6 +4974,7 @@ This function is an internal primitive--use `make-frame' instead. */) #endif /* USE_LUCID && USE_TOOLKIT_SCROLL_BARS */ f->output_data.x->white_relief.pixel = -1; f->output_data.x->black_relief.pixel = -1; + f->output_data.x->visibility_state = VisibilityFullyObscured; fset_icon_name (f, gui_display_get_arg (dpyinfo, parms, @@ -5723,13 +5962,13 @@ x_get_net_workarea (struct x_display_info *dpyinfo, XRectangle *rect) = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) dpyinfo->root_window, (xcb_atom_t) dpyinfo->Xatom_net_current_desktop, - XCB_ATOM_CARDINAL, 0, 1); + XA_CARDINAL, 0, 1); workarea_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) dpyinfo->root_window, (xcb_atom_t) dpyinfo->Xatom_net_workarea, - XCB_ATOM_CARDINAL, 0, UINT32_MAX); + XA_CARDINAL, 0, UINT32_MAX); reply = xcb_get_property_reply (dpyinfo->xcb_connection, current_desktop_cookie, &error); @@ -5740,7 +5979,7 @@ x_get_net_workarea (struct x_display_info *dpyinfo, XRectangle *rect) else { if (xcb_get_property_value_length (reply) != 4 - || reply->type != XCB_ATOM_CARDINAL || reply->format != 32) + || reply->type != XA_CARDINAL || reply->format != 32) rc = false; else current_workspace = *(uint32_t *) xcb_get_property_value (reply); @@ -5755,7 +5994,7 @@ x_get_net_workarea (struct x_display_info *dpyinfo, XRectangle *rect) free (error), rc = false; else { - if (rc && reply->type == XCB_ATOM_CARDINAL && reply->format == 32 + if (rc && reply->type == XA_CARDINAL && reply->format == 32 && (xcb_get_property_value_length (reply) / sizeof (uint32_t) >= current_workspace + 4)) { @@ -7079,8 +7318,8 @@ that mouse buttons are being held down, such as immediately after a /* Catch errors since interning lots of targets can potentially generate a BadAlloc error. */ x_catch_errors (FRAME_X_DISPLAY (f)); - XInternAtoms (FRAME_X_DISPLAY (f), target_names, - ntargets, False, target_atoms); + x_intern_atoms (FRAME_DISPLAY_INFO (f), target_names, + ntargets, target_atoms); x_check_errors (FRAME_X_DISPLAY (f), "Failed to intern target atoms: %s"); x_uncatch_errors_after_check (); @@ -7377,20 +7616,6 @@ If TERMINAL is omitted or nil, that stands for the selected frame's display. */ return Qnil; } -/* Wait for responses to all X commands issued so far for frame F. */ - -void -x_sync (struct frame *f) -{ - block_input (); -#ifndef USE_XCB - XSync (FRAME_X_DISPLAY (f), False); -#else - xcb_aux_sync (FRAME_DISPLAY_INFO (f)->xcb_connection); -#endif - unblock_input (); -} - /*********************************************************************** Window properties @@ -7484,7 +7709,7 @@ silently ignored. */) elsize = element_format == 32 ? sizeof (long) : element_format >> 3; data = xnmalloc (nelements, elsize); - x_fill_property_data (FRAME_X_DISPLAY (f), value, data, nelements, + x_fill_property_data (FRAME_DISPLAY_INFO (f), value, data, nelements, element_format); } else @@ -9779,6 +10004,53 @@ This should be called from a variable watcher for `x-gtk-use-native-input'. */) return Qnil; } + +#if 0 + +DEFUN ("x-test-string-conversion", Fx_test_string_conversion, + Sx_test_string_conversion, 5, 5, 0, + doc: /* Perform tests on the XIM string conversion support. */) + (Lisp_Object frame, Lisp_Object position, + Lisp_Object direction, Lisp_Object operation, Lisp_Object factor) +{ + struct frame *f; + XIMStringConversionCallbackStruct call_data; + XIMStringConversionText text; + + f = decode_window_system_frame (frame); + + if (!FRAME_XIC (f)) + error ("No XIC on FRAME!"); + + CHECK_FIXNUM (position); + CHECK_FIXNUM (direction); + CHECK_FIXNUM (operation); + CHECK_FIXNUM (factor); + + /* xic_string_conversion_callback (XIC ic, XPointer client_data, + XIMStringConversionCallbackStruct *call_data) */ + + call_data.position = XFIXNUM (position); + call_data.direction = XFIXNUM (direction); + call_data.operation = XFIXNUM (operation); + call_data.factor = XFIXNUM (factor); + call_data.text = &text; + + block_input (); + xic_string_conversion_callback (FRAME_XIC (f), NULL, + &call_data); + unblock_input (); + + /* Place a breakpoint here to inspect TEXT! */ + + while (1) + maybe_quit (); + + return Qnil; +} + +#endif + /*********************************************************************** Initialization @@ -10225,6 +10497,9 @@ eliminated in future versions of Emacs. */); defsubr (&Sx_display_set_last_user_time); defsubr (&Sx_translate_coordinates); defsubr (&Sx_get_modifier_masks); +#if 0 + defsubr (&Sx_test_string_conversion); +#endif tip_timer = Qnil; staticpro (&tip_timer); diff --git a/src/xftfont.c b/src/xftfont.c index 1ade22a6006..4d5b855f178 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -628,6 +628,12 @@ xftfont_shape (Lisp_Object lgstring, Lisp_Object direction) static int xftfont_end_for_frame (struct frame *f) { + /* XftDrawDestroy tries to access dpyinfo->display, which could've + been destroyed by now, causing Emacs to crash. The alternative + is to leak the XftDraw, but that's better than a crash. */ + if (!FRAME_X_DISPLAY (f)) + return 0; + block_input (); XftDraw *xft_draw; diff --git a/src/xselect.c b/src/xselect.c index 45f933bba30..0586e46870b 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -16,7 +16,6 @@ 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/>. */ - /* Rewritten by jwz */ #include <config.h> @@ -44,7 +43,7 @@ struct prop_location; struct selection_data; static void x_decline_selection_request (struct selection_input_event *); -static bool x_convert_selection (Lisp_Object, Lisp_Object, Atom, bool, +static bool x_convert_selection (Lisp_Object, Lisp_Object, Atom, struct x_display_info *, bool); static bool waiting_for_other_props_on_window (Display *, Window); static struct prop_location *expect_property_change (Display *, Window, @@ -77,18 +76,20 @@ static void x_send_client_event (Lisp_Object, Lisp_Object, Lisp_Object, #define TRACE0(fmt) (void) 0 #define TRACE1(fmt, a0) (void) 0 #define TRACE2(fmt, a0, a1) (void) 0 +#define TRACE3(fmt, a0, a1, a2) (void) 0 #endif /* Bytes needed to represent 'long' data. This is as per libX11; it is not necessarily sizeof (long). */ #define X_LONG_SIZE 4 -/* If this is a smaller number than the max-request-size of the display, - emacs will use INCR selection transfer when the selection is larger - than this. The max-request-size is usually around 64k, so if you want - emacs to use incremental selection transfers when the selection is - smaller than that, set this. I added this mostly for debugging the - incremental transfer stuff, but it might improve server performance. +/* If this is a smaller number than the max-request-size of the + display, Emacs will use INCR selection transfer when the selection + is larger than this. The max-request-size is usually around 64k, + so if you want emacs to use incremental selection transfers when + the selection is smaller than that, set this. I added this mostly + for debugging the incremental transfer stuff, but it might improve + server performance. This value cannot exceed INT_MAX / max (X_LONG_SIZE, sizeof (long)) because it is multiplied by X_LONG_SIZE and by sizeof (long) in @@ -101,7 +102,9 @@ static void x_send_client_event (Lisp_Object, Lisp_Object, Lisp_Object, static int selection_quantum (Display *display) { - long mrs = XExtendedMaxRequestSize (display); + long mrs; + + mrs = XExtendedMaxRequestSize (display); if (!mrs) mrs = XMaxRequestSize (display); @@ -281,10 +284,8 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, timestamp = dpyinfo->last_user_time; block_input (); - x_catch_errors (display); - XSetSelectionOwner (display, selection_atom, selecting_window, timestamp); - x_check_errors (display, "Can't set selection: %s"); - x_uncatch_errors_after_check (); + XSetSelectionOwner (display, selection_atom, selecting_window, + timestamp); unblock_input (); /* Now update the local cache */ @@ -459,7 +460,7 @@ x_decline_selection_request (struct selection_input_event *event) /* The reason for the error may be that the receiver has died in the meantime. Handle that case. */ block_input (); - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, reply->requestor, False, 0, &reply_base); x_stop_ignoring_errors (dpyinfo); @@ -472,19 +473,65 @@ x_decline_selection_request (struct selection_input_event *event) struct selection_data { + /* Pointer to the selection data. */ unsigned char *data; + + /* A Lisp_Object containing the selection data. This is either + Qnil, or `data' is NULL. If non-nil, then this must be a string + whose contents will be written out verbatim. */ + Lisp_Object string; + + /* The size, in number of items, of the selection data. + The value is meaningless if string is non-nil. */ ptrdiff_t size; + + /* The format of the selection data. */ int format; + + /* The type of the selection data. */ Atom type; - bool nofree; + + /* The property describing the selection data. */ Atom property; - /* This can be set to non-NULL during x_reply_selection_request, if - the selection is waiting for an INCR transfer to complete. Don't - free these; that's done by unexpect_property_change. */ - struct prop_location *wait_object; + + /* The next piece of selection data in the current selection request + stack frame. This can be NULL. */ struct selection_data *next; }; +/* Structure representing a single outstanding selection request (or + subrequest if MULTIPLE is being used.) */ + +struct transfer +{ + /* The requestor of this transfer. */ + Window requestor; + + /* The current offset in items into the selection data, and the + number of items to send with each ChangeProperty request. */ + size_t offset, items_per_request; + + /* The display info associated with the transfer. */ + struct x_display_info *dpyinfo; + + /* The converted selection data. */ + struct selection_data data; + + /* The next and last selection transfers on this list. */ + struct transfer *next, *last; + + /* The atimer for the timeout. */ + struct atimer *timeout; + + /* The selection serial. */ + unsigned int serial; + + /* Flags. */ + int flags; +}; + +#define SELECTED_EVENTS 1 + struct x_selection_request { /* The last element in this stack. */ @@ -499,8 +546,8 @@ struct x_selection_request /* Linked list of the above (in support of MULTIPLE targets). */ struct selection_data *converted_selections; - /* "Data" to send a requestor for a failed MULTIPLE subtarget. */ - Atom conversion_fail_tag; + /* The serial used to handle X errors. */ + unsigned int serial; /* Whether or not conversion was successful. */ bool converted; @@ -511,6 +558,50 @@ struct x_selection_request struct x_selection_request *selection_request_stack; +/* List of all outstanding selection transfers which are currently + being processed. */ + +struct transfer outstanding_transfers; + +/* A counter for selection serials. */ + +static unsigned int selection_serial; + + + +struct prop_location +{ + int identifier; + Display *display; + Window window; + Atom property; + int desired_state; + bool arrived; + struct prop_location *next; +}; + +static int prop_location_identifier; + +static Lisp_Object property_change_reply; + +static struct prop_location *property_change_reply_object; + +static struct prop_location *property_change_wait_list; + +static void +set_property_change_object (struct prop_location *location) +{ + /* Input must be blocked so we don't get the event before we set + these. */ + if (! input_blocked_p ()) + emacs_abort (); + + XSETCAR (property_change_reply, Qnil); + property_change_reply_object = location; +} + + + static void x_push_current_selection_request (struct selection_input_event *se, struct x_display_info *dpyinfo) @@ -523,7 +614,6 @@ x_push_current_selection_request (struct selection_input_event *se, frame->request = se; frame->dpyinfo = dpyinfo; frame->converted_selections = NULL; - frame->conversion_fail_tag = None; selection_request_stack = frame; } @@ -554,7 +644,7 @@ x_selection_request_lisp_error (void) for (cs = frame->converted_selections; cs; cs = next) { next = cs->next; - if (! cs->nofree && cs->data) + if (cs->data) xfree (cs->data); xfree (cs); } @@ -564,250 +654,450 @@ x_selection_request_lisp_error (void) x_decline_selection_request (frame->request); } -static void -x_catch_errors_unwind (void) + + +static size_t +c_size_for_format (int format) { - block_input (); - x_uncatch_errors (); - unblock_input (); + switch (format) + { + case 8: + return sizeof (char); + + case 16: + return sizeof (short); + + case 32: + return sizeof (long); + } + + emacs_abort (); } - -/* This stuff is so that INCR selections are reentrant (that is, so we can - be servicing multiple INCR selection requests simultaneously.) I haven't - actually tested that yet. */ +static size_t +x_size_for_format (int format) +{ + switch (format) + { + case 8: + return 1; + + case 16: + return 2; -/* Keep a list of the property changes that are awaited. */ + case 32: + return 4; + } -struct prop_location + emacs_abort (); +} + +/* Return a pointer to the remaining part of the selection data, given + a pointer to a struct selection_data and an offset in items. Place + the number of items remaining in REMAINING. Garbage collection + must not happen, or the returned pointer becomes invalid. */ + +static unsigned char * +selection_data_for_offset (struct selection_data *data, + long offset, size_t *remaining) { - int identifier; - Display *display; - Window window; - Atom property; - int desired_state; - bool arrived; - struct prop_location *next; -}; + unsigned char *base; + size_t size; -static int prop_location_identifier; + if (!NILP (data->string)) + { + base = SDATA (data->string); + size = SBYTES (data->string); + } + else + { + base = data->data; + size = data->size; + } -static Lisp_Object property_change_reply; + if (offset >= size) + { + *remaining = 0; + return NULL; + } -static struct prop_location *property_change_reply_object; + base += (offset * c_size_for_format (data->format)); + *remaining = size - offset; + return base; +} -static struct prop_location *property_change_wait_list; +/* Return the size, in bytes transferred to the X server, of + data->size items of selection data in data->format-bit + quantities. */ -static void -set_property_change_object (struct prop_location *location) +static size_t +selection_data_size (struct selection_data *data) { - /* Input must be blocked so we don't get the event before we set these. */ - if (! input_blocked_p ()) - emacs_abort (); - XSETCAR (property_change_reply, Qnil); - property_change_reply_object = location; + size_t scratch; + + if (!NILP (data->string)) + return SBYTES (data->string); + + switch (data->format) + { + case 8: + return (size_t) data->size; + + case 16: + if (INT_MULTIPLY_WRAPV (data->size, 2, &scratch)) + return SIZE_MAX; + + return scratch; + + case 32: + if (INT_MULTIPLY_WRAPV (data->size, 4, &scratch)) + return SIZE_MAX; + + return scratch; + } + + /* The specified format is invalid. */ + emacs_abort (); } - -/* Send the reply to a selection request event EVENT. */ +/* Return whether or not another outstanding selection transfer is + still selecting for events on the specified requestor window. */ -#ifdef TRACE_SELECTION -static int x_reply_selection_request_cnt; -#endif /* TRACE_SELECTION */ +static bool +transfer_selecting_event (struct x_display_info *dpyinfo, + Window requestor) +{ + struct transfer *next; + + next = outstanding_transfers.next; + for (; next != &outstanding_transfers; next = next->next) + { + if (next->requestor == requestor + && next->dpyinfo == dpyinfo) + return true; + } + + return false; +} + +/* Cancel the specified selection transfer. When called by + `start_transfer', the transfer may be partially formed. */ static void -x_reply_selection_request (struct selection_input_event *event, - struct x_display_info *dpyinfo) +x_cancel_selection_transfer (struct transfer *transfer) { - XEvent reply_base; - XSelectionEvent *reply = &(reply_base.xselection); - Display *display = SELECTION_EVENT_DISPLAY (event); - Window window = SELECTION_EVENT_REQUESTOR (event); - ptrdiff_t bytes_remaining; - int max_bytes = selection_quantum (display); - specpdl_ref count = SPECPDL_INDEX (); - struct selection_data *cs; - struct x_selection_request *frame; + xfree (transfer->data.data); - frame = selection_request_stack; + if (transfer->next) + { + transfer->next->last = transfer->last; + transfer->last->next = transfer->next; + } - reply->type = SelectionNotify; - reply->display = display; - reply->requestor = window; - reply->selection = SELECTION_EVENT_SELECTION (event); - reply->time = SELECTION_EVENT_TIME (event); - reply->target = SELECTION_EVENT_TARGET (event); - reply->property = SELECTION_EVENT_PROPERTY (event); - if (reply->property == None) - reply->property = reply->target; + if (transfer->flags & SELECTED_EVENTS + && !transfer_selecting_event (transfer->dpyinfo, + transfer->requestor) + /* This can be called from x_delete_display. */ + && transfer->dpyinfo->display) + { + /* Ignore errors generated by the change window request in case + the window has gone away. */ + block_input (); + x_ignore_errors_for_next_request (transfer->dpyinfo, 0); + XSelectInput (transfer->dpyinfo->display, + transfer->requestor, NoEventMask); + x_stop_ignoring_errors (transfer->dpyinfo); + unblock_input (); + } - block_input (); - /* The protected block contains wait_for_property_change, which can - run random lisp code (process handlers) or signal. Therefore, we - put the x_uncatch_errors call in an unwind. */ - record_unwind_protect_void (x_catch_errors_unwind); - x_catch_errors (display); + cancel_atimer (transfer->timeout); + xfree (transfer); +} - /* Loop over converted selections, storing them in the requested - properties. If data is large, only store the first N bytes - (section 2.7.2 of ICCCM). Note that we store the data for a - MULTIPLE request in the opposite order; the ICCM says only that - the conversion itself must be done in the same order. */ - for (cs = frame->converted_selections; cs; cs = cs->next) +static void +x_selection_transfer_timeout (struct atimer *atimer) +{ + struct transfer *transfer; + + transfer = atimer->client_data; + x_cancel_selection_transfer (transfer); +} + +/* Start a selection transfer to write the specified selection data to + its requestor. If the data is small enough, write it to the + requestor window and return. Otherwise, start INCR transfer and + begin listening for PropertyNotify events on the requestor. */ + +static void +x_start_selection_transfer (struct x_display_info *dpyinfo, Window requestor, + struct selection_data *data) +{ + struct transfer *transfer; + intmax_t timeout; + intmax_t secs; + int nsecs; + size_t remaining, max_size; + unsigned char *xdata; + unsigned long data_size; + + timeout = max (0, x_selection_timeout); + secs = timeout / 1000; + nsecs = (timeout % 1000) * 1000000; + + transfer = xzalloc (sizeof *transfer); + transfer->requestor = requestor; + transfer->dpyinfo = dpyinfo; + + transfer->timeout = start_atimer (ATIMER_RELATIVE, + make_timespec (secs, nsecs), + x_selection_transfer_timeout, + transfer); + + /* Note that DATA is copied into transfer. DATA->data is then set + to NULL, giving the struct transfer ownership over the selection + data. */ + + transfer->data = *data; + data->data = NULL; + + /* Finally, transfer now holds a reference to data->string, if it is + present. GC cannot be allowed to happen until this function + returns. */ + data->string = Qnil; + + /* Now, try to write the selection data. If it is bigger than + selection_quantum (dpyinfo->display), start incremental transfer + and link the transfer onto the list of pending selections. + Otherwise, write the transfer at once. */ + + max_size = selection_quantum (dpyinfo->display); + + TRACE3 (" x_start_selection_transfer: transferring to 0x%lx. " + "transfer consists of %zu bytes, quantum being %zu", + requestor, selection_data_size (&transfer->data), + max_size); + + if (selection_data_size (&transfer->data) > max_size) { - if (cs->property == None) - continue; + /* Begin incremental selection transfer. First, calculate how + many elements it is ok to write for every ChangeProperty + request. */ + transfer->items_per_request + = (max_size / x_size_for_format (transfer->data.format)); + TRACE1 (" x_start_selection_transfer: starting incremental" + " selection transfer, with %zu items per request", + transfer->items_per_request); + + /* Next, link the transfer onto the list of pending selection + transfers. */ + transfer->next = outstanding_transfers.next; + transfer->last = &outstanding_transfers; + transfer->next->last = transfer; + transfer->last->next = transfer; + + /* Find a valid (non-zero) serial for the selection transfer. + Any asynchronously trapped errors will then cause the + selection transfer to be cancelled. */ + transfer->serial = (++selection_serial + ? selection_serial + : ++selection_serial); + + /* Now, write the INCR property to begin incremental selection + transfer. offset is currently 0. */ + + data_size = selection_data_size (&transfer->data); + + /* Set SELECTED_EVENTS before the actual XSelectInput + request. */ + transfer->flags |= SELECTED_EVENTS; + + x_ignore_errors_for_next_request (dpyinfo, transfer->serial); + XChangeProperty (dpyinfo->display, requestor, + transfer->data.property, + dpyinfo->Xatom_INCR, 32, PropModeReplace, + (unsigned char *) &data_size, 1); + + /* This assumes that Emacs is not selecting for any other events + from the requestor! + + If the holder of some manager selections (i.e. the settings + manager) asks Emacs for selection data, things will subtly go + wrong. */ + XSelectInput (dpyinfo->display, requestor, PropertyChangeMask); + x_stop_ignoring_errors (dpyinfo); + } + else + { + /* Write the property data now. */ + xdata = selection_data_for_offset (&transfer->data, + 0, &remaining); + eassert (remaining <= INT_MAX); + + TRACE1 (" x_start_selection_transfer: writing" + " %zu elements directly to requestor window", + remaining); + + x_ignore_errors_for_next_request (dpyinfo, 0); + XChangeProperty (dpyinfo->display, requestor, + transfer->data.property, + transfer->data.type, + transfer->data.format, + PropModeReplace, xdata, remaining); + x_stop_ignoring_errors (dpyinfo); + + /* Next, get rid of the transfer. */ + x_cancel_selection_transfer (transfer); + } +} - bytes_remaining = cs->size; - bytes_remaining *= cs->format >> 3; - if (bytes_remaining <= max_bytes) - { - /* Send all the data at once, with minimal handshaking. */ - TRACE1 ("Sending all %"pD"d bytes", bytes_remaining); - XChangeProperty (display, window, cs->property, - cs->type, cs->format, PropModeReplace, - cs->data, cs->size); - } - else - { - /* Send an INCR tag to initiate incremental transfer. */ - long value[1]; - - TRACE2 ("Start sending %"pD"d bytes incrementally (%s)", - bytes_remaining, XGetAtomName (display, cs->property)); - cs->wait_object - = expect_property_change (display, window, cs->property, - PropertyDelete); - - /* XChangeProperty expects an array of long even if long is - more than 32 bits. */ - value[0] = min (bytes_remaining, X_LONG_MAX); - XChangeProperty (display, window, cs->property, - dpyinfo->Xatom_INCR, 32, PropModeReplace, - (unsigned char *) value, 1); - XSelectInput (display, window, PropertyChangeMask); - } +/* Write out the next piece of data that is part of the specified + selection transfer. If no more data remains to be written, write + the EOF property and complete the transfer. */ + +static void +x_continue_selection_transfer (struct transfer *transfer) +{ + size_t remaining; + unsigned char *xdata; + + xdata = selection_data_for_offset (&transfer->data, + transfer->offset, + &remaining); + remaining = min (remaining, transfer->items_per_request); + + if (!remaining) + { + /* The transfer is finished. Write zero-length property data to + signal EOF and remove the transfer. */ + TRACE0 (" x_continue_selection_transfer: writing 0 items to" + " indicate EOF"); + x_ignore_errors_for_next_request (transfer->dpyinfo, 0); + XChangeProperty (transfer->dpyinfo->display, + transfer->requestor, + transfer->data.property, + transfer->data.type, + transfer->data.format, + PropModeReplace, + NULL, 0); + x_stop_ignoring_errors (transfer->dpyinfo); + TRACE0 (" x_continue_selection_transfer: done sending incrementally"); + + x_cancel_selection_transfer (transfer); + } + else + { + TRACE2 (" x_continue_selection_transfer: writing %zu items" + "; current offset is %zu", remaining, transfer->offset); + eassert (remaining <= INT_MAX); + + transfer->offset += remaining; + + x_ignore_errors_for_next_request (transfer->dpyinfo, + transfer->serial); + XChangeProperty (transfer->dpyinfo->display, + transfer->requestor, + transfer->data.property, + transfer->data.type, + transfer->data.format, + PropModeReplace, xdata, + remaining); + x_stop_ignoring_errors (transfer->dpyinfo); } +} - /* Now issue the SelectionNotify event. */ - XSendEvent (display, window, False, 0, &reply_base); - XFlush (display); +void +x_remove_selection_transfers (struct x_display_info *dpyinfo) +{ + struct transfer *next, *last; -#ifdef TRACE_SELECTION - { - char *sel = XGetAtomName (display, reply->selection); - char *tgt = XGetAtomName (display, reply->target); - TRACE3 ("Sent SelectionNotify: %s, target %s (%d)", - sel, tgt, ++x_reply_selection_request_cnt); - if (sel) XFree (sel); - if (tgt) XFree (tgt); - } -#endif /* TRACE_SELECTION */ + next = outstanding_transfers.next; + while (next != &outstanding_transfers) + { + last = next; + next = next->next; - /* Finish sending the rest of each of the INCR values. This should - be improved; there's a chance of deadlock if more than one - subtarget in a MULTIPLE selection requires an INCR transfer, and - the requestor and Emacs loop waiting on different transfers. */ - for (cs = frame->converted_selections; cs; cs = cs->next) - if (cs->wait_object) - { - int format_bytes = cs->format / 8; - bool had_errors_p = x_had_errors_p (display); + if (last->dpyinfo == dpyinfo) + x_cancel_selection_transfer (last); + } +} - /* Must set this inside block_input (). unblock_input may read - events and setting property_change_reply in - wait_for_property_change is then too late. */ - set_property_change_object (cs->wait_object); - unblock_input (); +/* Handle an X error generated trying to write to a window. SERIAL + identifies the outstanding incremental selection transfer, which is + immediately removed. */ - bytes_remaining = cs->size; - bytes_remaining *= format_bytes; +void +x_handle_selection_error (unsigned int serial, XErrorEvent *error) +{ + struct transfer *next, *last; - /* Wait for the requestor to ack by deleting the property. - This can run Lisp code (process handlers) or signal. */ - if (! had_errors_p) - { - TRACE1 ("Waiting for ACK (deletion of %s)", - XGetAtomName (display, cs->property)); - wait_for_property_change (cs->wait_object); - } - else - unexpect_property_change (cs->wait_object); + if (error->error_code != BadWindow) + /* The error was not caused by the window going away. As such, + Emacs must deselect for PropertyChangeMask from the requestor + window, which isn't safe here. Return and wait for the timeout + to run. */ + return; - while (bytes_remaining) - { - int i = ((bytes_remaining < max_bytes) - ? bytes_remaining - : max_bytes) / format_bytes; - block_input (); - - cs->wait_object - = expect_property_change (display, window, cs->property, - PropertyDelete); - - TRACE1 ("Sending increment of %d elements", i); - TRACE1 ("Set %s to increment data", - XGetAtomName (display, cs->property)); - - /* Append the next chunk of data to the property. */ - XChangeProperty (display, window, cs->property, - cs->type, cs->format, PropModeAppend, - cs->data, i); - bytes_remaining -= i * format_bytes; - cs->data += i * ((cs->format == 32) ? sizeof (long) - : format_bytes); - XFlush (display); - had_errors_p = x_had_errors_p (display); - /* See comment above about property_change_reply. */ - set_property_change_object (cs->wait_object); - unblock_input (); - - if (had_errors_p) break; - - /* Wait for the requestor to ack this chunk by deleting - the property. This can run Lisp code or signal. */ - TRACE1 ("Waiting for increment ACK (deletion of %s)", - XGetAtomName (display, cs->property)); - wait_for_property_change (cs->wait_object); - } + next = outstanding_transfers.next; + while (next != &outstanding_transfers) + { + last = next; + next = next->next; - /* Now write a zero-length chunk to the property to tell the - requestor that we're done. */ - block_input (); - if (! waiting_for_other_props_on_window (display, window)) - XSelectInput (display, window, 0); - - TRACE1 ("Set %s to a 0-length chunk to indicate EOF", - XGetAtomName (display, cs->property)); - XChangeProperty (display, window, cs->property, - cs->type, cs->format, PropModeReplace, - cs->data, 0); - TRACE0 ("Done sending incrementally"); - } + if (last->serial == serial) + { + /* Clear SELECTED_EVENTS, so x_cancel_selection_transfer + will not make X requests. That is unsafe inside an error + handler, and unnecessary because the window has already + gone. */ + last->flags &= ~SELECTED_EVENTS; + x_cancel_selection_transfer (last); + } + } +} - /* rms, 2003-01-03: I think I have fixed this bug. */ - /* The window we're communicating with may have been deleted - in the meantime (that's a real situation from a bug report). - In this case, there may be events in the event queue still - referring to the deleted window, and we'll get a BadWindow error - in XTread_socket when processing the events. I don't have - an idea how to fix that. gerd, 2001-01-98. */ - /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are - delivered before uncatch errors. */ - XSync (display, False); - unblock_input (); +/* Send the reply to a selection request event EVENT. */ + +static void +x_reply_selection_request (struct selection_input_event *event, + struct x_display_info *dpyinfo) +{ + XEvent message; + struct selection_data *cs; + struct x_selection_request *frame; - /* GTK queues events in addition to the queue in Xlib. So we - UNBLOCK to enter the event loop and get possible errors delivered, - and then BLOCK again because x_uncatch_errors requires it. */ block_input (); - /* This calls x_uncatch_errors. */ - unbind_to (count, Qnil); + frame = selection_request_stack; + + message.xselection.type = SelectionNotify; + message.xselection.display = dpyinfo->display; + message.xselection.requestor = SELECTION_EVENT_REQUESTOR (event); + message.xselection.selection = SELECTION_EVENT_SELECTION (event); + message.xselection.time = SELECTION_EVENT_TIME (event); + message.xselection.target = SELECTION_EVENT_TARGET (event); + message.xselection.property = SELECTION_EVENT_PROPERTY (event); + + if (message.xselection.property == None) + message.xselection.property = message.xselection.target; + + /* For each of the converted selections, start a write transfer from + Emacs to the requestor. */ + for (cs = frame->converted_selections; cs; cs = cs->next) + x_start_selection_transfer (dpyinfo, + SELECTION_EVENT_REQUESTOR (event), + cs); + + + /* Send the SelectionNotify event to the requestor, telling it that + the property data has arrived. */ + x_ignore_errors_for_next_request (dpyinfo, 0); + XSendEvent (dpyinfo->display, SELECTION_EVENT_REQUESTOR (event), + False, NoEventMask, &message); + x_stop_ignoring_errors (dpyinfo); unblock_input (); } - -/* Handle a SelectionRequest event EVENT. - This is called from keyboard.c when such an event is found in the queue. */ + +/* Handle a SelectionRequest event EVENT. This is called from + keyboard.c when such an event is found in the queue. */ static void x_handle_selection_request (struct selection_input_event *event) @@ -892,7 +1182,9 @@ x_handle_selection_request (struct selection_input_event *event) ptrdiff_t j, nselections; struct selection_data cs; - if (property == None) goto DONE; + if (property == None) + goto DONE; + multprop = x_get_window_property_as_lisp_data (dpyinfo, requestor, property, QMULTIPLE, selection, true); @@ -904,23 +1196,24 @@ x_handle_selection_request (struct selection_input_event *event) /* Perform conversions. This can signal. */ for (j = 0; j < nselections; j++) { - Lisp_Object subtarget = AREF (multprop, 2*j); + Lisp_Object subtarget = AREF (multprop, 2 * j); Atom subproperty = symbol_to_x_atom (dpyinfo, AREF (multprop, 2*j+1)); bool subsuccess = false; if (subproperty != None) subsuccess = x_convert_selection (selection_symbol, subtarget, - subproperty, true, dpyinfo, + subproperty, dpyinfo, use_alternate); if (!subsuccess) - ASET (multprop, 2*j+1, Qnil); + ASET (multprop, 2 * j + 1, Qnil); } + /* Save conversion results */ lisp_data_to_selection_data (dpyinfo, multprop, &cs); - /* If cs.type is ATOM, change it to ATOM_PAIR. This is because - the parameters to a MULTIPLE are ATOM_PAIRs. */ + /* If cs.type is ATOM, change it to ATOM_PAIR. This is + because the parameters to a MULTIPLE are ATOM_PAIRs. */ if (cs.type == XA_ATOM) cs.type = dpyinfo->Xatom_ATOM_PAIR; @@ -929,27 +1222,29 @@ x_handle_selection_request (struct selection_input_event *event) cs.type, cs.format, PropModeReplace, cs.data, cs.size); success = true; + + xfree (cs.data); } else { if (property == None) property = SELECTION_EVENT_TARGET (event); + success = x_convert_selection (selection_symbol, target_symbol, property, - false, dpyinfo, - use_alternate); + dpyinfo, use_alternate); } DONE: - if (pushed) - selection_request_stack->converted = true; - if (success) x_reply_selection_request (event, dpyinfo); else x_decline_selection_request (event); + if (pushed) + selection_request_stack->converted = true; + /* Run the `x-sent-selection-functions' abnormal hook. */ if (!NILP (Vx_sent_selection_functions) && !BASE_EQ (Vx_sent_selection_functions, Qunbound)) @@ -960,19 +1255,18 @@ x_handle_selection_request (struct selection_input_event *event) REALLY_DONE: unbind_to (count, Qnil); + return; } /* Perform the requested selection conversion, and write the data to the converted_selections linked list, where it can be accessed by - x_reply_selection_request. If FOR_MULTIPLE, write out - the data even if conversion fails, using conversion_fail_tag. + x_reply_selection_request. Return true if successful. */ static bool -x_convert_selection (Lisp_Object selection_symbol, - Lisp_Object target_symbol, Atom property, - bool for_multiple, struct x_display_info *dpyinfo, +x_convert_selection (Lisp_Object selection_symbol, Lisp_Object target_symbol, + Atom property, struct x_display_info *dpyinfo, bool use_alternate) { Lisp_Object lisp_selection; @@ -988,33 +1282,16 @@ x_convert_selection (Lisp_Object selection_symbol, /* A nil return value means we can't perform the conversion. */ if (NILP (lisp_selection) || (CONSP (lisp_selection) && NILP (XCDR (lisp_selection)))) - { - if (for_multiple) - { - cs = xmalloc (sizeof *cs); - cs->data = ((unsigned char *) - &selection_request_stack->conversion_fail_tag); - cs->size = 1; - cs->format = 32; - cs->type = XA_ATOM; - cs->nofree = true; - cs->property = property; - cs->wait_object = NULL; - cs->next = frame->converted_selections; - frame->converted_selections = cs; - } - - return false; - } + return false; /* Otherwise, record the converted selection to binary. */ cs = xmalloc (sizeof *cs); cs->data = NULL; - cs->nofree = true; + cs->string = Qnil; cs->property = property; - cs->wait_object = NULL; cs->next = frame->converted_selections; frame->converted_selections = cs; + lisp_data_to_selection_data (dpyinfo, lisp_selection, cs); return true; } @@ -1274,6 +1551,10 @@ void x_handle_property_notify (const XPropertyEvent *event) { struct prop_location *rest; + struct transfer *next; +#ifdef TRACE_SELECTION + char *name; +#endif for (rest = property_change_wait_list; rest; rest = rest->next) { @@ -1283,9 +1564,16 @@ x_handle_property_notify (const XPropertyEvent *event) && rest->display == event->display && rest->desired_state == event->state) { +#ifdef TRACE_SELECTION + name = XGetAtomName (event->display, event->atom); + TRACE2 ("Expected %s of property %s", (event->state == PropertyDelete ? "deletion" : "change"), - XGetAtomName (event->display, event->atom)); + name ? name : "unknown"); + + if (name) + XFree (name); +#endif rest->arrived = true; @@ -1297,6 +1585,26 @@ x_handle_property_notify (const XPropertyEvent *event) return; } } + + /* Look for a property change for an outstanding selection + transfer. */ + next = outstanding_transfers.next; + while (next != &outstanding_transfers) + { + if (next->dpyinfo->display == event->display + && next->requestor == event->window + && next->data.property == event->atom + && event->state == PropertyDelete) + { + TRACE1 ("Expected PropertyDelete event arrived from the" + " requestor window %lx", next->requestor); + + x_continue_selection_transfer (next); + return; + } + + next = next->next; + } } static void @@ -1450,10 +1758,10 @@ x_get_window_property (Display *display, Window window, Atom property, /* Maximum value for TOTAL_SIZE. It cannot exceed PTRDIFF_MAX - 1 and SIZE_MAX - 1, for an extra byte at the end. And it cannot exceed LONG_MAX * X_LONG_SIZE, for XGetWindowProperty. */ - ptrdiff_t total_size_max = - ((min (PTRDIFF_MAX, SIZE_MAX) - 1) / x_long_size < LONG_MAX - ? min (PTRDIFF_MAX, SIZE_MAX) - 1 - : LONG_MAX * x_long_size); + ptrdiff_t total_size_max + = ((min (PTRDIFF_MAX, SIZE_MAX) - 1) / x_long_size < LONG_MAX + ? min (PTRDIFF_MAX, SIZE_MAX) - 1 + : LONG_MAX * x_long_size); block_input (); @@ -1946,10 +2254,14 @@ static void lisp_data_to_selection_data (struct x_display_info *dpyinfo, Lisp_Object obj, struct selection_data *cs) { - Lisp_Object type = Qnil; + Lisp_Object type; + char **name_buffer; + + USE_SAFE_ALLOCA; + + type = Qnil; eassert (cs != NULL); - cs->nofree = false; if (CONSP (obj) && SYMBOLP (XCAR (obj))) { @@ -1959,8 +2271,10 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, obj = XCAR (obj); } + /* This is not the same as declining. */ + if (EQ (obj, QNULL) || (EQ (type, QNULL))) - { /* This is not the same as declining */ + { cs->format = 32; cs->size = 0; cs->data = NULL; @@ -1971,12 +2285,14 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, if (SCHARS (obj) < SBYTES (obj)) /* OBJ is a multibyte string containing a non-ASCII char. */ signal_error ("Non-ASCII string must be encoded in advance", obj); + if (NILP (type)) type = QSTRING; + cs->format = 8; - cs->size = SBYTES (obj); - cs->data = SDATA (obj); - cs->nofree = true; + cs->size = -1; + cs->data = NULL; + cs->string = obj; } else if (SYMBOLP (obj)) { @@ -2048,8 +2364,19 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, x_atoms = data; cs->format = 32; cs->size = size; - for (i = 0; i < size; i++) - x_atoms[i] = symbol_to_x_atom (dpyinfo, AREF (obj, i)); + + if (size == 1) + x_atoms[0] = symbol_to_x_atom (dpyinfo, AREF (obj, i)); + else + { + SAFE_NALLOCA (name_buffer, sizeof *x_atoms, size); + + for (i = 0; i < size; i++) + name_buffer[i] = SSDATA (SYMBOL_NAME (AREF (obj, i))); + + x_intern_atoms (dpyinfo, name_buffer, size, + x_atoms); + } } else /* This vector is an INTEGER set, or something like it */ @@ -2091,6 +2418,8 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, signal_error (/* Qselection_error */ "Unrecognized selection data", obj); cs->type = symbol_to_x_atom (dpyinfo, type); + + SAFE_FREE (); } static Lisp_Object @@ -2618,8 +2947,8 @@ x_check_property_data (Lisp_Object data) XClientMessageEvent). */ void -x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, - int nelements_max, int format) +x_fill_property_data (struct x_display_info *dpyinfo, Lisp_Object data, + void *ret, int nelements_max, int format) { unsigned long val; unsigned long *d32 = (unsigned long *) ret; @@ -2654,7 +2983,7 @@ x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, else if (STRINGP (o)) { block_input (); - val = XInternAtom (dpy, SSDATA (o), False); + val = x_intern_cached_atom (dpyinfo, SSDATA (o), false); unblock_input (); } else @@ -2942,7 +3271,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, memset (event.xclient.data.l, 0, sizeof (event.xclient.data.l)); /* event.xclient.data can hold 20 chars, 10 shorts, or 5 longs. */ - x_fill_property_data (dpyinfo->display, values, event.xclient.data.b, + x_fill_property_data (dpyinfo, values, event.xclient.data.b, 5 * 32 / event.xclient.format, event.xclient.format); @@ -3002,10 +3331,11 @@ syms_of_xselect (void) reading_selection_reply = Fcons (Qnil, Qnil); staticpro (&reading_selection_reply); - staticpro (&property_change_reply); - /* FIXME: Duplicate definition in nsselect.c. */ + outstanding_transfers.next = &outstanding_transfers; + outstanding_transfers.last = &outstanding_transfers; + DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist, doc: /* An alist associating X Windows selection-types with functions. These functions are called to convert the selection, with three args: @@ -3120,9 +3450,43 @@ Note that this does not affect setting or owning selections. */); static void syms_of_xselect_for_pdumper (void) { + outstanding_transfers.next = &outstanding_transfers; + outstanding_transfers.last = &outstanding_transfers; + reading_selection_window = 0; reading_which_selection = 0; property_change_wait_list = 0; prop_location_identifier = 0; property_change_reply = Fcons (Qnil, Qnil); } + +void +mark_xselect (void) +{ + struct transfer *next; + struct x_selection_request *frame; + struct selection_data *cs; + + /* Mark all the strings being used as selection data. A string that + is still reachable is always reachable via either the selection + request stack or the list of outstanding transfers. */ + + next = outstanding_transfers.next; + + if (!next) + /* syms_of_xselect has not yet been called. */ + return; + + while (next != &outstanding_transfers) + { + mark_object (next->data.string); + next = next->next; + } + + frame = selection_request_stack; + for (; frame; frame = frame->last) + { + for (cs = frame->converted_selections; cs; cs = cs->next) + mark_object (cs->string); + } +} diff --git a/src/xterm.c b/src/xterm.c index e981a36fa9c..d621d94a2cf 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -26,6 +26,22 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ contains subroutines comprising the redisplay interface, setting up scroll bars and widgets, and handling input. + X WINDOW SYSTEM + + The X Window System is a windowing system for bitmap graphics + displays which originated at MIT in 1984. Version 11, which is + currently supported by Emacs, first appeared in September 1987. + + X has a long history and has been developed by many different + organizations over the years; at present, it is being primarily + developed by the X.Org Foundation. It is the main window system + that Emacs is developed and tested against, and X version 10 was + the first window system that Emacs was ported to. As a consequence + of its age and wide availability, X contains many idiosyncrasies, + but that has not prevented it from becoming the dominant free + window system, and the platform of reference for all GUI code in + Emacs. + Some of what is explained below also applies to the other window systems that Emacs supports, to varying degrees. YMMV. @@ -555,7 +571,56 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ drop happening with the primary selection and synthetic button events (see `x_dnd_do_unsupported_drop'). That function implements the OffiX drag-and-drop protocol by default. See - `x-dnd-handle-unsupported-drop' in `x-dnd.el' for more details. */ + `x-dnd-handle-unsupported-drop' in `x-dnd.el' for more details. + + DISPLAY ERROR HANDLING + + While error handling under X was originally designed solely as a + mechanism for the X server to report fatal errors to clients, most + clients (including Emacs) have adopted a system of "error traps" to + handle or discard these errors as they arrive. Discarding errors is + usually necessary when Emacs performs an X request that might fail: + for example, sending a message to a window that may no longer exist, + or might not exist at all. Handling errors is then necessary when + the detailed error must be reported to another piece of code: for + example, as a Lisp error. + + It is not acceptable for Emacs to crash when it is sent invalid data + by another client, or by Lisp. As a result, errors must be caught + around Xlib functions generating requests containing resource + identifiers that could potentially be invalid, such as window or + atom identifiers provided in a client message from another program, + or a child window ID obtained through XTranslateCoordinates that may + refer to a window that has been deleted in the meantime. + + There are two sets of functions used to perform this "error + trapping". Which one should be used depends on what kind of + processing must be done on the error. The first consists of the + functions `x_ignore_errors_for_next_request' and + `x_stop_ignoring_errors', which ignore errors generated by requests + made in between a call to the first function and a corresponding + call to the second. They should be used for simple asynchronous + requests that do not require a reply from the X server: using them + instead of the second set improves performance, as they simply + record a range of request serials to ignore errors from, instead of + synchronizing with the X server to handle errors. + + The second set consists of the following functions: + + - x_catch_errors_with_handler + - x_catch_errors + - x_uncatch_errors_after_check + - x_uncatch_errors + - x_check_errors + - x_had_errors_p + - x_clear_errors + + Callers using this set should consult the comment(s) on top of the + aformentioned functions. They should not be used when the requests + being made do not require roundtrips to the X server, and obtaining + the details of any error generated is unecessary, as + `x_uncatch_errors' will always synchronize with the X server, which + is a potentially slow operation. */ #include <config.h> #include <stdlib.h> @@ -571,10 +636,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "xterm.h" #include <X11/cursorfont.h> +#ifdef HAVE_X_I18N +#include "textconv.h" +#endif + #ifdef USE_XCB #include <xcb/xproto.h> #include <xcb/xcb.h> -#include <xcb/xcb_aux.h> #endif /* If we have Xfixes extension, use it for pointer blanking. */ @@ -1052,6 +1120,20 @@ static const struct x_atom_ref x_atom_refs[] = /* Old OffiX (a.k.a. old KDE) drop protocol support. */ ATOM_REFS_INIT ("DndProtocol", Xatom_DndProtocol) ATOM_REFS_INIT ("_DND_PROTOCOL", Xatom_DND_PROTOCOL) + /* Here are some atoms that are not actually used from C, just + defined to make replying to selection requests fast. */ + ATOM_REFS_INIT ("text/plain;charset=utf-8", Xatom_text_plain_charset_utf_8) + ATOM_REFS_INIT ("LENGTH", Xatom_LENGTH) + ATOM_REFS_INIT ("FILE_NAME", Xatom_FILE_NAME) + ATOM_REFS_INIT ("CHARACTER_POSITION", Xatom_CHARACTER_POSITION) + ATOM_REFS_INIT ("LINE_NUMBER", Xatom_LINE_NUMBER) + ATOM_REFS_INIT ("COLUMN_NUMBER", Xatom_COLUMN_NUMBER) + ATOM_REFS_INIT ("OWNER_OS", Xatom_OWNER_OS) + ATOM_REFS_INIT ("HOST_NAME", Xatom_HOST_NAME) + ATOM_REFS_INIT ("USER", Xatom_USER) + ATOM_REFS_INIT ("CLASS", Xatom_CLASS) + ATOM_REFS_INIT ("NAME", Xatom_NAME) + ATOM_REFS_INIT ("SAVE_TARGETS", Xatom_SAVE_TARGETS) }; enum @@ -2509,7 +2591,7 @@ xm_send_drop_message (struct x_display_info *dpyinfo, Window source, *((uint32_t *) &msg.xclient.data.b[12]) = dmsg->index_atom; *((uint32_t *) &msg.xclient.data.b[16]) = dmsg->source_window; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -2536,7 +2618,7 @@ xm_send_top_level_enter_message (struct x_display_info *dpyinfo, Window source, msg.xclient.data.b[18] = 0; msg.xclient.data.b[19] = 0; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -2567,7 +2649,7 @@ xm_send_drag_motion_message (struct x_display_info *dpyinfo, Window source, msg.xclient.data.b[18] = 0; msg.xclient.data.b[19] = 0; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -2626,7 +2708,7 @@ xm_send_top_level_leave_message (struct x_display_info *dpyinfo, Window source, msg.xclient.data.b[18] = 0; msg.xclient.data.b[19] = 0; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -2921,7 +3003,7 @@ x_dnd_free_toplevels (bool display_alive) if (n_windows) { eassume (dpyinfo); - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); for (i = 0; i < n_windows; ++i) { @@ -3058,7 +3140,7 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) 0, 0); get_property_cookies[i] = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) toplevels[i], - (xcb_atom_t) dpyinfo->Xatom_wm_state, XCB_ATOM_ANY, + (xcb_atom_t) dpyinfo->Xatom_wm_state, 0, 0, 2); xm_property_cookies[i] = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) toplevels[i], @@ -3069,7 +3151,7 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) toplevels[i], (xcb_atom_t) dpyinfo->Xatom_net_frame_extents, - XCB_ATOM_CARDINAL, 0, 4); + XA_CARDINAL, 0, 4); get_geometry_cookies[i] = xcb_get_geometry (dpyinfo->xcb_connection, (xcb_window_t) toplevels[i]); @@ -3197,7 +3279,7 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) { if (xcb_get_property_value_length (extent_property_reply) == 16 && extent_property_reply->format == 32 - && extent_property_reply->type == XCB_ATOM_CARDINAL) + && extent_property_reply->type == XA_CARDINAL) { fextents = xcb_get_property_value (extent_property_reply); frame_extents[0] = fextents[0]; @@ -3291,7 +3373,7 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) if (dpyinfo->xshape_supported_p) { - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XShapeSelectInput (dpyinfo->display, toplevels[i], ShapeNotifyMask); @@ -3456,7 +3538,7 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) } #endif - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSelectInput (dpyinfo->display, toplevels[i], (attrs.your_event_mask | StructureNotifyMask @@ -3571,13 +3653,13 @@ x_dnd_get_proxy_proto (struct x_display_info *dpyinfo, Window wdesc, xdnd_proxy_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) wdesc, (xcb_atom_t) dpyinfo->Xatom_XdndProxy, - XCB_ATOM_WINDOW, 0, 1); + XA_WINDOW, 0, 1); if (proto_out) xdnd_proto_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) wdesc, (xcb_atom_t) dpyinfo->Xatom_XdndAware, - XCB_ATOM_ATOM, 0, 1); + XA_ATOM, 0, 1); if (proxy_out) { @@ -3589,7 +3671,7 @@ x_dnd_get_proxy_proto (struct x_display_info *dpyinfo, Window wdesc, else { if (reply->format == 32 - && reply->type == XCB_ATOM_WINDOW + && reply->type == XA_WINDOW && (xcb_get_property_value_length (reply) >= 4)) *proxy_out = *(xcb_window_t *) xcb_get_property_value (reply); @@ -3607,7 +3689,7 @@ x_dnd_get_proxy_proto (struct x_display_info *dpyinfo, Window wdesc, else { if (reply->format == 32 - && reply->type == XCB_ATOM_ATOM + && reply->type == XA_ATOM && (xcb_get_property_value_length (reply) >= 4)) *proto_out = (int) *(xcb_atom_t *) xcb_get_property_value (reply); @@ -3791,15 +3873,15 @@ x_dnd_get_wm_state_and_proto (struct x_display_info *dpyinfo, wmstate_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) window, (xcb_atom_t) dpyinfo->Xatom_wm_state, - XCB_ATOM_ANY, 0, 2); + 0, 0, 2); xdnd_proto_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) window, (xcb_atom_t) dpyinfo->Xatom_XdndAware, - XCB_ATOM_ATOM, 0, 1); + XA_ATOM, 0, 1); xdnd_proxy_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) window, (xcb_atom_t) dpyinfo->Xatom_XdndProxy, - XCB_ATOM_WINDOW, 0, 1); + XA_WINDOW, 0, 1); xm_style_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) window, (xcb_atom_t) dpyinfo->Xatom_MOTIF_DRAG_RECEIVER_INFO, @@ -3846,7 +3928,7 @@ x_dnd_get_wm_state_and_proto (struct x_display_info *dpyinfo, else { if (reply->format == 32 - && reply->type == XCB_ATOM_WINDOW + && reply->type == XA_WINDOW && (xcb_get_property_value_length (reply) >= 4)) *proxy_out = *(xcb_window_t *) xcb_get_property_value (reply); @@ -3962,6 +4044,12 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, if (owner != FRAME_X_WINDOW (f)) return; + /* mouse-drag-and-drop-region will immediately deactivate the mark + after this is set. Make sure the primary selection is not + clobbered in that case by setting `deactivate-mark' to + Qdont_save. */ + Vdeactivate_mark = Qdont_save; + event.xbutton.window = child; event.xbutton.subwindow = None; event.xbutton.x = dest_x; @@ -3975,7 +4063,7 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, event.xbutton.type = ButtonPress; event.xbutton.time = before + 1; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, child, True, ButtonPressMask, &event); @@ -4487,7 +4575,7 @@ x_dnd_send_enter (struct frame *f, Window target, Window toplevel, so we don't have to set it again. */ x_dnd_init_type_lists = true; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -4559,7 +4647,7 @@ x_dnd_send_position (struct frame *f, Window target, Window toplevel, return; } - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); @@ -4586,7 +4674,7 @@ x_dnd_send_leave (struct frame *f, Window target, Window toplevel) x_dnd_waiting_for_status_window = None; x_dnd_pending_send_position.type = 0; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); } @@ -4619,7 +4707,7 @@ x_dnd_send_drop (struct frame *f, Window target, Window toplevel, if (supported >= 1) msg.xclient.data.l[2] = timestamp; - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); x_stop_ignoring_errors (dpyinfo); return true; @@ -5666,7 +5754,8 @@ xi_device_from_id (struct x_display_info *dpyinfo, int deviceid) static void xi_link_touch_point (struct xi_device_t *device, - int detail, double x, double y) + int detail, double x, double y, + struct frame *frame) { struct xi_touch_point_t *touchpoint; @@ -5675,6 +5764,7 @@ xi_link_touch_point (struct xi_device_t *device, touchpoint->x = x; touchpoint->y = y; touchpoint->number = detail; + touchpoint->frame = frame; device->touchpoints = touchpoint; } @@ -5703,6 +5793,36 @@ xi_unlink_touch_point (int detail, return false; } +/* Unlink all touch points associated with the frame F. + This is done upon unmapping or destroying F's window, because + touch point delivery after that point is undefined. */ + +static void +xi_unlink_touch_points (struct frame *f) +{ + struct xi_device_t *device; + struct xi_touch_point_t **next, *last; + int i; + + for (i = 0; i < FRAME_DISPLAY_INFO (f)->num_devices; ++i) + { + device = &FRAME_DISPLAY_INFO (f)->devices[i]; + + /* Now unlink all touch points on DEVICE matching F. */ + + for (next = &device->touchpoints; (last = *next);) + { + if (last->frame == f) + { + *next = last->next; + xfree (last); + } + else + next = &last->next; + } + } +} + static struct xi_touch_point_t * xi_find_touch_point (struct xi_device_t *device, int detail) { @@ -6733,7 +6853,7 @@ x_set_frame_alpha (struct frame *f) Do this unconditionally as this function is called on reparent when alpha has not changed on the frame. */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); if (!FRAME_PARENT_FRAME (f)) { @@ -6909,6 +7029,7 @@ static void x_sync_wait_for_frame_drawn_event (struct frame *f) { XEvent event; + struct x_display_info *dpyinfo; if (!FRAME_X_WAITING_FOR_DRAW (f) /* The compositing manager can't draw a frame if it is @@ -6916,6 +7037,8 @@ x_sync_wait_for_frame_drawn_event (struct frame *f) || !FRAME_VISIBLE_P (f)) return; + dpyinfo = FRAME_DISPLAY_INFO (f); + /* Wait for the frame drawn message to arrive. */ if (x_if_event (FRAME_X_DISPLAY (f), &event, x_sync_is_frame_drawn_event, (XPointer) f, @@ -6931,6 +7054,11 @@ x_sync_wait_for_frame_drawn_event (struct frame *f) "been disabled\n"); FRAME_X_OUTPUT (f)->use_vsync_p = false; + /* Remove the compositor bypass property from the outer + window. */ + XDeleteProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_bypass_compositor); + /* Also change the frame parameter to reflect the new state. */ store_frame_param (f, Quse_frame_synchronization, Qnil); @@ -6944,7 +7072,7 @@ x_sync_wait_for_frame_drawn_event (struct frame *f) } } else - x_sync_note_frame_times (FRAME_DISPLAY_INFO (f), f, &event); + x_sync_note_frame_times (dpyinfo, f, &event); FRAME_X_WAITING_FOR_DRAW (f) = false; } @@ -7557,6 +7685,46 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row) #endif } +/* Generate a premultiplied pixel value for COLOR with ALPHA applied + on the given display. COLOR will be modified. The display must + use a visual that supports an alpha channel. + + This is possibly dead code on builds which do not support + XRender. */ + +#ifndef USE_CAIRO + +static unsigned long +x_premultiply_pixel (struct x_display_info *dpyinfo, + XColor *color, double alpha) +{ + unsigned long pixel; + + eassert (dpyinfo->alpha_bits); + + /* Multiply the RGB channels. */ + color->red *= alpha; + color->green *= alpha; + color->blue *= alpha; + + /* First, allocate a fully opaque pixel. */ + pixel = x_make_truecolor_pixel (dpyinfo, color->red, + color->green, + color->blue); + + /* Next, erase the alpha component. */ + pixel &= ~dpyinfo->alpha_mask; + + /* And add an alpha channel. */ + pixel |= (((unsigned long) (alpha * 65535) + >> (16 - dpyinfo->alpha_bits)) + << dpyinfo->alpha_offset); + + return pixel; +} + +#endif + static void x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fringe_bitmap_params *p) @@ -7646,18 +7814,15 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, if (FRAME_DISPLAY_INFO (f)->alpha_bits && f->alpha_background < 1.0) { + /* Extend the background color with an alpha channel + according to f->alpha_background. */ bg.pixel = background; x_query_colors (f, &bg, 1); - bg.red *= f->alpha_background; - bg.green *= f->alpha_background; - bg.blue *= f->alpha_background; - background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f), - bg.red, bg.green, bg.blue); - background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask; - background |= (((unsigned long) (f->alpha_background * 0xffff) - >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) - << FRAME_DISPLAY_INFO (f)->alpha_offset); + background + = x_premultiply_pixel (FRAME_DISPLAY_INFO (f), + &bg, + f->alpha_background); } /* Draw the bitmap. I believe these small pixmaps can be cached @@ -8806,7 +8971,11 @@ x_color_cells (Display *dpy, int *ncells) /* On frame F, translate pixel colors to RGB values for the NCOLORS - colors in COLORS. Use cached information, if available. */ + colors in COLORS. Use cached information, if available. + + Pixel values are in unsigned normalized format, meaning that + extending missing bits is done straightforwardly without any + complex colorspace conversions. */ void x_query_colors (struct frame *f, XColor *colors, int ncolors) @@ -8854,6 +9023,7 @@ x_query_colors (struct frame *f, XColor *colors, int ncolors) colors[i].green = (g * gmult) >> 16; colors[i].blue = (b * bmult) >> 16; } + return; } @@ -8896,16 +9066,10 @@ x_query_frame_background_color (struct frame *f, XColor *bgcolor) { bg.pixel = background; x_query_colors (f, &bg, 1); - bg.red *= f->alpha_background; - bg.green *= f->alpha_background; - bg.blue *= f->alpha_background; - background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f), - bg.red, bg.green, bg.blue); - background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask; - background |= (((unsigned long) (f->alpha_background * 0xffff) - >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) - << FRAME_DISPLAY_INFO (f)->alpha_offset); + background + = x_premultiply_pixel (FRAME_DISPLAY_INFO (f), + &bg, f->alpha_background); } #endif } @@ -10995,6 +11159,31 @@ x_clear_frame (struct frame *f) unblock_input (); } +/* Send a message to frame F telling the event loop to track whether + or not an hourglass is being displayed. This is required to ignore + the right events when the hourglass is mapped without callig XSync + after displaying or hiding the hourglass. */ + +static void +x_send_hourglass_message (struct frame *f, bool hourglass_enabled) +{ + struct x_display_info *dpyinfo; + XEvent msg; + + dpyinfo = FRAME_DISPLAY_INFO (f); + memset (&msg, 0, sizeof msg); + + msg.xclient.type = ClientMessage; + msg.xclient.message_type + = dpyinfo->Xatom_EMACS_TMP; + msg.xclient.format = 8; + msg.xclient.window = FRAME_X_WINDOW (f); + msg.xclient.data.b[0] = hourglass_enabled ? 1 : 0; + + XSendEvent (dpyinfo->display, FRAME_X_WINDOW (f), + False, NoEventMask, &msg); +} + /* RIF: Show hourglass cursor on frame F. */ static void @@ -11015,14 +11204,14 @@ x_show_hourglass (struct frame *f) if (popup_activated ()) return; + x_send_hourglass_message (f, true); + #ifdef USE_X_TOOLKIT if (x->widget) #else if (FRAME_OUTER_WINDOW (f)) #endif { - x->hourglass_p = true; - if (!x->hourglass_window) { #ifndef USE_XCB @@ -11089,15 +11278,11 @@ x_hide_hourglass (struct frame *f) { #ifndef USE_XCB XUnmapWindow (FRAME_X_DISPLAY (f), x->hourglass_window); - /* Sync here because XTread_socket looks at the - hourglass_p flag that is reset to zero below. */ - XSync (FRAME_X_DISPLAY (f), False); #else xcb_unmap_window (FRAME_DISPLAY_INFO (f)->xcb_connection, (xcb_window_t) x->hourglass_window); - xcb_aux_sync (FRAME_DISPLAY_INFO (f)->xcb_connection); #endif - x->hourglass_p = false; + x_send_hourglass_message (f, false); } } @@ -11221,21 +11406,32 @@ XTflash (struct frame *f) static void XTring_bell (struct frame *f) { - if (FRAME_X_DISPLAY (f)) + struct x_display_info *dpyinfo; + + if (!FRAME_X_DISPLAY (f)) + return; + + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (visible_bell) + XTflash (f); + else { - if (visible_bell) - XTflash (f); - else - { - block_input (); + /* When Emacs is untrusted, Bell requests sometimes generate + Access errors. This is not in the security extension + specification but seems to be a bug in the X consortium XKB + implementation. */ + + block_input (); + x_ignore_errors_for_next_request (dpyinfo, 0); #ifdef HAVE_XKB - XkbBell (FRAME_X_DISPLAY (f), None, 0, None); + XkbBell (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 0, None); #else - XBell (FRAME_X_DISPLAY (f), 0); + XBell (FRAME_X_DISPLAY (f), 0); #endif - XFlush (FRAME_X_DISPLAY (f)); - unblock_input (); - } + XFlush (FRAME_X_DISPLAY (f)); + x_stop_ignoring_errors (dpyinfo); + unblock_input (); } } @@ -11481,7 +11677,7 @@ x_frame_highlight (struct frame *f) the window-manager in use, tho something more is at play since I've been using that same window-manager binary for ever. Let's not crash just because of this (bug#9310). */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->border_pixel); x_stop_ignoring_errors (dpyinfo); @@ -11504,7 +11700,7 @@ x_frame_unhighlight (struct frame *f) block_input (); /* Same as above for XSetWindowBorder (bug#9310). */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSetWindowBorderPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->border_tile); x_stop_ignoring_errors (dpyinfo); @@ -11568,7 +11764,7 @@ x_new_focus_frame (struct x_display_info *dpyinfo, struct frame *frame) x_frame_rehighlight (dpyinfo); } -#ifdef HAVE_XFIXES +#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000 /* True if the display in DPYINFO supports a version of Xfixes sufficient for pointer blanking. */ @@ -11580,11 +11776,12 @@ x_fixes_pointer_blanking_supported (struct x_display_info *dpyinfo) && dpyinfo->xfixes_major >= 4); } -#endif /* HAVE_XFIXES */ +#endif /* HAVE_XFIXES && XFIXES_VERSION >= 40000 */ /* Toggle mouse pointer visibility on frame F using the XFixes extension. */ -#ifdef HAVE_XFIXES +#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000 + static void xfixes_toggle_visible_pointer (struct frame *f, bool invisible) @@ -11595,6 +11792,7 @@ xfixes_toggle_visible_pointer (struct frame *f, bool invisible) XFixesShowCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); f->pointer_invisible = invisible; } + #endif /* HAVE_XFIXES */ /* Create invisible cursor on the X display referred by DPYINFO. */ @@ -11643,7 +11841,7 @@ x_toggle_visible_pointer (struct frame *f, bool invisible) if (dpyinfo->invisible_cursor == None) dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); -#ifndef HAVE_XFIXES +#if !defined HAVE_XFIXES || XFIXES_VERSION < 40000 if (dpyinfo->invisible_cursor == None) invisible = false; #else @@ -11676,7 +11874,7 @@ static void XTtoggle_invisible_pointer (struct frame *f, bool invisible) { block_input (); -#ifdef HAVE_XFIXES +#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000 if (FRAME_DISPLAY_INFO (f)->fixes_pointer_blanking && x_fixes_pointer_blanking_supported (FRAME_DISPLAY_INFO (f))) xfixes_toggle_visible_pointer (f, invisible); @@ -12265,6 +12463,13 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, struct xi_device_t *device; #endif + if (FRAME_DISPLAY_INFO (f)->untrusted) + /* Untrusted clients cannot send messages to trusted clients or + read the window tree, so drag and drop will likely not work at + all. */ + error ("Drag-and-drop is not possible when the client is" + " not trusted by the X server."); + base = SPECPDL_INDEX (); /* Bind this here to avoid juggling bindings and SAFE_FREE in @@ -13370,6 +13575,10 @@ xi_disable_devices (struct x_display_info *dpyinfo, #ifdef HAVE_XINPUT2_2 struct xi_touch_point_t *tem, *last; #endif +#if defined HAVE_XINPUT2_2 && !defined HAVE_EXT_TOOL_BAR + struct x_output *output; + Lisp_Object tail, frame; +#endif /* Don't pointlessly copy dpyinfo->devices if there are no devices to disable. */ @@ -13412,6 +13621,34 @@ xi_disable_devices (struct x_display_info *dpyinfo, tem = tem->next; xfree (last); } + +#ifndef HAVE_EXT_TOOL_BAR + + /* Now look through each frame on DPYINFO. If it has an + outstanding tool bar press for this device, release + the tool bar. */ + + FOR_EACH_FRAME (tail, frame) + { + if (!FRAME_X_P (XFRAME (frame)) + || (FRAME_DISPLAY_INFO (XFRAME (frame)) + != dpyinfo)) + continue; + + output = FRAME_OUTPUT_DATA (XFRAME (frame)); + + if (output->tool_bar_touch_device + == dpyinfo->devices[i].device_id) + { + if (XFRAME (frame)->last_tool_bar_item != -1 + && WINDOWP (XFRAME (frame)->tool_bar_window)) + handle_tool_bar_click (XFRAME (frame), 0, 0, + false, 0); + + output->tool_bar_touch_device = 0; + } + } +#endif #endif goto out; @@ -15036,9 +15273,7 @@ x_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part, XClientMessageEvent *ev = &event.xclient; struct window *w = XWINDOW (window); struct frame *f = XFRAME (w->frame); - intptr_t iw = (intptr_t) w; verify (INTPTR_WIDTH <= 64); - int sign_shift = INTPTR_WIDTH - 32; /* Don't do anything if too many scroll bar events have been sent but not received. */ @@ -15055,15 +15290,11 @@ x_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part, ev->window = FRAME_X_WINDOW (f); ev->format = 32; - /* A 32-bit X client can pass a window pointer through the X server - as-is. - - A 64-bit client is in trouble because a pointer does not fit in - the 32 bits given for ClientMessage data and will be truncated by - Xlib. So use two slots and hope that X12 will resolve such - issues someday. */ - ev->data.l[0] = iw >> 31 >> 1; - ev->data.l[1] = sign_shift <= 0 ? iw : iw << sign_shift >> sign_shift; + /* These messages formerly contained a pointer to the window, but + now that information is kept internally. The following two + fields are thus zero. */ + ev->data.l[0] = 0; + ev->data.l[1] = 0; ev->data.l[2] = part; ev->data.l[3] = portion; ev->data.l[4] = whole; @@ -18494,7 +18725,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_dnd_waiting_for_status_window = None; else { - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSendEvent (dpyinfo->display, target, False, NoEventMask, &x_dnd_pending_send_position); @@ -18608,6 +18839,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } + if (event->xclient.message_type == dpyinfo->Xatom_EMACS_TMP + && event->xclient.format == 8) + { + /* This is actually an hourglass message. Set whether or + not events from here on have the hourglass enabled. */ + + if (any) + FRAME_X_OUTPUT (any)->hourglass_p = event->xclient.data.b[0]; + } + if (event->xclient.message_type == dpyinfo->Xatom_wm_protocols && event->xclient.format == 32) { @@ -19196,7 +19437,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) FRAME_OUTER_WINDOW (f), (xcb_atom_t) dpyinfo->Xatom_net_wm_window_opacity, - XCB_ATOM_CARDINAL, 0, 1); + XA_CARDINAL, 0, 1); opacity_reply = xcb_get_property_reply (dpyinfo->xcb_connection, opacity_cookie, &error); @@ -19205,9 +19446,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, free (error), rc = false; else rc = (opacity_reply->format == 32 - && (opacity_reply->type == XCB_ATOM_CARDINAL - || opacity_reply->type == XCB_ATOM_ATOM - || opacity_reply->type == XCB_ATOM_WINDOW) + && (opacity_reply->type == XA_CARDINAL + || opacity_reply->type == XA_ATOM + || opacity_reply->type == XA_WINDOW) && (xcb_get_property_value_length (opacity_reply) >= 4)); if (rc) @@ -21355,7 +21596,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (FRAME_PARENT_FRAME (f) || (hf && frame_ancestor_p (f, hf))) { - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), RevertToParent, event->xbutton.time); x_stop_ignoring_errors (dpyinfo); @@ -21576,9 +21817,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, case VisibilityNotify: f = x_top_window_to_frame (dpyinfo, event->xvisibility.window); - if (f && (event->xvisibility.state == VisibilityUnobscured - || event->xvisibility.state == VisibilityPartiallyObscured)) - SET_FRAME_VISIBLE (f, 1); + + if (f) + FRAME_X_OUTPUT (f)->visibility_state = event->xvisibility.state; goto OTHER; @@ -23053,7 +23294,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* This can generate XI_BadDevice if the device's attachment was destroyed server-side. */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XISetFocus (dpyinfo->display, device->attachment, /* Note that the input extension only supports RevertToParent-type @@ -23066,7 +23307,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, events to handle focus. Errors are still caught here in case the window is not viewable. */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), RevertToParent, xev->time); x_stop_ignoring_errors (dpyinfo); @@ -24042,6 +24283,73 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #endif +#ifndef HAVE_EXT_TOOL_BAR + /* Is this a touch from a direct touch device that is in + the tool-bar? */ + if (device->direct_p + && WINDOWP (f->tool_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window))) + { + Lisp_Object window; + int x = xev->event_x; + int y = xev->event_y; + + window = window_from_coordinates (f, x, y, 0, true, true); + /* Ignore button release events if the mouse + wasn't previously pressed on the tool bar. + We do this because otherwise selecting some + text with the mouse and then releasing it on + the tool bar doesn't stop selecting text, + since the tool bar eats the button up + event. */ + tool_bar_p = EQ (window, f->tool_bar_window); + + /* If this touch has started in the tool bar, do not + send it to Lisp. Instead, simulate a tool bar + click, releasing it once it goes away. */ + + if (tool_bar_p) + { + /* Call note_mouse_highlight on the tool bar + item. Otherwise, get_tool_bar_item will + return 1. + + This is not necessary when mouse-highlight is + nil. */ + + if (!NILP (Vmouse_highlight)) + { + note_mouse_highlight (f, x, y); + + /* Always allow future mouse motion to + update the mouse highlight, no matter + where it is. */ + memset (&dpyinfo->last_mouse_glyph, 0, + sizeof dpyinfo->last_mouse_glyph); + dpyinfo->last_mouse_glyph_frame = f; + } + + handle_tool_bar_click_with_device (f, x, y, true, 0, + (source + ? source->name : Qt)); + + /* Flush any changes made by that to the front + buffer. */ + x_flush_dirty_back_buffer_on (f); + + /* Record the device and the touch ID on the + frame. That way, Emacs knows when to dismiss + the tool bar click later. */ + + FRAME_OUTPUT_DATA (f)->tool_bar_touch_device + = device->device_id; + FRAME_OUTPUT_DATA (f)->tool_bar_touch_id = xev->detail; + + goto XI_OTHER; + } + } +#endif + if (!menu_bar_p && !tool_bar_p) { if (f && device->direct_p) @@ -24051,13 +24359,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_catch_errors (dpyinfo->display); if (x_input_grab_touch_events) - XIAllowTouchEvents (dpyinfo->display, xev->deviceid, - xev->detail, xev->event, XIAcceptTouch); + XIAllowTouchEvents (dpyinfo->display, + xev->deviceid, + xev->detail, xev->event, + XIAcceptTouch); if (!x_had_errors_p (dpyinfo->display)) { - xi_link_touch_point (device, xev->detail, xev->event_x, - xev->event_y); + xi_link_touch_point (device, xev->detail, + xev->event_x, + xev->event_y, f); inev.ie.kind = TOUCHSCREEN_BEGIN_EVENT; inev.ie.timestamp = xev->time; @@ -24075,7 +24386,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifndef HAVE_GTK3 else if (x_input_grab_touch_events) { - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XIAllowTouchEvents (dpyinfo->display, xev->deviceid, xev->detail, xev->event, XIRejectTouch); x_stop_ignoring_errors (dpyinfo); @@ -24132,10 +24443,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, for (touchpoint = device->touchpoints; touchpoint; touchpoint = touchpoint->next) { - arg = Fcons (list3i (lrint (touchpoint->x), - lrint (touchpoint->y), - lrint (touchpoint->number)), - arg); + if (touchpoint->frame == f) + arg = Fcons (list3i (lrint (touchpoint->x), + lrint (touchpoint->y), + lrint (touchpoint->number)), + arg); } if (source) @@ -24181,6 +24493,33 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } +#ifndef HAVE_EXT_TOOL_BAR + /* Now see if the touchpoint was previously on the tool bar. + If it was, release the tool bar. */ + + if (!f) + f = x_window_to_frame (dpyinfo, xev->event); + + if (f && (FRAME_OUTPUT_DATA (f)->tool_bar_touch_id + == xev->detail)) + { + if (f->last_tool_bar_item != -1) + handle_tool_bar_click_with_device (f, xev->event_x, + xev->event_y, + false, 0, + (source + ? source->name + : Qnil)); + + /* Cancel any outstanding mouse highlight. */ + note_mouse_highlight (f, -1, -1); + x_flush_dirty_back_buffer_on (f); + + /* Now clear the tool bar device. */ + FRAME_OUTPUT_DATA (f)->tool_bar_touch_device = 0; + } +#endif + goto XI_OTHER; } @@ -25512,10 +25851,17 @@ x_clean_failable_requests (struct x_display_info *dpyinfo) x_uncatch_errors_after_check is that this function does not sync to catch errors if requests were made. It should be used instead of those two functions for catching errors around requests that do not - require a reply. */ + require a reply. + + As a special feature intended to support xselect.c, + SELECTION_SERIAL may be an arbitrary number greater than zero: when + that is the case, x_select_handle_selection_error is called with + the specified number to delete the selection request that + encountered the error. */ void -x_ignore_errors_for_next_request (struct x_display_info *dpyinfo) +x_ignore_errors_for_next_request (struct x_display_info *dpyinfo, + unsigned int selection_serial) { struct x_failable_request *request, *max; unsigned long next_request; @@ -25569,6 +25915,7 @@ x_ignore_errors_for_next_request (struct x_display_info *dpyinfo) request->start = next_request; request->end = 0; + request->selection_serial = selection_serial; dpyinfo->next_failable_request++; } @@ -25990,9 +26337,11 @@ For details, see etc/PROBLEMS.\n", if (!ioerror && dpyinfo) { /* Dump the list of error handlers for debugging - purposes. */ + purposes if the list exists. */ - fprintf (stderr, "X error handlers currently installed:\n"); + if ((dpyinfo->failable_requests + != dpyinfo->next_failable_request) || x_error_message) + fprintf (stderr, "X error handlers currently installed:\n"); for (failable = dpyinfo->failable_requests; failable < dpyinfo->next_failable_request; @@ -26081,6 +26430,12 @@ x_error_handler (Display *display, XErrorEvent *event) + (last - fail)); } + /* If a selection transfer is the cause of this error, + remove the selection transfer now. */ + if (fail->selection_serial) + x_handle_selection_error (fail->selection_serial, + event); + return 0; } } @@ -26117,8 +26472,10 @@ x_error_handler (Display *display, XErrorEvent *event) static void NO_INLINE x_error_quitter (Display *display, XErrorEvent *event) { - char buf[256], buf1[400 + INT_STRLEN_BOUND (int) - + INT_STRLEN_BOUND (unsigned long)]; + char buf[256], buf1[800 + INT_STRLEN_BOUND (int) + + INT_STRLEN_BOUND (unsigned long) + + INT_STRLEN_BOUND (XID) + + INT_STRLEN_BOUND (int)]; /* Ignore BadName errors. They can happen because of fonts or colors that are not defined. */ @@ -26131,8 +26488,12 @@ x_error_quitter (Display *display, XErrorEvent *event) XGetErrorText (display, event->error_code, buf, sizeof (buf)); sprintf (buf1, "X protocol error: %s on protocol request %d\n" - "Serial no: %lu\n", buf, event->request_code, - event->serial); + "Serial no: %lu\n" + "Failing resource ID (if any): 0x%lx\n" + "Minor code: %d\n" + "This is a bug! Please report this to bug-gnu-emacs@gnu.org!\n", + buf, event->request_code, event->serial, event->resourceid, + event->minor_code); x_connection_closed (display, buf1, false); } @@ -26633,38 +26994,43 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) modified_left, modified_top); #endif - /* 'x_sync_with_move' is too costly for dragging child frames. */ - if (!FRAME_PARENT_FRAME (f) - /* If no window manager exists, just calling XSync will be - sufficient to ensure that the window geometry has been - updated. */ - && NILP (Vx_no_window_manager)) - { - x_sync_with_move (f, f->left_pos, f->top_pos, - FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN); - - /* change_gravity is non-zero when this function is called from Lisp to - programmatically move a frame. In that case, we call - x_check_expected_move to discover if we have a "Type A" or "Type B" - window manager, and, for a "Type A" window manager, adjust the position - of the frame. - - We call x_check_expected_move if a programmatic move occurred, and - either the window manager type (A/B) is unknown or it is Type A but we - need to compute the top/left offset adjustment for this frame. */ - - if (change_gravity != 0 - && (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN - || (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_A - && (FRAME_X_OUTPUT (f)->move_offset_left == 0 - && FRAME_X_OUTPUT (f)->move_offset_top == 0)))) - x_check_expected_move (f, modified_left, modified_top); - } - /* Instead, just wait for the last ConfigureWindow request to - complete. No window manager is involved when moving child - frames. */ - else - XSync (FRAME_X_DISPLAY (f), False); + /* The following code is too slow over a latent network + connection. */ + if (NILP (Vx_lax_frame_positioning)) + { + /* 'x_sync_with_move' is too costly for dragging child frames. */ + if (!FRAME_PARENT_FRAME (f) + /* If no window manager exists, just calling XSync will be + sufficient to ensure that the window geometry has been + updated. */ + && NILP (Vx_no_window_manager)) + { + x_sync_with_move (f, f->left_pos, f->top_pos, + FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN); + + /* change_gravity is non-zero when this function is called from Lisp to + programmatically move a frame. In that case, we call + x_check_expected_move to discover if we have a "Type A" or "Type B" + window manager, and, for a "Type A" window manager, adjust the position + of the frame. + + We call x_check_expected_move if a programmatic move occurred, and + either the window manager type (A/B) is unknown or it is Type A but we + need to compute the top/left offset adjustment for this frame. */ + + if (change_gravity != 0 + && (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_UNKNOWN + || (FRAME_DISPLAY_INFO (f)->wm_type == X_WMTYPE_A + && (FRAME_X_OUTPUT (f)->move_offset_left == 0 + && FRAME_X_OUTPUT (f)->move_offset_top == 0)))) + x_check_expected_move (f, modified_left, modified_top); + } + /* Instead, just wait for the last ConfigureWindow request to + complete. No window manager is involved when moving child + frames. */ + else + XSync (FRAME_X_DISPLAY (f), False); + } unblock_input (); } @@ -26724,6 +27090,12 @@ x_wm_supports_1 (struct x_display_info *dpyinfo, Atom want_atom) if (!NILP (Vx_no_window_manager)) return false; + /* If the window system says Emacs is untrusted, there will be no + way to send any information to the window manager, making any + hints useless. */ + if (dpyinfo->untrusted) + return false; + block_input (); x_catch_errors (dpy); @@ -27194,13 +27566,12 @@ do_ewmh_fullscreen (struct frame *f) static void XTfullscreen_hook (struct frame *f) { - if (FRAME_VISIBLE_P (f)) - { - block_input (); - x_check_fullscreen (f); - x_sync (f); - unblock_input (); - } + if (!FRAME_VISIBLE_P (f)) + return; + + block_input (); + x_check_fullscreen (f); + unblock_input (); } @@ -27294,10 +27665,7 @@ x_check_fullscreen (struct frame *f) if (FRAME_VISIBLE_P (f)) x_wait_for_event (f, ConfigureNotify); else - { - change_frame_size (f, width, height, false, true, false); - x_sync (f); - } + change_frame_size (f, width, height, false, true, false); } /* `x_net_wm_state' might have reset the fullscreen frame parameter, @@ -27471,6 +27839,12 @@ x_set_window_size_1 (struct frame *f, bool change_gravity, we have to make sure to do it here. */ SET_FRAME_GARBAGED (f); + /* The following code is too slow over a latent network + connection, so skip it when the user says so. */ + + if (!NILP (Vx_lax_frame_positioning)) + return; + /* Now, strictly speaking, we can't be sure that this is accurate, but the window manager will get around to dealing with the size change request eventually, and we'll hear how it went when the @@ -27511,8 +27885,6 @@ x_set_window_size_1 (struct frame *f, bool change_gravity, adjust_frame_size (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, width), FRAME_PIXEL_TO_TEXT_HEIGHT (f, height), 5, 0, Qx_set_window_size_1); - - x_sync (f); } } @@ -27566,7 +27938,7 @@ frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) && deviceid != -1) { block_input (); - x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); + x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f), 0); XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None, FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f)); @@ -27863,7 +28235,7 @@ x_set_input_focus (struct x_display_info *dpyinfo, Window window, { eassert (device->use == XIMasterPointer); - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XISetFocus (dpyinfo->display, device->attachment, /* Note that the input extension only supports RevertToParent-type @@ -27878,7 +28250,7 @@ x_set_input_focus (struct x_display_info *dpyinfo, Window window, /* Otherwise, use the pointer device that the X server says is the client pointer. */ - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); XSetInputFocus (dpyinfo->display, window, RevertToParent, time); x_stop_ignoring_errors (dpyinfo); } @@ -27898,12 +28270,17 @@ x_focus_frame (struct frame *f, bool noactivate) struct x_display_info *dpyinfo; Time time; + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (dpyinfo->untrusted) + /* The X server ignores all input focus related requests from + untrusted clients. */ + return; + /* The code below is not reentrant wrt to dpyinfo->x_focus_frame and friends being set. */ block_input (); - dpyinfo = FRAME_DISPLAY_INFO (f); - if (FRAME_X_EMBEDDED_P (f)) /* For Xembedded frames, normally the embedder forwards key events. See XEmbed Protocol Specification at @@ -28015,7 +28392,7 @@ xembed_send_message (struct frame *f, Time t, enum xembed_message msg, but I don't understand why: there is no way for clients to survive the death of the parent anyway. */ - x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); + x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f), 0); XSendEvent (FRAME_X_DISPLAY (f), FRAME_X_OUTPUT (f)->parent_desc, False, NoEventMask, &event); x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f)); @@ -28166,6 +28543,7 @@ x_make_frame_visible (struct frame *f) && !FRAME_ICONIFIED_P (f) && !FRAME_X_EMBEDDED_P (f) && !FRAME_PARENT_FRAME (f) + && NILP (Vx_lax_frame_positioning) && f->win_gravity == NorthWestGravity && previously_visible) { @@ -28194,7 +28572,8 @@ x_make_frame_visible (struct frame *f) } /* Try to wait for a MapNotify event (that is what tells us when a - frame becomes visible). */ + frame becomes visible). Unless `x-lax-frame-positioning' is + non-nil: there, that is a little slow. */ #ifdef CYGWIN /* On Cygwin, which uses input polling, we need to force input to @@ -28212,7 +28591,8 @@ x_make_frame_visible (struct frame *f) poll_suppress_count = old_poll_suppress_count; #endif - if (!FRAME_VISIBLE_P (f)) + if (!FRAME_VISIBLE_P (f) + && NILP (Vx_lax_frame_positioning)) { if (CONSP (frame_size_history)) frame_size_history_plain @@ -28245,6 +28625,11 @@ x_make_frame_invisible (struct frame *f) block_input (); +#ifdef HAVE_XINPUT2_2 + /* Remove any touch points associated with F. */ + xi_unlink_touch_points (f); +#endif + /* Before unmapping the window, update the WM_SIZE_HINTS property to claim that the current position of the window is user-specified, rather than program-specified, so that when the window is mapped again, it will be @@ -28269,7 +28654,10 @@ x_make_frame_invisible (struct frame *f) error ("Can't notify window manager of window withdrawal"); } - x_sync (f); + /* Don't perform the synchronization if the network connection is + slow, and the user says it is unwanted. */ + if (NILP (Vx_lax_frame_positioning)) + XSync (FRAME_X_DISPLAY (f), False); /* We can't distinguish this from iconification just by the event that we get from the server. @@ -28280,8 +28668,7 @@ x_make_frame_invisible (struct frame *f) SET_FRAME_ICONIFIED (f, false); if (CONSP (frame_size_history)) - frame_size_history_plain - (f, build_string ("x_make_frame_invisible")); + frame_size_history_plain (f, build_string ("x_make_frame_invisible")); unblock_input (); } @@ -28448,6 +28835,11 @@ x_free_frame_resources (struct frame *f) xi_handle_delete_frame (dpyinfo, f); #endif +#ifdef HAVE_XINPUT2_2 + /* Remove any touch points associated with F. */ + xi_unlink_touch_points (f); +#endif + /* If a display connection is dead, don't try sending more commands to the X server. */ if (dpyinfo->display) @@ -28631,6 +29023,13 @@ x_free_frame_resources (struct frame *f) if (f == hlinfo->mouse_face_mouse_frame) reset_mouse_highlight (hlinfo); + /* These two need to be freed now that they are used to compute the + mouse position, I think. */ + if (f == dpyinfo->last_mouse_motion_frame) + dpyinfo->last_mouse_motion_frame = NULL; + if (f == dpyinfo->last_mouse_frame) + dpyinfo->last_mouse_frame = NULL; + #ifdef HAVE_XINPUT2 /* Consider a frame being unfocused with no following FocusIn event while an older focus from another seat exists. The client @@ -28867,6 +29266,53 @@ x_get_atom_name (struct x_display_info *dpyinfo, Atom atom, return value; } +/* Intern an array of atoms, and do so quickly, avoiding extraneous + roundtrips to the X server. + + Avoid sending atoms that have already been found to the X server. + This cannot do anything that will end up triggering garbage + collection. */ + +void +x_intern_atoms (struct x_display_info *dpyinfo, char **names, int count, + Atom *atoms_return) +{ + int i, j, indices[256]; + char *new_names[256]; + Atom results[256], candidate; + + if (count > 256) + /* Atoms array too big to inspect reasonably, just send it to the + server and back. */ + XInternAtoms (dpyinfo->display, new_names, count, False, atoms_return); + else + { + for (i = 0, j = 0; i < count; ++i) + { + candidate = x_intern_cached_atom (dpyinfo, names[i], + true); + + if (candidate) + atoms_return[i] = candidate; + else + { + indices[j++] = i; + new_names[j - 1] = names[i]; + } + } + + if (!j) + return; + + /* Now, get the results back from the X server. */ + XInternAtoms (dpyinfo->display, new_names, j, False, + results); + + for (i = 0; i < j; ++i) + atoms_return[indices[i]] = results[i]; + } +} + #ifndef USE_GTK /* Set up XEmbed for F, and change its save set to handle the parent @@ -29415,6 +29861,7 @@ struct x_display_info * x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) { Display *dpy; + XKeyboardState keyboard_state; struct terminal *terminal; struct x_display_info *dpyinfo; XrmDatabase xrdb; @@ -29634,6 +30081,32 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo = xzalloc (sizeof *dpyinfo); terminal = x_create_terminal (dpyinfo); + if (!NILP (Vx_detect_server_trust)) + { + /* Detect whether or not the X server trusts this client, which + is done by making a SetKeyboardControl request and checking + for an Access error. */ + XGrabServer (dpy); + XGetKeyboardControl (dpy, &keyboard_state); + + x_catch_errors (dpy); + + /* At this point, the display is not on x_display_list, so + x_uncatch_errors won't sync. However, that's okay because + x_had_errors_p will. */ + + if (keyboard_state.global_auto_repeat + == AutoRepeatModeOn) + XAutoRepeatOn (dpy); + else + XAutoRepeatOff (dpy); + + if (x_had_errors_p (dpy)) + dpyinfo->untrusted = true; + x_uncatch_errors_after_check (); + XUngrabServer (dpy); + } + dpyinfo->next_failable_request = dpyinfo->failable_requests; { @@ -29654,13 +30127,17 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) { char *vendor = ServerVendor (dpy); - /* Temporarily hide the partially initialized terminal. */ + /* Temporarily hide the partially initialized terminal. + Use safe_call so that if a signal happens, a partially + initialized display (and display connection) is not + kept around. */ terminal_list = terminal->next_terminal; unblock_input (); - kset_system_key_alist - (terminal->kboard, - call1 (Qvendor_specific_keysyms, - vendor ? build_string (vendor) : empty_unibyte_string)); + kset_system_key_alist (terminal->kboard, + safe_call1 (Qvendor_specific_keysyms, + (vendor + ? build_string (vendor) + : empty_unibyte_string))); block_input (); terminal->next_terminal = terminal_list; terminal_list = terminal; @@ -30278,8 +30755,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) 1, 0, 1); dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); -#ifdef HAVE_XFIXES - dpyinfo->fixes_pointer_blanking = egetenv ("EMACS_XFIXES"); +#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000 + dpyinfo->fixes_pointer_blanking = (egetenv ("EMACS_XFIXES") != NULL); #endif #ifdef HAVE_X_I18N @@ -30606,8 +31083,13 @@ x_delete_display (struct x_display_info *dpyinfo) last = ie; } + /* Delete selection requests bound for dpyinfo from the keyboard + buffer. */ x_delete_selection_requests (dpyinfo); + /* And remove any outstanding selection transfers. */ + x_remove_selection_transfers (dpyinfo); + if (next_noop_dpyinfo == dpyinfo) next_noop_dpyinfo = dpyinfo->next; @@ -31034,7 +31516,37 @@ x_initialize (void) XSetIOErrorHandler (x_io_error_quitter); } -#ifdef USE_GTK +#ifdef HAVE_X_I18N + +/* Notice that a change has occured on F that requires its input + method state to be reset. */ + +static void +x_reset_conversion (struct frame *f) +{ + char *string; + + if (FRAME_XIC (f)) + { + string = XmbResetIC (FRAME_XIC (f)); + + /* string is actually any string that was being composed at the + time of the reset. */ + + if (string) + XFree (string); + } +} + +/* Interface used to control input method ``text conversion''. */ + +static struct textconv_interface text_conversion_interface = + { + x_reset_conversion, + }; + +#endif + void init_xterm (void) { @@ -31048,8 +31560,11 @@ init_xterm (void) gdk_disable_multidevice (); #endif #endif -} + +#ifdef HAVE_X_I18N + register_texconv_interface (&text_conversion_interface); #endif +} void mark_xterm (void) @@ -31113,7 +31628,7 @@ x_catch_errors_for_lisp (struct x_display_info *dpyinfo) if (!x_fast_protocol_requests) x_catch_errors (dpyinfo->display); else - x_ignore_errors_for_next_request (dpyinfo); + x_ignore_errors_for_next_request (dpyinfo, 0); } void @@ -31322,6 +31837,8 @@ syms_of_xterm (void) DEFSYM (Qnow, "now"); DEFSYM (Qx_dnd_targets_list, "x-dnd-targets-list"); DEFSYM (Qx_auto_preserve_selections, "x-auto-preserve-selections"); + DEFSYM (Qexpose, "expose"); + DEFSYM (Qdont_save, "dont-save"); #ifdef USE_GTK xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); @@ -31491,7 +32008,6 @@ always uses gtk_window_move and ignores the value of this variable. */); This option is only effective when Emacs is built with XInput 2 support. */); Vx_scroll_event_delta_factor = make_float (1.0); - DEFSYM (Qexpose, "expose"); DEFVAR_BOOL ("x-gtk-use-native-input", x_gtk_use_native_input, doc: /* Non-nil means to use GTK for input method support. @@ -31705,4 +32221,26 @@ select text over slow X connections. If that is still too slow, setting this variable to the symbol `really-fast' will make Emacs return only cached values. */); Vx_use_fast_mouse_position = Qnil; + + DEFVAR_LISP ("x-detect-server-trust", Vx_detect_server_trust, + doc: /* If non-nil, Emacs should detect whether or not it is trusted by X. + +If non-nil, Emacs will make an X request at connection startup that is +prohibited to untrusted clients under the X Security Extension and +check whether or not a resulting Access error is generated by the X +server. If the X server reports the error, Emacs will disable certain +features that do not work for untrusted clients. */); + Vx_detect_server_trust = Qnil; + + DEFVAR_LISP ("x-lax-frame-positioning", Vx_lax_frame_positioning, + doc: /* If non-nil, Emacs won't compensate for WM geometry behavior. + +Setting this to non-nil is useful when the compensation proves to be +too slow, which is usually true when the X server is located over a +network connection with high latency. Doing so will make frame +creation and placement faster at the cost of reducing the accuracy of +frame placement via frame parameters, `set-frame-position', and +`set-frame-size', along with the actual state of a frame after +`x_make_frame_invisible'. */); + Vx_lax_frame_positioning = Qnil; } diff --git a/src/xterm.h b/src/xterm.h index 8834346e7ca..28ae00ca190 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -21,6 +21,22 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #define XTERM_H #include <X11/Xlib.h> + +#ifdef HAVE_XFIXES +#include <X11/extensions/Xfixes.h> + +#if defined HAVE_XINPUT2 && XFIXES_MAJOR < 5 +/* XI2 headers need PointerBarrier, which is not defined in old + versions of the fixes library. Define that type here. */ +typedef XID PointerBarrier; +#endif +#if defined HAVE_XCOMPOSITE && XFIXES_MAJOR < 2 +/* Recent Composite headers need XserverRegion, which is not defined + in old versions of the fixes library. Define that type here. */ +typedef XID XserverRegion; +#endif +#endif + #include <X11/cursorfont.h> /* Include Xutil.h after keysym.h to work around a bug that prevents @@ -241,10 +257,17 @@ struct xi_scroll_valuator_t struct xi_touch_point_t { + /* The next touch point in this list. */ struct xi_touch_point_t *next; + /* The touchpoint detail. */ int number; + + /* The last known X and Y position of the touchpoint. */ double x, y; + + /* The frame associated with this touch point. */ + struct frame *frame; }; #endif @@ -318,6 +341,9 @@ struct x_failable_request /* If this is zero, then the request has not yet been made. Otherwise, this is the request that ends this sequence. */ unsigned long end; + + /* Any selection event serial associated with this error trap. */ + unsigned int selection_serial; }; #ifdef HAVE_XFIXES @@ -360,6 +386,10 @@ struct x_display_info /* Number of frames that are on this display. */ int reference_count; + /* True if this display connection cannot communicate with the + window manager because it is not trusted by the X server. */ + bool untrusted; + /* The Screen this connection is connected to. */ Screen *screen; @@ -406,7 +436,7 @@ struct x_display_info Unused if this display supports Xfixes extension. */ Cursor invisible_cursor; -#ifdef HAVE_XFIXES +#if defined HAVE_XFIXES && XFIXES_VERSION >= 40000 /* Whether or not to use Xfixes for pointer blanking. */ bool fixes_pointer_blanking; #endif @@ -537,6 +567,12 @@ struct x_display_info KDE" protocol in x-dnd.el). */ Atom Xatom_DndProtocol, Xatom_DND_PROTOCOL; + /* Atoms to make x_intern_cached_atom fast. */ + Atom Xatom_text_plain_charset_utf_8, Xatom_LENGTH, Xatom_FILE_NAME, + Xatom_CHARACTER_POSITION, Xatom_LINE_NUMBER, Xatom_COLUMN_NUMBER, + Xatom_OWNER_OS, Xatom_HOST_NAME, Xatom_USER, Xatom_CLASS, + Xatom_NAME, Xatom_SAVE_TARGETS; + /* The frame (if any) which has the X window that has keyboard focus. Zero if none. This is examined by Ffocus_frame in xfns.c. Note that a mere EnterNotify event can set this; if you need to know the @@ -1261,6 +1297,21 @@ struct x_output strictly an optimization to avoid extraneous synchronizing in some cases. */ int root_x, root_y; + + /* The frame visibility state. This starts out + VisibilityFullyObscured, but is set to something else in + handle_one_xevent. */ + int visibility_state; + +#ifdef HAVE_XINPUT2_2 + /* The touch ID of the last touch point to have touched the tool + bar. */ + int tool_bar_touch_id; + + /* The device that last touched the tool bar. 0 if no device + touched the tool bar. */ + int tool_bar_touch_device; +#endif }; enum @@ -1379,6 +1430,11 @@ extern void x_mark_frame_dirty (struct frame *f); /* And its corresponding visual info. */ #define FRAME_X_VISUAL_INFO(f) (&FRAME_DISPLAY_INFO (f)->visual_info) +/* Whether or not the frame is visible. Do not test this alone. + Instead, use FRAME_REDISPLAY_P. */ +#define FRAME_X_VISIBLE(f) (FRAME_X_OUTPUT (f)->visibility_state \ + != VisibilityFullyObscured) + #ifdef HAVE_XRENDER #define FRAME_X_PICTURE_FORMAT(f) FRAME_DISPLAY_INFO (f)->pict_format #define FRAME_X_PICTURE(f) ((f)->output_data.x->picture) @@ -1644,7 +1700,8 @@ extern bool x_had_errors_p (Display *); extern void x_unwind_errors_to (int); extern void x_uncatch_errors (void); extern void x_uncatch_errors_after_check (void); -extern void x_ignore_errors_for_next_request (struct x_display_info *); +extern void x_ignore_errors_for_next_request (struct x_display_info *, + unsigned int); extern void x_stop_ignoring_errors (struct x_display_info *); extern void x_clear_errors (Display *); extern void x_set_window_size (struct frame *, bool, int, int); @@ -1717,6 +1774,11 @@ extern Lisp_Object x_handle_translate_coordinates (struct frame *, Lisp_Object, extern Bool x_query_pointer (Display *, Window, Window *, Window *, int *, int *, int *, int *, unsigned int *); +extern Atom x_intern_cached_atom (struct x_display_info *, const char *, + bool); +extern void x_intern_atoms (struct x_display_info *, char **, int, Atom *); +extern char *x_get_atom_name (struct x_display_info *, Atom, bool *) + ATTRIBUTE_MALLOC ATTRIBUTE_DEALLOC_FREE; #ifdef HAVE_GTK3 extern void x_scroll_bar_configure (GdkEvent *); @@ -1798,6 +1860,9 @@ extern void x_handle_property_notify (const XPropertyEvent *); extern void x_handle_selection_notify (const XSelectionEvent *); extern void x_handle_selection_event (struct selection_input_event *); extern void x_clear_frame_selections (struct frame *); +extern void x_remove_selection_transfers (struct x_display_info *); +extern void x_handle_selection_error (unsigned int, XErrorEvent *); + extern Lisp_Object x_atom_to_symbol (struct x_display_info *, Atom); extern Atom symbol_to_x_atom (struct x_display_info *, Lisp_Object); @@ -1807,11 +1872,8 @@ extern bool x_handle_dnd_message (struct frame *, struct input_event *, bool, int, int); extern int x_check_property_data (Lisp_Object); -extern void x_fill_property_data (Display *, - Lisp_Object, - void *, - int, - int); +extern void x_fill_property_data (struct x_display_info *, Lisp_Object, + void *, int, int); extern Lisp_Object x_property_data_to_lisp (struct frame *, const unsigned char *, Atom, @@ -1824,10 +1886,10 @@ extern Lisp_Object x_timestamp_for_selection (struct x_display_info *, Lisp_Object); extern void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Time); -extern Atom x_intern_cached_atom (struct x_display_info *, const char *, - bool); -extern char *x_get_atom_name (struct x_display_info *, Atom, bool *) - ATTRIBUTE_MALLOC ATTRIBUTE_DEALLOC_FREE; + +extern void mark_xselect (void); + +/* Misc definitions. */ #ifdef USE_GTK extern bool xg_set_icon (struct frame *, Lisp_Object); |