diff options
Diffstat (limited to 'src')
125 files changed, 7532 insertions, 3629 deletions
diff --git a/src/.gdbinit b/src/.gdbinit index 8d809b18711..d3bfad59486 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -1308,6 +1308,11 @@ if defined_HAVE_X_WINDOWS break x_error_quitter end +if defined_WINDOWSNT + while kbdhook.hook_count > 0 + call remove_w32_kbdhook() + end +end # Put the Python code at the end of .gdbinit so that if GDB does not # support Python, GDB will do all the above initializations before diff --git a/src/ChangeLog.1 b/src/ChangeLog.1 index d2fc8cc7fb2..1a47d45077e 100644 --- a/src/ChangeLog.1 +++ b/src/ChangeLog.1 @@ -3521,8 +3521,7 @@ * minibuf.c: Don't allow entry to minibuffer while minibuffer is selected. - Copyright (C) 1985\(en1986, 2001\(en2025 Free Software Foundation, - Inc. + Copyright (C) 1985-1986, 2001-2025 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/ChangeLog.2 b/src/ChangeLog.2 index eb2e86eaf59..f50fa7296fc 100644 --- a/src/ChangeLog.2 +++ b/src/ChangeLog.2 @@ -4771,8 +4771,7 @@ See ChangeLog.1 for earlier changes. - Copyright (C) 1986\(en1988, 2001\(en2025 Free Software Foundation, - Inc. + Copyright (C) 1986-1988, 2001-2025 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/ChangeLog.3 b/src/ChangeLog.3 index 0051330f556..3cb0d1ac453 100644 --- a/src/ChangeLog.3 +++ b/src/ChangeLog.3 @@ -16503,7 +16503,7 @@ See ChangeLog.2 for earlier changes. ;; coding: utf-8 ;; End: - Copyright (C) 1993, 2001\(en2025 Free Software Foundation, Inc. + Copyright (C) 1993, 2001-2025 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/ChangeLog.4 b/src/ChangeLog.4 index 07e62673a00..2b882bf9bba 100644 --- a/src/ChangeLog.4 +++ b/src/ChangeLog.4 @@ -6906,8 +6906,7 @@ See ChangeLog.3 for earlier changes. ;; coding: utf-8 ;; End: - Copyright (C) 1993\(en1994, 2001\(en2025 Free Software Foundation, - Inc. + Copyright (C) 1993-1994, 2001-2025 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/ChangeLog.5 b/src/ChangeLog.5 index 82662da042c..9ad5d0ffbcd 100644 --- a/src/ChangeLog.5 +++ b/src/ChangeLog.5 @@ -7148,8 +7148,7 @@ See ChangeLog.4 for earlier changes. ;; coding: utf-8 ;; End: - Copyright (C) 1994\(en1995, 2001\(en2025 Free Software Foundation, - Inc. + Copyright (C) 1994-1995, 2001-2025 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/ChangeLog.6 b/src/ChangeLog.6 index 2a7a2e1e6aa..9e6f7b641a4 100644 --- a/src/ChangeLog.6 +++ b/src/ChangeLog.6 @@ -5358,8 +5358,7 @@ See ChangeLog.5 for earlier changes. ;; coding: utf-8 ;; End: - Copyright (C) 1995\(en1996, 2001\(en2025 Free Software Foundation, - Inc. + Copyright (C) 1995-1996, 2001-2025 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/ChangeLog.7 b/src/ChangeLog.7 index 3f612d2a91b..7342c75bff0 100644 --- a/src/ChangeLog.7 +++ b/src/ChangeLog.7 @@ -11091,8 +11091,7 @@ See ChangeLog.6 for earlier changes. ;; coding: utf-8 ;; End: - Copyright (C) 1997\(en1998, 2001\(en2025 Free Software Foundation, - Inc. + Copyright (C) 1997-1998, 2001-2025 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/ChangeLog.8 b/src/ChangeLog.8 index 737240e7758..236c0b4c9c5 100644 --- a/src/ChangeLog.8 +++ b/src/ChangeLog.8 @@ -13979,7 +13979,7 @@ See ChangeLog.7 for earlier changes. - Copyright (C) 1999, 2001\(en2025 Free Software Foundation, Inc. + Copyright (C) 1999, 2001-2025 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/ChangeLog.9 b/src/ChangeLog.9 index bf29d7eac75..c7c25b08b6e 100644 --- a/src/ChangeLog.9 +++ b/src/ChangeLog.9 @@ -13294,7 +13294,7 @@ See ChangeLog.8 for earlier changes. ;; coding: utf-8 ;; End: - Copyright (C) 2001\(en2025 Free Software Foundation, Inc. + Copyright (C) 2001-2025 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/Makefile.in b/src/Makefile.in index b5d88eb749e..784aadd1689 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -682,7 +682,7 @@ endif ifeq ($(DUMPING),pdumper) $(pdmp): emacs$(EXEEXT) $(lispsource)/loaddefs.el $(lispsource)/loaddefs.elc LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=pdump \ - --bin-dest $(BIN_DESTDIR) --eln-dest $(ELN_DESTDIR) + --bin-dest '$(BIN_DESTDIR)' --eln-dest '$(ELN_DESTDIR)' cp -f $@ $(bootstrap_pdmp) endif @@ -975,7 +975,7 @@ NATIVE_COMPILATION_AOT = @NATIVE_COMPILATION_AOT@ find $@ -name '*.eln' | rebase -v -O -T -; \ fi; \ LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=pdump \ - --bin-dest $(BIN_DESTDIR) --eln-dest $(ELN_DESTDIR) \ + --bin-dest '$(BIN_DESTDIR)' --eln-dest '$(ELN_DESTDIR)' \ && cp -f emacs$(EXEEXT) bootstrap-emacs$(EXEEXT) \ && cp -f $(pdmp) $(bootstrap_pdmp); \ if test $(NATIVE_COMPILATION_AOT) = yes; then \ @@ -1014,7 +1014,7 @@ ifeq ($(DUMPING),pdumper) $(bootstrap_pdmp): bootstrap-emacs$(EXEEXT) rm -f $@ $(RUN_TEMACS) --batch $(BUILD_DETAILS) -l loadup --temacs=pbootstrap \ - --bin-dest $(BIN_DESTDIR) --eln-dest $(ELN_DESTDIR) + --bin-dest '$(BIN_DESTDIR)' --eln-dest '$(ELN_DESTDIR)' @: Compile some files earlier to speed up further compilation. @: First, byte compile these files, .... ANCIENT=yes $(MAKE) -C ../lisp compile-first EMACS="$(bootstrap_exe)" diff --git a/src/alloc.c b/src/alloc.c index ce2a9fe1aa0..8307c74c106 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -453,6 +453,7 @@ no_sanitize_memcpy (void *dest, void const *src, size_t size) #endif /* MAX_SAVE_STACK > 0 */ +static struct Lisp_Vector *allocate_clear_vector (ptrdiff_t, bool); static void unchain_finalizer (struct Lisp_Finalizer *); static void mark_terminals (void); static void gc_sweep (void); @@ -708,7 +709,7 @@ buffer_memory_full (ptrdiff_t nbytes) where Emacs would crash if malloc returned a non-GCALIGNED pointer. */ enum { LISP_ALIGNMENT = alignof (union { union emacs_align_type x; GCALIGNED_UNION_MEMBER }) }; -verify (LISP_ALIGNMENT % GCALIGNMENT == 0); +static_assert (LISP_ALIGNMENT % GCALIGNMENT == 0); /* True if malloc (N) is known to return storage suitably aligned for Lisp objects whenever N is a multiple of LISP_ALIGNMENT. In @@ -838,7 +839,7 @@ xfree (void *block) /* Other parts of Emacs pass large int values to allocator functions expecting ptrdiff_t. This is portable in practice, but check it to be safe. */ -verify (INT_MAX <= PTRDIFF_MAX); +static_assert (INT_MAX <= PTRDIFF_MAX); /* Allocate an array of NITEMS items, each of size ITEM_SIZE. @@ -998,6 +999,7 @@ record_xmalloc (size_t size) allocated memory block (for strings, for conses, ...). */ #if ! USE_LSB_TAG +extern void *lisp_malloc_loser; void *lisp_malloc_loser EXTERNALLY_VISIBLE; #endif @@ -1074,7 +1076,7 @@ lisp_free (void *block) #else /* !HAVE_UNEXEC */ # define BLOCK_ALIGN (1 << 15) #endif -verify (POWER_OF_2 (BLOCK_ALIGN)); +static_assert (POWER_OF_2 (BLOCK_ALIGN)); /* Use aligned_alloc if it or a simple substitute is available. Aligned allocation is incompatible with unexmacosx.c, so don't use @@ -1094,11 +1096,11 @@ aligned_alloc (size_t alignment, size_t size) { /* POSIX says the alignment must be a power-of-2 multiple of sizeof (void *). Verify this for all arguments this function is given. */ - verify (BLOCK_ALIGN % sizeof (void *) == 0 - && POWER_OF_2 (BLOCK_ALIGN / sizeof (void *))); - verify (MALLOC_IS_LISP_ALIGNED - || (LISP_ALIGNMENT % sizeof (void *) == 0 - && POWER_OF_2 (LISP_ALIGNMENT / sizeof (void *)))); + static_assert (BLOCK_ALIGN % sizeof (void *) == 0 + && POWER_OF_2 (BLOCK_ALIGN / sizeof (void *))); + static_assert (MALLOC_IS_LISP_ALIGNED + || (LISP_ALIGNMENT % sizeof (void *) == 0 + && POWER_OF_2 (LISP_ALIGNMENT / sizeof (void *)))); eassert (alignment == BLOCK_ALIGN || (!MALLOC_IS_LISP_ALIGNED && alignment == LISP_ALIGNMENT)); @@ -1219,7 +1221,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) #endif #ifdef USE_ALIGNED_ALLOC - verify (ABLOCKS_BYTES % BLOCK_ALIGN == 0); + static_assert (ABLOCKS_BYTES % BLOCK_ALIGN == 0); abase = base = aligned_alloc (BLOCK_ALIGN, ABLOCKS_BYTES); #else base = malloc (ABLOCKS_BYTES); @@ -1403,8 +1405,8 @@ lmalloc (size_t size, bool clearit) if (laligned (p, size) && (MALLOC_0_IS_NONNULL || size || p)) return p; free (p); - size_t bigger = size + LISP_ALIGNMENT; - if (size < bigger) + size_t bigger; + if (!ckd_add (&bigger, size, LISP_ALIGNMENT)) size = bigger; } } @@ -1417,8 +1419,8 @@ lrealloc (void *p, size_t size) p = realloc (p, size); if (laligned (p, size) && (size || p)) return p; - size_t bigger = size + LISP_ALIGNMENT; - if (size < bigger) + size_t bigger; + if (!ckd_add (&bigger, size, LISP_ALIGNMENT)) size = bigger; } } @@ -2405,30 +2407,39 @@ bool_vector_fill (Lisp_Object a, Lisp_Object init) return a; } -/* Return a newly allocated, uninitialized bool vector of size NBITS. */ +/* Return a newly allocated, bool vector of size NBITS. If CLEARIT, + clear its slots; otherwise the vector's slots are uninitialized. */ Lisp_Object -make_uninit_bool_vector (EMACS_INT nbits) +make_clear_bool_vector (EMACS_INT nbits, bool clearit) { + eassert (0 <= nbits && nbits <= BOOL_VECTOR_LENGTH_MAX); Lisp_Object val; - EMACS_INT words = bool_vector_words (nbits); - EMACS_INT word_bytes = words * sizeof (bits_word); - EMACS_INT needed_elements = ((bool_header_size - header_size + word_bytes + ptrdiff_t words = bool_vector_words (nbits); + ptrdiff_t word_bytes = words * sizeof (bits_word); + ptrdiff_t needed_elements = ((bool_header_size - header_size + word_bytes + word_size - 1) / word_size); - if (PTRDIFF_MAX < needed_elements) - memory_full (SIZE_MAX); struct Lisp_Bool_Vector *p - = (struct Lisp_Bool_Vector *) allocate_vector (needed_elements); + = (struct Lisp_Bool_Vector *) allocate_clear_vector (needed_elements, + clearit); + /* Clear padding at end; but only if necessary, to avoid polluting the + data cache. */ + if (!clearit && nbits % BITS_PER_BITS_WORD != 0) + p->data[words - 1] = 0; + XSETVECTOR (val, p); XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0); p->size = nbits; + return val; +} - /* Clear padding at the end. */ - if (words) - p->data[words - 1] = 0; +/* Return a newly allocated, uninitialized bool vector of size NBITS. */ - return val; +Lisp_Object +make_uninit_bool_vector (EMACS_INT nbits) +{ + return make_clear_bool_vector (nbits, false); } DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, @@ -2436,11 +2447,12 @@ DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, LENGTH must be a number. INIT matters only in whether it is t or nil. */) (Lisp_Object length, Lisp_Object init) { - Lisp_Object val; - CHECK_FIXNAT (length); - val = make_uninit_bool_vector (XFIXNAT (length)); - return bool_vector_fill (val, init); + EMACS_INT len = XFIXNAT (length); + if (BOOL_VECTOR_LENGTH_MAX < len) + memory_full (SIZE_MAX); + Lisp_Object val = make_clear_bool_vector (len, NILP (init)); + return NILP (init) ? val : bool_vector_fill (val, init); } DEFUN ("bool-vector", Fbool_vector, Sbool_vector, 0, MANY, 0, @@ -2449,13 +2461,12 @@ Allows any number of arguments, including zero. usage: (bool-vector &rest OBJECTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t i; - Lisp_Object vector; - - vector = make_uninit_bool_vector (nargs); - for (i = 0; i < nargs; i++) - bool_vector_set (vector, i, !NILP (args[i])); - + if (BOOL_VECTOR_LENGTH_MAX < nargs) + memory_full (SIZE_MAX); + Lisp_Object vector = make_clear_bool_vector (nargs, true); + for (ptrdiff_t i = 0; i < nargs; i++) + if (!NILP (args[i])) + bool_vector_set (vector, i, true); return vector; } @@ -3037,7 +3048,7 @@ enum { VECTOR_BLOCK_SIZE = 4096 }; enum { roundup_size = COMMON_MULTIPLE (LISP_ALIGNMENT, word_size) }; /* Verify assumption described above. */ -verify (VECTOR_BLOCK_SIZE % roundup_size == 0); +static_assert (VECTOR_BLOCK_SIZE % roundup_size == 0); /* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at compile time. */ #define vroundup_ct(x) ROUNDUP (x, roundup_size) @@ -3051,7 +3062,7 @@ enum {VECTOR_BLOCK_BYTES = VECTOR_BLOCK_SIZE - vroundup_ct (sizeof (void *))}; /* The current code expects to be able to represent an unused block by a single PVEC_FREE object, whose size is limited by the header word. (Of course we could use multiple such objects.) */ -verify (VECTOR_BLOCK_BYTES <= (word_size << PSEUDOVECTOR_REST_BITS)); +static_assert (VECTOR_BLOCK_BYTES <= (word_size << PSEUDOVECTOR_REST_BITS)); /* Size of the minimal vector allocated from block. */ @@ -3308,7 +3319,7 @@ vectorlike_nbytes (const union vectorlike_header *hdr) ptrdiff_t word_bytes = (bool_vector_words (bv->size) * sizeof (bits_word)); ptrdiff_t boolvec_bytes = bool_header_size + word_bytes; - verify (header_size <= bool_header_size); + static_assert (header_size <= bool_header_size); nwords = (boolvec_bytes - header_size + word_size - 1) / word_size; } else @@ -3688,7 +3699,7 @@ allocate_pseudovector (int memlen, int lisplen, /* Catch bogus values. */ enum { size_max = (1 << PSEUDOVECTOR_SIZE_BITS) - 1 }; enum { rest_max = (1 << PSEUDOVECTOR_REST_BITS) - 1 }; - verify (size_max + rest_max <= VECTOR_ELTS_MAX); + static_assert (size_max + rest_max <= VECTOR_ELTS_MAX); eassert (0 <= tag && tag <= PVEC_TAG_MAX); eassert (0 <= lisplen && lisplen <= zerolen && zerolen <= memlen); eassert (lisplen <= size_max); @@ -6842,9 +6853,11 @@ mark_glyph_matrix (struct glyph_matrix *matrix) struct glyph *end_glyph = glyph + row->used[area]; for (; glyph < end_glyph; ++glyph) - if (STRINGP (glyph->object) - && !string_marked_p (XSTRING (glyph->object))) - mark_object (glyph->object); + { + if (STRINGP (glyph->object) + && !string_marked_p (XSTRING (glyph->object))) + mark_object (glyph->object); + } } } } @@ -6997,33 +7010,6 @@ mark_face_cache (struct face_cache *c) } } -/* Remove killed buffers or items whose car is a killed buffer from - LIST, and mark other items. Return changed LIST, which is marked. */ - -static Lisp_Object -mark_discard_killed_buffers (Lisp_Object list) -{ - Lisp_Object tail, *prev = &list; - - for (tail = list; CONSP (tail) && !cons_marked_p (XCONS (tail)); - tail = XCDR (tail)) - { - Lisp_Object tem = XCAR (tail); - if (CONSP (tem)) - tem = XCAR (tem); - if (BUFFERP (tem) && !BUFFER_LIVE_P (XBUFFER (tem))) - *prev = XCDR (tail); - else - { - set_cons_marked (XCONS (tail)); - mark_object (XCAR (tail)); - prev = xcdr_addr (tail); - } - } - mark_object (tail); - return list; -} - static void mark_frame (struct Lisp_Vector *ptr) { @@ -7078,15 +7064,6 @@ mark_window (struct Lisp_Vector *ptr) mark_glyph_matrix (w->current_matrix); mark_glyph_matrix (w->desired_matrix); } - - /* Filter out killed buffers from both buffer lists - in attempt to help GC to reclaim killed buffers faster. - We can do it elsewhere for live windows, but this is the - best place to do it for dead windows. */ - wset_prev_buffers - (w, mark_discard_killed_buffers (w->prev_buffers)); - wset_next_buffers - (w, mark_discard_killed_buffers (w->next_buffers)); } /* Entry of the mark stack. */ @@ -8321,6 +8298,9 @@ N should be nonnegative. */); DEFSYM (QCemergency, ":emergency"); } +/* The below is for being able to do platform-specific stuff in .gdbinit + without risking error messages from GDB about missing types and + variables on other platforms. */ #ifdef HAVE_X_WINDOWS enum defined_HAVE_X_WINDOWS { defined_HAVE_X_WINDOWS = true }; #else @@ -8333,6 +8313,12 @@ enum defined_HAVE_PGTK { defined_HAVE_PGTK = true }; enum defined_HAVE_PGTK { defined_HAVE_PGTK = false }; #endif +#ifdef WINDOWSNT +enum defined_WINDOWSNT { defined_WINDOWSNT = true }; +#else +enum defined_WINDOWSNT { defined_WINDOWSNT = false }; +#endif + /* When compiled with GCC, GDB might say "No enum type named pvec_type" if we don't have at least one symbol with that type, and then xbacktrace could fail. Similarly for the other enums and @@ -8353,6 +8339,7 @@ extern union enums_for_gdb enum pvec_type pvec_type; enum defined_HAVE_X_WINDOWS defined_HAVE_X_WINDOWS; enum defined_HAVE_PGTK defined_HAVE_PGTK; + enum defined_WINDOWSNT defined_WINDOWSNT; } const gdb_make_enums_visible; union enums_for_gdb const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; #endif /* __GNUC__ */ diff --git a/src/android.c b/src/android.c index 0234fd50f69..f8d2df8fcf5 100644 --- a/src/android.c +++ b/src/android.c @@ -2969,7 +2969,7 @@ android_globalize_reference (jobject handle) (*android_java_env)->SetLongField (android_java_env, global, handle_class.handle, (jlong) global); - verify (sizeof (jlong) >= sizeof (intptr_t)); + static_assert (sizeof (jlong) >= sizeof (intptr_t)); return (intptr_t) global; } @@ -3521,7 +3521,7 @@ android_set_dashes (struct android_gc *gc, int dash_offset, /* Copy the list of segments into both arrays. */ for (i = 0; i < n; ++i) gc->dashes[i] = dash_list[i]; - verify (sizeof (int) == sizeof (jint)); + static_assert (sizeof (int) == sizeof (jint)); (*android_java_env)->SetIntArrayRegion (android_java_env, array, 0, n, (jint *) dash_list); diff --git a/src/android.h b/src/android.h index 1918e30ecfb..31436301df8 100644 --- a/src/android.h +++ b/src/android.h @@ -103,7 +103,7 @@ extern ssize_t android_readlinkat (int, const char *restrict, char *restrict, extern double android_pixel_density_x, android_pixel_density_y; extern double android_scaled_pixel_density; -verify (sizeof (android_handle) == sizeof (jobject)); +static_assert (sizeof (android_handle) == sizeof (jobject)); #define android_resolve_handle(handle) ((jobject) (handle)) extern unsigned char *android_lock_bitmap (android_drawable, diff --git a/src/androidfont.c b/src/androidfont.c index 3aad204fe61..fce62dc7ffa 100644 --- a/src/androidfont.c +++ b/src/androidfont.c @@ -654,7 +654,7 @@ androidfont_draw (struct glyph_string *s, int from, int to, /* Maybe initialize the font driver. */ androidfont_check_init (); - verify (sizeof (unsigned int) == sizeof (jint)); + static_assert (sizeof (unsigned int) == sizeof (jint)); info = (struct androidfont_info *) s->font; gcontext = android_resolve_handle (s->gc->gcontext); @@ -932,7 +932,7 @@ androidfont_text_extents (struct font *font, const unsigned int *code, memory_full (0); } - verify (sizeof (unsigned int) == sizeof (jint)); + static_assert (sizeof (unsigned int) == sizeof (jint)); /* Always true on every Android device. */ (*android_java_env)->SetIntArrayRegion (android_java_env, diff --git a/src/androidgui.h b/src/androidgui.h index 0e6d5cce3ae..55c139d403d 100644 --- a/src/androidgui.h +++ b/src/androidgui.h @@ -216,8 +216,6 @@ struct android_swap_info }; #define NativeRectangle Emacs_Rectangle -#define CONVERT_TO_NATIVE_RECT(xr, nr) ((xr) = (nr)) -#define CONVERT_FROM_EMACS_RECT(xr, nr) ((nr) = (xr)) #define STORE_NATIVE_RECT(nr, rx, ry, rwidth, rheight) \ ((nr).x = (rx), (nr).y = (ry), \ diff --git a/src/androidvfs.c b/src/androidvfs.c index 6543839312b..d7284a4cc85 100644 --- a/src/androidvfs.c +++ b/src/androidvfs.c @@ -259,7 +259,7 @@ struct android_special_vnode Lisp_Object special_coding_system; }; -verify (NIL_IS_ZERO); /* special_coding_system above. */ +static_assert (NIL_IS_ZERO); /* special_coding_system above. */ enum android_vnode_type { @@ -1323,7 +1323,7 @@ android_hack_asset_fd_fallback (AAsset *asset) if (fd < 0) return -1; - if (unlink (filename)) + if (unlink (filename) && errno != ENOENT) goto fail; if (ftruncate (fd, size)) diff --git a/src/bidi.c b/src/bidi.c index bfe2a0e8c51..d8754e2db73 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -566,7 +566,7 @@ bidi_copy_it (struct bidi_it *to, struct bidi_it *from) RTL characters in the offending line of text. */ /* Do we need to allow customization of this limit? */ #define BIDI_CACHE_MAX_ELTS_PER_SLOT 50000 -verify (BIDI_CACHE_CHUNK < BIDI_CACHE_MAX_ELTS_PER_SLOT); +static_assert (BIDI_CACHE_CHUNK < BIDI_CACHE_MAX_ELTS_PER_SLOT); static ptrdiff_t bidi_cache_max_elts = BIDI_CACHE_MAX_ELTS_PER_SLOT; static struct bidi_it *bidi_cache; static ptrdiff_t bidi_cache_size = 0; @@ -2626,7 +2626,7 @@ bidi_find_bracket_pairs (struct bidi_it *bidi_it) ptrdiff_t pairing_pos; int idx_at_entry = bidi_cache_idx; - verify (MAX_BPA_STACK >= 100); + static_assert (MAX_BPA_STACK >= 100); bidi_copy_it (&saved_it, bidi_it); /* bidi_cache_iterator_state refuses to cache on backward scans, and bidi_cache_fetch_state doesn't bring scan_dir from the diff --git a/src/bignum.c b/src/bignum.c index ceeb0c66bf5..ab76c723b44 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -145,9 +145,19 @@ make_neg_biguint (uintmax_t n) Lisp_Object make_integer_mpz (void) { + if (FASTER_BIGNUM && mpz_fits_slong_p (mpz[0])) + { + long int v = mpz_get_si (mpz[0]); + if (!FIXNUM_OVERFLOW_P (v)) + return make_fixnum (v); + } + size_t bits = mpz_sizeinbase (mpz[0], 2); - if (bits <= FIXNUM_BITS) + if (! (FASTER_BIGNUM + && FIXNUM_OVERFLOW_P (LONG_MIN) + && FIXNUM_OVERFLOW_P (LONG_MAX)) + && bits <= FIXNUM_BITS) { EMACS_INT v = 0; int i = 0, shift = 0; @@ -216,6 +226,17 @@ mpz_set_uintmax_slow (mpz_t result, uintmax_t v) bool mpz_to_intmax (mpz_t const z, intmax_t *pi) { + if (FASTER_BIGNUM) + { + if (mpz_fits_slong_p (z)) + { + *pi = mpz_get_si (z); + return true; + } + if (LONG_MIN <= INTMAX_MIN && INTMAX_MAX <= LONG_MAX) + return false; + } + ptrdiff_t bits = mpz_sizeinbase (z, 2); bool negative = mpz_sgn (z) < 0; @@ -246,6 +267,17 @@ mpz_to_intmax (mpz_t const z, intmax_t *pi) bool mpz_to_uintmax (mpz_t const z, uintmax_t *pi) { + if (FASTER_BIGNUM) + { + if (mpz_fits_ulong_p (z)) + { + *pi = mpz_get_ui (z); + return true; + } + if (UINTMAX_MAX <= ULONG_MAX) + return false; + } + if (mpz_sgn (z) < 0) return false; ptrdiff_t bits = mpz_sizeinbase (z, 2); diff --git a/src/bignum.h b/src/bignum.h index db3462bd696..5693aae148a 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -25,6 +25,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <gmp.h> #include "lisp.h" +/* Compile with -DFASTER_BIGNUM=0 to disable common optimizations and + allow easier testing of some slow-path code. */ +#ifndef FASTER_BIGNUM +# define FASTER_BIGNUM 1 +#endif + /* Number of data bits in a limb. */ #ifndef GMP_NUMB_BITS enum { GMP_NUMB_BITS = TYPE_WIDTH (mp_limb_t) }; @@ -68,16 +74,18 @@ mpz_set_intmax (mpz_t result, intmax_t v) /* mpz_set_si works in terms of long, but Emacs may use a wider integer type, and so sometimes will have to construct the mpz_t by hand. */ - if (LONG_MIN <= v && v <= LONG_MAX) - mpz_set_si (result, v); + long int i; + if (FASTER_BIGNUM && !ckd_add (&i, v, 0)) + mpz_set_si (result, i); else mpz_set_intmax_slow (result, v); } INLINE void ARG_NONNULL ((1)) mpz_set_uintmax (mpz_t result, uintmax_t v) { - if (v <= ULONG_MAX) - mpz_set_ui (result, v); + unsigned long int i; + if (FASTER_BIGNUM && !ckd_add (&i, v, 0)) + mpz_set_ui (result, i); else mpz_set_uintmax_slow (result, v); } diff --git a/src/buffer.c b/src/buffer.c index 4a5ad587ffa..224d56e33dd 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -27,8 +27,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <stdlib.h> #include <unistd.h> -#include <verify.h> - #include "lisp.h" #include "intervals.h" #include "process.h" @@ -2013,6 +2011,13 @@ cleaning up all windows currently displaying the buffer to be killed. */) buffer (bug#10114). */ replace_buffer_in_windows (buffer); + /* For dead windows that have not been collected yet, remove this + buffer from those windows' lists of previously and next shown + buffers and remove any 'quit-restore' or 'quit-restore-prev' + parameters mentioning the buffer. */ + if (XFIXNUM (BVAR (b, display_count)) > 0) + window_discard_buffer_from_dead_windows (buffer); + /* Exit if replacing the buffer in windows has killed our buffer. */ if (!BUFFER_LIVE_P (b)) return Qt; @@ -2030,7 +2035,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) /* If the buffer now current is shown in the minibuffer and our buffer is the sole other buffer give up. */ XSETBUFFER (tem, current_buffer); - if (EQ (tem, XWINDOW (minibuf_window)->contents) + if (BASE_EQ (tem, XWINDOW (minibuf_window)->contents) && BASE_EQ (buffer, Fother_buffer (buffer, Qnil, Qnil))) return Qnil; @@ -3169,7 +3174,7 @@ mouse_face_overlay_overlaps (Lisp_Object overlay) { if (node->begin < end && node->end > start && node->begin < node->end - && !EQ (node->data, overlay) + && !BASE_EQ (node->data, overlay) && (tem = Foverlay_get (overlay, Qmouse_face), !NILP (tem))) return true; @@ -3232,7 +3237,7 @@ compare_overlays (const void *v1, const void *v2) return s2->end < s1->end ? -1 : 1; else if (s1->spriority != s2->spriority) return (s1->spriority < s2->spriority ? -1 : 1); - else if (EQ (s1->overlay, s2->overlay)) + else if (BASE_EQ (s1->overlay, s2->overlay)) return 0; else /* Avoid the non-determinism of qsort by choosing an arbitrary ordering @@ -4084,7 +4089,7 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, bool after, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) { /* True if this change is an insertion. */ - bool insertion = (after ? XFIXNAT (arg3) == 0 : EQ (start, end)); + bool insertion = (after ? XFIXNAT (arg3) == 0 : BASE_EQ (start, end)); /* We used to run the functions as soon as we found them and only register them in last_overlay_modification_hooks for the purpose of the `after' @@ -4854,7 +4859,7 @@ init_buffer_once (void) The local flag bits are in the local_var_flags slot of the buffer. */ /* Nothing can work if this isn't true. */ - { verify (sizeof (EMACS_INT) == word_size); } + { static_assert (sizeof (EMACS_INT) == word_size); } Vbuffer_alist = Qnil; current_buffer = 0; diff --git a/src/bytecode.c b/src/bytecode.c index 770af6b486a..fcf369400b9 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -29,11 +29,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "window.h" #include "puresize.h" -/* Work around GCC bug 54561. */ -#if GNUC_PREREQ (4, 3, 0) -# pragma GCC diagnostic ignored "-Wclobbered" -#endif - /* Define BYTE_CODE_SAFE true to enable some minor sanity checking, useful for debugging the byte compiler. It defaults to false. */ @@ -536,6 +531,12 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, for (ptrdiff_t i = nargs - rest; i < nonrest; i++) PUSH (Qnil); + unsigned char volatile saved_quitcounter; +#if GCC_LINT && __GNUC__ && !__clang__ + Lisp_Object *volatile saved_vectorp; + unsigned char const *volatile saved_bytestr_data; +#endif + while (true) { int op; @@ -967,15 +968,23 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, if (sys_setjmp (c->jmp)) { + quitcounter = saved_quitcounter; struct handler *c = handlerlist; handlerlist = c->next; top = c->bytecode_top; op = c->bytecode_dest; + bc = ¤t_thread->bc; struct bc_frame *fp = bc->fp; Lisp_Object fun = fp->fun; Lisp_Object bytestr = AREF (fun, CLOSURE_CODE); Lisp_Object vector = AREF (fun, CLOSURE_CONSTANTS); +#if GCC_LINT && __GNUC__ && !__clang__ + /* These useless assignments pacify GCC 14.2.1 x86-64 + <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=21161>. */ + bytestr_data = saved_bytestr_data; + vectorp = saved_vectorp; +#endif bytestr_data = SDATA (bytestr); vectorp = XVECTOR (vector)->contents; if (BYTE_CODE_SAFE) @@ -989,6 +998,11 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, goto op_branch; } + saved_quitcounter = quitcounter; +#if GCC_LINT && __GNUC__ && !__clang__ + saved_vectorp = vectorp; + saved_bytestr_data = bytestr_data; +#endif NEXT; } @@ -1242,7 +1256,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, if (FIXNUMP (v1) && FIXNUMP (v2)) TOP = BASE_EQ (v1, v2) ? Qt : Qnil; else - TOP = arithcompare (v1, v2, ARITH_EQUAL); + TOP = arithcompare (v1, v2) & Cmp_EQ ? Qt : Qnil; NEXT; } @@ -1253,7 +1267,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, if (FIXNUMP (v1) && FIXNUMP (v2)) TOP = XFIXNUM (v1) > XFIXNUM (v2) ? Qt : Qnil; else - TOP = arithcompare (v1, v2, ARITH_GRTR); + TOP = arithcompare (v1, v2) & Cmp_GT ? Qt : Qnil; NEXT; } @@ -1264,7 +1278,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, if (FIXNUMP (v1) && FIXNUMP (v2)) TOP = XFIXNUM (v1) < XFIXNUM (v2) ? Qt : Qnil; else - TOP = arithcompare (v1, v2, ARITH_LESS); + TOP = arithcompare (v1, v2) & Cmp_LT ? Qt : Qnil; NEXT; } @@ -1275,7 +1289,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, if (FIXNUMP (v1) && FIXNUMP (v2)) TOP = XFIXNUM (v1) <= XFIXNUM (v2) ? Qt : Qnil; else - TOP = arithcompare (v1, v2, ARITH_LESS_OR_EQUAL); + TOP = arithcompare (v1, v2) & (Cmp_LT | Cmp_EQ) ? Qt : Qnil; NEXT; } @@ -1286,7 +1300,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, if (FIXNUMP (v1) && FIXNUMP (v2)) TOP = XFIXNUM (v1) >= XFIXNUM (v2) ? Qt : Qnil; else - TOP = arithcompare (v1, v2, ARITH_GRTR_OR_EQUAL); + TOP = arithcompare (v1, v2) & (Cmp_GT | Cmp_EQ) ? Qt : Qnil; NEXT; } diff --git a/src/casefiddle.c b/src/casefiddle.c index 5b5a98e5a1b..68b8dc63dbe 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -285,7 +285,7 @@ do_casify_multibyte_string (struct casing_context *ctx, Lisp_Object obj) representation of the character is at the beginning of the buffer. This is why we don’t need a separate struct casing_str_buf object, and can write directly to the destination. */ - verify (offsetof (struct casing_str_buf, data) == 0); + static_assert (offsetof (struct casing_str_buf, data) == 0); ptrdiff_t size = SCHARS (obj), n; USE_SAFE_ALLOCA; diff --git a/src/character.h b/src/character.h index 6d0f035c2bb..67eaf8934ef 100644 --- a/src/character.h +++ b/src/character.h @@ -23,7 +23,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef EMACS_CHARACTER_H #define EMACS_CHARACTER_H -#include <verify.h> #include "lisp.h" INLINE_HEADER_BEGIN diff --git a/src/charset.c b/src/charset.c index cf0122eeceb..c41a6622f00 100644 --- a/src/charset.c +++ b/src/charset.c @@ -819,6 +819,7 @@ TO-CODE, which are CHARSET code points. */) from = CHARSET_MIN_CODE (cs); else { + CHECK_FIXNAT (from_code); from = XFIXNUM (from_code); if (from < CHARSET_MIN_CODE (cs)) from = CHARSET_MIN_CODE (cs); @@ -827,6 +828,7 @@ TO-CODE, which are CHARSET code points. */) to = CHARSET_MAX_CODE (cs); else { + CHECK_FIXNAT (to_code); to = XFIXNUM (to_code); if (to > CHARSET_MAX_CODE (cs)) to = CHARSET_MAX_CODE (cs); @@ -1007,7 +1009,8 @@ usage: (define-charset-internal ...) */) i = CODE_POINT_TO_INDEX (&charset, charset.max_code); if (MAX_CHAR - charset.code_offset < i) - error ("Unsupported max char: %d", charset.max_char); + error ("Unsupported max char: %d + %ud > MAX_CHAR (%d)", + i, charset.max_code, MAX_CHAR); charset.max_char = i + charset.code_offset; i = CODE_POINT_TO_INDEX (&charset, charset.min_code); charset.min_char = i + charset.code_offset; diff --git a/src/chartab.c b/src/chartab.c index 58bb1658504..76a40ca7cc4 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -122,8 +122,6 @@ the char-table has no extra slot. */) else { CHECK_FIXNAT (n); - if (XFIXNUM (n) > 10) - args_out_of_range (n, Qnil); n_extras = XFIXNUM (n); } @@ -193,7 +193,7 @@ calccost (struct tty_display_info *tty, tabcost; register const char *p; - /* If have just wrapped on a terminal with xn, + /* If we have just wrapped on a terminal with xn, don't believe the cursor position: give up here and force use of absolute positioning. */ @@ -317,6 +317,8 @@ losecursor (void) #define USELL 2 #define USECR 3 +/* Move the cursor to (ROW, COL), by computing the optimal way. */ + void cmgoto (struct tty_display_info *tty, int row, int col) { diff --git a/src/coding.c b/src/coding.c index b8ed3a35957..84cf5c8f34d 100644 --- a/src/coding.c +++ b/src/coding.c @@ -6367,7 +6367,7 @@ make_string_from_utf8 (const char *text, ptrdiff_t nbytes) /* If TEXT is a valid UTF-8 string, we can convert it to a Lisp string directly. Otherwise, we need to decode it. */ if (chars == nbytes || bytes == nbytes) - return make_specified_string (text, chars, nbytes, true); + return make_multibyte_string (text, chars, nbytes); else { struct coding_system coding; diff --git a/src/comp.c b/src/comp.c index e24f1afb902..b96fae4ae95 100644 --- a/src/comp.c +++ b/src/comp.c @@ -956,7 +956,7 @@ obj_to_reloc (Lisp_Object obj) xsignal1 (Qnative_ice, build_string ("can't find data in relocation containers")); - assume (false); + eassume (false); found: eassert (XFIXNUM (idx) < reloc.array.len); @@ -1009,7 +1009,7 @@ declare_imported_func (Lisp_Object subr_sym, gcc_jit_type *ret_type, } else if (!types) { - types = SAFE_ALLOCA (nargs * sizeof (* types)); + SAFE_NALLOCA (types, 1, nargs); for (ptrdiff_t i = 0; i < nargs; i++) types[i] = comp.lisp_obj_type; } @@ -2096,16 +2096,17 @@ static gcc_jit_rvalue * emit_simple_limple_call (Lisp_Object args, gcc_jit_type *ret_type, bool direct) { USE_SAFE_ALLOCA; - int i = 0; Lisp_Object callee = FIRST (args); args = XCDR (args); - ptrdiff_t nargs = list_length (args); - gcc_jit_rvalue **gcc_args = SAFE_ALLOCA (nargs * sizeof (*gcc_args)); + ptrdiff_t i = 0, nargs = list_length (args); + gcc_jit_rvalue **gcc_args; + SAFE_NALLOCA (gcc_args, 1, nargs); FOR_EACH_TAIL (args) gcc_args[i++] = emit_mvar_rval (XCAR (args)); + gcc_jit_rvalue *res = emit_call (callee, ret_type, nargs, gcc_args, direct); SAFE_FREE (); - return emit_call (callee, ret_type, nargs, gcc_args, direct); + return res; } static gcc_jit_rvalue * @@ -4213,11 +4214,13 @@ declare_lex_function (Lisp_Object func) { EMACS_INT max_args = XFIXNUM (CALL1I (comp-args-max, args)); eassert (max_args < INT_MAX); - gcc_jit_type **type = SAFE_ALLOCA (max_args * sizeof (*type)); + gcc_jit_type **type; + SAFE_NALLOCA (type, 1, max_args); for (ptrdiff_t i = 0; i < max_args; i++) type[i] = comp.lisp_obj_type; - gcc_jit_param **params = SAFE_ALLOCA (max_args * sizeof (*params)); + gcc_jit_param **params; + SAFE_NALLOCA (params, 1, max_args); for (int i = 0; i < max_args; ++i) params[i] = gcc_jit_context_new_param (comp.ctxt, NULL, @@ -4293,7 +4296,7 @@ compile_function (Lisp_Object func) comp.func_relocs_ptr_type, "freloc"); - comp.frame = SAFE_ALLOCA (comp.frame_size * sizeof (*comp.frame)); + SAFE_NALLOCA (comp.frame, 1, comp.frame_size); if (comp.func_has_non_local || !comp.func_speed) { /* FIXME: See bug#42360. */ @@ -4337,11 +4340,9 @@ compile_function (Lisp_Object func) /* Pre-declare all basic blocks to gcc. The "entry" block must be declared as first. */ declare_block (Qentry); - Lisp_Object blocks = CALL1I (comp-func-blocks, func); - struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks); - DOHASH_SAFE (ht, i) + struct Lisp_Hash_Table *ht = XHASH_TABLE (CALL1I (comp-func-blocks, func)); + DOHASH (ht, block_name, block) { - Lisp_Object block_name = HASH_KEY (ht, i); if (!EQ (block_name, Qentry)) declare_block (block_name); } @@ -4352,10 +4353,8 @@ compile_function (Lisp_Object func) gcc_jit_lvalue_as_rvalue (comp.func_relocs)); - DOHASH_SAFE (ht, i) + DOHASH (ht, block_name, block) { - Lisp_Object block_name = HASH_KEY (ht, i); - Lisp_Object block = HASH_VALUE (ht, i); Lisp_Object insns = CALL1I (comp-block-insns, block); if (NILP (block) || NILP (insns)) xsignal1 (Qnative_ice, @@ -4972,12 +4971,12 @@ DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, struct Lisp_Hash_Table *func_h = XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt)); - DOHASH_SAFE (func_h, i) - declare_function (HASH_VALUE (func_h, i)); + DOHASH (func_h, k, function) + declare_function (function); /* Compile all functions. Can't be done before because the relocation structs has to be already defined. */ - DOHASH_SAFE (func_h, i) - compile_function (HASH_VALUE (func_h, i)); + DOHASH (func_h, k, function) + compile_function (function); /* Work around bug#46495 (GCC PR99126). */ #if defined (WIDE_EMACS_INT) \ @@ -5489,7 +5488,10 @@ native_function_doc (Lisp_Object function) if (!VECTORP (cu->data_fdoc_v)) xsignal2 (Qnative_lisp_file_inconsistent, cu->file, build_string ("missing documentation vector")); - return AREF (cu->data_fdoc_v, XSUBR (function)->doc); + EMACS_INT doc = XSUBR (function)->doc; + if (doc < 0) + return AREF (cu->data_fdoc_v, -doc - 1); + return make_fixnum (doc); } static Lisp_Object @@ -5530,7 +5532,8 @@ make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg, x->s.symbol_name = xstrdup (SSDATA (symbol_name)); x->s.intspec.native = intspec; x->s.command_modes = command_modes; - x->s.doc = XFIXNUM (doc_idx); + x->s.doc = -XFIXNUM (doc_idx) - 1; + eassert (x->s.doc < 0); #ifdef HAVE_NATIVE_COMP x->s.native_comp_u = comp_u; x->s.native_c_name = xstrdup (SSDATA (c_name)); diff --git a/src/conf_post.h b/src/conf_post.h index 4f1288f2956..29d14bf672b 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -93,55 +93,6 @@ typedef bool bool_bf; # define ADDRESS_SANITIZER false #endif -#ifdef emacs -/* We include stdlib.h here, because Gnulib's stdlib.h might redirect - 'free' to its replacement, and we want to avoid that in unexec - builds. Including it here will render its inclusion after config.h - a no-op. */ -# if (defined DARWIN_OS && defined HAVE_UNEXEC) || defined HYBRID_MALLOC -# include <stdlib.h> -# endif -#endif - -#if defined DARWIN_OS && defined emacs && defined HAVE_UNEXEC -# undef malloc -# define malloc unexec_malloc -# undef realloc -# define realloc unexec_realloc -# undef free -# define free unexec_free - -extern void *unexec_malloc (size_t); -extern void *unexec_realloc (void *, size_t); -extern void unexec_free (void *); - -#endif - -/* If HYBRID_MALLOC is defined (e.g., on Cygwin), emacs will use - gmalloc before dumping and the system malloc after dumping. - hybrid_malloc and friends, defined in gmalloc.c, are wrappers that - accomplish this. */ -#ifdef HYBRID_MALLOC -#ifdef emacs -#undef malloc -#define malloc hybrid_malloc -#undef realloc -#define realloc hybrid_realloc -#undef aligned_alloc -#define aligned_alloc hybrid_aligned_alloc -#undef calloc -#define calloc hybrid_calloc -#undef free -#define free hybrid_free - -extern void *hybrid_malloc (size_t); -extern void *hybrid_calloc (size_t, size_t); -extern void hybrid_free (void *); -extern void *hybrid_aligned_alloc (size_t, size_t); -extern void *hybrid_realloc (void *, size_t); -#endif /* emacs */ -#endif /* HYBRID_MALLOC */ - /* We have to go this route, rather than the old hpux9 approach of renaming the functions via macros. The system's stdlib.h has fully prototyped declarations, which yields a conflicting definition of @@ -462,16 +413,18 @@ extern int emacs_setenv_TZ (char const *); # define UNINIT /* empty */ #endif -/* MB_CUR_MAX is often broken on systems which copy-paste LLVM - headers, so replace its definition with a working one if - necessary. */ - -#ifdef REPLACEMENT_MB_CUR_MAX -#include <stdlib.h> -#undef MB_CUR_MAX -#define MB_CUR_MAX REPLACEMENT_MB_CUR_MAX -#endif /* REPLACEMENT_MB_CUR_MAX */ - /* Emacs does not need glibc strftime behavior for AM and PM indicators. */ #define REQUIRE_GNUISH_STRFTIME_AM_PM false + +#ifdef MSDOS +/* These are required by file-has-acl.c but defined in dirent.h and + errno.h, which are not generated on DOS. */ +#define _GL_DT_NOTDIR 0x100 /* Not a directory */ +#define ENOTSUP ENOSYS +# define IFTODT(mode) \ + (S_ISREG (mode) ? DT_REG : S_ISDIR (mode) ? DT_DIR \ + : S_ISLNK (mode) ? DT_LNK : S_ISBLK (mode) ? DT_BLK \ + : S_ISCHR (mode) ? DT_CHR : S_ISFIFO (mode) ? DT_FIFO \ + : S_ISSOCK (mode) ? DT_SOCK : DT_UNKNOWN) +#endif /* MSDOS */ diff --git a/src/cygw32.c b/src/cygw32.c index c8c49852733..df3293cfe3a 100644 --- a/src/cygw32.c +++ b/src/cygw32.c @@ -37,7 +37,7 @@ chdir_to_default_directory (void) int old_cwd_fd = emacs_open (".", O_RDONLY | O_DIRECTORY, 0); if (old_cwd_fd == -1) - error ("could not open current directory: %s", strerror (errno)); + error ("Could not open current directory: %s", strerror (errno)); record_unwind_protect_int (fchdir_unwind, old_cwd_fd); @@ -47,7 +47,7 @@ chdir_to_default_directory (void) new_cwd = build_string ("/"); if (chdir (SSDATA (ENCODE_FILE (new_cwd)))) - error ("could not chdir: %s", strerror (errno)); + error ("Could not chdir: %s", strerror (errno)); } static Lisp_Object diff --git a/src/data.c b/src/data.c index 247b0da1bae..bbe14c83dfb 100644 --- a/src/data.c +++ b/src/data.c @@ -82,7 +82,7 @@ XOBJFWD (lispfwd a) static void set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found) { - eassert (found == !EQ (blv->defcell, blv->valcell)); + eassert (found == !BASE_EQ (blv->defcell, blv->valcell)); blv->found = found; } @@ -1644,7 +1644,7 @@ void set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, enum Set_Internal_Bind bindflag) { - bool voide = BASE_EQ (newval, Qunbound); + bool unbinding_p = BASE_EQ (newval, Qunbound); /* If restoring in a dead buffer, do nothing. */ @@ -1663,10 +1663,13 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, case SYMBOL_TRAPPED_WRITE: /* Setting due to thread-switching doesn't count. */ if (bindflag != SET_INTERNAL_THREAD_SWITCH) - notify_variable_watchers (symbol, voide? Qnil : newval, - (bindflag == SET_INTERNAL_BIND? Qlet : - bindflag == SET_INTERNAL_UNBIND? Qunlet : - voide? Qmakunbound : Qset), + notify_variable_watchers (symbol, (unbinding_p ? Qnil : newval), + (bindflag == SET_INTERNAL_BIND + ? Qlet + : (bindflag == SET_INTERNAL_UNBIND + ? Qunlet + : (unbinding_p + ? Qmakunbound : Qset))), where); break; @@ -1684,6 +1687,11 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); + + if (unbinding_p && blv->fwd.fwdptr) + /* Forbid unbinding built-in variables. */ + error ("Built-in variables may not be unbound"); + if (NILP (where)) XSETBUFFER (where, current_buffer); @@ -1691,9 +1699,9 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, loaded, or if it's a Lisp_Buffer_Local_Value and the default binding is loaded, the loaded binding may be the wrong one. */ - if (!EQ (blv->where, where) + if (!BASE_EQ (blv->where, where) /* Also unload a global binding (if the var is local_if_set). */ - || (EQ (blv->valcell, blv->defcell))) + || (BASE_EQ (blv->valcell, blv->defcell))) { /* The currently loaded binding is not necessarily valid. We need to unload it, and choose a new binding. */ @@ -1748,16 +1756,9 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, set_blv_value (blv, newval); if (blv->fwd.fwdptr) - { - if (voide) - /* If storing void (making the symbol void), forward only through - buffer-local indicator, not through Lisp_Objfwd, etc. */ - blv->fwd.fwdptr = NULL; - else - store_symval_forwarding (blv->fwd, newval, - BUFFERP (where) - ? XBUFFER (where) : current_buffer); - } + store_symval_forwarding (blv->fwd, newval, (BUFFERP (where) + ? XBUFFER (where) + : current_buffer)); break; } case SYMBOL_FORWARDED: @@ -1765,6 +1766,11 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, struct buffer *buf = BUFFERP (where) ? XBUFFER (where) : current_buffer; lispfwd innercontents = SYMBOL_FWD (sym); + + if (unbinding_p) + /* Forbid unbinding built-in variables. */ + error ("Built-in variables may not be unbound"); + if (BUFFER_OBJFWDP (innercontents)) { int offset = XBUFFER_OBJFWD (innercontents)->offset; @@ -1780,14 +1786,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, } } - if (voide) - { /* If storing void (making the symbol void), forward only through - buffer-local indicator, not through Lisp_Objfwd, etc. */ - sym->u.s.redirect = SYMBOL_PLAINVAL; - SET_SYMBOL_VAL (sym, newval); - } - else - store_symval_forwarding (/* sym, */ innercontents, newval, buf); + store_symval_forwarding (/* sym, */ innercontents, newval, buf); break; } default: emacs_abort (); @@ -1943,7 +1942,7 @@ default_value (Lisp_Object symbol) But the `realvalue' slot may be more up to date, since ordinary setq stores just that slot. So use that. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); - if (blv->fwd.fwdptr && EQ (blv->valcell, blv->defcell)) + if (blv->fwd.fwdptr && BASE_EQ (blv->valcell, blv->defcell)) return do_symval_forwarding (blv->fwd); else return XCDR (blv->defcell); @@ -2038,7 +2037,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value, XSETCDR (blv->defcell, value); /* If the default binding is now loaded, set the REALVALUE slot too. */ - if (blv->fwd.fwdptr && EQ (blv->defcell, blv->valcell)) + if (blv->fwd.fwdptr && BASE_EQ (blv->defcell, blv->valcell)) store_symval_forwarding (blv->fwd, value, NULL); return; } @@ -2404,7 +2403,7 @@ Also see `buffer-local-boundp'.*/) XSETBUFFER (tmp, buf); XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ - if (EQ (blv->where, tmp)) /* The binding is already loaded. */ + if (BASE_EQ (blv->where, tmp)) /* The binding is already loaded. */ return blv_found (blv) ? Qt : Qnil; else return NILP (assq_no_quit (variable, BVAR (buf, local_var_alist))) @@ -2685,26 +2684,25 @@ check_number_coerce_marker (Lisp_Object x) return x; } -Lisp_Object -arithcompare (Lisp_Object num1, Lisp_Object num2, - enum Arith_Comparison comparison) +static Lisp_Object +coerce_marker (Lisp_Object x) { - EMACS_INT i1 = 0, i2 = 0; - bool lt, eq = true, gt; - bool test; + return MARKERP (x) ? make_fixnum (marker_position (x)) : x; +} - num1 = check_number_coerce_marker (num1); - num2 = check_number_coerce_marker (num2); +static AVOID +not_number_or_marker (Lisp_Object x) +{ + wrong_type_argument (Qnumber_or_marker_p, x); +} - /* If the comparison is mostly done by comparing two doubles, - set LT, EQ, and GT to the <, ==, > results of that comparison, - respectively, taking care to avoid problems if either is a NaN, - and trying to avoid problems on platforms where variables (in - violation of the C standard) can contain excess precision. - Regardless, set I1 and I2 to integers that break ties if the - two-double comparison is either not done or reports - equality. */ +cmp_bits_t +arithcompare (Lisp_Object num1, Lisp_Object num2) +{ + num1 = coerce_marker (num1); + num2 = coerce_marker (num2); + bool lt, eq, gt; if (FLOATP (num1)) { double f1 = XFLOAT_DATA (num1); @@ -2726,16 +2724,35 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, (exactly) so I1 - I2 = NUM1 - NUM2 (exactly), so comparing I1 to I2 will break the tie correctly. */ double f2 = XFIXNUM (num2); - lt = f1 < f2; - eq = f1 == f2; - gt = f1 > f2; - i1 = f2; - i2 = XFIXNUM (num2); + if (f1 == f2) + { + EMACS_INT i1 = f2; + EMACS_INT i2 = XFIXNUM (num2); + eq = i1 == i2; + lt = i1 < i2; + gt = i1 > i2; + } + else + { + eq = false; + lt = f1 < f2; + gt = f1 > f2; + } + } + else if (BIGNUMP (num2)) + { + if (isnan (f1)) + lt = eq = gt = false; + else + { + int cmp = mpz_cmp_d (*xbignum_val (num2), f1); + eq = cmp == 0; + lt = cmp > 0; + gt = cmp < 0; + } } - else if (isnan (f1)) - lt = eq = gt = false; else - i2 = mpz_cmp_d (*xbignum_val (num2), f1); + not_number_or_marker (num2); } else if (FIXNUMP (num1)) { @@ -2744,81 +2761,84 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, /* Compare an integer NUM1 to a float NUM2. This is the converse of comparing float to integer (see above). */ double f1 = XFIXNUM (num1), f2 = XFLOAT_DATA (num2); - lt = f1 < f2; - eq = f1 == f2; - gt = f1 > f2; - i1 = XFIXNUM (num1); - i2 = f1; + if (f1 == f2) + { + EMACS_INT i1 = XFIXNUM (num1); + EMACS_INT i2 = f1; + eq = i1 == i2; + lt = i1 < i2; + gt = i1 > i2; + } + else + { + eq = false; + lt = f1 < f2; + gt = f1 > f2; + } } else if (FIXNUMP (num2)) { - i1 = XFIXNUM (num1); - i2 = XFIXNUM (num2); + EMACS_INT i1 = XFIXNUM (num1); + EMACS_INT i2 = XFIXNUM (num2); + eq = i1 == i2; + lt = i1 < i2; + gt = i1 > i2; + } + else if (BIGNUMP (num2)) + { + int sgn = mpz_sgn (*xbignum_val (num2)); + eassume (sgn != 0); + eq = false; + lt = sgn > 0; + gt = sgn < 0; } else - i2 = mpz_sgn (*xbignum_val (num2)); + not_number_or_marker (num2); } - else if (FLOATP (num2)) + else if (BIGNUMP (num1)) { - double f2 = XFLOAT_DATA (num2); - if (isnan (f2)) - lt = eq = gt = false; + if (FLOATP (num2)) + { + double f2 = XFLOAT_DATA (num2); + if (isnan (f2)) + lt = eq = gt = false; + else + { + int cmp = mpz_cmp_d (*xbignum_val (num1), f2); + eq = cmp == 0; + lt = cmp < 0; + gt = cmp > 0; + } + } + else if (FIXNUMP (num2)) + { + int sgn = mpz_sgn (*xbignum_val (num1)); + eassume (sgn != 0); + eq = false; + lt = sgn < 0; + gt = sgn > 0; + } + else if (BIGNUMP (num2)) + { + int cmp = mpz_cmp (*xbignum_val (num1), *xbignum_val (num2)); + eq = cmp == 0; + lt = cmp < 0; + gt = cmp > 0; + } else - i1 = mpz_cmp_d (*xbignum_val (num1), f2); + not_number_or_marker (num2); } - else if (FIXNUMP (num2)) - i1 = mpz_sgn (*xbignum_val (num1)); else - i1 = mpz_cmp (*xbignum_val (num1), *xbignum_val (num2)); - - if (eq) - { - /* The two-double comparison either reported equality, or was not done. - Break the tie by comparing the integers. */ - lt = i1 < i2; - eq = i1 == i2; - gt = i1 > i2; - } - - switch (comparison) - { - case ARITH_EQUAL: - test = eq; - break; - - case ARITH_NOTEQUAL: - test = !eq; - break; - - case ARITH_LESS: - test = lt; - break; - - case ARITH_LESS_OR_EQUAL: - test = lt | eq; - break; - - case ARITH_GRTR: - test = gt; - break; - - case ARITH_GRTR_OR_EQUAL: - test = gt | eq; - break; - - default: - eassume (false); - } + not_number_or_marker (num1); - return test ? Qt : Qnil; + return lt << Cmp_Bit_LT | gt << Cmp_Bit_GT | eq << Cmp_Bit_EQ; } static Lisp_Object -arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args, - enum Arith_Comparison comparison) +arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args, cmp_bits_t cmpmask) { for (ptrdiff_t i = 1; i < nargs; i++) - if (NILP (arithcompare (args[i - 1], args[i], comparison))) + if (!(arithcompare (args[i - 1], args[i]) & cmpmask)) return Qnil; return Qt; } @@ -2828,7 +2848,7 @@ DEFUN ("=", Feqlsign, Seqlsign, 1, MANY, 0, usage: (= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return arithcompare_driver (nargs, args, ARITH_EQUAL); + return arithcompare_driver (nargs, args, Cmp_EQ); } DEFUN ("<", Flss, Slss, 1, MANY, 0, @@ -2839,7 +2859,7 @@ usage: (< NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1])) return XFIXNUM (args[0]) < XFIXNUM (args[1]) ? Qt : Qnil; - return arithcompare_driver (nargs, args, ARITH_LESS); + return arithcompare_driver (nargs, args, Cmp_LT); } DEFUN (">", Fgtr, Sgtr, 1, MANY, 0, @@ -2850,7 +2870,7 @@ usage: (> NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1])) return XFIXNUM (args[0]) > XFIXNUM (args[1]) ? Qt : Qnil; - return arithcompare_driver (nargs, args, ARITH_GRTR); + return arithcompare_driver (nargs, args, Cmp_GT); } DEFUN ("<=", Fleq, Sleq, 1, MANY, 0, @@ -2861,7 +2881,7 @@ usage: (<= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1])) return XFIXNUM (args[0]) <= XFIXNUM (args[1]) ? Qt : Qnil; - return arithcompare_driver (nargs, args, ARITH_LESS_OR_EQUAL); + return arithcompare_driver (nargs, args, Cmp_LT | Cmp_EQ); } DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0, @@ -2872,14 +2892,14 @@ usage: (>= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1])) return XFIXNUM (args[0]) >= XFIXNUM (args[1]) ? Qt : Qnil; - return arithcompare_driver (nargs, args, ARITH_GRTR_OR_EQUAL); + return arithcompare_driver (nargs, args, Cmp_GT | Cmp_EQ); } DEFUN ("/=", Fneq, Sneq, 2, 2, 0, doc: /* Return t if first arg is not equal to second arg. Both must be numbers or markers. */) (register Lisp_Object num1, Lisp_Object num2) { - return arithcompare (num1, num2, ARITH_NOTEQUAL); + return arithcompare (num1, num2) & Cmp_EQ ? Qnil : Qt; } /* Convert the cons-of-integers, integer, or float value C to an @@ -3421,14 +3441,13 @@ Both X and Y must be numbers or markers. */) } static Lisp_Object -minmax_driver (ptrdiff_t nargs, Lisp_Object *args, - enum Arith_Comparison comparison) +minmax_driver (ptrdiff_t nargs, Lisp_Object *args, cmp_bits_t cmpmask) { Lisp_Object accum = check_number_coerce_marker (args[0]); for (ptrdiff_t argnum = 1; argnum < nargs; argnum++) { Lisp_Object val = check_number_coerce_marker (args[argnum]); - if (!NILP (arithcompare (val, accum, comparison))) + if (arithcompare (val, accum) & cmpmask) accum = val; else if (FLOATP (val) && isnan (XFLOAT_DATA (val))) return val; @@ -3442,7 +3461,7 @@ The value is always a number; markers are converted to numbers. usage: (max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return minmax_driver (nargs, args, ARITH_GRTR); + return minmax_driver (nargs, args, Cmp_GT); } DEFUN ("min", Fmin, Smin, 1, MANY, 0, @@ -3451,7 +3470,7 @@ The value is always a number; markers are converted to numbers. usage: (min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { - return minmax_driver (nargs, args, ARITH_LESS); + return minmax_driver (nargs, args, Cmp_LT); } DEFUN ("logand", Flogand, Slogand, 0, MANY, 0, diff --git a/src/dbusbind.c b/src/dbusbind.c index 247142d1cf3..7c8388cca61 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1314,7 +1314,7 @@ The following usages are expected: `dbus-call-method', `dbus-call-method-asynchronously': (dbus-message-internal dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER - &optional :timeout TIMEOUT &rest ARGS) + &optional :timeout TIMEOUT :authorizable AUTH &rest ARGS) `dbus-send-signal': (dbus-message-internal @@ -1512,12 +1512,38 @@ usage: (dbus-message-internal &rest REST) */) XD_SIGNAL1 (build_string ("Unable to create an error message")); } - /* Check for timeout parameter. */ - if ((count + 2 <= nargs) && EQ (args[count], QCtimeout)) + while ((count + 2 <= nargs)) { - CHECK_FIXNAT (args[count+1]); - timeout = min (XFIXNAT (args[count+1]), INT_MAX); - count = count+2; + /* Check for timeout parameter. */ + if (EQ (args[count], QCtimeout)) + { + if (mtype != DBUS_MESSAGE_TYPE_METHOD_CALL) + XD_SIGNAL1 + (build_string (":timeout is only supported on method calls")); + + CHECK_FIXNAT (args[count+1]); + timeout = min (XFIXNAT (args[count+1]), INT_MAX); + count = count + 2; + } + /* Check for authorizable parameter. */ + else if (EQ (args[count], QCauthorizable)) + { + if (mtype != DBUS_MESSAGE_TYPE_METHOD_CALL) + XD_SIGNAL1 + (build_string (":authorizable is only supported on method calls")); + + /* Ignore this keyword if unsupported. */ +#ifdef HAVE_DBUS_MESSAGE_SET_ALLOW_INTERACTIVE_AUTHORIZATION + dbus_message_set_allow_interactive_authorization + (dmessage, NILP (args[count+1]) ? FALSE : TRUE); +#else + XD_DEBUG_MESSAGE (":authorizable not supported"); +#endif + + count = count + 2; + } + else break; + } /* Initialize parameter list of message. */ @@ -1895,6 +1921,9 @@ syms_of_dbusbind (void) /* Lisp symbol for method call timeout. */ DEFSYM (QCtimeout, ":timeout"); + /* Lisp symbol for method interactive authorization. */ + DEFSYM (QCauthorizable, ":authorizable"); + /* Lisp symbols of D-Bus types. */ DEFSYM (QCbyte, ":byte"); DEFSYM (QCboolean, ":boolean"); diff --git a/src/decompress.c b/src/decompress.c index ac0cfd36060..7cc6f73d4cd 100644 --- a/src/decompress.c +++ b/src/decompress.c @@ -27,8 +27,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "composite.h" #include "md5.h" -#include <verify.h> - #ifdef WINDOWSNT # include <windows.h> # include "w32common.h" diff --git a/src/dispextern.h b/src/dispextern.h index e3a78ba79d3..e3e621e7318 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -482,6 +482,11 @@ struct glyph continuation glyphs, or the overlay-arrow glyphs on TTYs. */ Lisp_Object object; + /* Frame on which the glyph was produced. The face_id of this glyph + refers to the face_cache of this frame. This is used on tty + frames only. */ + struct frame *frame; + /* Width in pixels. */ short pixel_width; @@ -626,10 +631,12 @@ struct glyph #define FONT_TYPE_UNKNOWN 0 -/* Is GLYPH a space? */ +/* Is GLYPH a space in default face on frame FRAME? */ -#define CHAR_GLYPH_SPACE_P(GLYPH) \ - ((GLYPH).u.ch == SPACEGLYPH && (GLYPH).face_id == DEFAULT_FACE_ID) +# define CHAR_GLYPH_SPACE_P(FRAME, GLYPH) \ + ((GLYPH).u.ch == SPACEGLYPH \ + && (GLYPH).face_id == DEFAULT_FACE_ID \ + && (GLYPH).frame == (FRAME)) /* Are glyph slices of glyphs *X and *Y equal? It assumes that both glyphs have the same type. @@ -654,6 +661,7 @@ struct glyph && (X)->u.val == (Y)->u.val \ && GLYPH_SLICE_EQUAL_P (X, Y) \ && (X)->face_id == (Y)->face_id \ + && (X)->frame == (Y)->frame \ && (X)->padding_p == (Y)->padding_p \ && (X)->left_box_line_p == (Y)->left_box_line_p \ && (X)->right_box_line_p == (Y)->right_box_line_p \ @@ -665,16 +673,18 @@ struct glyph #define GLYPH_CHAR_AND_FACE_EQUAL_P(X, Y) \ ((X)->u.ch == (Y)->u.ch \ && (X)->face_id == (Y)->face_id \ + && (X)->frame == (Y)->frame \ && (X)->padding_p == (Y)->padding_p) /* Fill a character glyph GLYPH. CODE, FACE_ID, PADDING_P correspond to the bits defined for the typedef `GLYPH' in lisp.h. */ -#define SET_CHAR_GLYPH(GLYPH, CODE, FACE_ID, PADDING_P) \ +#define SET_CHAR_GLYPH(FRAME, GLYPH, CODE, FACE_ID, PADDING_P) \ do \ { \ (GLYPH).u.ch = (CODE); \ (GLYPH).face_id = (FACE_ID); \ + (GLYPH).frame = (FRAME); \ (GLYPH).padding_p = (PADDING_P); \ } \ while (false) @@ -682,11 +692,9 @@ struct glyph /* Fill a character type glyph GLYPH from a glyph typedef FROM as defined in lisp.h. */ -#define SET_CHAR_GLYPH_FROM_GLYPH(GLYPH, FROM) \ - SET_CHAR_GLYPH (GLYPH, \ - GLYPH_CHAR (FROM), \ - GLYPH_FACE (FROM), \ - false) +#define SET_CHAR_GLYPH_FROM_GLYPH(FRAME, GLYPH, FROM) \ + SET_CHAR_GLYPH (FRAME, GLYPH, GLYPH_CHAR (FROM), \ + GLYPH_FACE (FROM), false) /* Construct a glyph code from a character glyph GLYPH. If the character is multibyte, return -1 as we can't use glyph table for a @@ -1314,9 +1322,6 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int); extern struct glyph space_glyph; -/* True means last display completed. False means it was preempted. */ - -extern bool display_completed; /************************************************************************ Glyph Strings @@ -1561,6 +1566,34 @@ struct glyph_string : estimate_mode_line_height \ (XFRAME ((W)->frame), CURRENT_MODE_LINE_ACTIVE_FACE_ID (W))))) +/* Return the desired face id for the header line of a window, depending + on whether the window is selected or not, or if the window is the + scrolling window for the currently active minibuffer window. + + Due to the way display_mode_lines manipulates with the contents of + selected_window, this macro needs three arguments: SELW which is + compared against the current value of selected_window, MBW which is + compared against minibuf_window (if SELW doesn't match), and SCRW + which is compared against minibuf_selected_window (if MBW matches). */ + +#define CURRENT_HEADER_LINE_ACTIVE_FACE_ID_3(SELW, MBW, SCRW) \ + ((!mode_line_in_non_selected_windows \ + || (SELW) == XWINDOW (selected_window) \ + || (minibuf_level > 0 \ + && !NILP (minibuf_selected_window) \ + && (MBW) == XWINDOW (minibuf_window) \ + && (SCRW) == XWINDOW (minibuf_selected_window))) \ + ? HEADER_LINE_ACTIVE_FACE_ID \ + : HEADER_LINE_INACTIVE_FACE_ID) + + +/* Return the desired face id for the header line of window W. */ + +#define CURRENT_HEADER_LINE_ACTIVE_FACE_ID(W) \ + CURRENT_HEADER_LINE_ACTIVE_FACE_ID_3(W, \ + XWINDOW (selected_window), \ + W) + /* Return the current height of the header line of window W. If not known from W->header_line_height, look at W's current glyph matrix, or return an estimation based on the height of the font of the face `header-line'. */ @@ -1572,7 +1605,7 @@ struct glyph_string = (MATRIX_HEADER_LINE_HEIGHT ((W)->current_matrix) \ ? MATRIX_HEADER_LINE_HEIGHT ((W)->current_matrix) \ : estimate_mode_line_height \ - (XFRAME ((W)->frame), HEADER_LINE_FACE_ID)))) + (XFRAME ((W)->frame), CURRENT_HEADER_LINE_ACTIVE_FACE_ID (W))))) /* Return the current height of the tab line of window W. If not known from W->tab_line_height, look at W's current glyph matrix, or return @@ -1893,7 +1926,8 @@ enum face_id MODE_LINE_INACTIVE_FACE_ID, TOOL_BAR_FACE_ID, FRINGE_FACE_ID, - HEADER_LINE_FACE_ID, + HEADER_LINE_ACTIVE_FACE_ID, + HEADER_LINE_INACTIVE_FACE_ID, SCROLL_BAR_FACE_ID, BORDER_FACE_ID, CURSOR_FACE_ID, @@ -3172,6 +3206,7 @@ struct image #endif /* HAVE_ANDROID */ #ifdef HAVE_NTGUI XFORM xform; + bool smoothing; #endif #ifdef HAVE_HAIKU /* The affine transformation to apply to this image. */ @@ -3222,6 +3257,9 @@ struct image /* Width and height of the image. */ int width, height; + /* The scale factor applied to the image. */ + double scale; + /* These values are used for the rectangles displayed for images that can't be loaded. */ #define DEFAULT_IMAGE_WIDTH 30 @@ -3797,7 +3835,7 @@ extern Lisp_Object marginal_area_string (struct window *, enum window_part, Lisp_Object *, int *, int *, int *, int *); extern void redraw_frame (struct frame *); -extern bool update_frame (struct frame *, bool, bool); +void update_frame (struct frame *, bool); extern void update_frame_with_menu (struct frame *, int, int); extern int update_mouse_position (struct frame *, int, int); extern void bitch_at_user (void); @@ -3805,7 +3843,7 @@ extern void adjust_frame_glyphs (struct frame *); void free_glyphs (struct frame *); void free_window_matrices (struct window *); void check_glyph_memory (void); -void mirrored_line_dance (struct glyph_matrix *, int, int, int *, char *); +void mirrored_line_dance (struct frame *f, int, int, int *, char *); void clear_glyph_matrix (struct glyph_matrix *); void clear_current_matrices (struct frame *f); void clear_desired_matrices (struct frame *); @@ -3829,7 +3867,7 @@ extern bool frame_size_change_delayed (struct frame *); void init_display (void); void syms_of_display (void); extern void spec_glyph_lookup_face (struct window *, GLYPH *); -extern void fill_up_frame_row_with_spaces (struct glyph_row *, int); +extern void fill_up_frame_row_with_spaces (struct frame *, struct glyph_row *, int); /* Defined in terminal.c. */ @@ -3911,6 +3949,16 @@ extern void gui_redo_mouse_highlight (Display_Info *); #endif /* HAVE_WINDOW_SYSTEM */ +struct frame *root_frame (struct frame *f); +Lisp_Object frames_in_reverse_z_order (struct frame *f, bool visible); +bool is_tty_frame (struct frame *f); +bool is_tty_child_frame (struct frame *f); +bool is_tty_root_frame (struct frame *f); +void combine_updates (Lisp_Object root_frames); +void combine_updates_for_frame (struct frame *f, bool inhibit_id_p); +void tty_raise_lower_frame (struct frame *f, bool raise); +int max_child_z_order (struct frame *parent); + INLINE_HEADER_END #endif /* not DISPEXTERN_H_INCLUDED */ diff --git a/src/dispnew.c b/src/dispnew.c index a46f7d9b094..5bc6958622d 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -42,6 +42,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "tparam.h" #include "xwidget.h" #include "pdumper.h" +#include "disptab.h" +#include "cm.h" #ifdef HAVE_ANDROID #include "android.h" @@ -71,7 +73,7 @@ struct dim /* Function prototypes. */ -static void update_frame_line (struct frame *, int, bool); +static void write_row (struct frame *f, int vpos, bool updating_menu_p); static int required_matrix_height (struct window *); static int required_matrix_width (struct window *); static void increment_row_positions (struct glyph_row *, ptrdiff_t, ptrdiff_t); @@ -80,9 +82,9 @@ static void build_frame_matrix_from_window_tree (struct glyph_matrix *, static void build_frame_matrix_from_leaf_window (struct glyph_matrix *, struct window *); static void adjust_decode_mode_spec_buffer (struct frame *); -static void fill_up_glyph_row_with_spaces (struct glyph_row *); +static void fill_up_glyph_row_with_spaces (struct frame *, struct glyph_row *); static void clear_window_matrices (struct window *, bool); -static void fill_up_glyph_row_area_with_spaces (struct glyph_row *, int); +static void fill_up_glyph_row_area_with_spaces (struct frame *, struct glyph_row *, int); static int scrolling_window (struct window *, int); static bool update_window_line (struct window *, int, bool *); static void mirror_make_current (struct window *, int); @@ -91,18 +93,28 @@ static void check_matrix_pointers (struct glyph_matrix *, struct glyph_matrix *); #endif static void mirror_line_dance (struct window *, int, int, int *, char *); -static bool update_window_tree (struct window *, bool); -static bool update_window (struct window *, bool); -static bool update_frame_1 (struct frame *, bool, bool, bool, bool); -static bool scrolling (struct frame *); +static void update_window_tree (struct window *); +static void update_window (struct window *); +static void write_matrix (struct frame *, bool, bool, bool); +static void scrolling (struct frame *); static void set_window_cursor_after_update (struct window *); static void adjust_frame_glyphs_for_window_redisplay (struct frame *); static void adjust_frame_glyphs_for_frame_redisplay (struct frame *); static void set_window_update_flags (struct window *w, bool on_p); -/* True means last display completed. False means it was preempted. */ - -bool display_completed; +#if 0 /* Please leave this in as a debugging aid. */ +static void +check_rows (struct frame *f) +{ + for (int y = 0; y < f->desired_matrix->nrows; ++y) + if (MATRIX_ROW_ENABLED_P (f->desired_matrix, y)) + { + struct glyph_row *row = MATRIX_ROW (f->desired_matrix, y); + for (int x = 0; x < row->used[TEXT_AREA]; ++x) + eassert (row->glyphs[TEXT_AREA][x].frame != 0); + } +} +#endif /* True means SIGWINCH happened when not safe. */ @@ -122,11 +134,6 @@ static int glyph_pool_count; #endif /* GLYPH_DEBUG and ENABLE_CHECKING */ -/* If non-null, the frame whose frame matrices are manipulated. If - null, window matrices are worked on. */ - -static struct frame *frame_matrix_frame; - /* Convert vpos and hpos from frame to window and vice versa. This may only be used for terminal frames. */ @@ -164,11 +171,10 @@ static uintmax_t history_tick; /* Add to the redisplay history how window W has been displayed. MSG is a trace containing the information how W's glyph matrix - has been constructed. PAUSED_P means that the update - has been interrupted for pending input. */ + has been constructed. */ static void -add_window_display_history (struct window *w, const char *msg, bool paused_p) +add_window_display_history (struct window *w, const char *msg) { char *buf; void *ptr = w; @@ -179,14 +185,13 @@ add_window_display_history (struct window *w, const char *msg, bool paused_p) ++history_idx; snprintf (buf, sizeof redisplay_history[0].trace, - "%"PRIuMAX": window %p (%s)%s\n%s", + "%"PRIuMAX": window %p %s\n%s", history_tick++, ptr, ((BUFFERP (w->contents) && STRINGP (BVAR (XBUFFER (w->contents), name))) ? SSDATA (BVAR (XBUFFER (w->contents), name)) : "???"), - paused_p ? " ***paused***" : "", msg); } @@ -1178,7 +1183,15 @@ line_hash_code (struct frame *f, struct glyph_row *row) while (glyph < end) { int c = glyph->u.ch; - int face_id = glyph->face_id; + unsigned int face_id = glyph->face_id; + /* A given row of a frame glyph matrix could have glyphs + from more than one frame, if child frames are displayed. + Since face_id of a face depends on the frame (it's an + index into the frame's face cache), we need the hash + value to include something specific to the frame, and we + use the frame cache's address for that purpose. */ + if (glyph->frame && glyph->frame != f) + face_id += (uintptr_t) glyph->frame->face_cache; if (FRAME_MUST_WRITE_SPACES (f)) c -= SPACEGLYPH; hash = (((hash << 4) + (hash >> 24)) & 0x0fffffff) + c; @@ -1213,7 +1226,7 @@ line_draw_cost (struct frame *f, struct glyph_matrix *matrix, int vpos) if (!FRAME_MUST_WRITE_SPACES (f)) { /* Skip from the end over trailing spaces. */ - while (end > beg && CHAR_GLYPH_SPACE_P (*(end - 1))) + while (end > beg && CHAR_GLYPH_SPACE_P (f, *(end - 1))) --end; /* All blank line. */ @@ -1221,7 +1234,7 @@ line_draw_cost (struct frame *f, struct glyph_matrix *matrix, int vpos) return 0; /* Skip over leading spaces. */ - while (CHAR_GLYPH_SPACE_P (*beg)) + while (CHAR_GLYPH_SPACE_P (f, *beg)) ++beg; } @@ -2117,8 +2130,7 @@ adjust_frame_glyphs_for_frame_redisplay (struct frame *f) current matrix over a call to adjust_glyph_matrix, we must make a copy of the current glyphs, and restore the current matrix' contents from that copy. */ - if (display_completed - && !FRAME_GARBAGED_P (f) + if (!FRAME_GARBAGED_P (f) && matrix_dim.width == f->current_matrix->matrix_w && matrix_dim.height == f->current_matrix->matrix_h /* For some reason, the frame glyph matrix gets corrupted if @@ -2558,6 +2570,7 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w int window_y, frame_y; /* If non-zero, a glyph to insert at the right border of W. */ GLYPH right_border_glyph; + struct frame *f = XFRAME (w->frame); SET_GLYPH_FROM_CHAR (right_border_glyph, 0); @@ -2599,10 +2612,10 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w /* Fill up the frame row with spaces up to the left margin of the window row. */ - fill_up_frame_row_with_spaces (frame_row, window_matrix->matrix_x); + fill_up_frame_row_with_spaces (f, frame_row, window_matrix->matrix_x); /* Fill up areas in the window matrix row with spaces. */ - fill_up_glyph_row_with_spaces (window_row); + fill_up_glyph_row_with_spaces (f, window_row); /* If only part of W's desired matrix has been built, and window_row wasn't displayed, use the corresponding current @@ -2616,10 +2629,21 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w if (current_row_p) { - /* Copy window row to frame row. */ - memcpy (frame_row->glyphs[TEXT_AREA] + window_matrix->matrix_x, - window_row->glyphs[0], - window_matrix->matrix_w * sizeof (struct glyph)); + /* If the desired glyphs for this row haven't been built, + copy from the corresponding current row, but only if it + is enabled, because ottherwise its contents are invalid. */ + struct glyph *to = frame_row->glyphs[TEXT_AREA] + window_matrix->matrix_x; + struct glyph *from = window_row->glyphs[0]; + for (int i = 0; i < window_matrix->matrix_w; ++i) + { + if (window_row->enabled_p) + to[i] = from[i]; + else + { + to[i] = space_glyph; + to[i].frame = f; + } + } } else { @@ -2638,7 +2662,7 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w glyph with the vertical border glyph. */ eassert (border->type == CHAR_GLYPH); border->type = CHAR_GLYPH; - SET_CHAR_GLYPH_FROM_GLYPH (*border, right_border_glyph); + SET_CHAR_GLYPH_FROM_GLYPH (f, *border, right_border_glyph); } #ifdef GLYPH_DEBUG @@ -2651,7 +2675,7 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w frame and window share glyphs. */ strcpy (w->current_matrix->method, w->desired_matrix->method); - add_window_display_history (w, w->current_matrix->method, 0); + add_window_display_history (w, w->current_matrix->method); #endif } @@ -2701,11 +2725,11 @@ spec_glyph_lookup_face (struct window *w, GLYPH *glyph) To be called for frame-based redisplay, only. */ static void -fill_up_glyph_row_with_spaces (struct glyph_row *row) +fill_up_glyph_row_with_spaces (struct frame *f, struct glyph_row *row) { - fill_up_glyph_row_area_with_spaces (row, LEFT_MARGIN_AREA); - fill_up_glyph_row_area_with_spaces (row, TEXT_AREA); - fill_up_glyph_row_area_with_spaces (row, RIGHT_MARGIN_AREA); + fill_up_glyph_row_area_with_spaces (f, row, LEFT_MARGIN_AREA); + fill_up_glyph_row_area_with_spaces (f, row, TEXT_AREA); + fill_up_glyph_row_area_with_spaces (f, row, RIGHT_MARGIN_AREA); } @@ -2713,15 +2737,19 @@ fill_up_glyph_row_with_spaces (struct glyph_row *row) frame-based redisplay only. */ static void -fill_up_glyph_row_area_with_spaces (struct glyph_row *row, int area) +fill_up_glyph_row_area_with_spaces (struct frame *f, struct glyph_row *row, + int area) { if (row->glyphs[area] < row->glyphs[area + 1]) { struct glyph *end = row->glyphs[area + 1]; struct glyph *text = row->glyphs[area] + row->used[area]; - while (text < end) - *text++ = space_glyph; + for (; text < end; ++text) + { + *text = space_glyph; + text->frame = f; + } row->used[area] = text - row->glyphs[area]; } } @@ -2731,13 +2759,16 @@ fill_up_glyph_row_area_with_spaces (struct glyph_row *row, int area) reached. In frame matrices only one area, TEXT_AREA, is used. */ void -fill_up_frame_row_with_spaces (struct glyph_row *row, int upto) +fill_up_frame_row_with_spaces (struct frame *f, struct glyph_row *row, int upto) { int i = row->used[TEXT_AREA]; struct glyph *glyph = row->glyphs[TEXT_AREA]; - while (i < upto) - glyph[i++] = space_glyph; + for (; i < upto; ++i) + { + glyph[i] = space_glyph; + glyph[i].frame = f; + } row->used[TEXT_AREA] = i; } @@ -2748,17 +2779,6 @@ fill_up_frame_row_with_spaces (struct glyph_row *row, int upto) Mirroring operations on frame matrices in window matrices **********************************************************************/ -/* Set frame being updated via frame-based redisplay to F. This - function must be called before updates to make explicit that we are - working on frame matrices or not. */ - -static void -set_frame_matrix_frame (struct frame *f) -{ - frame_matrix_frame = f; -} - - /* Make sure glyph row ROW in CURRENT_MATRIX is up to date. DESIRED_MATRIX is the desired matrix corresponding to CURRENT_MATRIX. The update is done by exchanging glyph pointers @@ -2768,9 +2788,10 @@ set_frame_matrix_frame (struct frame *f) operations in window matrices of frame_matrix_frame. */ static void -make_current (struct glyph_matrix *desired_matrix, - struct glyph_matrix *current_matrix, int row) +make_current (struct frame *f, struct window *w, int row) { + struct glyph_matrix *desired_matrix = f ? f->desired_matrix : w->desired_matrix; + struct glyph_matrix *current_matrix = f ? f->current_matrix : w->current_matrix; struct glyph_row *current_row = MATRIX_ROW (current_matrix, row); struct glyph_row *desired_row = MATRIX_ROW (desired_matrix, row); bool mouse_face_p = current_row->mouse_face_p; @@ -2797,8 +2818,8 @@ make_current (struct glyph_matrix *desired_matrix, /* If we are called on frame matrices, perform analogous operations for window matrices. */ - if (frame_matrix_frame) - mirror_make_current (XWINDOW (frame_matrix_frame->root_window), row); + if (f) + mirror_make_current (XWINDOW (f->root_window), row); } @@ -2862,9 +2883,11 @@ mirror_make_current (struct window *w, int frame_row) This function is called from do_scrolling and do_direct_scrolling. */ void -mirrored_line_dance (struct glyph_matrix *matrix, int unchanged_at_top, int nlines, +mirrored_line_dance (struct frame *f, int unchanged_at_top, int nlines, int *copy_from, char *retained_p) { + struct glyph_matrix *matrix = f->current_matrix; + /* A copy of original rows. */ struct glyph_row *old_rows; @@ -2894,9 +2917,8 @@ mirrored_line_dance (struct glyph_matrix *matrix, int unchanged_at_top, int nlin } /* Do the same for window matrices, if MATRIX is a frame matrix. */ - if (frame_matrix_frame) - mirror_line_dance (XWINDOW (frame_matrix_frame->root_window), - unchanged_at_top, nlines, copy_from, retained_p); + mirror_line_dance (XWINDOW (f->root_window), + unchanged_at_top, nlines, copy_from, retained_p); SAFE_FREE (); } @@ -3194,7 +3216,10 @@ redraw_frame (struct frame *f) future. */ SET_FRAME_GARBAGED (f); - clear_frame (f); + /* clear_frame is actually a "clear_terminal", i.e. + it clears the entire screen. */ + if (!FRAME_PARENT_FRAME (f)) + clear_frame (f); clear_current_matrices (f); update_end (f); fset_redisplay (f); @@ -3229,145 +3254,774 @@ DEFUN ("redraw-display", Fredraw_display, Sredraw_display, 0, 0, "", return Qnil; } - -/*********************************************************************** - Frame Update - ***********************************************************************/ +/********************************************************************** + TTY Child Frames + **********************************************************************/ -/* Update frame F based on the data in desired matrices. +/* Child frames on ttys break the assumption that frames on a tty + always occupy the whole terminal. They can overlap instead. + + Let a "root" frame be a frame that has no parent frame. Such root + frames are required to be the size of the terminal screen. The + current glyph matrix of a root frame of a termimnal represents what + is on the screen. The desired matrix of a root frame represents + what should be one the screen. + + Building the desired matrix of root frame proceeds by + + - building the desired matrix of the root frame itself which is + the bottommost frame in z-order; + - building desired matrices of child frames in z-order, topmost last; + - copying the desired glyphs from child frames to the desired glyphs + of the root frame + + Updating the screen is then done using root frame matrices as it + was before child frames were introduced. Child frame's current + matrices are updated by copying glyph contents of the current + matrix of the root frames to the current matrices of child + frames. This implicitly also updates the glyph contents of their + windows' current matrices. */ + +struct rect +{ + int x, y, w, h; +}; + +#ifndef HAVE_ANDROID + +/* Compute the intersection of R1 and R2 in R. Value is true if R1 and + R2 intersect, false otherwise. */ + +static bool +rect_intersect (struct rect *r, struct rect r1, struct rect r2) +{ + int x1 = max (r1.x, r2.x); + int x2 = min (r1.x + r1.w, r2.x + r2.w); + if (x2 < x1) + return false; + int y1 = max (r1.y, r2.y); + int y2 = min (r1.y + r1.h, r2.y + r2.h); + if (y2 < y1) + return false; + *r = (struct rect) { .x = x1, .y = y1, .w = x2 - x1, .h = y2 - y1 }; + return true; +} + +/* Return the absolute position of frame F in *X and *Y. */ + +static void +frame_pos_abs (struct frame *f, int *x, int *y) +{ + *x = *y = 0; + for (; f; f = FRAME_PARENT_FRAME (f)) + { + *x += f->left_pos; + *y += f->top_pos; + } +} + +/* Return the rectangle frame F occupies. X and Y are in absolute + coordinates. */ + +static struct rect +frame_rect_abs (struct frame *f) +{ + int x, y; + frame_pos_abs (f, &x, &y); + return (struct rect) { x, y, f->total_cols, f->total_lines }; +} + +#endif /* !HAVE_ANDROID */ + +/* Return the root frame of frame F. Follow the parent_frame chain + until we reach a frame that has no parent. That is the root frame. + Note that the root of a root frame is itself. */ + +struct frame * +root_frame (struct frame *f) +{ + while (FRAME_PARENT_FRAME (f)) + f = FRAME_PARENT_FRAME (f); + return f; +} + +int +max_child_z_order (struct frame *parent) +{ + Lisp_Object tail, frame; + int z_order = 0; + FOR_EACH_FRAME (tail, frame) + { + struct frame *f = XFRAME (frame); + if (FRAME_PARENT_FRAME (f) == parent) + z_order = max (z_order, f->z_order); + } + return z_order; +} + +/* Return true if F1 is an ancestor of F2. */ + +static bool +is_frame_ancestor (struct frame *f1, struct frame *f2) +{ + for (struct frame *f = FRAME_PARENT_FRAME (f2); f; f = FRAME_PARENT_FRAME (f)) + if (f == f1) + return true; + return false; +} + +/* Return a list of all frames having root frame ROOT. + If VISIBLE_ONLY is true, return only visible frames. */ + +static Lisp_Object +frames_with_root (struct frame *root, bool visible_only) +{ + Lisp_Object list = Qnil; + Lisp_Object tail, frame; + FOR_EACH_FRAME (tail, frame) + { + struct frame *f = XFRAME (frame); + if (root_frame (f) == root + && (!visible_only || FRAME_VISIBLE_P (f))) + list = Fcons (frame, list); + } + return list; +} + +/* Return a list of frames having parent frame PARENT. + If VISIBLE_ONLY is true, return only visible frames. */ - If FORCE_P, don't let redisplay be stopped by detecting pending input. - If INHIBIT_HAIRY_ID_P, don't try scrolling. +static Lisp_Object +frames_with_parent (struct frame *parent, bool visible_only) +{ + Lisp_Object list = Qnil; + Lisp_Object tail, frame; + FOR_EACH_FRAME (tail, frame) + { + struct frame *f = XFRAME (frame); + if (FRAME_PARENT_FRAME (f) == parent + && (!visible_only || FRAME_VISIBLE_P (f))) + list = Fcons (frame, list); + } + return list; +} - Value is true if redisplay was stopped due to pending input. */ +/* Compare frames F1 and F2 for z-order. Value is like strcmp. */ + +static int +frame_z_order_cmp (struct frame *f1, struct frame *f2) +{ + if (f1 == f2) + return 0; + if (is_frame_ancestor (f1, f2)) + return -1; + if (is_frame_ancestor (f2, f1)) + return 1; + return f1->z_order - f2->z_order; +} + +DEFUN ("frame--z-order-lessp", Fframe__z_order_lessp, Sframe__z_order_lessp, + 2, 2, 0, doc: /* Internal frame sorting function A < B. */) + (Lisp_Object a, Lisp_Object b) +{ + eassert (FRAMEP (a) && FRAMEP (b)); + return frame_z_order_cmp (XFRAME (a), XFRAME (b)) < 0 ? Qt : Qnil; +} + +/* Return a z-order list of frames with the same root as F. The list + is ordered topmost frame last. Note that this list contains + the root frame of F itself as first element. */ + +Lisp_Object +frames_in_reverse_z_order (struct frame *f, bool visible_only) +{ + struct frame *root = root_frame (f); + Lisp_Object frames = frames_with_root (root, visible_only); + frames = CALLN (Fsort, frames, QClessp, Qframe__z_order_lessp); + eassert (FRAMEP (XCAR (frames))); + eassert (XFRAME (XCAR (frames)) == root); + return frames; +} + +/* Raise of lower frame F in z-order. If RAISE is true, raise F, else + lower f. */ + +void +tty_raise_lower_frame (struct frame *f, bool raise) +{ + struct frame *parent = FRAME_PARENT_FRAME (f); + if (parent == NULL) + return; + + Lisp_Object siblings = frames_with_parent (parent, false); + siblings = CALLN (Fsort, siblings, QClessp, Qframe__z_order_lessp); + + int i = 0; + for (Lisp_Object tail = siblings; CONSP (tail); tail = XCDR (tail)) + { + struct frame *child = XFRAME (XCAR (tail)); + if (child != f) + child->z_order = i++; + } + f->z_order = raise ? i : 0; +} + +/* Return true if frame F is a tty frame. */ bool -update_frame (struct frame *f, bool force_p, bool inhibit_hairy_id_p) +is_tty_frame (struct frame *f) { - /* True means display has been paused because of pending input. */ - bool paused_p; - struct window *root_window = XWINDOW (f->root_window); + return FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f); +} + +/* Return true if frame F is a tty child frame. */ - if (redisplay_dont_pause) - force_p = true; - else if (!force_p && detect_input_pending_ignore_squeezables ()) +bool +is_tty_child_frame (struct frame *f) +{ + return FRAME_PARENT_FRAME (f) && is_tty_frame (f); +} + +/* Return true if frame F is a tty root frame. */ + +bool +is_tty_root_frame (struct frame *f) +{ + return !FRAME_PARENT_FRAME (f) && is_tty_frame (f); +} + +/* Return the index of the first enabled row in MATRIX, or -1 if there + is none. */ + +static int +first_enabled_row (struct glyph_matrix *matrix) +{ + for (int i = 0; i < matrix->nrows; ++i) + if (MATRIX_ROW_ENABLED_P (matrix, i)) + return i; + return -1; +} + +/* On tty frame F, make desired matrix current, without writing + to the terminal. */ + +static void +make_matrix_current (struct frame *f) +{ + int first_row = first_enabled_row (f->desired_matrix); + if (first_row >= 0) + for (int i = first_row; i < f->desired_matrix->nrows; ++i) + if (MATRIX_ROW_ENABLED_P (f->desired_matrix, i)) + make_current (f, NULL, i); +} + +#ifndef HAVE_ANDROID + +/* Prepare ROOT's desired row at index Y for copying child frame + contents to it. Value is the prepared desired row or NULL if we + don't have, and can't contruct a desired row. */ + +static struct glyph_row * +prepare_desired_root_row (struct frame *root, int y) +{ + /* If we have a desired row that has been displayed, use that. */ + struct glyph_row *desired_row = MATRIX_ROW (root->desired_matrix, y); + if (desired_row->enabled_p) + return desired_row; + + /* If we have a current row that is up to date, copy that to the + desired row and use that. */ + /* Don't copy rows that aren't enabled, in particuler because they + might not have the 'frame' member of glyphs set. */ + struct glyph_row *current_row = MATRIX_ROW (root->current_matrix, y); + if (current_row->enabled_p) { - paused_p = true; - goto do_pause; + memcpy (desired_row->glyphs[0], current_row->glyphs[0], + root->current_matrix->matrix_w * sizeof (struct glyph)); + desired_row->enabled_p = true; + return desired_row; } - if (FRAME_WINDOW_P (f)) + return NULL; +} + +/* Change GLYPH to be a space glyph. */ + +static void +make_glyph_space (struct glyph *glyph) +{ + glyph->u.ch = ' '; + glyph->pixel_width = 1; + glyph->padding_p = 0; +} + +/* On root frame ROOT, if the glyph in ROW at position X is part of a + sequence of glyphs for a wide character, change every glyph belonging + to the sequence to a space. If X is outside of ROOT, do nothing. */ + +static void +neutralize_wide_char (struct frame *root, struct glyph_row *row, int x) +{ + if (x < 0 || x >= root->desired_matrix->matrix_w) + return; + + struct glyph *glyph = row->glyphs[TEXT_AREA] + x; + if (glyph->type == CHAR_GLYPH && CHARACTER_WIDTH (glyph->u.ch) > 1) { - /* We are working on window matrix basis. All windows whose - flag must_be_updated_p is set have to be updated. */ + /* Glyph is somewhere in a sequence of glyphs for a wide + character, find the start. */ + struct glyph *row_start = row->glyphs[TEXT_AREA]; + while (glyph > row_start && glyph->padding_p) + --glyph; - /* Record that we are not working on frame matrices. */ - set_frame_matrix_frame (NULL); + /* Make everything in the sequence a space glyph. */ + eassert (!glyph->padding_p); + make_glyph_space (glyph); + struct glyph *row_limit = row_start + row->used[TEXT_AREA]; + for (++glyph; glyph < row_limit && glyph->padding_p; ++glyph) + make_glyph_space (glyph); + } +} - /* Update all windows in the window tree of F, maybe stopping - when pending input is detected. */ - update_begin (f); +/* Produce glyphs for box character BOX in ROW. X is the position in + ROW where to start producing glyphs. N is the number of glyphs to + produce. CHILD is the frame to use for the face of the glyphs. */ -#if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR - /* Update the menu bar on X frames that don't have toolkit - support. */ - if (WINDOWP (f->menu_bar_window)) - update_window (XWINDOW (f->menu_bar_window), true); -#endif +static void +produce_box_glyphs (enum box box, struct glyph_row *row, int x, int n, + struct frame *child) +{ + int dflt; + switch (box) + { + case BOX_VERTICAL: + dflt = '|'; + break; + case BOX_HORIZONTAL: + dflt = '-'; + break; + case BOX_DOWN_RIGHT: + case BOX_DOWN_LEFT: + case BOX_UP_RIGHT: + case BOX_UP_LEFT: + dflt = '+'; + break; + } -#if defined (HAVE_WINDOW_SYSTEM) - /* Update the tab-bar window, if present. */ - if (WINDOWP (f->tab_bar_window)) + /* FIXME/tty: some face for the border. */ + int face_id = BORDER_FACE_ID; + GLYPH g; + SET_GLYPH (g, dflt, face_id); + + if (DISP_TABLE_P (Vstandard_display_table)) + { + struct Lisp_Char_Table *dp = XCHAR_TABLE (Vstandard_display_table); + Lisp_Object gc = dp->extras[box]; + if (GLYPH_CODE_P (gc)) { - struct window *w = XWINDOW (f->tab_bar_window); + SET_GLYPH_FROM_GLYPH_CODE (g, gc); + /* Sorry, but I really don't care if the glyph has a face :-). */ + } + } - /* Update tab-bar window. */ - if (w->must_be_updated_p) - { - Lisp_Object tem; + struct glyph *glyph = row->glyphs[0] + x; + for (int i = 0; i < n; ++i, ++glyph) + { + glyph->type = CHAR_GLYPH; + glyph->u.ch = GLYPH_CHAR (g); + glyph->charpos = -1; + glyph->pixel_width = 1; + glyph->multibyte_p = 1; + glyph->face_id = GLYPH_FACE (g); + glyph->frame = child; + glyph->padding_p = 0; + glyph->object = Qnil; + glyph->padding_p = 0; + } +} - update_window (w, true); - w->must_be_updated_p = false; +/* Produce box glyphs LEFT and RIGHT in ROOT_ROW. X and W are the start + and width of a range in ROOT_ROW before and after which to put the + box glyphs, if they fit. ROOT and CHILD are root and child frame we + are working on. ROOT is the root frame whose matrix dimensions + determines if the box glyphs fit. CHILD is the frame whose faces to + use for the box glyphs. */ - /* Swap tab-bar strings. We swap because we want to - reuse strings. */ - tem = f->current_tab_bar_string; - fset_current_tab_bar_string (f, f->desired_tab_bar_string); - fset_desired_tab_bar_string (f, tem); - } +static void +produce_box_sides (enum box left, enum box right, struct glyph_row *root_row, int x, + int w, struct frame *root, struct frame *child) +{ + if (x > 0) + { + neutralize_wide_char (root, root_row, x - 1); + produce_box_glyphs (left, root_row, x - 1, 1, child); + } + + if (x + w < root->desired_matrix->matrix_w) + { + neutralize_wide_char (root, root_row, x + w); + produce_box_glyphs (right, root_row, x + w, 1, child); + } +} + +static void +produce_box_line (struct frame *root, struct frame *child, int x, int y, int w, + bool first) +{ + struct glyph_row *root_row = prepare_desired_root_row (root, y); + if (root_row == NULL) + return; + if (first) + produce_box_sides (BOX_DOWN_RIGHT, BOX_DOWN_LEFT, root_row, x, w, root, child); + else + produce_box_sides (BOX_UP_RIGHT, BOX_UP_LEFT, root_row, x, w, root, child); + produce_box_glyphs (BOX_HORIZONTAL, root_row, x, w, child); + root_row->hash = row_hash (root_row); +} + +/* Copy to ROOT's desired matrix what we need from CHILD. */ + +static void +copy_child_glyphs (struct frame *root, struct frame *child) +{ + eassert (!FRAME_PARENT_FRAME (root)); + eassert (is_frame_ancestor (root, child)); + + /* Determine the intersection of the child frame rectangle with the + root frame. This is basically clipping the child frame to the + root frame rectangle. */ + struct rect r; + if (!rect_intersect (&r, frame_rect_abs (root), frame_rect_abs (child))) + return; + + /* Build CHILD's current matrix which we need to copy from it. */ + make_matrix_current (child); + + /* Draw borders around the child frame. */ + if (!FRAME_UNDECORATED (child)) + { + /* Horizontal line above. */ + if (r.y > 0) + produce_box_line (root, child, r.x, r.y - 1, r.w, true); + + for (int y = r.y; y < r.y + r.h; ++y) + { + struct glyph_row *root_row = prepare_desired_root_row (root, y); + if (root_row) + produce_box_sides (BOX_VERTICAL, BOX_VERTICAL, root_row, r.x, r.w, + root, child); } -#endif -#if defined (HAVE_WINDOW_SYSTEM) && ! defined (HAVE_EXT_TOOL_BAR) - /* Update the tool-bar window, if present. */ - if (WINDOWP (f->tool_bar_window)) + /* Horizontal line below. */ + if (r.y + r.h < root->desired_matrix->matrix_h) + produce_box_line (root, child, r.x, r.y + r.h, r.w, false); + } + + /* First visible row/col, relative to the child frame. */ + int child_x = child->left_pos < 0 ? - child->left_pos : 0; + int child_y = child->top_pos < 0 ? - child->top_pos : 0; + + /* For all rows in the intersection, copy glyphs from the child's + current matrix to the root's desired matrix, enabling those rows + if they aren't already. */ + for (int y = r.y; y < r.y + r.h; ++y, ++child_y) + { + struct glyph_row *root_row = prepare_desired_root_row (root, y); + if (root_row == NULL) + continue; + + /* Deal with wide characters unless already done as part of + drawing a box around the child frame. */ + if (FRAME_UNDECORATED (child)) { - struct window *w = XWINDOW (f->tool_bar_window); + neutralize_wide_char (root, root_row, r.x - 1); + neutralize_wide_char (root, root_row, r.x + r.w); + } - /* Update tool-bar window. */ - if (w->must_be_updated_p) - { - Lisp_Object tem; + /* Copy what's visible from the child's current row. If that row + is not enabled_p, we can't copy anything that makes sense. */ + struct glyph_row *child_row = MATRIX_ROW (child->current_matrix, child_y); + if (child_row->enabled_p) + memcpy (root_row->glyphs[0] + r.x, child_row->glyphs[0] + child_x, + r.w * sizeof (struct glyph)); - update_window (w, true); - w->must_be_updated_p = false; + /* Compute a new hash since we changed glyphs. */ + root_row->hash = row_hash (root_row); + } +} - /* Swap tool-bar strings. We swap because we want to - reuse strings. */ - tem = f->current_tool_bar_string; - fset_current_tool_bar_string (f, f->desired_tool_bar_string); - fset_desired_tool_bar_string (f, tem); - } +#endif /* !HAVE_ANDROID */ + +/*********************************************************************** + Frame Update + ***********************************************************************/ + +/* Update the menu bar on X frames that don't have toolkit + support. */ + +static void +update_menu_bar (struct frame *f) +{ +#if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR + if (WINDOWP (f->menu_bar_window)) + update_window (XWINDOW (f->menu_bar_window)); +#endif +} + +#ifdef HAVE_WINDOW_SYSTEM +static void +update_bar_window (Lisp_Object window, Lisp_Object *current, + Lisp_Object *desired) +{ + if (WINDOWP (window)) + { + struct window *w = XWINDOW (window); + if (w->must_be_updated_p) + { + update_window (w); + w->must_be_updated_p = false; + Lisp_Object tem = *current; + *current = *desired; + *desired = tem; } + } +} #endif - /* Update windows. */ - paused_p = update_window_tree (root_window, force_p); - update_end (f); +/* Update the tab-bar window of frame F, if present. */ + +static void +update_tab_bar (struct frame *f) +{ +#if defined(HAVE_WINDOW_SYSTEM) + update_bar_window (f->tab_bar_window, &f->current_tab_bar_string, + &f->desired_tab_bar_string); +#endif +} + +static void +update_tool_bar (struct frame *f) +{ +#if defined(HAVE_WINDOW_SYSTEM) && !defined(HAVE_EXT_TOOL_BAR) + update_bar_window (f->tool_bar_window, &f->current_tool_bar_string, + &f->desired_tool_bar_string); +#endif +} + +static void +update_window_frame (struct frame *f) +{ + eassert (FRAME_WINDOW_P (f)); + update_begin (f); + update_menu_bar (f); + update_tab_bar (f); + update_tool_bar (f); + struct window *root_window = XWINDOW (f->root_window); + update_window_tree (root_window); + update_end (f); + set_window_update_flags (root_window, false); +} + +static void +update_initial_frame (struct frame *f) +{ + build_frame_matrix (f); + struct window *root_window = XWINDOW (f->root_window); + set_window_update_flags (root_window, false); +} + +static void +flush_terminal (struct frame *f) +{ + if (FRAME_TTY (f)->termscript) + fflush (FRAME_TTY (f)->termscript); + fflush (FRAME_TTY (f)->output); +} + +static void +update_tty_frame (struct frame *f) +{ + build_frame_matrix (f); +} + +#ifndef HAVE_ANDROID + +/* Return the cursor position of the selected window of frame F, in + absolute coordinates in *X and *Y. Note that if F is a child frame, + its cursor may be clipped, i.e. outside of the bounds of the terminal + window. Value is false if the selected window of F doesn't have + valid cursor position info. */ + +static bool +abs_cursor_pos (struct frame *f, int *x, int *y) +{ + struct window *w = XWINDOW (f->selected_window); + if (w->cursor.vpos >= 0 + /* The cursor vpos may be temporarily out of bounds + in the following situation: There is one window, + with the cursor in the lower half of it. The window + is split, and a message causes a redisplay before + a new cursor position has been computed. */ + && w->cursor.vpos < WINDOW_TOTAL_LINES (w)) + { + int wx = WINDOW_TO_FRAME_HPOS (w, w->cursor.hpos); + int wy = WINDOW_TO_FRAME_VPOS (w, w->cursor.vpos); + + wx += max (0, w->left_margin_cols); + + int fx, fy; + frame_pos_abs (f, &fx, &fy); + *x = fx + wx; + *y = fy + wy; + return true; } - else + + *x = *y = 0; + return false; +} + +static bool +is_in_matrix (struct frame *f, int x, int y) +{ + struct frame *root = root_frame (f); + if (x < 0 || x >= root->current_matrix->matrix_w || y < 0 + || y >= root->current_matrix->matrix_h) + return false; + return true; +} + +/* Is the terminal cursor of the selected frame obscured by a child + frame? */ + +static bool +is_cursor_obscured (void) +{ + /* Give up if we can't tell where the cursor currently is. */ + int x, y; + if (!abs_cursor_pos (SELECTED_FRAME (), &x, &y)) + return false; + + /* (x, y) may be outside of the root frame in case the selected frame is a + child frame which is clipped. */ + struct frame *root = root_frame (SELECTED_FRAME ()); + if (!is_in_matrix (root, x, y)) + return true; + + struct glyph_row *cursor_row = MATRIX_ROW (root->current_matrix, y); + struct glyph *cursor_glyph = cursor_row->glyphs[0] + x; + return cursor_glyph->frame != SELECTED_FRAME (); +} + +/* Decide where to show the cursor, and whether to hide it. + + This works very well for Vertico-Posframe, Transient-Posframe and + Corfu, but it's debatable if it's the right thing for a general use + of child frames of all sorts, nested and so on. But it is also + debatable if that's a realistic use case from my POV. */ + +static void +terminal_cursor_magic (struct frame *root, struct frame *topmost_child) +{ + /* By default, prevent the cursor "shining through" child frames. */ + if (is_cursor_obscured ()) + tty_hide_cursor (FRAME_TTY (root)); + + /* If the terminal cursor is not in the topmost child, the topmost + child's tty-cursor-if-topmost determines what to do. If it is + non-nil, display the cursor in this "non-selected" topmost child + frame to compensate for the fact that we can't display a + non-selected cursor like on a window system frame. */ + if (topmost_child != SELECTED_FRAME ()) { - /* We are working on frame matrix basis. Set the frame on whose - frame matrix we operate. */ - set_frame_matrix_frame (f); + Lisp_Object frame; + XSETFRAME (frame, topmost_child); - /* Build F's desired matrix from window matrices. */ - build_frame_matrix (f); + int x, y; + Lisp_Object cursor = Fframe_parameter (frame, Qtty_non_selected_cursor); + if (!NILP (cursor) && abs_cursor_pos (topmost_child, &x, &y)) + { + if (is_in_matrix (root, x, y)) + { + cursor_to (root, y, x); + tty_show_cursor (FRAME_TTY (topmost_child)); + } + else + tty_hide_cursor (FRAME_TTY (root)); + } + } +} - /* Update the display. */ - if (FRAME_INITIAL_P (f)) - /* No actual display to update so the "update" is a nop and - obviously isn't interrupted by pending input. */ - paused_p = false; - else - { - update_begin (f); - paused_p = update_frame_1 (f, force_p, inhibit_hairy_id_p, 1, false); - update_end (f); - } - - if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) - { - if (FRAME_TTY (f)->termscript) - fflush (FRAME_TTY (f)->termscript); - if (FRAME_TERMCAP_P (f)) - fflush (FRAME_TTY (f)->output); - } - - /* Check window matrices for lost pointers. */ +#endif /* !HAVE_ANDROID */ + +void +combine_updates_for_frame (struct frame *f, bool inhibit_scrolling) +{ +#ifndef HAVE_ANDROID + struct frame *root = root_frame (f); + eassert (FRAME_VISIBLE_P (root)); + + /* Process child frames in reverse z-order, topmost last. For each + child, copy what we need to the root's desired matrix. */ + Lisp_Object z_order = frames_in_reverse_z_order (root, true); + struct frame *topmost_child = NULL; + for (Lisp_Object tail = XCDR (z_order); CONSP (tail); tail = XCDR (tail)) + { + topmost_child = XFRAME (XCAR (tail)); + copy_child_glyphs (root, topmost_child); + } + + update_begin (root); + write_matrix (root, inhibit_scrolling, 1, false); + make_matrix_current (root); + update_end (root); + + /* If a child is displayed, and the cursor is displayed in another + frame, the child might lay above the cursor, so that it appears to + "shine through" the child. Avoid that because it's confusing. */ + if (topmost_child) + terminal_cursor_magic (root, topmost_child); + flush_terminal (root); + + for (Lisp_Object tail = z_order; CONSP (tail); tail = XCDR (tail)) + { + struct frame *f = XFRAME (XCAR (tail)); + struct window *root_window = XWINDOW (f->root_window); + set_window_update_flags (root_window, false); + clear_desired_matrices (f); #ifdef GLYPH_DEBUG check_window_matrix_pointers (root_window); - add_frame_display_history (f, paused_p); + add_frame_display_history (f, false); #endif } +#endif /* HAVE_ANDROID */ +} - do_pause: - /* Reset flags indicating that a window should be updated. */ - set_window_update_flags (root_window, false); +/* Update on the screen all root frames ROOTS. Called from + redisplay_internal as the last step of redisplaying. */ - display_completed = !paused_p; - return paused_p; +void +combine_updates (Lisp_Object roots) +{ + for (; CONSP (roots); roots = XCDR (roots)) + { + struct frame *root = XFRAME (XCAR (roots)); + combine_updates_for_frame (root, false); + } +} + +/* Update frame F based on the data in desired matrices. + If INHIBIT_SCROLLING, don't try scrolling. */ + +void +update_frame (struct frame *f, bool inhibit_scrolling) +{ + if (FRAME_WINDOW_P (f)) + update_window_frame (f); + else if (FRAME_INITIAL_P (f)) + update_initial_frame (f); + else + update_tty_frame (f); } /* Update a TTY frame F that has a menu dropped down over some of its @@ -3384,29 +4038,25 @@ void update_frame_with_menu (struct frame *f, int row, int col) { struct window *root_window = XWINDOW (f->root_window); - bool paused_p, cursor_at_point_p; + bool cursor_at_point_p; eassert (FRAME_TERMCAP_P (f)); - /* We are working on frame matrix basis. Set the frame on whose - frame matrix we operate. */ - set_frame_matrix_frame (f); - /* Update the display. */ update_begin (f); cursor_at_point_p = !(row >= 0 && col >= 0); - /* Force update_frame_1 not to stop due to pending input, and not - try scrolling. */ - paused_p = update_frame_1 (f, 1, 1, cursor_at_point_p, true); + /* Do not stop due to pending input, and do not try scrolling. This + means that write_glyphs will always return false. */ + write_matrix (f, 1, cursor_at_point_p, true); + make_matrix_current (f); + clear_desired_matrices (f); /* ROW and COL tell us where in the menu to position the cursor, so that screen readers know the active region on the screen. */ if (!cursor_at_point_p) cursor_to (f, row, col); update_end (f); + flush_terminal (f); - if (FRAME_TTY (f)->termscript) - fflush (FRAME_TTY (f)->termscript); - fflush (FRAME_TTY (f)->output); /* Check window matrices for lost pointers. */ #if GLYPH_DEBUG #if 0 @@ -3415,12 +4065,11 @@ update_frame_with_menu (struct frame *f, int row, int col) making any updates to the window matrices. */ check_window_matrix_pointers (root_window); #endif - add_frame_display_history (f, paused_p); + add_frame_display_history (f, false); #endif /* Reset flags indicating that a window should be updated. */ set_window_update_flags (root_window, false); - display_completed = !paused_p; } /* Update the mouse position for a frame F. This handles both @@ -3453,19 +4102,20 @@ update_mouse_position (struct frame *f, int x, int y) } DEFUN ("display--update-for-mouse-movement", Fdisplay__update_for_mouse_movement, - Sdisplay__update_for_mouse_movement, 2, 2, 0, + Sdisplay__update_for_mouse_movement, 3, 3, 0, doc: /* Handle mouse movement detected by Lisp code. This function should be called when Lisp code detects the mouse has moved, even if `track-mouse' is nil. This handles updates that do not rely on input events such as updating display for mouse-face properties or updating the help echo text. */) - (Lisp_Object mouse_x, Lisp_Object mouse_y) + (Lisp_Object mouse_frame, Lisp_Object mouse_x, Lisp_Object mouse_y) { + CHECK_FRAME (mouse_frame); CHECK_FIXNUM (mouse_x); CHECK_FIXNUM (mouse_y); - update_mouse_position (SELECTED_FRAME (), XFIXNUM (mouse_x), + update_mouse_position (XFRAME (mouse_frame), XFIXNUM (mouse_x), XFIXNUM (mouse_y)); return Qnil; } @@ -3475,30 +4125,24 @@ properties or updating the help echo text. */) Window-based updates ************************************************************************/ -/* Perform updates in window tree rooted at W. - If FORCE_P, don't stop updating if input is pending. */ +/* Perform updates in window tree rooted at W. */ -static bool -update_window_tree (struct window *w, bool force_p) +static void +update_window_tree (struct window *w) { - bool paused_p = 0; - - while (w && !paused_p) + while (w) { if (WINDOWP (w->contents)) - paused_p |= update_window_tree (XWINDOW (w->contents), force_p); + update_window_tree (XWINDOW (w->contents)); else if (w->must_be_updated_p) - paused_p |= update_window (w, force_p); + update_window (w); w = NILP (w->next) ? 0 : XWINDOW (w->next); } - - return paused_p; } -/* Update window W if its flag must_be_updated_p is set. - If FORCE_P, don't stop updating if input is pending. */ +/* Update window W if its flag must_be_updated_p is set. */ void update_single_window (struct window *w) @@ -3507,12 +4151,9 @@ update_single_window (struct window *w) { struct frame *f = XFRAME (WINDOW_FRAME (w)); - /* Record that this is not a frame-based redisplay. */ - set_frame_matrix_frame (NULL); - /* Update W. */ update_begin (f); - update_window (w, true); + update_window (w); update_end (f); /* Reset flag in W. */ @@ -3652,15 +4293,12 @@ check_current_matrix_flags (struct window *w) #endif /* GLYPH_DEBUG */ -/* Update display of window W. - If FORCE_P, don't stop updating when input is pending. */ +/* Update display of window W. */ -static bool -update_window (struct window *w, bool force_p) +static void +update_window (struct window *w) { struct glyph_matrix *desired_matrix = w->desired_matrix; - bool paused_p; - int preempt_count = clip_to_bounds (1, baud_rate / 2400 + 1, INT_MAX); #ifdef HAVE_WINDOW_SYSTEM struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w))); #endif @@ -3669,222 +4307,200 @@ update_window (struct window *w, bool force_p) eassert (FRAME_WINDOW_P (XFRAME (WINDOW_FRAME (w)))); #endif - /* Check pending input the first time so that we can quickly return. */ - if (!force_p) - detect_input_pending_ignore_squeezables (); - /* If forced to complete the update, no input is pending, or we are tracking the mouse, do the update. */ - if (force_p || !input_pending || !NILP (track_mouse)) - { - struct glyph_row *row, *end; - struct glyph_row *mode_line_row; - struct glyph_row *tab_line_row; - struct glyph_row *header_line_row; - int yb; - bool changed_p = 0, mouse_face_overwritten_p = 0; - int n_updated = 0; - bool invisible_rows_marked = false; + struct glyph_row *row, *end; + struct glyph_row *mode_line_row; + struct glyph_row *tab_line_row; + struct glyph_row *header_line_row; + int yb; + bool changed_p = 0, mouse_face_overwritten_p = 0; + bool invisible_rows_marked = false; #ifdef HAVE_WINDOW_SYSTEM - gui_update_window_begin (w); + gui_update_window_begin (w); +#else + (void) changed_p; #endif - yb = window_text_bottom_y (w); - row = MATRIX_ROW (desired_matrix, 0); - end = MATRIX_MODE_LINE_ROW (desired_matrix); + yb = window_text_bottom_y (w); + row = MATRIX_ROW (desired_matrix, 0); + end = MATRIX_MODE_LINE_ROW (desired_matrix); - /* Take note of the tab line, if there is one. We will - update it below, after updating all of the window's lines. */ - if (row->mode_line_p && row->tab_line_p) - { - tab_line_row = row; - ++row; - } - else - tab_line_row = NULL; + /* Take note of the tab line, if there is one. We will + update it below, after updating all of the window's lines. */ + if (row->mode_line_p && row->tab_line_p) + { + tab_line_row = row; + ++row; + } + else + tab_line_row = NULL; - /* Take note of the header line, if there is one. We will - update it below, after updating all of the window's lines. */ - if (row->mode_line_p) - { - header_line_row = row; - ++row; - } - else - header_line_row = NULL; + /* Take note of the header line, if there is one. We will + update it below, after updating all of the window's lines. */ + if (row->mode_line_p) + { + header_line_row = row; + ++row; + } + else + header_line_row = NULL; - /* Update the mode line, if necessary. */ - mode_line_row = MATRIX_MODE_LINE_ROW (desired_matrix); - if (mode_line_row->mode_line_p && mode_line_row->enabled_p) - { - mode_line_row->y = yb + WINDOW_SCROLL_BAR_AREA_HEIGHT (w); - update_window_line (w, MATRIX_ROW_VPOS (mode_line_row, - desired_matrix), - &mouse_face_overwritten_p); - } + /* Update the mode line, if necessary. */ + mode_line_row = MATRIX_MODE_LINE_ROW (desired_matrix); + if (mode_line_row->mode_line_p && mode_line_row->enabled_p) + { + mode_line_row->y = yb + WINDOW_SCROLL_BAR_AREA_HEIGHT (w); + update_window_line (w, MATRIX_ROW_VPOS (mode_line_row, + desired_matrix), + &mouse_face_overwritten_p); + } - /* Find first enabled row. Optimizations in redisplay_internal - may lead to an update with only one row enabled. There may - be also completely empty matrices. */ - while (row < end && !row->enabled_p) - ++row; + /* Find first enabled row. Optimizations in redisplay_internal + may lead to an update with only one row enabled. There may + be also completely empty matrices. */ + while (row < end && !row->enabled_p) + ++row; - /* Try reusing part of the display by copying. */ - if (row < end && !desired_matrix->no_scrolling_p) + /* Try reusing part of the display by copying. */ + if (row < end && !desired_matrix->no_scrolling_p) + { + int rc = scrolling_window (w, (tab_line_row != NULL ? 1 : 0) + + (header_line_row != NULL ? 1 : 0)); + if (rc < 0) { - int rc = scrolling_window (w, (tab_line_row != NULL ? 1 : 0) - + (header_line_row != NULL ? 1 : 0)); - if (rc < 0) - { - /* All rows were found to be equal. */ - paused_p = 0; - goto set_cursor; - } - else if (rc > 0) - { - /* We've scrolled the display. */ - force_p = 1; - changed_p = 1; - } + /* All rows were found to be equal. */ + goto set_cursor; } + else if (rc > 0) + { + /* We've scrolled the display. */ + changed_p = 1; + } + } - /* Update the rest of the lines. */ - for (; row < end && (force_p || !input_pending); ++row) - /* scrolling_window resets the enabled_p flag of the rows it - reuses from current_matrix. */ - if (row->enabled_p) + /* Update the rest of the lines. */ + for (; row < end; ++row) + /* scrolling_window resets the enabled_p flag of the rows it + reuses from current_matrix. */ + if (row->enabled_p) + { + int vpos = MATRIX_ROW_VPOS (row, desired_matrix); + int i; + + changed_p |= update_window_line (w, vpos, + &mouse_face_overwritten_p); + + /* Mark all rows below the last visible one in the current + matrix as invalid. This is necessary because of + variable line heights. Consider the case of three + successive redisplays, where the first displays 5 + lines, the second 3 lines, and the third 5 lines again. + If the second redisplay wouldn't mark rows in the + current matrix invalid, the third redisplay might be + tempted to optimize redisplay based on lines displayed + in the first redisplay. */ + if (MATRIX_ROW_BOTTOM_Y (row) >= yb) { - int vpos = MATRIX_ROW_VPOS (row, desired_matrix); - int i; - - /* We'll have to play a little bit with when to - detect_input_pending. If it's done too often, - scrolling large windows with repeated scroll-up - commands will too quickly pause redisplay. */ - if (!force_p && ++n_updated % preempt_count == 0) - detect_input_pending_ignore_squeezables (); - changed_p |= update_window_line (w, vpos, - &mouse_face_overwritten_p); - - /* Mark all rows below the last visible one in the current - matrix as invalid. This is necessary because of - variable line heights. Consider the case of three - successive redisplays, where the first displays 5 - lines, the second 3 lines, and the third 5 lines again. - If the second redisplay wouldn't mark rows in the - current matrix invalid, the third redisplay might be - tempted to optimize redisplay based on lines displayed - in the first redisplay. */ - if (MATRIX_ROW_BOTTOM_Y (row) >= yb) - { - for (i = vpos + 1; i < w->current_matrix->nrows - 1; ++i) - SET_MATRIX_ROW_ENABLED_P (w->current_matrix, i, false); - invisible_rows_marked = true; - } + for (i = vpos + 1; i < w->current_matrix->nrows - 1; ++i) + SET_MATRIX_ROW_ENABLED_P (w->current_matrix, i, false); + invisible_rows_marked = true; } + } - /* If the window doesn't display its mode line, make sure the - corresponding row of the current glyph matrix is disabled, so - that if and when the mode line is displayed again, it will be - cleared and completely redrawn. */ - if (!window_wants_mode_line (w)) - SET_MATRIX_ROW_ENABLED_P (w->current_matrix, - w->current_matrix->nrows - 1, false); - - /* Was display preempted? */ - paused_p = row < end; - - if (!paused_p && !invisible_rows_marked) + /* If the window doesn't display its mode line, make sure the + corresponding row of the current glyph matrix is disabled, so + that if and when the mode line is displayed again, it will be + cleared and completely redrawn. */ + if (!window_wants_mode_line (w)) + SET_MATRIX_ROW_ENABLED_P (w->current_matrix, + w->current_matrix->nrows - 1, false); + + if (!invisible_rows_marked) + { + /* If we didn't mark the invisible rows in the current + matrix as invalid above, do that now. This can happen if + scrolling_window updates the last visible rows of the + current matrix, in which case the above loop doesn't get + to examine the last visible row. */ + int i; + for (i = 0; i < w->current_matrix->nrows - 1; ++i) { - /* If we didn't mark the invisible rows in the current - matrix as invalid above, do that now. This can happen if - scrolling_window updates the last visible rows of the - current matrix, in which case the above loop doesn't get - to examine the last visible row. */ - int i; - for (i = 0; i < w->current_matrix->nrows - 1; ++i) + struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, i); + if (current_row->enabled_p + && MATRIX_ROW_BOTTOM_Y (current_row) >= yb) { - struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, i); - if (current_row->enabled_p - && MATRIX_ROW_BOTTOM_Y (current_row) >= yb) - { - for (++i ; i < w->current_matrix->nrows - 1; ++i) - SET_MATRIX_ROW_ENABLED_P (w->current_matrix, i, false); - } + for (++i ; i < w->current_matrix->nrows - 1; ++i) + SET_MATRIX_ROW_ENABLED_P (w->current_matrix, i, false); } } + } - set_cursor: + set_cursor: - /* Update the tab line after scrolling because a new tab - line would otherwise overwrite lines at the top of the window - that can be scrolled. */ - if (tab_line_row && tab_line_row->enabled_p) - { - tab_line_row->y = 0; - update_window_line (w, 0, &mouse_face_overwritten_p); - } + /* Update the tab line after scrolling because a new tab + line would otherwise overwrite lines at the top of the window + that can be scrolled. */ + if (tab_line_row && tab_line_row->enabled_p) + { + tab_line_row->y = 0; + update_window_line (w, 0, &mouse_face_overwritten_p); + } - /* Update the header line after scrolling because a new header - line would otherwise overwrite lines at the top of the window - that can be scrolled. */ - if (header_line_row && header_line_row->enabled_p) - { - header_line_row->y = tab_line_row ? CURRENT_TAB_LINE_HEIGHT (w) : 0; - update_window_line (w, tab_line_row ? 1 : 0, &mouse_face_overwritten_p); - } + /* Update the header line after scrolling because a new header + line would otherwise overwrite lines at the top of the window + that can be scrolled. */ + if (header_line_row && header_line_row->enabled_p) + { + header_line_row->y = tab_line_row ? CURRENT_TAB_LINE_HEIGHT (w) : 0; + update_window_line (w, tab_line_row ? 1 : 0, &mouse_face_overwritten_p); + } - /* Fix the appearance of overlapping/overlapped rows. */ - if (!paused_p && !w->pseudo_window_p) - { + /* Fix the appearance of overlapping/overlapped rows. */ + if (!w->pseudo_window_p) + { #ifdef HAVE_WINDOW_SYSTEM - if (changed_p && rif->fix_overlapping_area) - { - redraw_overlapped_rows (w, yb); - redraw_overlapping_rows (w, yb); - } + if (changed_p && rif->fix_overlapping_area) + { + redraw_overlapped_rows (w, yb); + redraw_overlapping_rows (w, yb); + } #endif - /* Make cursor visible at cursor position of W. */ - set_window_cursor_after_update (w); + /* Make cursor visible at cursor position of W. */ + set_window_cursor_after_update (w); #if 0 /* Check that current matrix invariants are satisfied. This is - for debugging only. See the comment of check_matrix_invariants. */ - IF_DEBUG (check_matrix_invariants (w)); + for debugging only. See the comment of check_matrix_invariants. */ + IF_DEBUG (check_matrix_invariants (w)); #endif - } + } #ifdef GLYPH_DEBUG - /* Remember the redisplay method used to display the matrix. */ - strcpy (w->current_matrix->method, w->desired_matrix->method); + /* Remember the redisplay method used to display the matrix. */ + strcpy (w->current_matrix->method, w->desired_matrix->method); #endif #ifdef HAVE_WINDOW_SYSTEM - update_window_fringes (w, 0); + update_window_fringes (w, 0); - /* End the update of window W. Don't set the cursor if we - paused updating the display because in this case, - set_window_cursor_after_update hasn't been called, and - W->output_cursor doesn't contain the cursor location. */ - gui_update_window_end (w, !paused_p, mouse_face_overwritten_p); + /* End the update of window W. Don't set the cursor if we + paused updating the display because in this case, + set_window_cursor_after_update hasn't been called, and + W->output_cursor doesn't contain the cursor location. */ + gui_update_window_end (w, true, mouse_face_overwritten_p); #endif - /* If the update wasn't interrupted, this window has been - completely updated. */ - if (!paused_p) - w->must_be_updated_p = false; - } - else - paused_p = 1; + /* If the update wasn't interrupted, this window has been + completely updated. */ + w->must_be_updated_p = false; #ifdef GLYPH_DEBUG /* check_current_matrix_flags (w); */ - add_window_display_history (w, w->current_matrix->method, paused_p); + add_window_display_history (w, w->current_matrix->method); #endif xwidget_end_redisplay (w, w->current_matrix); clear_glyph_matrix (desired_matrix); - - return paused_p; } #ifdef HAVE_WINDOW_SYSTEM @@ -4321,7 +4937,7 @@ update_window_line (struct window *w, int vpos, bool *mouse_face_overwritten_p) /* Update current_row from desired_row. */ was_stipple = current_row->stipple_p; - make_current (w->desired_matrix, w->current_matrix, vpos); + make_current (NULL, w, vpos); /* If only a partial update was performed, any stipple already displayed in MATRIX_ROW (w->current_matrix, vpos) might still be @@ -4667,7 +5283,7 @@ scrolling_window (struct window *w, int tab_line_p) 13, then next_almost_prime_increment_max would be 14, e.g., because next_almost_prime (113) would be 127. */ { - verify (NEXT_ALMOST_PRIME_LIMIT == 11); + static_assert (NEXT_ALMOST_PRIME_LIMIT == 11); enum { next_almost_prime_increment_max = 10 }; ptrdiff_t row_table_max = (min (PTRDIFF_MAX, SIZE_MAX) / (3 * sizeof *row_table) @@ -4931,179 +5547,131 @@ scrolling_window (struct window *w, int tab_line_p) Frame-Based Updates ************************************************************************/ -/* Update the desired frame matrix of frame F. - - FORCE_P means that the update should not be stopped by pending input. - INHIBIT_ID_P means that scrolling by insert/delete should not be tried. - SET_CURSOR_P false means do not set cursor at point in selected window. - - Value is true if update was stopped due to pending input. */ - -static bool -update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p, - bool set_cursor_p, bool updating_menu_p) +static void +tty_set_cursor (void) { - /* Frame matrices to work on. */ - struct glyph_matrix *current_matrix = f->current_matrix; - struct glyph_matrix *desired_matrix = f->desired_matrix; - int i; - bool pause_p; - int preempt_count = clip_to_bounds (1, baud_rate / 2400 + 1, INT_MAX); - - eassert (current_matrix && desired_matrix); - - if (baud_rate != FRAME_COST_BAUD_RATE (f)) - calculate_costs (f); - - if (!force_p && detect_input_pending_ignore_squeezables ()) + struct frame *f = SELECTED_FRAME (); + + if ((cursor_in_echo_area + /* If we are showing a message instead of the mini-buffer, + show the cursor for the message instead of for the + (now hidden) mini-buffer contents. */ + || (BASE_EQ (minibuf_window, selected_window) + && BASE_EQ (minibuf_window, echo_area_window) + && !NILP (echo_area_buffer[0]))) + /* These cases apply only to the frame that contains + the active mini-buffer window. */ + && FRAME_HAS_MINIBUF_P (f) + && BASE_EQ (FRAME_MINIBUF_WINDOW (f), echo_area_window)) { - pause_p = 1; - goto do_pause; - } + int top = WINDOW_TOP_EDGE_LINE (XWINDOW (FRAME_MINIBUF_WINDOW (f))); + int col; - /* If we cannot insert/delete lines, it's no use trying it. */ - if (!FRAME_LINE_INS_DEL_OK (f)) - inhibit_id_p = 1; - - /* See if any of the desired lines are enabled; don't compute for - i/d line if just want cursor motion. */ - for (i = 0; i < desired_matrix->nrows; i++) - if (MATRIX_ROW_ENABLED_P (desired_matrix, i)) - break; + /* Put cursor at the end of the prompt. If the mini-buffer + is several lines high, find the last line that has + any text on it. */ + int row = FRAME_TOTAL_LINES (f); + do + { + row--; + col = 0; - /* Try doing i/d line, if not yet inhibited. */ - if (!inhibit_id_p && i < desired_matrix->nrows) - force_p |= scrolling (f); + if (MATRIX_ROW_ENABLED_P (f->current_matrix, row)) + { + /* Frame rows are filled up with spaces that + must be ignored here. */ + struct glyph_row *r = MATRIX_ROW (f->current_matrix, row); + struct glyph *start = r->glyphs[TEXT_AREA]; + + col = r->used[TEXT_AREA]; + while (0 < col && start[col - 1].charpos < 0) + col--; + } + } + while (row > top && col == 0); - /* Update the individual lines as needed. Do bottom line first. */ - if (MATRIX_ROW_ENABLED_P (desired_matrix, desired_matrix->nrows - 1)) - update_frame_line (f, desired_matrix->nrows - 1, updating_menu_p); + /* We exit the loop with COL at the glyph _after_ the last one. */ + if (col > 0) + col--; - /* Now update the rest of the lines. */ - for (i = 0; i < desired_matrix->nrows - 1 && (force_p || !input_pending); i++) - { - if (MATRIX_ROW_ENABLED_P (desired_matrix, i)) + /* Make sure COL is not out of range. */ + if (col >= FRAME_CURSOR_X_LIMIT (f)) { - /* Note that output_buffer_size being 0 means that we want the - old default behavior of flushing output every now and then. */ - if (FRAME_TERMCAP_P (f) && FRAME_TTY (f)->output_buffer_size == 0) + /* If we have another row, advance cursor into it. */ + if (row < FRAME_TOTAL_LINES (f) - 1) { - /* Flush out every so many lines. - Also flush out if likely to have more than 1k buffered - otherwise. I'm told that some telnet connections get - really screwed by more than 1k output at once. */ - FILE *display_output = FRAME_TTY (f)->output; - if (display_output) - { - ptrdiff_t outq = __fpending (display_output); - if (outq > 900 - || (outq > 20 && ((i - 1) % preempt_count == 0))) - fflush (display_output); - } + col = FRAME_LEFT_SCROLL_BAR_COLS (f); + row++; } + /* Otherwise move it back in range. */ + else + col = FRAME_CURSOR_X_LIMIT (f) - 1; + } - if (!force_p && (i - 1) % preempt_count == 0) - detect_input_pending_ignore_squeezables (); + cursor_to (f, row, col); + } + else + { + /* We have only one cursor on terminal frames. Use it to + display the cursor of the selected window. */ + struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f)); + if (w->cursor.vpos >= 0 + /* The cursor vpos may be temporarily out of bounds + in the following situation: There is one window, + with the cursor in the lower half of it. The window + is split, and a message causes a redisplay before + a new cursor position has been computed. */ + && w->cursor.vpos < WINDOW_TOTAL_LINES (w)) + { + int x = WINDOW_TO_FRAME_HPOS (w, w->cursor.hpos); + int y = WINDOW_TO_FRAME_VPOS (w, w->cursor.vpos); - update_frame_line (f, i, updating_menu_p); + x += max (0, w->left_margin_cols); + cursor_to (f, y, x); } } +} - pause_p = 0 < i && i < FRAME_TOTAL_LINES (f) - 1; - - /* Now just clean up termcap drivers and set cursor, etc. */ - if (!pause_p && set_cursor_p) - { - if ((cursor_in_echo_area - /* If we are showing a message instead of the mini-buffer, - show the cursor for the message instead of for the - (now hidden) mini-buffer contents. */ - || (BASE_EQ (minibuf_window, selected_window) - && BASE_EQ (minibuf_window, echo_area_window) - && !NILP (echo_area_buffer[0]))) - /* These cases apply only to the frame that contains - the active mini-buffer window. */ - && FRAME_HAS_MINIBUF_P (f) - && BASE_EQ (FRAME_MINIBUF_WINDOW (f), echo_area_window)) - { - int top = WINDOW_TOP_EDGE_LINE (XWINDOW (FRAME_MINIBUF_WINDOW (f))); - int col; - - /* Put cursor at the end of the prompt. If the mini-buffer - is several lines high, find the last line that has - any text on it. */ - int row = FRAME_TOTAL_LINES (f); - do - { - row--; - col = 0; - - if (MATRIX_ROW_ENABLED_P (current_matrix, row)) - { - /* Frame rows are filled up with spaces that - must be ignored here. */ - struct glyph_row *r = MATRIX_ROW (current_matrix, row); - struct glyph *start = r->glyphs[TEXT_AREA]; - - col = r->used[TEXT_AREA]; - while (0 < col && start[col - 1].charpos < 0) - col--; - } - } - while (row > top && col == 0); +/* Write desired matix of tty frame F and make it current. + INHIBIT_ID_P means that scrolling by insert/delete should not be tried. + SET_CURSOR_P false means do not set cursor at point in selected window. */ - /* We exit the loop with COL at the glyph _after_ the last one. */ - if (col > 0) - col--; +static void +write_matrix (struct frame *f, bool inhibit_id_p, + bool set_cursor_p, bool updating_menu_p) +{ + /* If we cannot insert/delete lines, it's no use trying it. */ + if (!FRAME_LINE_INS_DEL_OK (f)) + inhibit_id_p = true; - /* Make sure COL is not out of range. */ - if (col >= FRAME_CURSOR_X_LIMIT (f)) - { - /* If we have another row, advance cursor into it. */ - if (row < FRAME_TOTAL_LINES (f) - 1) - { - col = FRAME_LEFT_SCROLL_BAR_COLS (f); - row++; - } - /* Otherwise move it back in range. */ - else - col = FRAME_CURSOR_X_LIMIT (f) - 1; - } + if (baud_rate != FRAME_COST_BAUD_RATE (f)) + calculate_costs (f); - cursor_to (f, row, col); - } - else - { - /* We have only one cursor on terminal frames. Use it to - display the cursor of the selected window. */ - struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f)); - if (w->cursor.vpos >= 0 - /* The cursor vpos may be temporarily out of bounds - in the following situation: There is one window, - with the cursor in the lower half of it. The window - is split, and a message causes a redisplay before - a new cursor position has been computed. */ - && w->cursor.vpos < WINDOW_TOTAL_LINES (w)) - { - int x = WINDOW_TO_FRAME_HPOS (w, w->cursor.hpos); - int y = WINDOW_TO_FRAME_VPOS (w, w->cursor.vpos); + /* See if any of the desired lines are enabled; don't compute for + i/d line if just want cursor motion. */ + int first_row = first_enabled_row (f->desired_matrix); + if (!inhibit_id_p && first_row >= 0) + scrolling (f); - x += max (0, w->left_margin_cols); - cursor_to (f, y, x); - } - } - } + /* Update the individual lines as needed. Do bottom line first. This + is done so that messages are made visible when pausing. */ + int last_row = f->desired_matrix->nrows - 1; + if (MATRIX_ROW_ENABLED_P (f->desired_matrix, last_row)) + write_row (f, last_row, updating_menu_p); - do_pause: + if (first_row >= 0) + for (int i = first_row; i < last_row; ++i) + if (MATRIX_ROW_ENABLED_P (f->desired_matrix, i)) + write_row (f, i, updating_menu_p); - clear_desired_matrices (f); - return pause_p; + /* Now just clean up termcap drivers and set cursor, etc. */ + if (set_cursor_p) + tty_set_cursor (); } - /* Do line insertions/deletions on frame F for frame-based redisplay. */ -static bool +static void scrolling (struct frame *frame) { /* In fact this code should never be reached at all under @@ -5118,8 +5686,8 @@ scrolling (struct frame *frame) int free_at_end_vpos = height; struct glyph_matrix *current_matrix = frame->current_matrix; struct glyph_matrix *desired_matrix = frame->desired_matrix; - verify (sizeof (int) <= sizeof (unsigned)); - verify (alignof (unsigned) % alignof (int) == 0); + static_assert (sizeof (int) <= sizeof (unsigned)); + static_assert (alignof (unsigned) % alignof (int) == 0); unsigned *old_hash; USE_SAFE_ALLOCA; SAFE_NALLOCA (old_hash, 4, height); @@ -5140,7 +5708,7 @@ scrolling (struct frame *frame) if (!MATRIX_ROW_ENABLED_P (current_matrix, i)) { SAFE_FREE (); - return false; + return; } old_hash[i] = line_hash_code (frame, MATRIX_ROW (current_matrix, i)); if (! MATRIX_ROW_ENABLED_P (desired_matrix, i)) @@ -5171,7 +5739,7 @@ scrolling (struct frame *frame) || unchanged_at_bottom == height) { SAFE_FREE (); - return true; + return; } window_size = (height - unchanged_at_top @@ -5201,7 +5769,6 @@ scrolling (struct frame *frame) SAFE_FREE (); #endif - return false; } @@ -5209,12 +5776,12 @@ scrolling (struct frame *frame) which is LEN glyphs long. */ static int -count_blanks (struct glyph *r, int len) +count_blanks (struct frame *f, struct glyph *r, int len) { int i; for (i = 0; i < len; ++i) - if (!CHAR_GLYPH_SPACE_P (r[i])) + if (!CHAR_GLYPH_SPACE_P (f, r[i])) break; return i; @@ -5250,7 +5817,7 @@ count_match (struct glyph *str1, struct glyph *end1, struct glyph *str2, struct /* Perform a frame-based update on line VPOS in frame FRAME. */ static void -update_frame_line (struct frame *f, int vpos, bool updating_menu_p) +write_row (struct frame *f, int vpos, bool updating_menu_p) { struct glyph *obody, *nbody, *op1, *op2, *np1, *nend; int tem; @@ -5264,11 +5831,6 @@ update_frame_line (struct frame *f, int vpos, bool updating_menu_p) bool colored_spaces_p = (FACE_FROM_ID (f, DEFAULT_FACE_ID)->background != FACE_TTY_DEFAULT_BG_COLOR); - /* This should never happen, but evidently sometimes does if one - resizes the frame quickly enough. Prevent aborts in cmcheckmagic. */ - if (vpos >= FRAME_TOTAL_LINES (f)) - return; - if (colored_spaces_p) write_spaces_p = 1; @@ -5287,7 +5849,7 @@ update_frame_line (struct frame *f, int vpos, bool updating_menu_p) /* Ignore trailing spaces, if we can. */ if (!write_spaces_p) - while (olen > 0 && CHAR_GLYPH_SPACE_P (obody[olen-1])) + while (olen > 0 && CHAR_GLYPH_SPACE_P (f, obody[olen-1])) olen--; } @@ -5316,7 +5878,7 @@ update_frame_line (struct frame *f, int vpos, bool updating_menu_p) { /* Ignore spaces at the end, if we can. */ if (!write_spaces_p) - while (nlen > 0 && CHAR_GLYPH_SPACE_P (nbody[nlen - 1])) + while (nlen > 0 && CHAR_GLYPH_SPACE_P (f, nbody[nlen - 1])) --nlen; /* Write the contents of the desired line. */ @@ -5338,15 +5900,13 @@ update_frame_line (struct frame *f, int vpos, bool updating_menu_p) /* Make sure we are in the right row, otherwise cursor movement with cmgoto might use `ch' in the wrong row. */ cursor_to (f, vpos, 0); - - make_current (desired_matrix, current_matrix, vpos); return; } /* Pretend trailing spaces are not there at all, unless for one reason or another we must write all spaces. */ if (!write_spaces_p) - while (nlen > 0 && CHAR_GLYPH_SPACE_P (nbody[nlen - 1])) + while (nlen > 0 && CHAR_GLYPH_SPACE_P (f, nbody[nlen - 1])) nlen--; /* If there's no i/d char, quickly do the best we can without it. */ @@ -5383,9 +5943,6 @@ update_frame_line (struct frame *f, int vpos, bool updating_menu_p) cursor_to (f, vpos, nlen); clear_end_of_line (f, olen); } - - /* Make current row = desired row. */ - make_current (desired_matrix, current_matrix, vpos); return; } @@ -5399,7 +5956,7 @@ update_frame_line (struct frame *f, int vpos, bool updating_menu_p) if (write_spaces_p) nsp = 0; else - nsp = count_blanks (nbody, nlen); + nsp = count_blanks (f, nbody, nlen); if (nlen > nsp) { @@ -5407,14 +5964,12 @@ update_frame_line (struct frame *f, int vpos, bool updating_menu_p) write_glyphs (f, nbody + nsp, nlen - nsp); } - /* Exchange contents between current_frame and new_frame. */ - make_current (desired_matrix, current_matrix, vpos); return; } /* Compute number of leading blanks in old and new contents. */ - osp = count_blanks (obody, olen); - nsp = (colored_spaces_p ? 0 : count_blanks (nbody, nlen)); + osp = count_blanks (f, obody, olen); + nsp = (colored_spaces_p ? 0 : count_blanks (f, nbody, nlen)); /* Compute number of matching chars starting with first non-blank. */ begmatch = count_match (obody + osp, obody + olen, @@ -5425,7 +5980,7 @@ update_frame_line (struct frame *f, int vpos, bool updating_menu_p) if (!write_spaces_p && osp + begmatch == olen) { np1 = nbody + nsp; - while (np1 + begmatch < nend && CHAR_GLYPH_SPACE_P (np1[begmatch])) + while (np1 + begmatch < nend && CHAR_GLYPH_SPACE_P (f, np1[begmatch])) ++begmatch; } @@ -5566,9 +6121,6 @@ update_frame_line (struct frame *f, int vpos, bool updating_menu_p) cursor_to (f, vpos, nlen); clear_end_of_line (f, olen); } - - /* Exchange contents between current_frame and new_frame. */ - make_current (desired_matrix, current_matrix, vpos); } @@ -5967,7 +6519,8 @@ handle_window_change_signal (int sig) { struct frame *f = XFRAME (frame); - if (FRAME_TERMCAP_P (f) && FRAME_TTY (f) == tty) + if (FRAME_TERMCAP_P (f) && FRAME_TTY (f) == tty + && !FRAME_PARENT_FRAME (f)) /* Record the new sizes, but don't reallocate the data structures now. Let that be done later outside of the signal handler. */ @@ -6073,13 +6626,14 @@ change_frame_size (struct frame *f, int new_width, int new_height, { Lisp_Object tail, frame; - if (FRAME_MSDOS_P (f)) + if (FRAME_MSDOS_P (f) && !FRAME_PARENT_FRAME (f)) { /* On MS-DOS, all frames use the same screen, so a change in size affects all frames. Termcap now supports multiple ttys. */ FOR_EACH_FRAME (tail, frame) - if (!FRAME_WINDOW_P (XFRAME (frame))) + if (!FRAME_WINDOW_P (XFRAME (frame)) + && !FRAME_PARENT_FRAME (XFRAME (frame))) change_frame_size_1 (XFRAME (frame), new_width, new_height, pretend, delay, safe); } @@ -6347,27 +6901,18 @@ sit_for (Lisp_Object timeout, bool reading, int display_option) DEFUN ("redisplay", Fredisplay, Sredisplay, 0, 1, 0, - doc: /* Perform redisplay. -Optional arg FORCE, if non-nil, prevents redisplay from being -preempted by arriving input, even if `redisplay-dont-pause' is nil. -If `redisplay-dont-pause' is non-nil (the default), redisplay is never -preempted by arriving input, so FORCE does nothing. - -Return t if redisplay was performed, nil if redisplay was preempted -immediately by pending input. */) + doc : /* Perform redisplay. +Optional arg FORCE exists for historical reasons and is ignored. +Value is t if redisplay has been performed, nil if executing a +keyboard macro. */) (Lisp_Object force) { swallow_events (true); - if ((detect_input_pending_run_timers (1) - && NILP (force) && !redisplay_dont_pause) - || !NILP (Vexecuting_kbd_macro)) + if (!NILP (Vexecuting_kbd_macro)) return Qnil; - specpdl_ref count = SPECPDL_INDEX (); - if (!NILP (force) && !redisplay_dont_pause) - specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (2); - return unbind_to (count, Qt); + return Qt; } @@ -6534,7 +7079,7 @@ init_display_interactive (void) /* Construct the space glyph. */ space_glyph.type = CHAR_GLYPH; - SET_CHAR_GLYPH (space_glyph, ' ', DEFAULT_FACE_ID, 0); + SET_CHAR_GLYPH (NULL, space_glyph, ' ', DEFAULT_FACE_ID, 0); space_glyph.charpos = -1; inverse_video = 0; @@ -6808,6 +7353,7 @@ syms_of_display (void) defsubr (&Ssend_string_to_terminal); defsubr (&Sinternal_show_cursor); defsubr (&Sinternal_show_cursor_p); + defsubr (&Sframe__z_order_lessp); #ifdef GLYPH_DEBUG defsubr (&Sdump_redisplay_history); @@ -6818,8 +7364,8 @@ syms_of_display (void) /* This is the "purpose" slot of a display table. */ DEFSYM (Qdisplay_table, "display-table"); - - DEFSYM (Qredisplay_dont_pause, "redisplay-dont-pause"); + DEFSYM (Qframe__z_order_lessp, "frame--z-order-lessp"); + DEFSYM (Qtty_non_selected_cursor, "tty-non-selected-cursor"); DEFVAR_INT ("baud-rate", baud_rate, doc: /* The output baud rate of the terminal. @@ -6900,17 +7446,6 @@ It is also used for standard output and error streams. See `buffer-display-table' for more information. */); Vstandard_display_table = Qnil; - DEFVAR_BOOL ("redisplay-dont-pause", redisplay_dont_pause, - doc: /* Nil means display update is paused when input is detected. */); - /* Contrary to expectations, a value of "false" can be detrimental to - responsiveness since aborting a redisplay throws away some of the - work already performed. It's usually more efficient (and gives - more prompt feedback to the user) to let the redisplay terminate, - and just completely skip the next command's redisplay (which is - done regardless of this setting if there's pending input at the - beginning of the next redisplay). */ - redisplay_dont_pause = true; - DEFVAR_LISP ("x-show-tooltip-timeout", Vx_show_tooltip_timeout, doc: /* The default timeout (in seconds) for `x-show-tip'. */); Vx_show_tooltip_timeout = make_fixnum (5); @@ -6921,6 +7456,8 @@ Possible values are t (below the tool bar), nil (above the tool bar). This option affects only builds where the tool bar is not external. */); pdumper_do_now_and_after_load (syms_of_display_for_pdumper); + + Fprovide (intern_c_string ("tty-child-frames"), Qnil); } static void diff --git a/src/disptab.h b/src/disptab.h index d1c152f84a6..8db9a06d2f4 100644 --- a/src/disptab.h +++ b/src/disptab.h @@ -28,7 +28,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ && EQ (XCHAR_TABLE (obj)->purpose, Qdisplay_table) \ && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (obj)) == DISP_TABLE_EXTRA_SLOTS) -#define DISP_TABLE_EXTRA_SLOTS 6 +#define DISP_TABLE_EXTRA_SLOTS 12 #define DISP_TRUNC_GLYPH(dp) ((dp)->extras[0]) #define DISP_CONTINUE_GLYPH(dp) ((dp)->extras[1]) #define DISP_ESCAPE_GLYPH(dp) ((dp)->extras[2]) @@ -36,6 +36,16 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #define DISP_INVIS_VECTOR(dp) ((dp)->extras[4]) #define DISP_BORDER_GLYPH(dp) ((dp)->extras[5]) +enum box +{ + BOX_VERTICAL = 6, + BOX_HORIZONTAL, + BOX_DOWN_RIGHT, + BOX_DOWN_LEFT, + BOX_UP_RIGHT, + BOX_UP_LEFT +}; + extern Lisp_Object disp_char_vector (struct Lisp_Char_Table *, int); #define DISP_CHAR_VECTOR(dp, c) \ diff --git a/src/doc.c b/src/doc.c index e5679a92b78..04afe50d3dd 100644 --- a/src/doc.c +++ b/src/doc.c @@ -479,7 +479,10 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) fun = XCDR (fun); /* Lisp_Subrs have a slot for it. */ if (SUBRP (fun)) - XSUBR (fun)->doc = offset; + { + XSUBR (fun)->doc = offset; + eassert (XSUBR (fun)->doc >= 0); + } else if (CLOSUREP (fun)) { /* This bytecode object must have a slot for the docstring, since @@ -497,7 +500,7 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) } else { - AUTO_STRING (format, "Ignoring DOC string on non-compiled" + AUTO_STRING (format, "Ignoring DOC string on non-compiled " "non-subr: %S"); CALLN (Fmessage, format, obj); } diff --git a/src/editfns.c b/src/editfns.c index e02cf14b968..8a5fb673fe7 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -46,7 +46,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <c-ctype.h> #include <intprops.h> #include <stdlib.h> -#include <verify.h> #include "composite.h" #include "intervals.h" @@ -3408,7 +3407,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) SPRINTF_BUFSIZE = (sizeof "-." + (LDBL_MAX_10_EXP + 1) + USEFUL_PRECISION_MAX) }; - verify (USEFUL_PRECISION_MAX > 0); + static_assert (USEFUL_PRECISION_MAX > 0); ptrdiff_t n; /* The number of the next arg to substitute. */ char initial_buffer[1000 + SPRINTF_BUFSIZE]; diff --git a/src/emacs-module.c b/src/emacs-module.c index 1f6aa11a216..196b8a57754 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -94,12 +94,6 @@ To add a new module function, proceed as follows: #include "thread.h" #include <intprops.h> -#include <verify.h> - -/* Work around GCC bug 83162. */ -#if GNUC_PREREQ (4, 3, 0) -# pragma GCC diagnostic ignored "-Wclobbered" -#endif /* We use different strategies for allocating the user-visible objects (struct emacs_runtime, emacs_env, emacs_value), depending on @@ -273,14 +267,17 @@ module_decode_utf_8 (const char *str, ptrdiff_t len) module_out_of_memory (env); \ return retval; \ } \ - struct handler *internal_cleanup \ + emacs_env *env_volatile = env; \ + struct handler *volatile internal_cleanup \ = internal_handler; \ - if (sys_setjmp (internal_cleanup->jmp)) \ + if (sys_setjmp (internal_handler->jmp)) \ { \ + emacs_env *env = env_volatile; \ + struct handler *internal_handler = internal_cleanup; \ module_handle_nonlocal_exit (env, \ - internal_cleanup->nonlocal_exit, \ - internal_cleanup->val); \ - module_reset_handlerlist (internal_cleanup); \ + internal_handler->nonlocal_exit, \ + internal_handler->val); \ + module_reset_handlerlist (internal_handler); \ return retval; \ } \ do { } while (false) @@ -1036,15 +1033,24 @@ import/export overhead on most platforms. /* Verify that emacs_limb_t indeed has unique object representations. */ -verify (CHAR_BIT == 8); -verify ((sizeof (emacs_limb_t) == 4 && EMACS_LIMB_MAX == 0xFFFFFFFF) - || (sizeof (emacs_limb_t) == 8 - && EMACS_LIMB_MAX == 0xFFFFFFFFFFFFFFFF)); +static_assert (CHAR_BIT == 8); +static_assert ((sizeof (emacs_limb_t) == 4 && EMACS_LIMB_MAX == 0xFFFFFFFF) + || (sizeof (emacs_limb_t) == 8 + && EMACS_LIMB_MAX == 0xFFFFFFFFFFFFFFFF)); static bool module_extract_big_integer (emacs_env *env, emacs_value arg, int *sign, ptrdiff_t *count, emacs_limb_t *magnitude) { +#if GCC_LINT && __GNUC__ && !__clang__ + /* These useless assignments pacify GCC 14.2.1 x86-64 + <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=21161>. */ + { + int *volatile sign_volatile = sign; + sign = sign_volatile; + } +#endif + MODULE_FUNCTION_BEGIN (false); Lisp_Object o = value_to_lisp (arg); CHECK_INTEGER (o); @@ -1077,7 +1083,7 @@ module_extract_big_integer (emacs_env *env, emacs_value arg, int *sign, suffice. */ EMACS_UINT u; enum { required = (sizeof u + size - 1) / size }; - verify (0 < required && +required <= module_bignum_count_max); + static_assert (0 < required && +required <= module_bignum_count_max); if (magnitude == NULL) { *count = required; @@ -1097,7 +1103,7 @@ module_extract_big_integer (emacs_env *env, emacs_value arg, int *sign, u = (EMACS_UINT) x; else u = -(EMACS_UINT) x; - verify (required * bits < PTRDIFF_MAX); + static_assert (required * bits < PTRDIFF_MAX); for (ptrdiff_t i = 0; i < required; ++i) magnitude[i] = (emacs_limb_t) (u >> (i * bits)); MODULE_INTERNAL_CLEANUP (); @@ -1266,7 +1272,15 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) record_unwind_protect_module (SPECPDL_MODULE_ENVIRONMENT, env); USE_SAFE_ALLOCA; - emacs_value *args = nargs > 0 ? SAFE_ALLOCA (nargs * sizeof *args) : NULL; + emacs_value *args; + /* FIXME: Is this (nargs <= 0) test needed? Either omit it and call + SAFE_NALLOCA unconditionally, or fix this comment to explain why + the test is needed. */ + if (nargs <= 0) + args = NULL; + else + SAFE_NALLOCA (args, 1, nargs); + for (ptrdiff_t i = 0; i < nargs; ++i) { args[i] = lisp_to_value (env, arglist[i]); diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index a4cd1e15ed9..b8afda8eb73 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -198,6 +198,23 @@ struct emacs_env_30 @module_env_snippet_30@ }; +struct emacs_env_31 +{ +@module_env_snippet_25@ + +@module_env_snippet_26@ + +@module_env_snippet_27@ + +@module_env_snippet_28@ + +@module_env_snippet_29@ + +@module_env_snippet_30@ + +@module_env_snippet_31@ +}; + /* 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 1e07b2c8638..896f219baab 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -23,6 +23,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <errno.h> #include <fcntl.h> +#include <locale.h> #include <stdlib.h> #include <sys/file.h> @@ -132,10 +133,6 @@ extern char etext; # endif #endif -#ifdef HAVE_SETLOCALE -#include <locale.h> -#endif - #if HAVE_WCHAR_H # include <wchar.h> #endif @@ -402,14 +399,6 @@ section of the Emacs manual or the file BUGS.\n" /* True if handling a fatal error already. */ bool fatal_error_in_progress; -#if !HAVE_SETLOCALE -static char * -setlocale (int cat, char const *locale) -{ - return 0; -} -#endif - /* True if the current system locale uses UTF-8 encoding. */ static bool using_utf8 (void) @@ -1274,12 +1263,12 @@ maybe_load_seccomp (int argc, char **argv) #endif /* SECCOMP_USABLE */ -#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY +#if !defined HAVE_ANDROID || defined ANDROID_STUBIFY int -android_emacs_init (int argc, char **argv, char *dump_file) +main (int argc, char **argv) #else int -main (int argc, char **argv) +android_emacs_init (int argc, char **argv, char *dump_file) #endif { /* Variable near the bottom of the stack, and aligned appropriately @@ -1430,7 +1419,18 @@ main (int argc, char **argv) #ifdef HAVE_PDUMPER if (attempt_load_pdump) - initial_emacs_executable = load_pdump (argc, argv, dump_file); + { + initial_emacs_executable = load_pdump (argc, argv, dump_file); +#ifdef WINDOWSNT + /* Reinitialize the codepage for file names, needed to decode + non-ASCII file names during startup. This is needed because + loading the pdumper file above assigns to those variables values + from the dump stage, which might be incorrect, if dumping was done + on a different system. */ + if (dumped_with_pdumper_p ()) + w32_init_file_name_codepage (); +#endif + } #else ptrdiff_t bufsize; initial_emacs_executable = find_emacs_executable (argv[0], &bufsize); @@ -2483,6 +2483,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #ifdef HAVE_W32NOTIFY syms_of_w32notify (); #endif /* HAVE_W32NOTIFY */ + syms_of_w32dwrite (); #endif /* WINDOWSNT */ syms_of_xwidget (); @@ -3277,7 +3278,6 @@ You must run Emacs in batch mode in order to dump it. */) #endif -#if HAVE_SETLOCALE /* Recover from setlocale (LC_ALL, ""). */ void fixup_locale (void) @@ -3297,7 +3297,7 @@ synchronize_locale (int category, Lisp_Object *plocale, Lisp_Object desired_loca *plocale = desired_locale; char const *locale_string = STRINGP (desired_locale) ? SSDATA (desired_locale) : ""; -# ifdef WINDOWSNT +#ifdef WINDOWSNT /* Changing categories like LC_TIME usually requires specifying an encoding suitable for the new locale, but MS-Windows's 'setlocale' will only switch the encoding when LC_ALL is @@ -3306,9 +3306,9 @@ synchronize_locale (int category, Lisp_Object *plocale, Lisp_Object desired_loca numbers is unaffected. */ setlocale (LC_ALL, locale_string); fixup_locale (); -# else /* !WINDOWSNT */ +#else setlocale (category, locale_string); -# endif /* !WINDOWSNT */ +#endif } } @@ -3322,21 +3322,20 @@ synchronize_system_time_locale (void) Vsystem_time_locale); } -# ifdef LC_MESSAGES +#ifdef LC_MESSAGES static Lisp_Object Vprevious_system_messages_locale; -# endif +#endif /* Set system messages locale to match Vsystem_messages_locale, if possible. */ void synchronize_system_messages_locale (void) { -# ifdef LC_MESSAGES +#ifdef LC_MESSAGES synchronize_locale (LC_MESSAGES, &Vprevious_system_messages_locale, Vsystem_messages_locale); -# endif +#endif } -#endif /* HAVE_SETLOCALE */ /* Return a diagnostic string for ERROR_NUMBER, in the wording and encoding appropriate for the current locale. */ diff --git a/src/eval.c b/src/eval.c index caae4cb17e2..a73700419dd 100644 --- a/src/eval.c +++ b/src/eval.c @@ -31,15 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "pdumper.h" #include "atimer.h" -/* CACHEABLE is ordinarily nothing, except it is 'volatile' if - necessary to cajole GCC into not warning incorrectly that a - variable should be volatile. */ -#if defined GCC_LINT || defined lint -# define CACHEABLE volatile -#else -# define CACHEABLE /* empty */ -#endif - /* Non-nil means record all fset's and provide's, to be undone if the file being autoloaded is not fully loaded. They are recorded by being consed onto the front of Vautoload_queue: @@ -59,8 +50,6 @@ Lisp_Object Vsignaling_function; /* These would ordinarily be static, but they need to be visible to GDB. */ bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; -Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE; -Lisp_Object backtrace_function (union specbinding *) EXTERNALLY_VISIBLE; union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE; union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; @@ -117,12 +106,22 @@ specpdl_arg (union specbinding *pdl) return pdl->unwind.arg; } -Lisp_Object -backtrace_function (union specbinding *pdl) +/* To work around GDB bug 32313 + <https://sourceware.org/bugzilla/show_bug.cgi?id=32313> make + backtrace_* functions visible-to-GDB pointers instead of merely + being an externally visible functions themselves. Declare the + pointer first to pacify gcc -Wmissing-variable-declarations. */ +#define GDB_FUNCPTR(func, resulttype, params) \ + extern resulttype (*const func) params EXTERNALLY_VISIBLE; \ + resulttype (*const func) params = func##_body + +static Lisp_Object +backtrace_function_body (union specbinding *pdl) { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->bt.function; } +GDB_FUNCPTR (backtrace_function, Lisp_Object, (union specbinding *)); static ptrdiff_t backtrace_nargs (union specbinding *pdl) @@ -131,12 +130,13 @@ backtrace_nargs (union specbinding *pdl) return pdl->bt.nargs; } -Lisp_Object * -backtrace_args (union specbinding *pdl) +static Lisp_Object * +backtrace_args_body (union specbinding *pdl) { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->bt.args; } +GDB_FUNCPTR (backtrace_args, Lisp_Object *, (union specbinding *)); /* Functions to modify slots of backtrace records. */ @@ -430,7 +430,7 @@ DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0, usage: (progn BODY...) */) (Lisp_Object body) { - Lisp_Object CACHEABLE val = Qnil; + Lisp_Object val = Qnil; while (CONSP (body)) { @@ -1026,7 +1026,7 @@ usage: (let* VARLIST BODY...) */) { Lisp_Object newenv = Fcons (Fcons (var, val), Vinternal_interpreter_environment); - if (EQ (Vinternal_interpreter_environment, lexenv)) + if (BASE_EQ (Vinternal_interpreter_environment, lexenv)) /* Save the old lexical environment on the specpdl stack, but only for the first lexical binding, since we'll never need to revert to one of the intermediate ones. */ @@ -1102,7 +1102,7 @@ usage: (let VARLIST BODY...) */) specbind (var, tem); } - if (!EQ (lexenv, Vinternal_interpreter_environment)) + if (!BASE_EQ (lexenv, Vinternal_interpreter_environment)) /* Instantiate a new lexical environment. */ specbind (Qinternal_interpreter_environment, lexenv); @@ -1257,17 +1257,11 @@ usage: (catch TAG BODY...) */) return internal_catch (tag, Fprogn, XCDR (args)); } -/* Work around GCC bug 61118 - <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=61118>. */ -#if GNUC_PREREQ (4, 9, 0) -# pragma GCC diagnostic ignored "-Wclobbered" -#endif - /* Assert that E is true, but do not evaluate E. Use this instead of eassert (E) when E contains variables that might be clobbered by a longjmp. */ -#define clobbered_eassert(E) verify (sizeof (E) != 0) +#define clobbered_eassert(E) static_assert (sizeof (E) != 0) void pop_handler (void) @@ -1488,8 +1482,10 @@ Lisp_Object internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, Lisp_Object handlers) { - struct handler *oldhandlerlist = handlerlist; - ptrdiff_t CACHEABLE clausenb = 0; + struct handler *volatile oldhandlerlist = handlerlist; + + /* The number of non-success handlers, plus 1 for a sentinel. */ + ptrdiff_t clausenb = 1; var = maybe_remove_pos_from_symbol (var); CHECK_TYPE (BARE_SYMBOL_P (var), Qsymbolp, var); @@ -1521,69 +1517,67 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, memory_full (SIZE_MAX); Lisp_Object volatile *clauses = alloca (clausenb * sizeof *clauses); clauses += clausenb; + *--clauses = make_fixnum (0); for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail)) { Lisp_Object tem = XCAR (tail); if (!(CONSP (tem) && EQ (XCAR (tem), QCsuccess))) *--clauses = tem; } - for (ptrdiff_t i = 0; i < clausenb; i++) + Lisp_Object volatile var_volatile = var; + Lisp_Object val, handler_body; + for (Lisp_Object volatile *pcl = clauses; ; pcl++) { - Lisp_Object clause = clauses[i]; + if (BASE_EQ (*pcl, make_fixnum (0))) + { + val = eval_sub (bodyform); + handlerlist = oldhandlerlist; + if (NILP (success_handler)) + return val; +#if GCC_LINT && __GNUC__ && !__clang__ + /* This useless assignment pacifies GCC 14.2.1 x86-64 + <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=21161>. */ + var = var_volatile; +#endif + handler_body = XCDR (success_handler); + break; + } + Lisp_Object clause = *pcl; Lisp_Object condition = CONSP (clause) ? XCAR (clause) : Qnil; if (!CONSP (condition)) condition = list1 (condition); struct handler *c = push_handler (condition, CONDITION_CASE); + Lisp_Object volatile *clauses_volatile = clauses; if (sys_setjmp (c->jmp)) { - Lisp_Object val = handlerlist->val; - Lisp_Object volatile *chosen_clause = clauses; - for (struct handler *h = handlerlist->next; h != oldhandlerlist; - h = h->next) + var = var_volatile; + val = handlerlist->val; + Lisp_Object volatile *chosen_clause = clauses_volatile; + struct handler *oldh = oldhandlerlist; + for (struct handler *h = handlerlist->next; h != oldh; h = h->next) chosen_clause++; - Lisp_Object handler_body = XCDR (*chosen_clause); - handlerlist = oldhandlerlist; - - if (NILP (var)) - return Fprogn (handler_body); - - Lisp_Object handler_var = var; - if (!NILP (Vinternal_interpreter_environment)) - { - val = Fcons (Fcons (var, val), - Vinternal_interpreter_environment); - handler_var = Qinternal_interpreter_environment; - } + handler_body = XCDR (*chosen_clause); + handlerlist = oldh; - /* Bind HANDLER_VAR to VAL while evaluating HANDLER_BODY. - The unbind_to undoes just this binding; whoever longjumped - to us unwound the stack to C->pdlcount before throwing. */ - specpdl_ref count = SPECPDL_INDEX (); - specbind (handler_var, val); - return unbind_to (count, Fprogn (handler_body)); + /* Whoever longjumped to us unwound the stack to C->pdlcount before + throwing, so the unbind_to will undo just this binding. */ + break; } } - Lisp_Object CACHEABLE result = eval_sub (bodyform); - handlerlist = oldhandlerlist; - if (!NILP (success_handler)) - { - if (NILP (var)) - return Fprogn (XCDR (success_handler)); + if (NILP (var)) + return Fprogn (handler_body); - Lisp_Object handler_var = var; - if (!NILP (Vinternal_interpreter_environment)) - { - result = Fcons (Fcons (var, result), - Vinternal_interpreter_environment); - handler_var = Qinternal_interpreter_environment; - } - - specpdl_ref count = SPECPDL_INDEX (); - specbind (handler_var, result); - return unbind_to (count, Fprogn (XCDR (success_handler))); + if (!NILP (Vinternal_interpreter_environment)) + { + val = Fcons (Fcons (var, val), + Vinternal_interpreter_environment); + var = Qinternal_interpreter_environment; } - return result; + + specpdl_ref count = SPECPDL_INDEX (); + specbind (var, val); + return unbind_to (count, Fprogn (handler_body)); } /* Call the function BFUN with no arguments, catching errors within it @@ -1740,7 +1734,7 @@ push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype) struct handler * push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype) { - struct handler *CACHEABLE c = handlerlist->nextfree; + struct handler *c = handlerlist->nextfree; if (!c) { c = malloc (sizeof *c); @@ -1857,14 +1851,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable) if (gc_in_progress || waiting_for_input) emacs_abort (); -#if 0 /* rms: I don't know why this was here, - but it is surely wrong for an error that is handled. */ -#ifdef HAVE_WINDOW_SYSTEM - if (display_hourglass_p) - cancel_hourglass (); -#endif -#endif - /* This hook is used by edebug. */ if (! NILP (Vsignal_hook_function) && !oom) @@ -2006,6 +1992,9 @@ signal_error (const char *s, Lisp_Object arg) xsignal (Qerror, Fcons (build_string (s), arg)); } +/* Simplified version of 'define-error' that works with pure + objects. */ + void define_error (Lisp_Object name, const char *message, Lisp_Object parent) { @@ -3328,7 +3317,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector) else if (i < nargs) xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs)); - if (!EQ (lexenv, Vinternal_interpreter_environment)) + if (!BASE_EQ (lexenv, Vinternal_interpreter_environment)) /* Instantiate a new lexical environment. */ specbind (Qinternal_interpreter_environment, lexenv); @@ -3479,7 +3468,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) 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)) + && BASE_EQ (specpdl_where (p), buf)) return 1; } diff --git a/src/fileio.c b/src/fileio.c index e522dd93cd6..db7c491e1a1 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -523,7 +523,7 @@ file_name_directory (Lisp_Object filename) else { dostounix_filename (beg); - tem_fn = make_specified_string (beg, -1, p - beg, 0); + tem_fn = make_unibyte_string (beg, p - beg); } SAFE_FREE (); return tem_fn; @@ -3907,7 +3907,7 @@ union read_non_regular } s; GCALIGNED_UNION_MEMBER }; -verify (GCALIGNED (union read_non_regular)); +static_assert (GCALIGNED (union read_non_regular)); static Lisp_Object read_non_regular (Lisp_Object state) @@ -5742,7 +5742,7 @@ DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, Lisp_Object ca = Fcar (a), cb = Fcar (b); if (FIXNUMP (ca) && FIXNUMP (cb)) return XFIXNUM (ca) < XFIXNUM (cb) ? Qt : Qnil; - return arithcompare (ca, cb, ARITH_LESS); + return arithcompare (ca, cb) & Cmp_LT ? Qt : Qnil; } /* Build the complete list of annotations appropriate for writing out @@ -6317,7 +6317,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) continue; enum { growth_factor = 4 }; - verify (BUF_BYTES_MAX <= EMACS_INT_MAX / growth_factor); + static_assert (BUF_BYTES_MAX <= EMACS_INT_MAX / growth_factor); set_buffer_internal (b); if (NILP (Vauto_save_include_big_deletions) diff --git a/src/filelock.c b/src/filelock.c index 8bbbd5439ef..c276f19dcd1 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -271,36 +271,39 @@ lock_file_1 (Lisp_Object lfname, bool force) intmax_t boot = get_boot_sec (); Lisp_Object luser_name = Fuser_login_name (Qnil); Lisp_Object lhost_name = Fsystem_name (); - - /* Protect against the extremely unlikely case of the host name - containing an @ character. */ - if (!NILP (lhost_name) && strchr (SSDATA (lhost_name), '@')) - lhost_name = CALLN (Ffuncall, Qstring_replace, - build_string ("@"), build_string ("-"), - lhost_name); - char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : ""; char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : ""; char lock_info_str[MAX_LFINFO + 1]; intmax_t pid = getpid (); - char const *lock_info_fmt = (boot - ? "%s@%s.%"PRIdMAX":%"PRIdMAX - : "%s@%s.%"PRIdMAX); - int len = snprintf (lock_info_str, sizeof lock_info_str, - lock_info_fmt, user_name, host_name, pid, boot); + int room = sizeof lock_info_str; + int len = snprintf (lock_info_str, room, "%s@", user_name); if (! (0 <= len && len < sizeof lock_info_str)) return ENAMETOOLONG; - + /* Protect against the extremely unlikely case of the host name + containing an @ character. */ + for (; *host_name; len++, host_name++) + { + if (! (len < sizeof lock_info_str - 1)) + return ENAMETOOLONG; + lock_info_str[len] = *host_name == '@' ? '-' : *host_name; + } + char const *lock_info_fmt = boot ? ".%"PRIdMAX":%"PRIdMAX : ".%"PRIdMAX; + room = sizeof lock_info_str - len; + int suffixlen = snprintf (lock_info_str + len, room, + lock_info_fmt, pid, boot); + if (! (0 <= suffixlen && suffixlen < room)) + return ENAMETOOLONG; return create_lock_file (SSDATA (lfname), lock_info_str, force); } /* Return true if times A and B are no more than one second apart. */ static bool -within_one_second (time_t a, time_t b) +within_one_second (intmax_t a, time_t b) { - return (a - b >= -1 && a - b <= 1); + intmax_t diff; + return !ckd_sub (&diff, a, b) && -1 <= diff && diff <= 1; } /* On systems lacking ELOOP, test for an errno value that shouldn't occur. */ @@ -383,9 +386,6 @@ static int current_lock_owner (lock_info_type *owner, Lisp_Object lfname) { lock_info_type local_owner; - ptrdiff_t lfinfolen; - intmax_t pid, boot_time; - char *at, *dot, *lfinfo_end; /* Even if the caller doesn't want the owner info, we still have to read it to determine return value. */ @@ -393,95 +393,115 @@ current_lock_owner (lock_info_type *owner, Lisp_Object lfname) owner = &local_owner; /* If nonexistent lock file, all is well; otherwise, got strange error. */ - lfinfolen = read_lock_data (SSDATA (lfname), owner->user); + ptrdiff_t lfinfolen = read_lock_data (SSDATA (lfname), owner->user); if (lfinfolen < 0) return errno == ENOENT || errno == ENOTDIR ? 0 : errno; - if (MAX_LFINFO < lfinfolen) - return ENAMETOOLONG; - owner->user[lfinfolen] = 0; - - /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return EINVAL. */ - /* The USER is everything before the last @. */ - owner->at = at = memrchr (owner->user, '@', lfinfolen); - if (!at) - return EINVAL; - owner->dot = dot = strrchr (at, '.'); - if (!dot) - return EINVAL; - - /* The PID is everything from the last '.' to the ':' or equivalent. */ - if (! integer_prefixed (dot + 1)) - return EINVAL; - errno = 0; - pid = strtoimax (dot + 1, &owner->colon, 10); - if (errno == ERANGE) - pid = -1; - - /* After the ':' or equivalent, if there is one, comes the boot time. */ - char *boot = owner->colon + 1; - switch (owner->colon[0]) + + /* If the lock file seems valid, return a value based on its contents. */ + if (lfinfolen) { - case 0: - boot_time = 0; - lfinfo_end = owner->colon; - break; + if (MAX_LFINFO < lfinfolen) + return ENAMETOOLONG; + owner->user[lfinfolen] = 0; + + /* Parse USER@HOST.PID:BOOT_TIME. If can't parse, return EINVAL. */ + /* The USER is everything before the last @. */ + char *at = memrchr (owner->user, '@', lfinfolen); + if (!at) + return EINVAL; + owner->at = at; + char *dot = strrchr (at, '.'); + if (!dot) + return EINVAL; + owner->dot = dot; - case '\357': - /* Treat "\357\200\242" (U+F022 in UTF-8) as if it were ":" (Bug#24656). - This works around a bug in the Linux CIFS kernel client, which can - mistakenly transliterate ':' to U+F022 in symlink contents. - See <https://bugzilla.redhat.com/show_bug.cgi?id=1384153>. */ - if (! (boot[0] == '\200' && boot[1] == '\242')) + /* The PID is everything from the last '.' to the ':' or equivalent. */ + if (! integer_prefixed (dot + 1)) return EINVAL; - boot += 2; - FALLTHROUGH; - case ':': - if (! integer_prefixed (boot)) + errno = 0; + intmax_t pid = strtoimax (dot + 1, &owner->colon, 10); + if (errno == ERANGE) + pid = -1; + + /* After the ':' or equivalent, if there is one, comes the boot time. */ + intmax_t boot_time; + char *boot = owner->colon + 1, *lfinfo_end; + switch (owner->colon[0]) + { + case 0: + boot_time = 0; + lfinfo_end = owner->colon; + break; + + case '\357': + /* Treat "\357\200\242" (U+F022 in UTF-8) like ":" (Bug#24656). + This works around a bug in the Linux CIFS kernel client, which can + mistakenly transliterate ':' to U+F022 in symlink contents. + See <https://bugzilla.redhat.com/show_bug.cgi?id=1384153>. */ + if (! (boot[0] == '\200' && boot[1] == '\242')) + return EINVAL; + boot += 2; + FALLTHROUGH; + case ':': + if (! integer_prefixed (boot)) + return EINVAL; + boot_time = strtoimax (boot, &lfinfo_end, 10); + break; + + default: + return EINVAL; + } + if (lfinfo_end != owner->user + lfinfolen) return EINVAL; - boot_time = strtoimax (boot, &lfinfo_end, 10); - break; - default: - return EINVAL; - } - if (lfinfo_end != owner->user + lfinfolen) - return EINVAL; - - Lisp_Object system_name = Fsystem_name (); - /* If `system-name' returns nil, that means we're in a - --no-build-details Emacs, and the name part of the link (e.g., - .#test.txt -> larsi@.118961:1646577954) is an empty string. */ - if (NILP (system_name)) - system_name = build_string (""); - /* Protect against the extremely unlikely case of the host name - containing an @ character. */ - else if (strchr (SSDATA (system_name), '@')) - system_name = CALLN (Ffuncall, intern ("string-replace"), - build_string ("@"), build_string ("-"), - system_name); - /* On current host? */ - if (STRINGP (system_name) - && dot - (at + 1) == SBYTES (system_name) - && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0) - { - if (pid == getpid ()) - return I_OWN_IT; - else if (VALID_PROCESS_ID (pid) - && (kill (pid, 0) >= 0 || errno == EPERM) - && (boot_time == 0 - || (boot_time <= TYPE_MAXIMUM (time_t) - && within_one_second (boot_time, get_boot_sec ())))) - return ANOTHER_OWNS_IT; - /* The owner process is dead or has a strange pid, so try to - zap the lockfile. */ + char *linkhost = at + 1; + ptrdiff_t linkhostlen = dot - linkhost; + Lisp_Object system_name = Fsystem_name (); + /* If `system-name' returns nil, that means we're in a + --no-build-details Emacs, and the name part of the link (e.g., + .#test.txt -> larsi@.118961:1646577954) is an empty string. */ + bool on_current_host; + if (NILP (system_name)) + on_current_host = linkhostlen == 0; else - return emacs_unlink (SSDATA (lfname)) < 0 ? errno : 0; - } - else - { /* If we wanted to support the check for stale locks on remote machines, - here's where we'd do it. */ - return ANOTHER_OWNS_IT; + { + on_current_host = linkhostlen == SBYTES (system_name); + if (on_current_host) + { + /* Protect against the extremely unlikely case of the host + name containing '@'. */ + char *sysname = SSDATA (system_name); + for (ptrdiff_t i = 0; i < linkhostlen; i++) + if (linkhost[i] != (sysname[i] == '@' ? '-' : sysname[i])) + { + on_current_host = false; + break; + } + } + } + if (!on_current_host) + { + /* Not on current host. If we wanted to support the check for + stale locks on remote machines, here's where we'd do it. */ + return ANOTHER_OWNS_IT; + } + + if (pid == getpid ()) + return I_OWN_IT; + + if (VALID_PROCESS_ID (pid) + && ! (kill (pid, 0) < 0 && errno != EPERM) + && (boot_time == 0 + || within_one_second (boot_time, get_boot_sec ()))) + return ANOTHER_OWNS_IT; } + + /* The owner process is dead or has a strange pid, or the lock file is empty. + Try to zap the lockfile. If the lock file is empty, this assumes + the file system is buggy, e.g., <https://bugs.gnu.org/72641>. + Emacs never creates empty lock files even temporarily, so removing + an empty lock file should be harmless. */ + return emacs_unlink (SSDATA (lfname)) < 0 && errno != ENOENT ? errno : 0; } diff --git a/src/fns.c b/src/fns.c index bee44b222c5..191154c651a 100644 --- a/src/fns.c +++ b/src/fns.c @@ -26,7 +26,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <intprops.h> #include <vla.h> #include <errno.h> -#include <ctype.h> #include <math.h> #include "lisp.h" @@ -117,7 +116,7 @@ See Info node `(elisp)Random Numbers' for more details. */) ptrdiff_t list_length (Lisp_Object list) { - intptr_t i = 0; + ptrdiff_t i = 0; FOR_EACH_TAIL (list) i++; CHECK_LIST_END (list, list); @@ -167,7 +166,7 @@ it returns 0. If LIST is circular, it returns an integer that is at least the number of distinct elements. */) (Lisp_Object list) { - intptr_t len = 0; + ptrdiff_t len = 0; FOR_EACH_TAIL_SAFE (list) len++; return make_fixnum (len); @@ -248,7 +247,7 @@ A proper list is neither circular nor dotted (i.e., its last cdr is nil). */ attributes: const) (Lisp_Object object) { - intptr_t len = 0; + ptrdiff_t len = 0; Lisp_Object last_tail = object; Lisp_Object tail = object; FOR_EACH_TAIL_SAFE (tail) @@ -292,7 +291,8 @@ Letter-case is significant, but text properties are ignored. */) ptrdiff_t x, y, lastdiag, olddiag; USE_SAFE_ALLOCA; - ptrdiff_t *column = SAFE_ALLOCA ((len1 + 1) * sizeof (ptrdiff_t)); + ptrdiff_t *column; + SAFE_NALLOCA (column, 1, len1 + 1); for (y = 0; y <= len1; y++) column[y] = y; @@ -1924,6 +1924,15 @@ The value is actually the tail of LIST whose car is ELT. */) return Qnil; } +Lisp_Object +memq_no_quit (Lisp_Object elt, Lisp_Object list) +{ + for (; CONSP (list); list = XCDR (list)) + if (EQ (XCAR (list), elt)) + return list; + return Qnil; +} + DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'. The value is actually the tail of LIST whose car is ELT. */) @@ -2314,12 +2323,12 @@ See also the function `nreverse', which is used more often. */) } else if (BOOL_VECTOR_P (seq)) { - ptrdiff_t i; EMACS_INT nbits = bool_vector_size (seq); - new = make_uninit_bool_vector (nbits); - for (i = 0; i < nbits; i++) - bool_vector_set (new, i, bool_vector_bitref (seq, nbits - i - 1)); + new = make_clear_bool_vector (nbits, true); + for (ptrdiff_t i = 0; i < nbits; i++) + if (bool_vector_bitref (seq, nbits - i - 1)) + bool_vector_set (new, i, true); } else if (STRINGP (seq)) { @@ -2823,8 +2832,8 @@ static ptrdiff_t hash_lookup_with_hash (struct Lisp_Hash_Table *h, if EQUAL_KIND == EQUAL_NO_QUIT. */ static bool -internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, - int depth, Lisp_Object ht) +internal_equal_1 (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, + int depth, Lisp_Object *ht) { tail_recurse: if (depth > 10) @@ -2832,13 +2841,13 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, eassert (equal_kind != EQUAL_NO_QUIT); if (depth > 200) error ("Stack overflow in equal"); - if (NILP (ht)) - ht = CALLN (Fmake_hash_table, QCtest, Qeq); + if (NILP (*ht)) + *ht = CALLN (Fmake_hash_table, QCtest, Qeq); switch (XTYPE (o1)) { case Lisp_Cons: case Lisp_Vectorlike: { - struct Lisp_Hash_Table *h = XHASH_TABLE (ht); + struct Lisp_Hash_Table *h = XHASH_TABLE (*ht); hash_hash_t hash = hash_from_key (h, o1); ptrdiff_t i = hash_lookup_with_hash (h, o1, hash); if (i >= 0) @@ -2888,8 +2897,8 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, { if (! CONSP (o2)) return false; - if (! internal_equal (XCAR (o1), XCAR (o2), - equal_kind, depth + 1, ht)) + if (! internal_equal_1 (XCAR (o1), XCAR (o2), + equal_kind, depth + 1, ht)) return false; o2 = XCDR (o2); if (EQ (XCDR (o1), o2)) @@ -2964,7 +2973,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, Lisp_Object v1, v2; v1 = AREF (o1, i); v2 = AREF (o2, i); - if (!internal_equal (v1, v2, equal_kind, depth + 1, ht)) + if (!internal_equal_1 (v1, v2, equal_kind, depth + 1, ht)) return false; } return true; @@ -2985,6 +2994,13 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, return false; } +static bool +internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, + int depth, Lisp_Object ht) +{ + return internal_equal_1 (o1, o2, equal_kind, depth, &ht); +} + /* Return -1/0/1 for the </=/> lexicographic relation between bool-vectors. */ static int bool_vector_cmp (Lisp_Object a, Lisp_Object b) @@ -3017,6 +3033,25 @@ bool_vector_cmp (Lisp_Object a, Lisp_Object b) return (d & aw) ? 1 : -1; } +/* Return -1 if a<b, 1 if a>b, 0 if a=b or if b is NaN (a must be a fixnum). */ +static inline int +fixnum_float_cmp (EMACS_INT a, double b) +{ + double fa = (double)a; + if (fa == b) + { + /* This doesn't mean that a=b because the conversion may have rounded. + However, b must be an integer that fits in an EMACS_INT, + because |b| ≤ 2|a| and EMACS_INT has at least one bit more than + needed to represent any fixnum. + Thus we can compare in the integer domain instead. */ + EMACS_INT ib = b; /* lossless conversion */ + return a < ib ? -1 : a > ib; + } + else + return fa < b ? -1 : fa > b; /* return 0 if b is NaN */ +} + /* Return -1, 0 or 1 to indicate whether a<b, a=b or a>b in the sense of value<. In particular 0 does not mean equality in the sense of Fequal, only that the arguments cannot be ordered yet they can be compared (same @@ -3040,7 +3075,7 @@ value_cmp (Lisp_Object a, Lisp_Object b, int maxdepth) if (FIXNUMP (b)) return ia < XFIXNUM (b) ? -1 : 1; /* we know that a != b */ if (FLOATP (b)) - return ia < XFLOAT_DATA (b) ? -1 : ia > XFLOAT_DATA (b); + return fixnum_float_cmp (ia, XFLOAT_DATA (b)); if (BIGNUMP (b)) return -mpz_sgn (*xbignum_val (b)); } @@ -3181,7 +3216,7 @@ value_cmp (Lisp_Object a, Lisp_Object b, int maxdepth) if (FLOATP (b)) return fa < XFLOAT_DATA (b) ? -1 : fa > XFLOAT_DATA (b); if (FIXNUMP (b)) - return fa < XFIXNUM (b) ? -1 : fa > XFIXNUM (b); + return -fixnum_float_cmp (XFIXNUM (b), fa); if (BIGNUMP (b)) { if (isnan (fa)) @@ -3561,13 +3596,14 @@ by a mouse, or by some window-system gesture, or via a menu. */) if (use_short_answers) return call1 (Qy_or_n_p, prompt); - { - char *s = SSDATA (prompt); - ptrdiff_t len = strlen (s); - if ((len > 0) && !isspace (s[len - 1])) - prompt = CALLN (Fconcat, prompt, build_string (" ")); - } - prompt = CALLN (Fconcat, prompt, Vyes_or_no_prompt); + ptrdiff_t promptlen = SCHARS (prompt); + bool prompt_ends_in_nonspace + = (0 < promptlen + && !blankp (XFIXNAT (Faref (prompt, make_fixnum (promptlen - 1))))); + AUTO_STRING (space_string, " "); + prompt = CALLN (Fconcat, prompt, + prompt_ends_in_nonspace ? space_string : empty_unibyte_string, + Vyes_or_no_prompt); specpdl_ref count = SPECPDL_INDEX (); specbind (Qenable_recursive_minibuffers, Qt); @@ -4616,36 +4652,12 @@ check_hash_table (Lisp_Object obj) EMACS_INT next_almost_prime (EMACS_INT n) { - verify (NEXT_ALMOST_PRIME_LIMIT == 11); + static_assert (NEXT_ALMOST_PRIME_LIMIT == 11); for (n |= 1; ; n += 2) if (n % 3 != 0 && n % 5 != 0 && n % 7 != 0) return n; } - -/* Find KEY in ARGS which has size NARGS. Don't consider indices for - which USED[I] is non-zero. If found at index I in ARGS, set - USED[I] and USED[I + 1] to 1, and return I + 1. Otherwise return - 0. This function is used to extract a keyword/argument pair from - a DEFUN parameter list. */ - -static ptrdiff_t -get_key_arg (Lisp_Object key, ptrdiff_t nargs, Lisp_Object *args, char *used) -{ - ptrdiff_t i; - - for (i = 1; i < nargs; i++) - if (!used[i - 1] && EQ (args[i - 1], key)) - { - used[i - 1] = 1; - used[i] = 1; - return i; - } - - return 0; -} - - /* Return a Lisp vector which has the same contents as VEC but has at least INCR_MIN more entries, where INCR_MIN is positive. If NITEMS_MAX is not -1, do not grow the vector to be any larger @@ -5376,7 +5388,7 @@ hash_string (char const *ptr, ptrdiff_t len) /* String is shorter than an EMACS_UINT. Use smaller loads. */ eassume (p <= end && end - p < sizeof (EMACS_UINT)); EMACS_UINT tail = 0; - verify (sizeof tail <= 8); + static_assert (sizeof tail <= 8); #if EMACS_INT_MAX > INT32_MAX if (end - p >= 4) { @@ -5747,32 +5759,43 @@ and ignored. usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - USE_SAFE_ALLOCA; + Lisp_Object test_arg = Qnil; + Lisp_Object weakness_arg = Qnil; + Lisp_Object size_arg = Qnil; + Lisp_Object purecopy_arg = Qnil; + + if (nargs & 1) + error ("Odd number of arguments"); + while (nargs >= 2) + { + Lisp_Object arg = maybe_remove_pos_from_symbol (args[--nargs]); + Lisp_Object kw = maybe_remove_pos_from_symbol (args[--nargs]); + if (BASE_EQ (kw, QCtest)) + test_arg = arg; + else if (BASE_EQ (kw, QCweakness)) + weakness_arg = arg; + else if (BASE_EQ (kw, QCsize)) + size_arg = arg; + else if (BASE_EQ (kw, QCpurecopy)) + purecopy_arg = arg; + else if (BASE_EQ (kw, QCrehash_threshold) || BASE_EQ (kw, QCrehash_size)) + ; /* ignore obsolete keyword arguments */ + else + signal_error ("Invalid keyword argument", kw); + } - /* The vector `used' is used to keep track of arguments that - have been consumed. */ - char *used = SAFE_ALLOCA (nargs * sizeof *used); - memset (used, 0, nargs * sizeof *used); - - /* See if there's a `:test TEST' among the arguments. */ - ptrdiff_t i = get_key_arg (QCtest, nargs, args, used); - Lisp_Object test = i ? maybe_remove_pos_from_symbol (args[i]) : Qeql; - const struct hash_table_test *testdesc; - if (BASE_EQ (test, Qeq)) - testdesc = &hashtest_eq; - else if (BASE_EQ (test, Qeql)) - testdesc = &hashtest_eql; - else if (BASE_EQ (test, Qequal)) - testdesc = &hashtest_equal; + const struct hash_table_test *test; + if (NILP (test_arg) || BASE_EQ (test_arg, Qeql)) + test = &hashtest_eql; + else if (BASE_EQ (test_arg, Qeq)) + test = &hashtest_eq; + else if (BASE_EQ (test_arg, Qequal)) + test = &hashtest_equal; else - testdesc = get_hash_table_user_test (test); - - /* See if there's a `:purecopy PURECOPY' argument. */ - i = get_key_arg (QCpurecopy, nargs, args, used); - bool purecopy = i && !NILP (args[i]); - /* See if there's a `:size SIZE' argument. */ - i = get_key_arg (QCsize, nargs, args, used); - Lisp_Object size_arg = i ? args[i] : Qnil; + test = get_hash_table_user_test (test_arg); + + bool purecopy = !NILP (purecopy_arg); + EMACS_INT size; if (NILP (size_arg)) size = DEFAULT_HASH_SIZE; @@ -5781,36 +5804,21 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) else signal_error ("Invalid hash table size", size_arg); - /* Look for `:weakness WEAK'. */ - i = get_key_arg (QCweakness, nargs, args, used); - Lisp_Object weakness = i ? args[i] : Qnil; hash_table_weakness_t weak; - if (NILP (weakness)) + if (NILP (weakness_arg)) weak = Weak_None; - else if (EQ (weakness, Qkey)) + else if (BASE_EQ (weakness_arg, Qkey)) weak = Weak_Key; - else if (EQ (weakness, Qvalue)) + else if (BASE_EQ (weakness_arg, Qvalue)) weak = Weak_Value; - else if (EQ (weakness, Qkey_or_value)) + else if (BASE_EQ (weakness_arg, Qkey_or_value)) weak = Weak_Key_Or_Value; - else if (EQ (weakness, Qt) || EQ (weakness, Qkey_and_value)) + else if (BASE_EQ (weakness_arg, Qt) || BASE_EQ (weakness_arg, Qkey_and_value)) weak = Weak_Key_And_Value; else - signal_error ("Invalid hash table weakness", weakness); - - /* Now, all args should have been used up, or there's a problem. */ - for (i = 0; i < nargs; ++i) - if (!used[i]) - { - /* Ignore obsolete arguments. */ - if (EQ (args[i], QCrehash_threshold) || EQ (args[i], QCrehash_size)) - i++; - else - signal_error ("Invalid argument list", args[i]); - } + signal_error ("Invalid hash table weakness", weakness_arg); - SAFE_FREE (); - return make_hash_table (testdesc, size, weak, purecopy); + return make_hash_table (test, size, weak, purecopy); } @@ -5923,7 +5931,10 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0, DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0, doc: /* Look up KEY in TABLE and return its associated value. -If KEY is not found, return DFLT which defaults to nil. */) +If KEY is not found in table, return DEFAULT, or nil if DEFAULT is not +provided. + +usage: (gethash KEY TABLE &optional DEFAULT) */) (Lisp_Object key, Lisp_Object table, Lisp_Object dflt) { struct Lisp_Hash_Table *h = check_hash_table (table); @@ -6306,7 +6317,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, const char *input = extract_data_from_object (spec, &start_byte, &end_byte); if (input == NULL) - error ("secure_hash: failed to extract data from object, aborting!"); + error ("secure_hash: Failed to extract data from object, aborting!"); if (EQ (algorithm, Qmd5)) { diff --git a/src/font.c b/src/font.c index eebc33a1eab..86382267a4a 100644 --- a/src/font.c +++ b/src/font.c @@ -1627,15 +1627,30 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font) { bool decimal = 0, size_found = 1; for (q = p + 1; *q && *q != ':'; q++) - if (! c_isdigit (*q)) - { - if (*q != '.' || decimal) - { - size_found = 0; - break; - } - decimal = 1; - } + { +#ifdef HAVE_NTGUI + /* MS-Windows has several CJK fonts whose name ends in + "-ExtB". It also has fonts whose names end in "-R" or + "-B", and one font whose name ends in "-SB". */ + if (q == p + 1 && (strncmp (q, "ExtB", 4) == 0 + || strncmp (q, "R", 1) == 0 + || strncmp (q, "B", 1) == 0 + || strncmp (q, "SB", 2) == 0)) + { + size_found = 0; + break; + } +#endif + if (! c_isdigit (*q)) + { + if (*q != '.' || decimal) + { + size_found = 0; + break; + } + decimal = 1; + } + } if (size_found) { family_end = p; @@ -2000,6 +2015,15 @@ font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Objec len = SBYTES (family); p0 = SSDATA (family); p1 = strchr (p0, '-'); +#ifdef HAVE_NTGUI + /* MS-Windows has fonts whose family name ends in "-ExtB" and + other suffixes which include a hyphen. */ + if (p1 && (strcmp (p1, "-ExtB") == 0 + || strcmp (p1, "-R") == 0 + || strcmp (p1, "-B") == 0 + || strcmp (p1, "-SB") == 0)) + p1 = NULL; +#endif if (p1) { if ((*p0 != '*' && p1 - p0 > 0) @@ -2230,7 +2254,7 @@ font_sort_entities (Lisp_Object list, Lisp_Object prefer, maxlen = ASIZE (vec); } - data = SAFE_ALLOCA (maxlen * sizeof *data); + SAFE_NALLOCA (data, 1, maxlen); best_score = 0xFFFFFFFF; best_entity = Qnil; diff --git a/src/fontset.c b/src/fontset.c index 909850812a0..c0086b49257 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -668,38 +668,8 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face, font_object = font_open_for_lface (f, font_entity, face->lface, FONT_DEF_SPEC (font_def)); -#ifdef HAVE_ANDROID - /* If the font registry is not the same as explicitly - specified in the font spec, do not cache the font. - TrueType fonts have contrived character map selection - semantics which makes determining the repertory at font - spec matching time unduly expensive. */ - - { - Lisp_Object spec; - - spec = FONT_DEF_SPEC (font_def); - - if (!NILP (font_object) - && !NILP (AREF (spec, FONT_REGISTRY_INDEX)) - && !NILP (AREF (font_object, FONT_REGISTRY_INDEX)) - && !EQ (AREF (spec, FONT_REGISTRY_INDEX), - AREF (font_object, FONT_REGISTRY_INDEX)) - /* See sfntfont_registries_compatible_p in - sfntfont.c. */ - && !(EQ (AREF (spec, FONT_REGISTRY_INDEX), - Qiso8859_1) - && EQ (AREF (font_object, FONT_REGISTRY_INDEX), - Qiso10646_1))) - goto strangeness; - } -#endif /* HAVE_ANDROID */ - if (NILP (font_object)) { -#ifdef HAVE_ANDROID - strangeness: -#endif /* HAVE_ANDROID */ /* Something strange happened, perhaps because of a Font-backend problem. To avoid crashing, record that this spec is unusable. It may be better to find diff --git a/src/frame.c b/src/frame.c index 8753f168a3b..146ecb226a4 100644 --- a/src/frame.c +++ b/src/frame.c @@ -130,6 +130,14 @@ decode_window_system_frame (Lisp_Object frame) #endif } +struct frame * +decode_tty_frame (Lisp_Object frame) +{ + struct frame *f = decode_live_frame (frame); + check_tty (f); + return f; +} + void check_window_system (struct frame *f) { @@ -141,6 +149,20 @@ check_window_system (struct frame *f) : "Window system is not in use or not initialized"); } +void +check_tty (struct frame *f) +{ + /* FIXME: the noninteractive case is here because some tests running + in batch mode, like xt-mouse-tests, test with the initial frame + which is no tty frame. It would be nicer if the test harness + would allow testing with real tty frames. */ + if (f && noninteractive) + return; + + if (!f || !FRAME_TERMCAP_P (f)) + error ("tty frame should be used"); +} + /* Return the value of frame parameter PROP in frame FRAME. */ Lisp_Object @@ -158,20 +180,19 @@ bool frame_inhibit_resize (struct frame *f, bool horizontal, Lisp_Object parameter) { Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); - bool inhibit - = (f->after_make_frame - ? (EQ (frame_inhibit_implied_resize, Qt) - || (CONSP (frame_inhibit_implied_resize) - && !NILP (Fmemq (parameter, frame_inhibit_implied_resize))) - || (horizontal - && !NILP (fullscreen) && !EQ (fullscreen, Qfullheight)) - || (!horizontal - && !NILP (fullscreen) && !EQ (fullscreen, Qfullwidth)) - || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) - : ((horizontal && f->inhibit_horizontal_resize) - || (!horizontal && f->inhibit_vertical_resize))); - return inhibit; + return (f->after_make_frame +#ifdef USE_GTK + && f->tool_bar_resized +#endif + && (EQ (frame_inhibit_implied_resize, Qt) + || (CONSP (frame_inhibit_implied_resize) + && !NILP (Fmemq (parameter, frame_inhibit_implied_resize))) + || (horizontal + && !NILP (fullscreen) && !EQ (fullscreen, Qfullheight)) + || (!horizontal + && !NILP (fullscreen) && !EQ (fullscreen, Qfullwidth)) + || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))); } @@ -182,6 +203,17 @@ set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) int olines = FRAME_MENU_BAR_LINES (f); int nlines = TYPE_RANGED_FIXNUMP (int, value) ? XFIXNUM (value) : 0; + /* Menu bars on child frames don't work on all platforms, which is + the reason why prepare_menu_bar does not update_menu_bar for + child frames (info from Martin Rudalics). This could be + implemented in ttys, but it's probaly not worth it. */ + if (is_tty_child_frame (f)) + { + FRAME_MENU_BAR_LINES (f) = 0; + FRAME_MENU_BAR_HEIGHT (f) = 0; + return; + } + /* Right now, menu bars don't work properly in minibuf-only frames; most of the commands try to apply themselves to the minibuffer frame itself, and get an error because you can't switch buffers @@ -370,17 +402,17 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, } else retval = XFIXNUM (call4 (Qframe_windows_min_size, frame, horizontal, - ignore, pixelwise)); + ignore, pixelwise)); /* Don't allow too small height of text-mode frames, or else cm.c might abort in cmcheckmagic. */ if ((FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) && NILP (horizontal)) { - int min_height = (FRAME_MENU_BAR_LINES (f) - + FRAME_TAB_BAR_LINES (f) + int min_height = (FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f) + FRAME_WANTS_MODELINE_P (f) - + 2); /* one text line and one echo-area line */ - + + FRAME_HAS_MINIBUF_P (f)); + if (min_height == 0) + min_height = 1; if (retval < min_height) retval = min_height; } @@ -389,7 +421,6 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, } -#ifdef HAVE_WINDOW_SYSTEM /** * keep_ratio: * @@ -508,7 +539,6 @@ keep_ratio (struct frame *f, struct frame *p, int old_width, int old_height, } } } -#endif static void @@ -817,14 +847,18 @@ adjust_frame_size (struct frame *f, int new_text_width, int new_text_height, block_input (); #ifdef MSDOS - /* We only can set screen dimensions to certain values supported by - our video hardware. Try to find the smallest size greater or - equal to the requested dimensions, while accounting for the fact - that the menu-bar lines are not counted in the frame height. */ - int dos_new_text_lines = new_text_lines + FRAME_TOP_MARGIN (f); - - dos_set_window_size (&dos_new_text_lines, &new_text_cols); - new_text_lines = dos_new_text_lines - FRAME_TOP_MARGIN (f); + if (!FRAME_PARENT_FRAME (f)) + { + /* We only can set screen dimensions to certain values supported + by our video hardware. Try to find the smallest size greater + or equal to the requested dimensions, while accounting for the + fact that the menu-bar lines are not counted in the frame + height. */ + int dos_new_text_lines = new_text_lines + FRAME_TOP_MARGIN (f); + + dos_set_window_size (&dos_new_text_lines, &new_text_cols); + new_text_lines = dos_new_text_lines - FRAME_TOP_MARGIN (f); + } #endif if (new_inner_width != old_inner_width) @@ -833,8 +867,9 @@ adjust_frame_size (struct frame *f, int new_text_width, int new_text_height, /* MSDOS frames cannot PRETEND, as they change frame size by manipulating video hardware. */ - if ((FRAME_TERMCAP_P (f) && !pretend) || FRAME_MSDOS_P (f)) - FrameCols (FRAME_TTY (f)) = new_text_cols; + if (is_tty_root_frame (f)) + if ((FRAME_TERMCAP_P (f) && !pretend) || FRAME_MSDOS_P (f)) + FrameCols (FRAME_TTY (f)) = new_text_cols; #if defined (HAVE_WINDOW_SYSTEM) if (WINDOWP (f->tab_bar_window)) @@ -866,9 +901,10 @@ adjust_frame_size (struct frame *f, int new_text_width, int new_text_height, resize_frame_windows (f, new_inner_height, false); /* MSDOS frames cannot PRETEND, as they change frame size by - manipulating video hardware. */ - if ((FRAME_TERMCAP_P (f) && !pretend) || FRAME_MSDOS_P (f)) - FrameRows (FRAME_TTY (f)) = new_text_lines + FRAME_TOP_MARGIN (f); + manipulating video hardware. */ + if (is_tty_root_frame (f)) + if ((FRAME_TERMCAP_P (f) && !pretend) || FRAME_MSDOS_P (f)) + FrameRows (FRAME_TTY (f)) = new_text_lines + FRAME_TOP_MARGIN (f); } else if (new_text_lines != old_text_lines) call2 (Qwindow__pixel_to_total, frame, Qnil); @@ -898,6 +934,9 @@ adjust_frame_size (struct frame *f, int new_text_width, int new_text_height, adjust_frame_glyphs (f); calculate_costs (f); SET_FRAME_GARBAGED (f); + if (is_tty_child_frame (f)) + SET_FRAME_GARBAGED (root_frame (f)); + /* We now say here that F was resized instead of using the old condition below. Some resizing must have taken place and if it was only shifting the root window's position (paranoia?). */ @@ -910,7 +949,6 @@ adjust_frame_size (struct frame *f, int new_text_width, int new_text_height, unblock_input (); -#ifdef HAVE_WINDOW_SYSTEM { /* Adjust size of F's child frames. */ Lisp_Object frames, frame1; @@ -920,7 +958,6 @@ adjust_frame_size (struct frame *f, int new_text_width, int new_text_height, keep_ratio (XFRAME (frame1), f, old_native_width, old_native_height, new_native_width, new_native_height); } -#endif } /* Allocate basically initialized frame. */ @@ -957,8 +994,6 @@ make_frame (bool mini_p) f->garbaged = true; f->can_set_window_size = false; f->after_make_frame = false; - f->inhibit_horizontal_resize = false; - f->inhibit_vertical_resize = false; f->tab_bar_redisplayed = false; f->tab_bar_resized = false; f->tool_bar_redisplayed = false; @@ -967,12 +1002,12 @@ make_frame (bool mini_p) f->line_height = 1; /* !FRAME_WINDOW_P value. */ f->new_width = -1; f->new_height = -1; + f->no_special_glyphs = false; #ifdef HAVE_WINDOW_SYSTEM f->vertical_scroll_bar_type = vertical_scroll_bar_none; f->horizontal_scroll_bars = false; f->want_fullscreen = FULLSCREEN_NONE; f->undecorated = false; - f->no_special_glyphs = false; #ifndef HAVE_NTGUI f->override_redirect = false; #endif @@ -1089,7 +1124,6 @@ make_frame (bool mini_p) return f; } -#ifdef HAVE_WINDOW_SYSTEM /* Make a frame using a separate minibuffer window on another frame. MINI_WINDOW is the minibuffer window to use. nil means use the default (the global minibuffer). */ @@ -1183,7 +1217,7 @@ make_minibuffer_frame (void) : Fcar (Vminibuffer_list)), 0, 0); return f; } -#endif /* HAVE_WINDOW_SYSTEM */ + /* Construct a frame that refers to a terminal. */ @@ -1209,7 +1243,7 @@ make_initial_frame (void) tty_frame_count = 1; fset_name (f, build_pure_c_string ("F1")); - SET_FRAME_VISIBLE (f, 1); + SET_FRAME_VISIBLE (f, true); f->output_method = terminal->type; f->terminal = terminal; @@ -1246,23 +1280,48 @@ make_initial_frame (void) #ifndef HAVE_ANDROID static struct frame * -make_terminal_frame (struct terminal *terminal) +make_terminal_frame (struct terminal *terminal, Lisp_Object parent, + Lisp_Object params) { - register struct frame *f; - Lisp_Object frame; char name[sizeof "F" + INT_STRLEN_BOUND (tty_frame_count)]; if (!terminal->name) error ("Terminal is not live, can't create new frames on it"); - f = make_frame (1); + struct frame *f; + if (NILP (parent)) + f = make_frame (true); + else + { + CHECK_LIVE_FRAME (parent); + + f = NULL; + Lisp_Object mini = Fassq (Qminibuffer, params); + if (CONSP (mini)) + { + mini = Fcdr (mini); + struct kboard *kb = FRAME_KBOARD (XFRAME (parent)); + if (EQ (mini, Qnone) || NILP (mini)) + f = make_frame_without_minibuffer (Qnil, kb, Qnil); + else if (EQ (mini, Qonly)) + error ("minibuffer-only child frames are not implemented"); + else if (WINDOWP (mini)) + f = make_frame_without_minibuffer (mini, kb, Qnil); + } + if (f == NULL) + f = make_frame (true); + f->parent_frame = parent; + f->z_order = 1 + max_child_z_order (XFRAME (parent)); + } + + Lisp_Object frame; XSETFRAME (frame, f); Vframe_list = Fcons (frame, Vframe_list); fset_name (f, make_formatted_string (name, "F%"PRIdMAX, ++tty_frame_count)); - SET_FRAME_VISIBLE (f, 1); + SET_FRAME_VISIBLE (f, true); f->terminal = terminal; f->terminal->reference_count++; @@ -1287,7 +1346,15 @@ make_terminal_frame (struct terminal *terminal) f->horizontal_scroll_bars = false; #endif - FRAME_MENU_BAR_LINES (f) = NILP (Vmenu_bar_mode) ? 0 : 1; + /* Menu bars on child frames don't work on all platforms, which is + the reason why prepare_menu_bar does not update_menu_bar for + child frames (info from Martin Rudalics). This could be + implemented in ttys, but it's unclear if it is worth it. */ + if (NILP (parent)) + FRAME_MENU_BAR_LINES (f) = NILP (Vmenu_bar_mode) ? 0 : 1; + else + FRAME_MENU_BAR_LINES (f) = 0; + FRAME_TAB_BAR_LINES (f) = NILP (Vtab_bar_mode) ? 0 : 1; FRAME_LINES (f) = FRAME_LINES (f) - FRAME_MENU_BAR_LINES (f) - FRAME_TAB_BAR_LINES (f); @@ -1296,16 +1363,18 @@ make_terminal_frame (struct terminal *terminal) FRAME_TEXT_HEIGHT (f) = FRAME_TEXT_HEIGHT (f) - FRAME_MENU_BAR_HEIGHT (f) - FRAME_TAB_BAR_HEIGHT (f); - /* Set the top frame to the newly created frame. */ - if (FRAMEP (FRAME_TTY (f)->top_frame) - && FRAME_LIVE_P (XFRAME (FRAME_TTY (f)->top_frame))) - SET_FRAME_VISIBLE (XFRAME (FRAME_TTY (f)->top_frame), 2); /* obscured */ + /* Mark current topmost frame obscured if we make a new root frame. + Child frames don't completely obscure other frames. */ + if (NILP (parent) && FRAMEP (FRAME_TTY (f)->top_frame)) + { + struct frame *top = XFRAME (FRAME_TTY (f)->top_frame); + struct frame *root = root_frame (top); + if (FRAME_LIVE_P (root)) + SET_FRAME_VISIBLE (root, false); + } + /* Set the top frame to the newly created frame. */ FRAME_TTY (f)->top_frame = frame; - - if (!noninteractive) - init_frame_faces (f); - return f; } @@ -1335,6 +1404,72 @@ get_future_frame_param (Lisp_Object parameter, #endif +int +tty_child_pos_param (struct frame *child, Lisp_Object key, + Lisp_Object params, int dflt) +{ + Lisp_Object val = Fassq (key, params); + if (CONSP (val)) + { + val = XCDR (val); + if (FIXNUMP (val)) + return XFIXNUM (val); + } + return dflt; +} + +int +tty_child_size_param (struct frame *child, Lisp_Object key, + Lisp_Object params, int dflt) +{ + Lisp_Object val = Fassq (key, params); + if (CONSP (val)) + { + val = XCDR (val); + if (CONSP (val)) + { + /* Width and height may look like (width text-pixels . PIXELS) + on window systems. Mimic that. */ + val = XCDR (val); + if (EQ (val, Qtext_pixels)) + val = XCDR (val); + } + else if (FLOATP (val)) + { + /* Width and height may be a float, in which case + it's a multiple of the parent's value. */ + struct frame *parent = FRAME_PARENT_FRAME (child); + eassert (parent); /* the caller ensures this, but... */ + if (parent) + { + int sz = (EQ (key, Qwidth) ? FRAME_TOTAL_COLS (parent) + : FRAME_TOTAL_LINES (parent)); + val = make_fixnum (XFLOAT_DATA (val) * sz); + } + else + val = Qnil; + } + + if (FIXNATP (val)) + return XFIXNUM (val); + } + return dflt; +} + +#ifndef HAVE_ANDROID + +static void +tty_child_frame_rect (struct frame *f, Lisp_Object params, + int *x, int *y, int *w, int *h) +{ + *x = tty_child_pos_param (f, Qleft, params, 0); + *y = tty_child_pos_param (f, Qtop, params, 0); + *w = tty_child_size_param (f, Qwidth, params, FRAME_TOTAL_COLS (f)); + *h = tty_child_size_param (f, Qheight, params, FRAME_TOTAL_LINES (f)); +} + +#endif /* !HAVE_ANDROID */ + DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame, 1, 1, 0, doc: /* Create an additional terminal frame, possibly on another terminal. @@ -1358,9 +1493,7 @@ affects all frames on the same terminal device. */) error ("Text terminals are not supported on this platform"); return Qnil; #else - struct frame *f; struct terminal *t = NULL; - Lisp_Object frame; struct frame *sf = SELECTED_FRAME (); #ifdef MSDOS @@ -1390,7 +1523,7 @@ affects all frames on the same terminal device. */) error ("Multiple terminals are not supported on this platform"); if (!t) t = the_only_display_info.terminal; -#endif +# endif } if (!t) @@ -1417,19 +1550,64 @@ affects all frames on the same terminal device. */) SAFE_FREE (); } - f = make_terminal_frame (t); + /* Make a new frame. We need to know up front if a parent frame is + specified because we behave differently in this case, e.g., child + frames don't obscure other frames. */ + Lisp_Object parent = Fcdr (Fassq (Qparent_frame, parms)); + struct frame *f = make_terminal_frame (t, parent, parms); - { - int width, height; - get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height); - /* With INHIBIT 5 pass correct text height to adjust_frame_size. */ - adjust_frame_size (f, width, height - FRAME_TOP_MARGIN (f), - 5, 0, Qterminal_frame); - } + if (!noninteractive) + init_frame_faces (f); + + /* Visibility of root frames cannot be set with a frame parameter. + Their visibility solely depends on whether or not they are the + top_frame on the terminal. */ + if (FRAME_PARENT_FRAME (f)) + { + Lisp_Object visible = Fassq (Qvisibility, parms); + if (CONSP (visible)) + SET_FRAME_VISIBLE (f, !NILP (visible)); + + /* FIXME/tty: The only way, for now, to get borders on a tty is + to allow decorations. */ + Lisp_Object undecorated = Fassq (Qundecorated, parms); + if (CONSP (undecorated) && !NILP (XCDR (undecorated))) + f->undecorated = true; + + /* Unused at present. */ + Lisp_Object no_focus = Fassq (Qno_accept_focus, parms); + if (CONSP (no_focus) && !NILP (XCDR (no_focus))) + f->no_accept_focus = true; + + Lisp_Object no_split = Fassq (Qunsplittable, parms); + if (CONSP (no_split) && !NILP (XCDR (no_split))) + f->no_split = true; + } + /* Determine width and height of the frame. For root frames use the + width/height of the terminal. For child frames, take it from frame + parameters. Note that a default (80x25) has been set in + make_frame. We handle root frames in this way because otherwise we + would end up needing glyph matrices for the terminal, which is both + more work and has its downsides (think of clipping frames to the + terminal size). */ + int x = 0, y = 0, width, height; + if (FRAME_PARENT_FRAME (f)) + tty_child_frame_rect (f, parms, &x, &y, &width, &height); + else + get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height); + adjust_frame_size (f, width, height - FRAME_TOP_MARGIN (f), 5, 0, + Qterminal_frame); adjust_frame_glyphs (f); + calculate_costs (f); - XSETFRAME (frame, f); + + f->left_pos = x; + f->top_pos = y; + store_in_alist (&parms, Qleft, make_fixnum (x)); + store_in_alist (&parms, Qtop, make_fixnum (y)); + store_in_alist (&parms, Qwidth, make_fixnum (width)); + store_in_alist (&parms, Qheight, make_fixnum (height)); store_in_alist (&parms, Qtty_type, build_string (t->display_info.tty->type)); store_in_alist (&parms, Qtty, @@ -1451,7 +1629,11 @@ affects all frames on the same terminal device. */) /* On terminal frames the `minibuffer' frame parameter is always virtually t. Avoid that a different value in parms causes complaints, see Bug#24758. */ - store_in_alist (&parms, Qminibuffer, Qt); + if (!FRAME_PARENT_FRAME (f)) + store_in_alist (&parms, Qminibuffer, Qt); + + Lisp_Object frame; + XSETFRAME (frame, f); Fmodify_frame_parameters (frame, parms); f->can_set_window_size = true; @@ -1480,8 +1662,6 @@ affects all frames on the same terminal device. */) Lisp_Object do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object norecord) { - struct frame *sf = SELECTED_FRAME (), *f; - /* If FRAME is a switch-frame event, extract the frame we should switch to. */ if (CONSP (frame) @@ -1493,7 +1673,9 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor a switch-frame event to arrive after a frame is no longer live, especially when deleting the initial frame during startup. */ CHECK_FRAME (frame); - f = XFRAME (frame); + struct frame *f = XFRAME (frame); + struct frame *sf = SELECTED_FRAME (); + /* Silently ignore dead and tooltip frames (Bug#47207). */ if (!FRAME_LIVE_P (f) || FRAME_TOOLTIP_P (f)) return Qnil; @@ -1546,24 +1728,37 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor struct tty_display_info *tty = FRAME_TTY (f); Lisp_Object top_frame = tty->top_frame; - /* Don't mark the frame garbaged and/or obscured if we are - switching to the frame that is already the top frame of that - TTY. */ + /* Don't mark the frame garbaged if we are switching to the frame + that is already the top frame of that TTY. */ if (!EQ (frame, top_frame)) { + struct frame *new_root = root_frame (f); + SET_FRAME_VISIBLE (new_root, true); + SET_FRAME_VISIBLE (f, true); + + /* Mark previously displayed frame as no longer visible. */ if (FRAMEP (top_frame)) - /* Mark previously displayed frame as now obscured. */ - SET_FRAME_VISIBLE (XFRAME (top_frame), 2); - SET_FRAME_VISIBLE (f, 1); - /* If the new TTY frame changed dimensions, we need to - resync term.c's idea of the frame size with the new - frame's data. */ - if (FRAME_COLS (f) != FrameCols (tty)) - FrameCols (tty) = FRAME_COLS (f); - if (FRAME_TOTAL_LINES (f) != FrameRows (tty)) - FrameRows (tty) = FRAME_TOTAL_LINES (f); + { + struct frame *top = XFRAME (top_frame); + struct frame *old_root = root_frame (top); + if (old_root != new_root) + SET_FRAME_VISIBLE (old_root, false); + } + + tty->top_frame = frame; + + /* FIXME: Why is it correct to set FrameCols/Rows? */ + if (!FRAME_PARENT_FRAME (f)) + { + /* If the new TTY frame changed dimensions, we need to + resync term.c's idea of the frame size with the new + frame's data. */ + if (FRAME_COLS (f) != FrameCols (tty)) + FrameCols (tty) = FRAME_COLS (f); + if (FRAME_TOTAL_LINES (f) != FrameRows (tty)) + FrameRows (tty) = FRAME_TOTAL_LINES (f); + } } - tty->top_frame = frame; } sf->select_mini_window_flag = MINI_WINDOW_P (XWINDOW (sf->selected_window)); @@ -1605,10 +1800,36 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor (select-window (frame-root-window (make-frame))) doesn't end up with your typing being interpreted in the new frame instead of the one you're actually typing in. */ -#ifdef HAVE_WINDOW_SYSTEM - if (!frame_ancestor_p (f, sf)) -#endif - internal_last_event_frame = Qnil; + + /* FIXME/tty: I don't understand this. (The comment above is from + Jim BLandy 1993 BTW, and the frame_ancestor_p from 2017.) + + Setting the last event frame to nil leads to switch-frame events + being generated even if they normally wouldn't be because the frame + in question equals selected-frame. See the places in keyboard.c + where make_lispy_switch_frame is called. + + This leads to problems at least on ttys. + + Imagine that we have functions in post-command-hook that use + select-frame in some way (e.g., with-selected-window). Let these + functions select different frames during the execution of + post-command-hook in command_loop_1. Setting + internal_last_event_frame to nil here makes these select-frame + calls (potentially and in reality) generate switch-frame events. + (But only in one direction (frame_ancestor_p), which I also don't + understand). + + These switch-frame events form an endless loop in + command_loop_1. It runs post-command-hook, which generates + switch-frame events, which command_loop_1 finds (bound to '#ignore) + and executes, which again runs post-command-hook etc., ad + infinitum. + + Let's not do that for now on ttys. */ + if (!is_tty_frame (f)) + if (!frame_ancestor_p (f, sf)) + internal_last_event_frame = Qnil; return frame; } @@ -1725,7 +1946,6 @@ parent window is the window-system's root window) or an embedded window return Qnil; } -#ifdef HAVE_WINDOW_SYSTEM bool frame_ancestor_p (struct frame *af, struct frame *df) { @@ -1741,7 +1961,6 @@ frame_ancestor_p (struct frame *af, struct frame *df) return false; } -#endif DEFUN ("frame-ancestor-p", Fframe_ancestor_p, Sframe_ancestor_p, 2, 2, 0, @@ -1752,15 +1971,10 @@ ANCESTOR and DESCENDANT must be live frames and default to the selected frame. */) (Lisp_Object ancestor, Lisp_Object descendant) { -#ifdef HAVE_WINDOW_SYSTEM struct frame *af = decode_live_frame (ancestor); struct frame *df = decode_live_frame (descendant); - return frame_ancestor_p (af, df) ? Qt : Qnil; -#else - return Qnil; -#endif - } +} /* Return CANDIDATE if it can be used as 'other-than-FRAME' frame on the same tty (for tty frames) or among frames which uses FRAME's keyboard. @@ -2021,7 +2235,9 @@ other_frames (struct frame *f, bool invisible, bool force) && (invisible || NILP (get_frame_param (f1, Qdelete_before))) /* For invisibility and normal deletions, at least one visible or iconified frame must remain (Bug#26682). */ - && (FRAME_VISIBLE_P (f1) || FRAME_ICONIFIED_P (f1) + && (FRAME_VISIBLE_P (f1) + || is_tty_frame (f1) + || FRAME_ICONIFIED_P (f1) || (!invisible && (force /* Allow deleting the terminal frame when at @@ -2281,8 +2497,10 @@ delete_frame (Lisp_Object frame, Lisp_Object force) delete_all_child_windows (f->root_window); fset_root_window (f, Qnil); + block_input (); Vframe_list = Fdelq (frame, Vframe_list); - SET_FRAME_VISIBLE (f, 0); + unblock_input (); + SET_FRAME_VISIBLE (f, false); /* Allow the vector of menu bar contents to be freed in the next garbage collection. The frame object itself may not be garbage @@ -2868,6 +3086,12 @@ If omitted, FRAME defaults to the currently selected frame. */) if (FRAME_WINDOW_P (f) && FRAME_TERMINAL (f)->frame_visible_invisible_hook) FRAME_TERMINAL (f)->frame_visible_invisible_hook (f, true); + if (is_tty_frame (f)) + { + SET_FRAME_VISIBLE (f, true); + tty_raise_lower_frame (f, true); + } + make_frame_visible_1 (f->root_window); /* Make menu bar update for the Buffers and Frames menus. */ @@ -2918,6 +3142,12 @@ displayed in the terminal. */) if (FRAME_WINDOW_P (f) && FRAME_TERMINAL (f)->frame_visible_invisible_hook) FRAME_TERMINAL (f)->frame_visible_invisible_hook (f, false); + /* The ELisp manual says that this "usually" makes child frames + invisible, too, but without saying when not. Since users can't + rely on this, it's not implemented. */ + if (is_tty_frame (f)) + SET_FRAME_VISIBLE (f, false); + /* Make menu bar update for the Buffers and Frames menus. */ windows_or_buffers_changed = 16; @@ -2977,10 +3207,13 @@ currently being displayed on the terminal. */) (Lisp_Object frame) { CHECK_LIVE_FRAME (frame); + struct frame *f = XFRAME (frame); - if (FRAME_VISIBLE_P (XFRAME (frame))) + if (FRAME_VISIBLE_P (f)) + return Qt; + else if (is_tty_root_frame (f)) return Qt; - if (FRAME_ICONIFIED_P (XFRAME (frame))) + if (FRAME_ICONIFIED_P (f)) return Qicon; return Qnil; } @@ -3012,12 +3245,7 @@ doesn't support multiple overlapping frames, this function selects FRAME. */) XSETFRAME (frame, f); - if (FRAME_TERMCAP_P (f)) - /* On a text terminal select FRAME. */ - Fselect_frame (frame, Qnil); - else - /* Do like the documentation says. */ - Fmake_frame_visible (frame); + Fmake_frame_visible (frame); if (FRAME_TERMINAL (f)->frame_raise_lower_hook) (*FRAME_TERMINAL (f)->frame_raise_lower_hook) (f, true); @@ -3128,8 +3356,6 @@ otherwise used with utter care to avoid that running functions on { struct frame *f = decode_live_frame (frame); f->after_make_frame = !NILP (made); - f->inhibit_horizontal_resize = false; - f->inhibit_vertical_resize = false; return made; } @@ -3318,6 +3544,15 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val) val = old_val; } + /* Re-parenting is currently not implemented when changing a root + frame to a child frame or vice versa. */ + if (is_tty_frame (f) && EQ (prop, Qparent_frame)) + { + if (NILP (f->parent_frame) != NILP (val)) + error ("Making a root frame a child or vice versa is not supported"); + f->parent_frame = val; + } + /* The tty color needed to be set before the frame's parameter alist was updated with the new value. This is not true any more, but we still do this test early on. */ @@ -3441,13 +3676,10 @@ If FRAME is omitted or nil, return information on the currently selected frame. else #endif { - /* This ought to be correct in f->param_alist for an X frame. */ - Lisp_Object lines; - - XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f)); - store_in_alist (&alist, Qmenu_bar_lines, lines); - XSETFASTINT (lines, FRAME_TAB_BAR_LINES (f)); - store_in_alist (&alist, Qtab_bar_lines, lines); + store_in_alist (&alist, Qmenu_bar_lines, make_fixnum (FRAME_MENU_BAR_LINES (f))); + store_in_alist (&alist, Qtab_bar_lines, make_fixnum (FRAME_TAB_BAR_LINES (f))); + store_in_alist (&alist, Qvisibility, FRAME_VISIBLE_P (f) ? Qt : Qnil); + store_in_alist (&alist, Qno_accept_focus, FRAME_NO_ACCEPT_FOCUS (f) ? Qt : Qnil); } return alist; @@ -3525,7 +3757,6 @@ If FRAME is nil, describe the currently selected frame. */) return value; } - DEFUN ("modify-frame-parameters", Fmodify_frame_parameters, Smodify_frame_parameters, 2, 2, 0, doc: /* Modify FRAME according to new values of its parameters in ALIST. @@ -3563,6 +3794,7 @@ list, but are otherwise ignored. */) USE_SAFE_ALLOCA; SAFE_ALLOCA_LISP (parms, 2 * length); values = parms + length; + Lisp_Object params = alist; /* Extract parm names and values into those vectors. */ @@ -3588,6 +3820,31 @@ list, but are otherwise ignored. */) update_face_from_frame_parameter (f, prop, val); } + if (is_tty_child_frame (f)) + { + int x = tty_child_pos_param (f, Qleft, params, f->left_pos); + int y = tty_child_pos_param (f, Qtop, params, f->top_pos); + if (x != f->left_pos || y != f->top_pos) + { + f->left_pos = x; + f->top_pos = y; + SET_FRAME_GARBAGED (root_frame (f)); + } + + int w = tty_child_size_param (f, Qwidth, params, f->total_cols); + int h = tty_child_size_param (f, Qheight, params, f->total_lines); + if (w != f->total_cols || h != f->total_lines) + change_frame_size (f, w, h, false, false, false); + + Lisp_Object visible = Fassq (Qvisibility, params); + if (CONSP (visible)) + SET_FRAME_VISIBLE (f, !NILP (Fcdr (visible))); + + Lisp_Object no_special = Fassq (Qno_special_glyphs, params); + if (CONSP (no_special)) + FRAME_NO_SPECIAL_GLYPHS (f) = !NILP (Fcdr (no_special)); + } + SAFE_FREE (); } return Qnil; @@ -3935,6 +4192,11 @@ bottom edge of FRAME's display. */) (void) yval; #endif } + else if (is_tty_child_frame (f)) + { + f->left_pos = xval; + f->top_pos = yval; + } return Qt; } @@ -3992,9 +4254,9 @@ multiplied to find the real number of pixels. */) /* Connect the frame-parameter names for frames to the ways of passing the parameter values to the window system. - The name of a parameter, as a Lisp symbol, has a - `frame-parameter-pos' property which is an integer in Lisp that is - an index in this table. */ + The name of a parameter, a Lisp symbol, has an `x-frame-parameter' + property which is its index in this table. This is initialized in + syms_of_frame. */ struct frame_parm_table { const char *name; @@ -4005,13 +4267,13 @@ static const struct frame_parm_table frame_parms[] = { {"auto-raise", SYMBOL_INDEX (Qauto_raise)}, {"auto-lower", SYMBOL_INDEX (Qauto_lower)}, - {"background-color", -1}, + {"background-color", SYMBOL_INDEX (Qbackground_color)}, {"border-color", SYMBOL_INDEX (Qborder_color)}, {"border-width", SYMBOL_INDEX (Qborder_width)}, {"cursor-color", SYMBOL_INDEX (Qcursor_color)}, {"cursor-type", SYMBOL_INDEX (Qcursor_type)}, - {"font", -1}, - {"foreground-color", -1}, + {"font", SYMBOL_INDEX (Qfont)}, + {"foreground-color", SYMBOL_INDEX (Qforeground_color)}, {"icon-name", SYMBOL_INDEX (Qicon_name)}, {"icon-type", SYMBOL_INDEX (Qicon_type)}, {"child-frame-border-width", SYMBOL_INDEX (Qchild_frame_border_width)}, @@ -4246,6 +4508,29 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what, } } +/* Handle frame parameter change with frame parameter handler. + F is the frame whose frame parameter was changed. + PROP is the name of the frame parameter. + VAL and OLD_VALUE are the current and the old value of the + frame parameter. */ + +static void +handle_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val, + Lisp_Object old_value) +{ + Lisp_Object param_index = Fget (prop, Qx_frame_parameter); + if (FIXNATP (param_index) && XFIXNAT (param_index) < ARRAYELTS (frame_parms)) + { + if (FRAME_RIF (f)) + { + frame_parm_handler handler + = FRAME_RIF (f)->frame_parm_handlers[XFIXNAT (param_index)]; + if (handler) + handler (f, val, old_value); + } + } +} + /* Change the parameters of frame F as specified by ALIST. If a parameter is not specially recognized, do nothing special; otherwise call the `gui_set_...' function for that parameter. @@ -4387,17 +4672,9 @@ gui_set_frame_parameters_1 (struct frame *f, Lisp_Object alist, } else { - Lisp_Object param_index, old_value; - - old_value = get_frame_param (f, prop); - + Lisp_Object old_value = get_frame_param (f, prop); store_frame_param (f, prop, val); - - param_index = Fget (prop, Qx_frame_parameter); - if (FIXNATP (param_index) - && XFIXNAT (param_index) < ARRAYELTS (frame_parms) - && FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)]) - (*(FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)])) (f, val, old_value); + handle_frame_param (f, prop, val, old_value); if (!default_parameter && EQ (prop, Qfont)) /* The user manually specified the `font' frame parameter. @@ -4716,14 +4993,7 @@ gui_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_va /* Apply the new gamma value to the frame background. */ bgcolor = Fassq (Qbackground_color, f->param_alist); if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor))) - { - Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter); - if (FIXNATP (parm_index) - && XFIXNAT (parm_index) < ARRAYELTS (frame_parms) - && FRAME_RIF (f)->frame_parm_handlers[XFIXNAT (parm_index)]) - (*FRAME_RIF (f)->frame_parm_handlers[XFIXNAT (parm_index)]) - (f, bgcolor, Qnil); - } + handle_frame_param (f, Qbackground_color, bgcolor, Qnil); clear_face_cache (true); /* FIXME: Why of all frames? */ fset_redisplay (f); @@ -5918,7 +6188,6 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, xsignal1 (Qargs_out_of_range, XCDR (width)); text_width = XFIXNUM (XCDR (width)); - f->inhibit_horizontal_resize = true; } else if (FLOATP (width)) { @@ -5954,7 +6223,6 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, xsignal1 (Qargs_out_of_range, XCDR (height)); text_height = XFIXNUM (XCDR (height)); - f->inhibit_vertical_resize = true; } else if (FLOATP (height)) { @@ -6463,17 +6731,13 @@ syms_of_frame (void) DEFSYM (Quse_frame_synchronization, "use-frame-synchronization"); DEFSYM (Qfont_parameter, "font-parameter"); - { - int i; - - for (i = 0; i < ARRAYELTS (frame_parms); i++) - { - Lisp_Object v = (frame_parms[i].sym < 0 - ? intern_c_string (frame_parms[i].name) - : builtin_lisp_symbol (frame_parms[i].sym)); - Fput (v, Qx_frame_parameter, make_fixnum (i)); - } - } + for (int i = 0; i < ARRAYELTS (frame_parms); i++) + { + int sym = frame_parms[i].sym; + eassert (sym >= 0 && sym < ARRAYELTS (lispsym)); + Lisp_Object v = builtin_lisp_symbol (sym); + Fput (v, Qx_frame_parameter, make_fixnum (i)); + } #ifdef HAVE_WINDOW_SYSTEM DEFVAR_LISP ("x-resource-name", Vx_resource_name, diff --git a/src/frame.h b/src/frame.h index 9265a95530c..bff610472c0 100644 --- a/src/frame.h +++ b/src/frame.h @@ -161,10 +161,8 @@ struct frame Usually it is nil. */ Lisp_Object title; -#if defined (HAVE_WINDOW_SYSTEM) /* This frame's parent frame, if it has one. */ Lisp_Object parent_frame; -#endif /* HAVE_WINDOW_SYSTEM */ /* Last device to move over this frame. Any value that isn't a string means the "Virtual core pointer". */ @@ -385,15 +383,8 @@ struct frame zero if the frame has been made invisible without an icon. */ /* Nonzero if the frame is currently displayed; we check - it to see if we should bother updating the frame's contents. - - On ttys and on Windows NT/9X, to avoid wasting effort updating - visible frames that are actually completely obscured by other - windows on the display, we bend the meaning of visible slightly: - if equal to 2, then the frame is obscured - we still consider - it to be "visible" as seen from lisp, but we don't bother - updating it. */ - unsigned visible : 2; + it to see if we should bother updating the frame's contents. */ + unsigned visible : 1; /* True if the frame is currently iconified. Do not set this directly, use SET_FRAME_ICONIFIED instead. */ @@ -451,6 +442,13 @@ struct frame This must be the same as the terminal->type. */ ENUM_BF (output_method) output_method : 4; + /* True if this is an undecorated frame. */ + bool_bf undecorated : 1; + + /* Nonzero if this frame's window does not want to receive input focus + via mouse clicks or by moving the mouse into it. */ + bool_bf no_accept_focus : 1; + #ifdef HAVE_WINDOW_SYSTEM /* True if this frame is a tooltip frame. */ bool_bf tooltip : 1; @@ -465,10 +463,7 @@ struct frame /* Nonzero if we should actually display horizontal scroll bars on this frame. */ bool_bf horizontal_scroll_bars : 1; - /* True if this is an undecorated frame. */ - bool_bf undecorated : 1; - -#ifndef HAVE_NTGUI +# ifndef HAVE_NTGUI /* True if this is an override_redirect frame. */ bool_bf override_redirect : 1; #endif @@ -480,17 +475,13 @@ struct frame receive input focus when it is mapped. */ bool_bf no_focus_on_map : 1; - /* Nonzero if this frame's window does not want to receive input focus - via mouse clicks or by moving the mouse into it. */ - bool_bf no_accept_focus : 1; - /* The z-group this frame's window belongs to. */ ENUM_BF (z_group) z_group : 2; +#endif /* HAVE_WINDOW_SYSTEM */ /* Non-zero if display of truncation and continuation glyphs outside the fringes is suppressed. */ bool_bf no_special_glyphs : 1; -#endif /* HAVE_WINDOW_SYSTEM */ /* True means set_window_size_hook requests can be processed for this frame. */ @@ -519,10 +510,6 @@ struct frame bool_bf tool_bar_redisplayed : 1; bool_bf tool_bar_resized : 1; - /* Inhibit implied resize before after_make_frame is set. */ - bool_bf inhibit_horizontal_resize : 1; - bool_bf inhibit_vertical_resize : 1; - /* Non-zero if this frame's faces need to be recomputed. */ bool_bf face_change : 1; @@ -740,7 +727,10 @@ struct frame #ifdef HAVE_TEXT_CONVERSION /* Text conversion state used by certain input methods. */ struct text_conversion_state conversion; -#endif +# endif + + /* Z-order of child frames. */ + int z_order; } GCALIGNED_STRUCT; /* Most code should use these functions to set Lisp fields in struct frame. */ @@ -1021,9 +1011,9 @@ default_pixels_per_inch_y (void) does not have FRAME_DISPLAY_INFO. */ #ifdef HAVE_WINDOW_SYSTEM #ifndef HAVE_ANDROID -# define MOUSE_HL_INFO(F) \ +# define MOUSE_HL_INFO(F) \ (FRAME_WINDOW_P (F) \ - ? &FRAME_DISPLAY_INFO(F)->mouse_highlight \ + ? &FRAME_DISPLAY_INFO (F)->mouse_highlight \ : &(F)->output_data.tty->display_info->mouse_highlight) #else /* There is no "struct tty_output" on Android at all. */ @@ -1176,9 +1166,6 @@ default_pixels_per_inch_y (void) && FRAME_X_VISIBLE (f))) #endif -/* True if frame F is currently visible but hidden. */ -#define FRAME_OBSCURED_P(f) ((f)->visible > 1) - /* True if frame F is currently iconified. */ #define FRAME_ICONIFIED_P(f) (f)->iconified @@ -1243,21 +1230,23 @@ default_pixels_per_inch_y (void) #define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT(f) ((void) (f), 0) #endif /* HAVE_WINDOW_SYSTEM */ -#if defined (HAVE_WINDOW_SYSTEM) +INLINE struct frame * +FRAME_PARENT_FRAME (struct frame *f) +{ + return NILP (f->parent_frame) ? NULL : XFRAME (f->parent_frame); +} + #define FRAME_UNDECORATED(f) ((f)->undecorated) + +#if defined (HAVE_WINDOW_SYSTEM) #ifdef HAVE_NTGUI #define FRAME_OVERRIDE_REDIRECT(f) ((void) (f), 0) #else #define FRAME_OVERRIDE_REDIRECT(f) ((f)->override_redirect) #endif -#define FRAME_PARENT_FRAME(f) \ - (NILP ((f)->parent_frame) \ - ? NULL \ - : XFRAME ((f)->parent_frame)) #define FRAME_SKIP_TASKBAR(f) ((f)->skip_taskbar) #define FRAME_NO_FOCUS_ON_MAP(f) ((f)->no_focus_on_map) #define FRAME_NO_ACCEPT_FOCUS(f) ((f)->no_accept_focus) -#define FRAME_NO_SPECIAL_GLYPHS(f) ((f)->no_special_glyphs) #define FRAME_Z_GROUP(f) ((f)->z_group) #define FRAME_Z_GROUP_NONE(f) ((f)->z_group == z_group_none) #define FRAME_Z_GROUP_ABOVE(f) ((f)->z_group == z_group_above) @@ -1270,13 +1259,10 @@ default_pixels_per_inch_y (void) #define FRAME_NS_TRANSPARENT_TITLEBAR(f) ((f)->ns_transparent_titlebar) #endif #else /* not HAVE_WINDOW_SYSTEM */ -#define FRAME_UNDECORATED(f) ((void) (f), 0) #define FRAME_OVERRIDE_REDIRECT(f) ((void) (f), 0) -#define FRAME_PARENT_FRAME(f) ((void) (f), NULL) #define FRAME_SKIP_TASKBAR(f) ((void) (f), 0) #define FRAME_NO_FOCUS_ON_MAP(f) ((void) (f), 0) #define FRAME_NO_ACCEPT_FOCUS(f) ((void) (f), 0) -#define FRAME_NO_SPECIAL_GLYPHS(f) ((void) (f), 0) #define FRAME_Z_GROUP(f) ((void) (f), z_group_none) #define FRAME_Z_GROUP_NONE(f) ((void) (f), true) #define FRAME_Z_GROUP_ABOVE(f) ((void) (f), false) @@ -1284,6 +1270,8 @@ default_pixels_per_inch_y (void) #define FRAME_TOOLTIP_P(f) ((void) f, false) #endif /* HAVE_WINDOW_SYSTEM */ +#define FRAME_NO_SPECIAL_GLYPHS(f) ((f)->no_special_glyphs) + /* Whether horizontal scroll bars are currently enabled for frame F. */ #if USE_HORIZONTAL_SCROLL_BARS #define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) \ @@ -1445,9 +1433,8 @@ extern bool frame_garbaged; if some changes were applied to it while it wasn't visible (and hence wasn't redisplayed). */ INLINE void -SET_FRAME_VISIBLE (struct frame *f, int v) +SET_FRAME_VISIBLE (struct frame *f, bool v) { - eassert (0 <= v && v <= 2); if (v) { if (v == 1 && f->visible != 1) @@ -1503,14 +1490,19 @@ extern struct frame *decode_live_frame (Lisp_Object); extern struct frame *decode_any_frame (Lisp_Object); extern struct frame *make_initial_frame (void); extern struct frame *make_frame (bool); +extern int tty_child_pos_param (struct frame *, Lisp_Object, + Lisp_Object, int); +extern int tty_child_size_param (struct frame *, Lisp_Object, + Lisp_Object, int); #ifdef HAVE_WINDOW_SYSTEM -extern struct frame *make_minibuffer_frame (void); -extern struct frame *make_frame_without_minibuffer (Lisp_Object, - struct kboard *, - Lisp_Object); extern bool display_available (void); #endif +struct frame *make_minibuffer_frame (void); +struct frame * +make_frame_without_minibuffer (Lisp_Object mini_window, + KBOARD *kb, Lisp_Object display); + INLINE bool window_system_available (struct frame *f) { @@ -1522,6 +1514,8 @@ window_system_available (struct frame *f) } extern WINDOW_SYSTEM_RETURN void check_window_system (struct frame *); +void check_tty (struct frame *f); +struct frame *decode_tty_frame (Lisp_Object frame); extern void frame_make_pointer_invisible (struct frame *); extern void frame_make_pointer_visible (struct frame *); extern Lisp_Object delete_frame (Lisp_Object, Lisp_Object); @@ -1617,15 +1611,11 @@ FRAME_CHILD_FRAME_BORDER_WIDTH (struct frame *f) INLINE int FRAME_INTERNAL_BORDER_WIDTH (struct frame *f) { -#ifdef HAVE_WINDOW_SYSTEM return (FRAME_PARENT_FRAME(f) ? (FRAME_CHILD_FRAME_BORDER_WIDTH(f) >= 0 ? FRAME_CHILD_FRAME_BORDER_WIDTH(f) : frame_dimension (f->internal_border_width)) : frame_dimension (f->internal_border_width)); -#else - return frame_dimension (f->internal_border_width); -#endif } /* Pixel-size of window divider lines. */ @@ -1880,7 +1870,6 @@ extern Lisp_Object gui_display_get_resource (Display_Info *, extern void set_frame_menubar (struct frame *f, bool deep_p); extern void frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y); extern void free_frame_menubar (struct frame *); -extern bool frame_ancestor_p (struct frame *af, struct frame *df); extern enum internal_border_part frame_internal_border_part (struct frame *f, int x, int y); #if defined HAVE_X_WINDOWS @@ -1907,6 +1896,8 @@ gui_set_bitmap_icon (struct frame *f) #endif /* !HAVE_NS */ #endif /* HAVE_WINDOW_SYSTEM */ +extern bool frame_ancestor_p (struct frame *af, struct frame *df); + INLINE void flush_frame (struct frame *f) { diff --git a/src/fringe.c b/src/fringe.c index 5ae7b52f7f8..5cd6ff5fc8d 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -1813,7 +1813,7 @@ init_fringe (void) fringe_bitmaps = xzalloc (max_fringe_bitmaps * sizeof *fringe_bitmaps); - verify (NIL_IS_ZERO); + static_assert (NIL_IS_ZERO); fringe_faces = xzalloc (max_fringe_bitmaps * sizeof *fringe_faces); } diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 808f5e7d9a6..42ee6c3e572 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -344,12 +344,20 @@ ftcrfont_close (struct font *font) ftcrfont_info->hb_font = NULL; } #endif - for (int i = 0; i < ftcrfont_info->metrics_nrows; i++) - if (ftcrfont_info->metrics[i]) - xfree (ftcrfont_info->metrics[i]); if (ftcrfont_info->metrics) - xfree (ftcrfont_info->metrics); - cairo_scaled_font_destroy (ftcrfont_info->cr_scaled_font); + { + for (int i = 0; i < ftcrfont_info->metrics_nrows; i++) + if (ftcrfont_info->metrics[i]) + xfree (ftcrfont_info->metrics[i]); + if (ftcrfont_info->metrics) + xfree (ftcrfont_info->metrics); + ftcrfont_info->metrics = NULL; + } + if (ftcrfont_info->cr_scaled_font) + { + cairo_scaled_font_destroy (ftcrfont_info->cr_scaled_font); + ftcrfont_info->cr_scaled_font = NULL; + } unblock_input (); } diff --git a/src/gmalloc.c b/src/gmalloc.c index 73b23950e84..3cb77b99997 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -62,7 +62,7 @@ extern void (*__MALLOC_HOOK_VOLATILE __malloc_initialize_hook) (void); grealloc... via the macros that follow). The dumped emacs, however, will use the system malloc, realloc.... In other source files, malloc, realloc... are renamed hybrid_malloc, - hybrid_realloc... via macros in conf_post.h. hybrid_malloc and + hybrid_realloc... via macros in lisp.h. hybrid_malloc and friends are wrapper functions defined later in this file. */ #undef malloc #undef realloc diff --git a/src/gnutls.c b/src/gnutls.c index 2098e97432d..b6aac944d4d 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1646,8 +1646,7 @@ string representation. */) emacs_gnutls_strerror (err)); } - Lisp_Object result = make_string_from_bytes ((char *) out.data, out.size, - out.size); + Lisp_Object result = make_unibyte_string ((char *) out.data, out.size); gnutls_free (out.data); gnutls_x509_crt_deinit (crt); diff --git a/src/gtkutil.c b/src/gtkutil.c index 655e838e745..0e9dd4dfe11 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -6081,13 +6081,13 @@ update_frame_tool_bar (struct frame *f) xg_pack_tool_bar (f, FRAME_TOOL_BAR_POSITION (f)); gtk_widget_show_all (x->toolbar_widget); if (xg_update_tool_bar_sizes (f)) - /* It's not entirely clear whether here we want a treatment - similar to that for frames with internal tool bar. */ - adjust_frame_size (f, -1, -1, 2, 0, Qtool_bar_lines); - - f->tool_bar_resized = f->tool_bar_redisplayed; + adjust_frame_size (f, -1, -1, 2, false, Qtool_bar_lines); } + /* Set this regardless of whether a tool bar was made or not. It's + needed for 'frame-inhibit-implied-resize' to work on GTK. */ + f->tool_bar_resized = true; + unblock_input (); } diff --git a/src/haikumenu.c b/src/haikumenu.c index 07231c3549f..acee8effe31 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -38,8 +38,6 @@ digest_menu_items (void *first_menu, int start, int menu_items_used, bool is_menu_bar) { void **menus, **panes; - ssize_t menu_len; - ssize_t pane_len; int i, menu_depth; void *menu, *window, *view; Lisp_Object pane_name, prefix; @@ -48,18 +46,18 @@ digest_menu_items (void *first_menu, int start, int menu_items_used, USE_SAFE_ALLOCA; - menu_len = (menu_items_used + 1 - start) * sizeof *menus; - pane_len = (menu_items_used + 1 - start) * sizeof *panes; + int menu_len = menu_items_used - start + 1; + int pane_len = menu_items_used - start + 1; menu = first_menu; i = start; menu_depth = 0; - menus = SAFE_ALLOCA (menu_len); - panes = SAFE_ALLOCA (pane_len); - memset (menus, 0, menu_len); - memset (panes, 0, pane_len); + SAFE_NALLOCA (menus, 1, menu_len); + SAFE_NALLOCA (panes, 1, pane_len); + memset (menus, 0, menu_len * sizeof *menus); menus[0] = first_menu; + memset (panes, 0, pane_len * sizeof *panes); window = NULL; view = NULL; @@ -393,8 +391,7 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags, view = FRAME_HAIKU_VIEW (f); i = 0; submenu_depth = 0; - subprefix_stack - = SAFE_ALLOCA (menu_items_used * sizeof (Lisp_Object)); + SAFE_NALLOCA (subprefix_stack, 1, menu_items_used); eassert (FRAME_HAIKU_P (f)); diff --git a/src/image.c b/src/image.c index b5b7de3351f..640e2a99904 100644 --- a/src/image.c +++ b/src/image.c @@ -19,9 +19,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> +#include <errno.h> #include <fcntl.h> #include <math.h> #include <unistd.h> +#include <stdlib.h> /* Include this before including <setjmp.h> to work around bugs with older libpng; see Bug#17429. */ @@ -63,11 +65,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include TERM_HEADER #endif /* HAVE_WINDOW_SYSTEM */ -/* Work around GCC bug 54561. */ -#if GNUC_PREREQ (4, 3, 0) -# pragma GCC diagnostic ignored "-Wclobbered" -#endif - #ifdef HAVE_X_WINDOWS typedef struct x_bitmap_record Bitmap_Record; #ifndef USE_CAIRO @@ -213,6 +210,9 @@ static void image_disable_image (struct frame *, struct image *); static void image_edge_detection (struct frame *, struct image *, Lisp_Object, Lisp_Object); +static double image_compute_scale (struct frame *f, Lisp_Object spec, + struct image *img); + static void init_color_table (void); static unsigned long lookup_rgb_color (struct frame *f, int r, int g, int b); #ifdef COLOR_TABLE_SUPPORT @@ -2225,9 +2225,12 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash, image spec specifies :background. However, the extra memory usage is probably negligible in practice, so we don't bother. */ + double scale = image_compute_scale (f, spec, NULL); + for (img = c->buckets[i]; img; img = img->next) if (img->hash == hash && !NILP (Fequal (img->spec, spec)) + && scale == img->scale && (ignore_colors || (img->face_foreground == foreground && img->face_background == background && img->face_font_size == font_size @@ -2670,18 +2673,15 @@ image_get_dimension (struct image *img, Lisp_Object symbol) return -1; } -/* Compute the desired size of an image with native size WIDTH x HEIGHT, - which is to be displayed on F. Use IMG to deduce the size. Store - the desired size into *D_WIDTH x *D_HEIGHT. Store -1 x -1 if the - native size is OK. */ - -static void -compute_image_size (struct frame *f, double width, double height, - struct image *img, - int *d_width, int *d_height) +/* Calculate the scale of the image. IMG may be null as it is only + required when creating an image, and this function is called from + image cache related functions that do not have access to the image + structure. */ +static double +image_compute_scale (struct frame *f, Lisp_Object spec, struct image *img) { double scale = 1; - Lisp_Object value = image_spec_value (img->spec, QCscale, NULL); + Lisp_Object value = image_spec_value (spec, QCscale, NULL); if (EQ (value, Qdefault)) { @@ -2695,7 +2695,9 @@ compute_image_size (struct frame *f, double width, double height, { /* This is a tag with which callers of `clear_image_cache' can refer to this image and its likenesses. */ - img->dependencies = Fcons (Qauto, img->dependencies); + if (img) + img->dependencies = Fcons (Qauto, img->dependencies); + scale = (FRAME_COLUMN_WIDTH (f) > 10 ? (FRAME_COLUMN_WIDTH (f) / 10.0f) : 1); } @@ -2719,6 +2721,24 @@ compute_image_size (struct frame *f, double width, double height, scale = dval; } + if (img) + img->scale = scale; + + return scale; +} + +/* Compute the desired size of an image with native size WIDTH x HEIGHT, + which is to be displayed on F. Use IMG to deduce the size. Store + the desired size into *D_WIDTH x *D_HEIGHT. Store -1 x -1 if the + native size is OK. */ + +static void +compute_image_size (struct frame *f, double width, double height, + struct image *img, + int *d_width, int *d_height) +{ + double scale = image_compute_scale(f, img->spec, img); + /* If width and/or height is set in the display spec assume we want to scale to those values. If either h or w is unspecified, the unspecified should be calculated from the specified to preserve @@ -3052,12 +3072,10 @@ image_set_transform (struct frame *f, struct image *img) flip = !NILP (image_spec_value (img->spec, QCflip, NULL)); # if defined USE_CAIRO || defined HAVE_XRENDER || defined HAVE_NS || defined HAVE_HAIKU \ - || defined HAVE_ANDROID + || defined HAVE_ANDROID || defined HAVE_NTGUI /* We want scale up operations to use a nearest neighbor filter to show real pixels instead of munging them, but scale down - operations to use a blended filter, to avoid aliasing and the like. - - TODO: implement for Windows. */ + operations to use a blended filter, to avoid aliasing and the like. */ bool smoothing; Lisp_Object s = image_spec_value (img->spec, QCtransform_smoothing, NULL); if (NILP (s)) @@ -3070,6 +3088,10 @@ image_set_transform (struct frame *f, struct image *img) img->use_bilinear_filtering = smoothing; #endif +#ifdef HAVE_NTGUI + img->smoothing = smoothing; +#endif + /* Perform scale transformation. */ matrix3x3 matrix @@ -3525,8 +3547,9 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id) img->face_font_size = font_size; img->face_font_height = face->font->height; img->face_font_width = face->font->average_width; - img->face_font_family = xmalloc (strlen (font_family) + 1); - strcpy (img->face_font_family, font_family); + size_t len = strlen (font_family) + 1; + img->face_font_family = xmalloc (len); + memcpy (img->face_font_family, font_family, len); img->load_failed_p = ! img->type->load_img (f, img); /* If we can't load the image, and we don't have a width and @@ -5539,15 +5562,13 @@ xpm_color_bucket (char *color_name) static struct xpm_cached_color * xpm_cache_color (struct frame *f, char *color_name, XColor *color, int bucket) { - size_t nbytes; - struct xpm_cached_color *p; - if (bucket < 0) bucket = xpm_color_bucket (color_name); - nbytes = FLEXSIZEOF (struct xpm_cached_color, name, strlen (color_name) + 1); - p = xmalloc (nbytes); - strcpy (p->name, color_name); + size_t len = strlen (color_name) + 1; + size_t nbytes = FLEXSIZEOF (struct xpm_cached_color, name, len); + struct xpm_cached_color *p = xmalloc (nbytes); + memcpy (p->name, color_name, len); p->color = *color; p->next = xpm_color_cache[bucket]; xpm_color_cache[bucket] = p; @@ -6244,14 +6265,32 @@ static const char xpm_color_key_strings[][4] = {"s", "m", "g4", "g", "c"}; static int xpm_str_to_color_key (const char *s) { - int i; - - for (i = 0; i < ARRAYELTS (xpm_color_key_strings); i++) + for (int i = 0; i < ARRAYELTS (xpm_color_key_strings); i++) if (strcmp (xpm_color_key_strings[i], s) == 0) return i; return -1; } +static int +xpm_str_to_int (char **buf) +{ + char *p; + + errno = 0; + long result = strtol (*buf, &p, 10); + if (errno || p == *buf || result < INT_MIN || result > INT_MAX) + return -1; + + /* Error out if we see something like "12x3xyz". */ + if (!c_isspace (*p) && *p != '\0') + return -1; + + /* Update position to read next integer. */ + *buf = p; + + return result; +} + static bool xpm_load_image (struct frame *f, struct image *img, @@ -6309,10 +6348,14 @@ xpm_load_image (struct frame *f, goto failure; memcpy (buffer, beg, len); buffer[len] = '\0'; - if (sscanf (buffer, "%d %d %d %d", &width, &height, - &num_colors, &chars_per_pixel) != 4 - || width <= 0 || height <= 0 - || num_colors <= 0 || chars_per_pixel <= 0) + char *next_int = buffer; + if ((width = xpm_str_to_int (&next_int)) <= 0) + goto failure; + if ((height = xpm_str_to_int (&next_int)) <= 0) + goto failure; + if ((num_colors = xpm_str_to_int (&next_int)) <= 0) + goto failure; + if ((chars_per_pixel = xpm_str_to_int (&next_int)) <= 0) goto failure; if (!check_image_size (f, width, height)) @@ -8191,7 +8234,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) bool transparent_p; struct png_memory_storage tbr; /* Data to be read */ ptrdiff_t nbytes; - Emacs_Pix_Container ximg, mask_img = NULL; + Emacs_Pix_Container ximg; /* Find out what file to load. */ specified_file = image_spec_value (img->spec, QCfile, NULL); @@ -8282,9 +8325,12 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) /* Set error jump-back. We come back here when the PNG library detects an error. */ + + struct png_load_context *volatile c_volatile = c; if (FAST_SETJMP (PNG_JMPBUF (png_ptr))) { error: + c = c_volatile; if (c->png_ptr) png_destroy_read_struct (&c->png_ptr, &c->info_ptr, &c->end_info); xfree (c->pixels); @@ -8294,6 +8340,13 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) return 0; } +#if GCC_LINT && __GNUC__ && !__clang__ + /* These useless assignments pacify GCC 14.2.1 x86-64 + <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=21161>. */ + c = c_volatile; + fp = c->fp; +#endif + /* Read image info. */ if (!NILP (specified_data)) png_set_read_fn (png_ptr, &tbr, png_read_from_memory); @@ -8420,6 +8473,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) /* Create an image and pixmap serving as mask if the PNG image contains an alpha channel. */ + Emacs_Pix_Container mask_img = NULL; if (channels == 4 && transparent_p && !image_create_x_image_and_pixmap (f, img, width, height, 1, @@ -8915,13 +8969,12 @@ jpeg_load_body (struct frame *f, struct image *img, struct my_jpeg_error_mgr *mgr) { Lisp_Object specified_file, specified_data; - FILE *volatile fp = NULL; + FILE *fp = NULL; JSAMPARRAY buffer; int row_stride, x, y; - int width, height; - int i, ir, ig, ib; - unsigned long *colors; - Emacs_Pix_Container ximg = NULL; + int width, height, ncomp; + int ir, ig, ib; + Emacs_Pix_Container volatile ximg_volatile = NULL; /* Open the JPEG file. */ specified_file = image_spec_value (img->spec, QCfile, NULL); @@ -8956,8 +9009,15 @@ jpeg_load_body (struct frame *f, struct image *img, error is detected. This function will perform a longjmp. */ mgr->cinfo.err = jpeg_std_error (&mgr->pub); mgr->pub.error_exit = my_error_exit; + struct my_jpeg_error_mgr *volatile mgr_volatile = mgr; + struct image *volatile img_volatile = img; + FILE *volatile fp_volatile = fp; if (sys_setjmp (mgr->setjmp_buffer)) { + mgr = mgr_volatile; + img = img_volatile; + fp = fp_volatile; + switch (mgr->failure_code) { case MY_JPEG_ERROR_EXIT: @@ -8983,6 +9043,7 @@ jpeg_load_body (struct frame *f, struct image *img, jpeg_destroy_decompress (&mgr->cinfo); /* If we already have an XImage, free that. */ + Emacs_Pix_Container ximg = ximg_volatile; if (ximg) image_destroy_x_image (ximg); /* Free pixmap and colors. */ @@ -8990,6 +9051,14 @@ jpeg_load_body (struct frame *f, struct image *img, return 0; } +#if GCC_LINT && __GNUC__ && !__clang__ + /* These useless assignments pacify GCC 14.2.1 x86-64 + <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=21161>. */ + mgr = mgr_volatile; + img = img_volatile; + fp = fp_volatile; +#endif + /* Create the JPEG decompression object. Let it read from fp. Read the JPEG image header. */ jpeg_CreateDecompress (&mgr->cinfo, JPEG_LIB_VERSION, sizeof *&mgr->cinfo); @@ -9002,12 +9071,17 @@ jpeg_load_body (struct frame *f, struct image *img, jpeg_read_header (&mgr->cinfo, 1); - /* Customize decompression so that color quantization will be used. - Start decompression. */ - mgr->cinfo.quantize_colors = 1; + /* Start decompression. */ jpeg_start_decompress (&mgr->cinfo); width = img->width = mgr->cinfo.output_width; height = img->height = mgr->cinfo.output_height; + ncomp = mgr->cinfo.output_components; + if (ncomp > 2) + ir = 0, ig = 1, ib = 2; + else if (ncomp > 1) + ir = 0, ig = 1, ib = 0; + else + ir = 0, ig = 0, ib = 0; if (!check_image_size (f, width, height)) { @@ -9016,61 +9090,44 @@ jpeg_load_body (struct frame *f, struct image *img, } /* Create X image and pixmap. */ - if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) + Emacs_Pix_Container ximg; + bool ximg_ok = image_create_x_image_and_pixmap (f, img, width, height, 0, + &ximg, 0); + ximg_volatile = ximg; + if (!ximg_ok) { mgr->failure_code = MY_JPEG_CANNOT_CREATE_X; sys_longjmp (mgr->setjmp_buffer, 1); } - /* Allocate colors. When color quantization is used, - mgr->cinfo.actual_number_of_colors has been set with the number of - colors generated, and mgr->cinfo.colormap is a two-dimensional array - of color indices in the range 0..mgr->cinfo.actual_number_of_colors. - No more than 255 colors will be generated. */ - USE_SAFE_ALLOCA; - { - if (mgr->cinfo.out_color_components > 2) - ir = 0, ig = 1, ib = 2; - else if (mgr->cinfo.out_color_components > 1) - ir = 0, ig = 1, ib = 0; - else - ir = 0, ig = 0, ib = 0; - - /* Use the color table mechanism because it handles colors that - cannot be allocated nicely. Such colors will be replaced with - a default color, and we don't have to care about which colors - can be freed safely, and which can't. */ - init_color_table (); - SAFE_NALLOCA (colors, 1, mgr->cinfo.actual_number_of_colors); - - for (i = 0; i < mgr->cinfo.actual_number_of_colors; ++i) - { - /* Multiply RGB values with 255 because X expects RGB values - in the range 0..0xffff. */ - int r = mgr->cinfo.colormap[ir][i] << 8; - int g = mgr->cinfo.colormap[ig][i] << 8; - int b = mgr->cinfo.colormap[ib][i] << 8; - colors[i] = lookup_rgb_color (f, r, g, b); - } - -#ifdef COLOR_TABLE_SUPPORT - /* Remember those colors actually allocated. */ - img->colors = colors_in_color_table (&img->ncolors); - free_color_table (); -#endif /* COLOR_TABLE_SUPPORT */ - } - - /* Read pixels. */ - row_stride = width * mgr->cinfo.output_components; + /* Allocate scanlines buffer and Emacs color table. */ + row_stride = width * ncomp; buffer = mgr->cinfo.mem->alloc_sarray ((j_common_ptr) &mgr->cinfo, JPOOL_IMAGE, row_stride, 1); + init_color_table (); + + /* Fill the X image from JPEG data. */ for (y = 0; y < height; ++y) { jpeg_read_scanlines (&mgr->cinfo, buffer, 1); - for (x = 0; x < mgr->cinfo.output_width; ++x) - PUT_PIXEL (ximg, x, y, colors[buffer[0][x]]); + for (x = 0; x < width; ++x) + { + int off = x * ncomp; + /* Multiply RGB values with 255 because X expects RGB values + in the range 0..0xffff. */ + int r = buffer[0][off + ir] << 8; + int g = buffer[0][off + ig] << 8; + int b = buffer[0][off + ib] << 8; + PUT_PIXEL (ximg, x, y, lookup_rgb_color (f, r, g, b)); + } } +#ifdef COLOR_TABLE_SUPPORT + /* Remember those colors actually allocated. */ + img->colors = colors_in_color_table (&img->ncolors); + free_color_table (); +#endif /* COLOR_TABLE_SUPPORT */ + /* Clean up. */ jpeg_finish_decompress (&mgr->cinfo); jpeg_destroy_decompress (&mgr->cinfo); @@ -9084,7 +9141,6 @@ jpeg_load_body (struct frame *f, struct image *img, /* Put ximg into the image. */ image_put_x_image (f, img, ximg, 0); - SAFE_FREE (); return 1; } @@ -10868,13 +10924,13 @@ static struct animation_cache *animation_cache = NULL; static struct animation_cache * imagemagick_create_cache (char *signature) { + size_t len = strlen (signature) + 1; struct animation_cache *cache - = xmalloc (FLEXSIZEOF (struct animation_cache, signature, - strlen (signature) + 1)); + = xmalloc (FLEXSIZEOF (struct animation_cache, signature, len)); cache->wand = 0; cache->index = 0; cache->next = 0; - strcpy (cache->signature, signature); + memcpy (cache->signature, signature, len); return cache; } diff --git a/src/insdel.c b/src/insdel.c index ea0a8976980..27d0d5d628c 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1929,10 +1929,10 @@ del_range_2 (ptrdiff_t from, ptrdiff_t from_byte, offset_intervals (current_buffer, from, - nchars_del); GAP_SIZE += nbytes_del; - ZV_BYTE -= nbytes_del; - Z_BYTE -= nbytes_del; ZV -= nchars_del; Z -= nchars_del; + ZV_BYTE -= nbytes_del; + Z_BYTE -= nbytes_del; GPT = from; GPT_BYTE = from_byte; if (GAP_SIZE > 0 && !current_buffer->text->inhibit_shrinking) diff --git a/src/itree.c b/src/itree.c index 3d480e5c2d6..3a91a7a534d 100644 --- a/src/itree.c +++ b/src/itree.c @@ -378,9 +378,9 @@ itree_inherit_offset (uintmax_t otick, struct itree_node *node) node->right->offset += node->offset; node->offset = 0; } - /* The only thing that matters about `otick` is whether it's equal to + /* The only thing that matters about 'otick' is whether it's equal to that of the tree. We could also "blindly" inherit from parent->otick, - but we need to tree's `otick` anyway for when there's no parent. */ + but we need to tree's 'otick' anyway for when there's no parent. */ if (node->parent == NULL || node->parent->otick == otick) node->otick = otick; } @@ -513,7 +513,7 @@ itree_size (struct itree_tree *tree) static void itree_rotate_left (struct itree_tree *tree, - struct itree_node *node) + struct itree_node *node) { eassert (node->right != NULL); @@ -556,7 +556,7 @@ itree_rotate_left (struct itree_tree *tree, static void itree_rotate_right (struct itree_tree *tree, - struct itree_node *node) + struct itree_node *node) { eassert (tree && node && node->left != NULL); @@ -595,7 +595,7 @@ itree_rotate_right (struct itree_tree *tree, static void itree_insert_fix (struct itree_tree *tree, - struct itree_node *node) + struct itree_node *node) { eassert (tree->root->red == false); @@ -683,7 +683,7 @@ itree_insert_node (struct itree_tree *tree, struct itree_node *node) struct itree_node *parent = NULL; struct itree_node *child = tree->root; uintmax_t otick = tree->otick; - /* It's the responsibility of the caller to set `otick` on the node, + /* It's the responsibility of the caller to set 'otick' on the node, to "confirm" that the begin/end fields are up to date. */ eassert (node->otick == otick); @@ -801,8 +801,8 @@ itree_subtree_min (uintmax_t otick, struct itree_node *node) static void itree_remove_fix (struct itree_tree *tree, - struct itree_node *node, - struct itree_node *parent) + struct itree_node *node, + struct itree_node *parent) { if (parent == NULL) eassert (node == tree->root); @@ -913,12 +913,12 @@ itree_total_offset (struct itree_node *node) link the tree root. Warning: DEST is left unmodified. SOURCE's child links are - unchanged. Caller is responsible for recalculation of `limit`. - Requires both nodes to be using the same effective `offset`. */ + unchanged. Caller is responsible for recalculation of 'limit'. + Requires both nodes to be using the same effective 'offset'. */ static void itree_replace_child (struct itree_tree *tree, - struct itree_node *source, - struct itree_node *dest) + struct itree_node *source, + struct itree_node *dest) { eassert (tree && dest != NULL); eassert (source == NULL @@ -939,12 +939,12 @@ itree_replace_child (struct itree_tree *tree, parent, left and right in surrounding nodes to point to SOURCE. Warning: DEST is left unmodified. Caller is responsible for - recalculation of `limit`. Requires both nodes to be using the same - effective `offset`. */ + recalculation of 'limit'. Requires both nodes to be using the same + effective 'offset'. */ static void itree_transplant (struct itree_tree *tree, - struct itree_node *source, - struct itree_node *dest) + struct itree_node *source, + struct itree_node *dest) { itree_replace_child (tree, source, dest); source->left = dest->left; @@ -964,38 +964,38 @@ itree_remove (struct itree_tree *tree, struct itree_node *node) eassert (itree_contains (tree, node)); eassert (check_tree (tree, true)); /* FIXME: Too expensive. */ - /* Find `splice`, the leaf node to splice out of the tree. When - `node` has at most one child this is `node` itself. Otherwise, - it is the in order successor of `node`. */ + /* Find 'splice', the leaf node to splice out of the tree. When + 'node' has at most one child this is 'node' itself. Otherwise, + it is the in order successor of 'node'. */ itree_inherit_offset (tree->otick, node); struct itree_node *splice = (node->left == NULL || node->right == NULL) ? node : itree_subtree_min (tree->otick, node->right); - /* Find `subtree`, the only child of `splice` (may be NULL). Note: - `subtree` will not be modified other than changing its parent to - `splice`. */ + /* Find 'subtree', the only child of 'splice' (may be NULL). Note: + 'subtree' will not be modified other than changing its parent to + 'splice'. */ eassert (splice->left == NULL || splice->right == NULL); struct itree_node *subtree = (splice->left != NULL) ? splice->left : splice->right; - /* Save a pointer to the parent of where `subtree` will eventually - be in `subtree_parent`. */ + /* Save a pointer to the parent of where 'subtree' will eventually + be in 'subtree_parent'. */ struct itree_node *subtree_parent = (splice->parent != node) ? splice->parent : splice; - /* If `splice` is black removing it may violate Red-Black + /* If 'splice' is black removing it may violate Red-Black invariants, so note this for later. */ - /* Replace `splice` with `subtree` under subtree's parent. If - `splice` is black, this creates a red-red violation, so remember + /* Replace 'splice' with 'subtree' under subtree's parent. If + 'splice' is black, this creates a red-red violation, so remember this now as the field can be overwritten when splice is transplanted below. */ itree_replace_child (tree, subtree, splice); bool removed_black = !splice->red; - /* Replace `node` with `splice` in the tree and propagate limit + /* Replace 'node' with 'splice' in the tree and propagate limit upwards, if necessary. Note: Limit propagation can stabilize at any point, so we must call from bottom to top for every node that has a new child. */ @@ -1054,8 +1054,8 @@ itree_insert_gap (struct itree_tree *tree, /* Nodes with front_advance starting at pos may mess up the tree order, so we need to remove them first. This doesn't apply for - `before_markers` since in that case, all positions move identically - regardless of `front_advance` or `rear_advance`. */ + 'before_markers' since in that case, all positions move identically + regardless of 'front_advance' or 'rear_advance'. */ struct itree_stack *saved = itree_stack_create (0); struct itree_node *node = NULL; if (!before_markers) @@ -1208,7 +1208,7 @@ itree_node_intersects (const struct itree_node *node, Note that this should return all the nodes that we need to traverse in order to traverse the nodes selected by the current narrowing (i.e. - `ITER->begin..ITER->end`) so it will also return some nodes which aren't in + 'ITER->begin..ITER->end') so it will also return some nodes which aren't in that narrowing simply because they may have children which are. The code itself is very unsatisfactory because the code of each one @@ -1221,8 +1221,8 @@ itree_iter_next_in_subtree (struct itree_node *node, struct itree_iterator *iter) { /* FIXME: Like in the previous version of the iterator, we - prune based on `limit` only when moving to a left child, - but `limit` can also get smaller when moving to a right child + prune based on 'limit' only when moving to a left child, + but 'limit' can also get smaller when moving to a right child It's actually fairly common, so maybe it would be worthwhile to prune a bit more aggressively here. */ struct itree_node *next; @@ -1304,7 +1304,7 @@ itree_iter_next_in_subtree (struct itree_node *node, return next; } } - } + } return NULL; case ITREE_POST_ORDER: @@ -1387,10 +1387,10 @@ itree_iterator_start (struct itree_iterator *iter, iter->end = end; iter->otick = tree->otick; iter->order = order; - /* Beware: the `node` field always holds "the next" node to consider. + /* Beware: the 'node' field always holds "the next" node to consider. so it's always "one node ahead" of what the iterator loop sees. In most respects this makes no difference, but we depend on this - detail in `delete_all_overlays` where this allows us to modify + detail in 'delete_all_overlays' where this allows us to modify the current node knowing that the iterator will not need it to find the next. */ iter->node = itree_iterator_first_node (tree, iter); diff --git a/src/itree.h b/src/itree.h index 66c25647206..1ff9a3c512b 100644 --- a/src/itree.h +++ b/src/itree.h @@ -41,7 +41,7 @@ INLINE_HEADER_BEGIN struct itree_node { /* The normal parent, left and right links found in binary trees. - See also `red`, below, which completes the Red-Black tree + See also 'red', below, which completes the Red-Black tree representation. */ struct itree_node *parent; struct itree_node *left; @@ -147,13 +147,13 @@ struct itree_iterator struct itree_node *node; ptrdiff_t begin; ptrdiff_t end; - uintmax_t otick; /* A copy of the tree's `otick`. */ + uintmax_t otick; /* A copy of the tree's 'otick'. */ enum itree_order order; }; /* Iterate over the intervals between BEG and END in the tree T. - N will hold successive nodes. ORDER can be one of : `ASCENDING`, - `DESCENDING`, `POST_ORDER`, or `PRE_ORDER`. + N will hold successive nodes. ORDER can be one of : 'ASCENDING', + 'DESCENDING', 'POST_ORDER', or 'PRE_ORDER'. It should be used as: ITREE_FOREACH (n, t, beg, end, order) @@ -167,12 +167,12 @@ struct itree_iterator - Don't modify the tree during the iteration. */ #define ITREE_FOREACH(n, t, beg, end, order) \ - /* FIXME: We'd want to declare `n` right here, but I can't figure out - how to make that work here: the `for` syntax only allows a single + /* FIXME: We'd want to declare 'n' right here, but I can't figure out + how to make that work here: the 'for' syntax only allows a single clause for the var declarations where we need 2 different types. - We could use the `struct {foo x; bar y; } p;` trick to declare two - vars `p.x` and `p.y` of unrelated types, but then none of the names - of the vars matches the `n` we receive :-(. */ \ + We could use the 'struct {foo x; bar y; } p;' trick to declare two + vars 'p.x' and 'p.y' of unrelated types, but then none of the names + of the vars matches the 'n' we receive :-(. */ \ if (!t) \ { } \ else \ diff --git a/src/json.c b/src/json.c index 2d3daee7836..4e156658ef7 100644 --- a/src/json.c +++ b/src/json.c @@ -1658,43 +1658,10 @@ json_parse_value (struct json_parser *parser, int c) } } -enum ParseEndBehavior - { - PARSEENDBEHAVIOR_CheckForGarbage, - PARSEENDBEHAVIOR_MovePoint - }; - static Lisp_Object -json_parse (struct json_parser *parser, - enum ParseEndBehavior parse_end_behavior) +json_parse (struct json_parser *parser) { - int c = json_skip_whitespace (parser); - - Lisp_Object result = json_parse_value (parser, c); - - switch (parse_end_behavior) - { - case PARSEENDBEHAVIOR_CheckForGarbage: - c = json_skip_whitespace_if_possible (parser); - if (c >= 0) - json_signal_error (parser, Qjson_trailing_content); - break; - case PARSEENDBEHAVIOR_MovePoint: - { - ptrdiff_t byte = (PT_BYTE + parser->input_current - parser->input_begin - + parser->additional_bytes_count); - ptrdiff_t position; - if (NILP (BVAR (current_buffer, enable_multibyte_characters))) - position = byte; - else - position = PT + parser->point_of_current_line + parser->current_column; - - SET_PT_BOTH (position, byte); - break; - } - } - - return result; + return json_parse_value (parser, json_skip_whitespace (parser)); } DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, @@ -1738,10 +1705,12 @@ usage: (json-parse-string STRING &rest ARGS) */) const unsigned char *begin = SDATA (string); json_parser_init (&p, conf, begin, begin + SBYTES (string), NULL, NULL); record_unwind_protect_ptr (json_parser_done, &p); + Lisp_Object result = json_parse (&p); - return unbind_to (count, - json_parse (&p, - PARSEENDBEHAVIOR_CheckForGarbage)); + if (json_skip_whitespace_if_possible (&p) >= 0) + json_signal_error (&p, Qjson_trailing_content); + + return unbind_to (count, result); } DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer, @@ -1799,9 +1768,17 @@ usage: (json-parse-buffer &rest args) */) json_parser_init (&p, conf, begin, end, secondary_begin, secondary_end); record_unwind_protect_ptr (json_parser_done, &p); + Lisp_Object result = json_parse (&p); + + ptrdiff_t byte = (PT_BYTE + p.input_current - p.input_begin + + p.additional_bytes_count); + ptrdiff_t position = (NILP (BVAR (current_buffer, + enable_multibyte_characters)) + ? byte + : PT + p.point_of_current_line + p.current_column); + SET_PT_BOTH (position, byte); - return unbind_to (count, - json_parse (&p, PARSEENDBEHAVIOR_MovePoint)); + return unbind_to (count, result); } void @@ -1841,16 +1818,6 @@ syms_of_json (void) define_error (Qjson_escape_sequence_error, "invalid escape sequence", Qjson_parse_error); - DEFSYM (Qpure, "pure"); - DEFSYM (Qside_effect_free, "side-effect-free"); - - DEFSYM (Qjson_serialize, "json-serialize"); - DEFSYM (Qjson_parse_string, "json-parse-string"); - Fput (Qjson_serialize, Qpure, Qt); - Fput (Qjson_serialize, Qside_effect_free, Qt); - Fput (Qjson_parse_string, Qpure, Qt); - Fput (Qjson_parse_string, Qside_effect_free, Qt); - DEFSYM (QCobject_type, ":object-type"); DEFSYM (QCarray_type, ":array-type"); DEFSYM (QCnull_object, ":null-object"); diff --git a/src/keyboard.c b/src/keyboard.c index ffb90c56f4a..f36243dd442 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -88,11 +88,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include TERM_HEADER #endif /* HAVE_WINDOW_SYSTEM */ -/* Work around GCC bug 54561. */ -#if GNUC_PREREQ (4, 3, 0) -# pragma GCC diagnostic ignored "-Wclobbered" -#endif - #ifdef WINDOWSNT char const DEV_TTY[] = "CONOUT$"; #else @@ -2522,7 +2517,7 @@ read_char (int commandflag, Lisp_Object map, Lisp_Object prev_event, bool *used_mouse_menu, struct timespec *end_time) { - volatile Lisp_Object c; + Lisp_Object c; sys_jmp_buf local_getcjmp; sys_jmp_buf save_jump; Lisp_Object tem, save; @@ -2668,8 +2663,7 @@ read_char (int commandflag, Lisp_Object map, swallow_events (false); /* May clear input_pending. */ /* Redisplay if no pending input. */ - while (!(input_pending - && (input_was_pending || !redisplay_dont_pause))) + while (!(input_pending && input_was_pending)) { input_was_pending = input_pending; if (help_echo_showing_p && !BASE_EQ (selected_window, minibuf_window)) @@ -2757,8 +2751,10 @@ read_char (int commandflag, Lisp_Object map, it *must not* be in effect when we call redisplay. */ specpdl_ref jmpcount = SPECPDL_INDEX (); + Lisp_Object volatile c_volatile = c; if (sys_setjmp (local_getcjmp)) { + c = c_volatile; /* Handle quits while reading the keyboard. */ /* We must have saved the outer value of getcjmp here, so restore it now. */ @@ -2803,6 +2799,12 @@ read_char (int commandflag, Lisp_Object map, goto non_reread; } +#if GCC_LINT && __GNUC__ && !__clang__ + /* This useless assignment pacifies GCC 14.2.1 x86-64 + <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=21161>. */ + c = c_volatile; +#endif + /* Start idle timers if no time limit is supplied. We don't do it if a time limit is supplied to avoid an infinite recursion in the situation where an idle timer calls `sit-for'. */ @@ -2964,6 +2966,8 @@ read_char (int commandflag, Lisp_Object map, } reread = true; } + + c_volatile = c; } /* Read something from current KBOARD's side queue, if possible. */ @@ -2975,6 +2979,7 @@ read_char (int commandflag, Lisp_Object map, if (!CONSP (KVAR (current_kboard, kbd_queue))) emacs_abort (); c = XCAR (KVAR (current_kboard, kbd_queue)); + c_volatile = c; kset_kbd_queue (current_kboard, XCDR (KVAR (current_kboard, kbd_queue))); if (NILP (KVAR (current_kboard, kbd_queue))) @@ -3030,6 +3035,8 @@ read_char (int commandflag, Lisp_Object map, c = XCDR (c); recorded = true; } + + c_volatile = c; } non_reread: @@ -3113,7 +3120,7 @@ read_char (int commandflag, Lisp_Object map, d = Faref (KVAR (current_kboard, Vkeyboard_translate_table), c); /* nil in keyboard-translate-table means no translation. */ if (!NILP (d)) - c = d; + c_volatile = c = d; } } @@ -3153,6 +3160,7 @@ read_char (int commandflag, Lisp_Object map, Vunread_command_events = Fcons (c, Vunread_command_events); } c = posn; + c_volatile = c; } } @@ -3278,6 +3286,7 @@ read_char (int commandflag, Lisp_Object map, } /* It returned one event or more. */ c = XCAR (tem); + c_volatile = c; Vunread_post_input_method_events = nconc2 (XCDR (tem), Vunread_post_input_method_events); } @@ -3352,6 +3361,7 @@ read_char (int commandflag, Lisp_Object map, do { c = read_char (0, Qnil, Qnil, 0, NULL); + c_volatile = c; if (EVENT_HAS_PARAMETERS (c) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_click)) XSETCAR (help_form_saved_window_configs, Qnil); @@ -3365,7 +3375,7 @@ read_char (int commandflag, Lisp_Object map, { cancel_echoing (); do - c = read_char (0, Qnil, Qnil, 0, NULL); + c_volatile = c = read_char (0, Qnil, Qnil, 0, NULL); while (BUFFERP (c)); } } @@ -4646,20 +4656,21 @@ timer_resume_idle (void) ...). Each element has the form (FUN . ARGS). */ Lisp_Object pending_funcalls; -/* Return true if TIMER is a valid timer, placing its value into *RESULT. */ -static bool -decode_timer (Lisp_Object timer, struct timespec *result) +/* Return the value of TIMER if it is a valid timer, an invalid struct + timespec otherwise. */ +static struct timespec +decode_timer (Lisp_Object timer) { Lisp_Object *vec; if (! (VECTORP (timer) && ASIZE (timer) == 10)) - return false; + return invalid_timespec (); vec = XVECTOR (timer)->contents; if (! NILP (vec[0])) - return false; + return invalid_timespec (); if (! FIXNUMP (vec[2])) - return false; - return list4_to_timespec (vec[1], vec[2], vec[3], vec[8], result); + return invalid_timespec (); + return list4_to_timespec (vec[1], vec[2], vec[3], vec[8]); } @@ -4678,15 +4689,6 @@ decode_timer (Lisp_Object timer, struct timespec *result) static struct timespec timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers) { - struct timespec nexttime; - struct timespec now; - struct timespec idleness_now; - Lisp_Object chosen_timer; - - nexttime = invalid_timespec (); - - chosen_timer = Qnil; - /* First run the code that was delayed. */ while (CONSP (pending_funcalls)) { @@ -4695,18 +4697,18 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers) safe_calln (Qapply, XCAR (funcall), XCDR (funcall)); } - if (CONSP (timers) || CONSP (idle_timers)) - { - now = current_timespec (); - idleness_now = (timespec_valid_p (timer_idleness_start_time) - ? timespec_sub (now, timer_idleness_start_time) - : make_timespec (0, 0)); - } + if (! (CONSP (timers) || CONSP (idle_timers))) + return invalid_timespec (); - while (CONSP (timers) || CONSP (idle_timers)) + struct timespec + now = current_timespec (), + idleness_now = (timespec_valid_p (timer_idleness_start_time) + ? timespec_sub (now, timer_idleness_start_time) + : make_timespec (0, 0)); + + do { - Lisp_Object timer = Qnil, idle_timer = Qnil; - struct timespec timer_time, idle_timer_time; + Lisp_Object chosen_timer, timer = Qnil, idle_timer = Qnil; struct timespec difference; struct timespec timer_difference = invalid_timespec (); struct timespec idle_timer_difference = invalid_timespec (); @@ -4720,7 +4722,8 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers) if (CONSP (timers)) { timer = XCAR (timers); - if (! decode_timer (timer, &timer_time)) + struct timespec timer_time = decode_timer (timer); + if (! timespec_valid_p (timer_time)) { timers = XCDR (timers); continue; @@ -4737,7 +4740,8 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers) if (CONSP (idle_timers)) { idle_timer = XCAR (idle_timers); - if (! decode_timer (idle_timer, &idle_timer_time)) + struct timespec idle_timer_time = decode_timer (idle_timer); + if (! timespec_valid_p (idle_timer_time)) { idle_timers = XCDR (idle_timers); continue; @@ -4808,8 +4812,7 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers) return 0 to indicate that. */ } - nexttime = make_timespec (0, 0); - break; + return make_timespec (0, 0); } else /* When we encounter a timer that is still waiting, @@ -4818,10 +4821,10 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers) return difference; } } + while (CONSP (timers) || CONSP (idle_timers)); /* No timers are pending in the future. */ - /* Return 0 if we generated an event, and -1 if not. */ - return nexttime; + return invalid_timespec (); } @@ -5411,7 +5414,7 @@ static const char *const lispy_kana_keys[] = /* You'll notice that this table is arranged to be conveniently indexed by X Windows keysym values. */ -#ifdef HAVE_NS +#if defined HAVE_NS || !defined HAVE_WINDOW_SYSTEM /* FIXME: Why are we using X11 keysym values for NS? */ static #endif @@ -7712,7 +7715,7 @@ This function potentially generates an artificial switch-frame event. */) if (!EQ (CAR_SAFE (event), Qfocus_in) || !CONSP (XCDR (event)) || !FRAMEP ((frame = XCAR (XCDR (event))))) - error ("invalid focus-in event"); + error ("Invalid focus-in event"); /* Conceptually, the concept of window manager focus on a particular frame and the Emacs selected frame shouldn't be related, but for diff --git a/src/keyboard.h b/src/keyboard.h index acfc9851206..c1bb966d485 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -497,8 +497,8 @@ INLINE void kbd_buffer_store_event_hold (struct input_event *event, struct input_event *hold_quit) { - verify (alignof (struct input_event) == alignof (union buffered_input_event) - && sizeof (struct input_event) == sizeof (union buffered_input_event)); + static_assert (alignof (struct input_event) == alignof (union buffered_input_event) + && sizeof (struct input_event) == sizeof (union buffered_input_event)); kbd_buffer_store_buffered_event ((union buffered_input_event *) event, hold_quit); } diff --git a/src/keymap.c b/src/keymap.c index 720eb5c32a4..c0f49a7c106 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -518,7 +518,7 @@ union map_keymap } s; GCALIGNED_UNION_MEMBER }; -verify (GCALIGNED (union map_keymap)); +static_assert (GCALIGNED (union map_keymap)); static void map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val) @@ -749,7 +749,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, def = Fcons (XCAR (def), XCDR (def)); if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap)) - error ("attempt to define a key in a non-keymap"); + error ("Attempt to define a key in a non-keymap"); /* If idx is a cons, and the car part is a character, idx must be of the form (FROM-CHAR . TO-CHAR). */ diff --git a/src/lisp.h b/src/lisp.h index 7ddde5071e8..e3142f3b8cc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -140,7 +140,7 @@ typedef unsigned char bits_word; # define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1) enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR }; #endif -verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1); +static_assert (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1); /* Use pD to format ptrdiff_t values, which suffice for indexes into buffers and strings. Emacs never allocates objects larger than @@ -281,14 +281,14 @@ 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 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 - requirement on the current platform. Types need this check if - their objects can be allocated outside the garbage collector. For - example, struct Lisp_Symbol needs the check because of lispsym and - struct Lisp_Cons needs it because of STACK_CONS. */ + 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 static_assert (GCALIGNED (T)) to verify the + requirement on the current platform. Types need this check if their + objects can be allocated outside the garbage collector. For example, + struct Lisp_Symbol needs the check because of lispsym and struct + Lisp_Cons needs it because of STACK_CONS. */ #define GCALIGNED_UNION_MEMBER char alignas (GCALIGNMENT) gcaligned; #if HAVE_STRUCT_ATTRIBUTE_ALIGNED @@ -865,7 +865,7 @@ struct Lisp_Symbol GCALIGNED_UNION_MEMBER } u; }; -verify (GCALIGNED (struct Lisp_Symbol)); +static_assert (GCALIGNED (struct Lisp_Symbol)); /* Declare a Lisp-callable function. The MAXARGS parameter has the same meaning as in the DEFUN macro, and is used to construct a prototype. */ @@ -1120,8 +1120,8 @@ SYMBOLP (Lisp_Object x) INLINE struct Lisp_Symbol_With_Pos * XSYMBOL_WITH_POS (Lisp_Object a) { - eassert (SYMBOL_WITH_POS_P (a)); - return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); + eassert (SYMBOL_WITH_POS_P (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); } INLINE Lisp_Object @@ -1353,10 +1353,10 @@ INLINE bool INLINE bool EQ (Lisp_Object x, Lisp_Object y) { - return BASE_EQ ((symbols_with_pos_enabled && SYMBOL_WITH_POS_P (x) - ? XSYMBOL_WITH_POS_SYM (x) : x), - (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (y) - ? XSYMBOL_WITH_POS_SYM (y) : y)); + return BASE_EQ ((__builtin_expect (symbols_with_pos_enabled, false) + && SYMBOL_WITH_POS_P (x) ? XSYMBOL_WITH_POS_SYM (x) : x), + (__builtin_expect (symbols_with_pos_enabled, false) + && SYMBOL_WITH_POS_P (y) ? XSYMBOL_WITH_POS_SYM (y) : y)); } INLINE intmax_t @@ -1480,7 +1480,7 @@ struct Lisp_Cons GCALIGNED_UNION_MEMBER } u; }; -verify (GCALIGNED (struct Lisp_Cons)); +static_assert (GCALIGNED (struct Lisp_Cons)); INLINE bool (NILP) (Lisp_Object x) @@ -1610,7 +1610,7 @@ struct Lisp_String GCALIGNED_UNION_MEMBER } u; }; -verify (GCALIGNED (struct Lisp_String)); +static_assert (GCALIGNED (struct Lisp_String)); INLINE bool STRINGP (Lisp_Object x) @@ -1840,7 +1840,7 @@ struct Lisp_Bool_Vector /* HEADER.SIZE is the vector's size field. It doesn't have the real size, just the subtype information. */ union vectorlike_header header; - /* This is the size in bits. */ + /* The size in bits; at most BOOL_VECTOR_LENGTH_MAX. */ EMACS_INT size; /* The actual bits, packed into bytes. Zeros fill out the last word if needed. @@ -1868,20 +1868,32 @@ enum word_size = sizeof (Lisp_Object) }; +/* A bool vector's length must be a fixnum for XFIXNUM (Flength (...)). + Also, it is limited object size, which must fit in both ptrdiff_t and + size_t including header overhead and trailing alignment. */ +#define BOOL_VECTOR_LENGTH_MAX \ + min (MOST_POSITIVE_FIXNUM, \ + ((INT_MULTIPLY_OVERFLOW (min (PTRDIFF_MAX, SIZE_MAX) - bool_header_size,\ + (EMACS_INT) BOOL_VECTOR_BITS_PER_CHAR) \ + ? EMACS_INT_MAX \ + : ((min (PTRDIFF_MAX, SIZE_MAX) - bool_header_size) \ + * (EMACS_INT) BOOL_VECTOR_BITS_PER_CHAR)) \ + - (BITS_PER_BITS_WORD - 1))) + /* The number of data words and bytes in a bool vector with SIZE bits. */ INLINE EMACS_INT bool_vector_words (EMACS_INT size) { eassume (0 <= size && size <= EMACS_INT_MAX - (BITS_PER_BITS_WORD - 1)); - return (size + BITS_PER_BITS_WORD - 1) / BITS_PER_BITS_WORD; + return (size + (BITS_PER_BITS_WORD - 1)) / BITS_PER_BITS_WORD; } INLINE EMACS_INT bool_vector_bytes (EMACS_INT size) { eassume (0 <= size && size <= EMACS_INT_MAX - (BITS_PER_BITS_WORD - 1)); - return (size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR; + return (size + (BOOL_VECTOR_BITS_PER_CHAR - 1)) / BOOL_VECTOR_BITS_PER_CHAR; } INLINE bits_word @@ -2013,10 +2025,11 @@ gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) } /* True, since Qnil's representation is zero. Every place in the code - that assumes Qnil is zero should verify (NIL_IS_ZERO), to make it easy - to find such assumptions later if we change Qnil to be nonzero. - Test iQnil and Lisp_Symbol instead of Qnil directly, since the latter - is not suitable for use in an integer constant expression. */ + that assumes Qnil is zero should static_assert (NIL_IS_ZERO), to make + it easy to find such assumptions later if we change Qnil to be + nonzero. Test iQnil and Lisp_Symbol instead of Qnil directly, since + the latter is not suitable for use in an integer constant + expression. */ enum { NIL_IS_ZERO = iQnil == 0 && Lisp_Symbol == 0 }; /* Clear the object addressed by P, with size NBYTES, so that all its @@ -2025,7 +2038,7 @@ INLINE void memclear (void *p, ptrdiff_t nbytes) { eassert (0 <= nbytes); - verify (NIL_IS_ZERO); + static_assert (NIL_IS_ZERO); /* Since Qnil is zero, memset suffices. */ memset (p, 0, nbytes); } @@ -2215,6 +2228,9 @@ struct Lisp_Subr Lisp_Object native; } intspec; Lisp_Object command_modes; + /* Positive values: offset into etc/DOC. Negative values: one's + complement of index into the native comp unit's vector of + documentation strings. */ EMACS_INT doc; #ifdef HAVE_NATIVE_COMP Lisp_Object native_comp_u; @@ -2228,7 +2244,7 @@ union Aligned_Lisp_Subr struct Lisp_Subr s; GCALIGNED_UNION_MEMBER }; -verify (GCALIGNED (union Aligned_Lisp_Subr)); +static_assert (GCALIGNED (union Aligned_Lisp_Subr)); INLINE bool SUBRP (Lisp_Object a) @@ -2269,11 +2285,11 @@ enum char_table_specials }; /* Sanity-check pseudovector layout. */ -verify (offsetof (struct Lisp_Char_Table, defalt) == header_size); -verify (offsetof (struct Lisp_Char_Table, extras) - == header_size + CHAR_TABLE_STANDARD_SLOTS * sizeof (Lisp_Object)); -verify (offsetof (struct Lisp_Sub_Char_Table, contents) - == header_size + SUB_CHAR_TABLE_OFFSET * sizeof (Lisp_Object)); +static_assert (offsetof (struct Lisp_Char_Table, defalt) == header_size); +static_assert (offsetof (struct Lisp_Char_Table, extras) + == header_size + CHAR_TABLE_STANDARD_SLOTS * sizeof (Lisp_Object)); +static_assert (offsetof (struct Lisp_Sub_Char_Table, contents) + == header_size + SUB_CHAR_TABLE_OFFSET * sizeof (Lisp_Object)); /* Return the number of "extra" slots in the char table CT. */ @@ -2807,7 +2823,7 @@ SXHASH_REDUCE (EMACS_UINT x) INLINE hash_hash_t reduce_emacs_uint_to_hash_hash (EMACS_UINT x) { - verify (sizeof x <= 2 * sizeof (hash_hash_t)); + static_assert (sizeof x <= 2 * sizeof (hash_hash_t)); return (sizeof x == sizeof (hash_hash_t) ? x : x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t))))); @@ -3202,7 +3218,7 @@ struct Lisp_Float GCALIGNED_UNION_MEMBER } u; }; -verify (GCALIGNED (struct Lisp_Float)); +static_assert (GCALIGNED (struct Lisp_Float)); INLINE bool (FLOATP) (Lisp_Object x) @@ -3839,9 +3855,6 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) All the other members are concerned with restoring the interpreter state. - Members are volatile if their values need to survive _longjmp when - a 'struct handler' is a local variable. - When running the HANDLER of a 'handler-bind', we need to temporarily "mute" the CONDITION_CASEs and HANDLERs that are "below" the current handler, but without hiding any CATCHERs. We do that by @@ -4192,7 +4205,7 @@ modiff_incr (modiff_count *a, ptrdiff_t len) /* Increase the counter more for a large modification and less for a small modification. Increase it logarithmically to avoid increasing it too much. */ - verify (PTRDIFF_MAX <= ULLONG_MAX); + static_assert (PTRDIFF_MAX <= ULLONG_MAX); int incr = len == 0 ? 1 : elogb (len) + 1; bool modiff_overflow = ckd_add (a, a0, incr); eassert (!modiff_overflow && *a >> 30 >> 30 == 0); @@ -4212,16 +4225,21 @@ extern void notify_variable_watchers (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object indirect_function (Lisp_Object); extern Lisp_Object find_symbol_value (Lisp_Object); -enum Arith_Comparison { - ARITH_EQUAL, - ARITH_NOTEQUAL, - ARITH_LESS, - ARITH_GRTR, - ARITH_LESS_OR_EQUAL, - ARITH_GRTR_OR_EQUAL + +enum { + Cmp_Bit_EQ, + Cmp_Bit_LT, + Cmp_Bit_GT }; -extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, - enum Arith_Comparison comparison); + +/* code indicating a comparison outcome */ +typedef enum { + Cmp_EQ = 1 << Cmp_Bit_EQ, /* = */ + Cmp_LT = 1 << Cmp_Bit_LT, /* < */ + Cmp_GT = 1 << Cmp_Bit_GT /* > */ +} cmp_bits_t; + +extern cmp_bits_t arithcompare (Lisp_Object num1, Lisp_Object num2); /* Convert the Emacs representation CONS back to an integer of type TYPE, storing the result the variable VAR. Signal an error if CONS @@ -4325,6 +4343,7 @@ extern Lisp_Object plist_put (Lisp_Object plist, Lisp_Object prop, extern Lisp_Object plist_member (Lisp_Object plist, Lisp_Object prop); extern void syms_of_fns (void); extern void mark_fns (void); +Lisp_Object memq_no_quit (Lisp_Object elt, Lisp_Object list); /* Defined in sort.c */ extern void tim_sort (Lisp_Object, Lisp_Object, Lisp_Object *, const ptrdiff_t, @@ -4332,7 +4351,7 @@ extern void tim_sort (Lisp_Object, Lisp_Object, Lisp_Object *, const ptrdiff_t, ARG_NONNULL ((3)); /* Defined in floatfns.c. */ -verify (FLT_RADIX == 2 || FLT_RADIX == 16); +static_assert (FLT_RADIX == 2 || FLT_RADIX == 16); enum { LOG2_FLT_RADIX = FLT_RADIX == 2 ? 1 : 4 }; int double_integer_scale (double); #ifndef HAVE_TRUNC @@ -4578,6 +4597,7 @@ list4i (intmax_t a, intmax_t b, intmax_t c, intmax_t d) return list4 (make_int (a), make_int (b), make_int (c), make_int (d)); } +extern Lisp_Object make_clear_bool_vector (EMACS_INT, bool); extern Lisp_Object make_uninit_bool_vector (EMACS_INT); extern Lisp_Object bool_vector_fill (Lisp_Object, Lisp_Object); extern AVOID string_overflow (void); @@ -4850,6 +4870,7 @@ extern AVOID xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID signal_error (const char *, Lisp_Object); extern AVOID overflow_error (void); +extern void define_error (Lisp_Object name, const char *message, Lisp_Object parent); extern bool FUNCTIONP (Lisp_Object); extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector); extern Lisp_Object eval_sub (Lisp_Object form); @@ -4913,10 +4934,45 @@ Lisp_Object funcall_general (Lisp_Object fun, /* Defined in unexmacosx.c. */ #if defined DARWIN_OS && defined HAVE_UNEXEC +/* Redirect calls to malloc, realloc and free to a macOS zone memory allocator. + FIXME: Either also redirect unexec_aligned_alloc and unexec_calloc, + or fix this comment to explain why those two redirections are not needed. */ extern void unexec_init_emacs_zone (void); extern void *unexec_malloc (size_t); extern void *unexec_realloc (void *, size_t); extern void unexec_free (void *); +# ifndef UNEXMACOSX_C +# include <stdlib.h> +# undef malloc +# undef realloc +# undef free +# define malloc unexec_malloc +# define realloc unexec_realloc +# define free unexec_free +# endif +#endif + +/* Defined in gmalloc.c. */ +#ifdef HYBRID_MALLOC +/* Redirect calls to malloc and friends to a hybrid allocator that + uses gmalloc before dumping and the system malloc after dumping. + This can be useful on Cygwin, for example. */ +extern void *hybrid_aligned_alloc (size_t, size_t); +extern void *hybrid_calloc (size_t, size_t); +extern void *hybrid_malloc (size_t); +extern void *hybrid_realloc (void *, size_t); +extern void hybrid_free (void *); +# include <stdlib.h> +# undef aligned_alloc +# undef calloc +# undef malloc +# undef realloc +# undef free +# define aligned_alloc hybrid_aligned_alloc +# define calloc hybrid_calloc +# define malloc hybrid_malloc +# define realloc hybrid_realloc +# define free hybrid_free #endif /* The definition of Lisp_Module_Function depends on emacs-module.h, @@ -5190,15 +5246,9 @@ extern AVOID terminate_due_to_signal (int, int); #ifdef WINDOWSNT extern Lisp_Object Vlibrary_cache; #endif -#if HAVE_SETLOCALE void fixup_locale (void); void synchronize_system_messages_locale (void); void synchronize_system_time_locale (void); -#else -INLINE void fixup_locale (void) {} -INLINE void synchronize_system_messages_locale (void) {} -INLINE void synchronize_system_time_locale (void) {} -#endif extern char *emacs_strerror (int) ATTRIBUTE_RETURNS_NONNULL; extern void shut_down_emacs (int, Lisp_Object); @@ -5929,11 +5979,6 @@ maybe_gc (void) maybe_garbage_collect (); } -/* Simplified version of 'define-error' that works with pure - objects. */ -void -define_error (Lisp_Object name, const char *message, Lisp_Object parent); - INLINE_HEADER_END #endif /* EMACS_LISP_H */ diff --git a/src/lread.c b/src/lread.c index 1d41a9d5cf4..ab900b3bee6 100644 --- a/src/lread.c +++ b/src/lread.c @@ -28,6 +28,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <sys/stat.h> #include <sys/file.h> #include <errno.h> +#include <locale.h> #include <math.h> #include <stat-time.h> #include "lisp.h" @@ -55,11 +56,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #endif #include <unistd.h> - -#ifdef HAVE_SETLOCALE -#include <locale.h> -#endif /* HAVE_SETLOCALE */ - #include <fcntl.h> #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY \ @@ -966,7 +962,7 @@ floating-point value. If `inhibit-interaction' is non-nil, this function will signal an `inhibited-interaction' error. */) -(Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds) + (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds) { Lisp_Object val; @@ -3575,7 +3571,7 @@ string_props_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun) static Lisp_Object read_bool_vector (Lisp_Object readcharfun) { - ptrdiff_t length = 0; + EMACS_INT length = 0; for (;;) { int c = READCHAR; @@ -3589,6 +3585,8 @@ read_bool_vector (Lisp_Object readcharfun) || ckd_add (&length, length, c - '0')) invalid_syntax ("#&", readcharfun); } + if (BOOL_VECTOR_LENGTH_MAX < length) + invalid_syntax ("#&", readcharfun); ptrdiff_t size_in_chars = bool_vector_bytes (length); Lisp_Object str = read_string_literal (readcharfun); @@ -3651,7 +3649,7 @@ skip_lazy_string (Lisp_Object readcharfun) and record where in the file it comes from. */ /* First exchange the two saved_strings. */ - verify (ARRAYELTS (saved_strings) == 2); + static_assert (ARRAYELTS (saved_strings) == 2); struct saved_string t = saved_strings[0]; saved_strings[0] = saved_strings[1]; saved_strings[1] = t; @@ -5034,8 +5032,8 @@ it defaults to the value of `obarray'. */) { if (longhand) { - tem = intern_driver (make_specified_string (longhand, longhand_chars, - longhand_bytes, true), + tem = intern_driver (make_multibyte_string (longhand, longhand_chars, + longhand_bytes), obarray, tem); xfree (longhand); } @@ -5087,13 +5085,12 @@ it defaults to the value of `obarray'. */) } } -DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0, +DEFUN ("unintern", Funintern, Sunintern, 2, 2, 0, doc: /* Delete the symbol named NAME, if any, from OBARRAY. The value is t if a symbol was found and deleted, nil otherwise. NAME may be a string or a symbol. If it is a symbol, that symbol is deleted, if it belongs to OBARRAY--no other symbol is deleted. -OBARRAY, if nil, defaults to the value of the variable `obarray'. -usage: (unintern NAME OBARRAY) */) +OBARRAY, if nil, defaults to the value of the variable `obarray'. */) (Lisp_Object name, Lisp_Object obarray) { register Lisp_Object tem; diff --git a/src/marker.c b/src/marker.c index cfdbd80bdbb..4ab68ec7bbe 100644 --- a/src/marker.c +++ b/src/marker.c @@ -202,19 +202,15 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos) if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff) CONSIDER (cached_charpos, cached_bytepos); - for (tail = BUF_MARKERS (b); tail; tail = tail->next) - { - CONSIDER (tail->charpos, tail->bytepos); - - /* If we are down to a range of 50 chars, - don't bother checking any other markers; - scan the intervening chars directly now. */ - if (best_above - charpos < distance - || charpos - best_below < distance) - break; - else - distance += BYTECHAR_DISTANCE_INCREMENT; - } + for (tail = BUF_MARKERS (b); + /* If we are down to a range of DISTANCE chars, + don't bother checking any other markers; + scan the intervening chars directly now. */ + tail && !(best_above - charpos < distance + || charpos - best_below < distance); + tail = tail->next, + distance += BYTECHAR_DISTANCE_INCREMENT) + CONSIDER (tail->charpos, tail->bytepos); /* We get here if we did not exactly hit one of the known places. We have one known above and one known below. @@ -354,19 +350,15 @@ buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos) if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff) CONSIDER (cached_bytepos, cached_charpos); - for (tail = BUF_MARKERS (b); tail; tail = tail->next) - { - CONSIDER (tail->bytepos, tail->charpos); - - /* If we are down to a range of DISTANCE bytes, - don't bother checking any other markers; - scan the intervening chars directly now. */ - if (best_above_byte - bytepos < distance - || bytepos - best_below_byte < distance) - break; - else - distance += BYTECHAR_DISTANCE_INCREMENT; - } + for (tail = BUF_MARKERS (b); + /* If we are down to a range of DISTANCE bytes, + don't bother checking any other markers; + scan the intervening chars directly now. */ + tail && !(best_above_byte - bytepos < distance + || bytepos - best_below_byte < distance); + tail = tail->next, + distance += BYTECHAR_DISTANCE_INCREMENT) + CONSIDER (tail->bytepos, tail->charpos); /* We get here if we did not exactly hit one of the known places. We have one known above and one known below. diff --git a/src/menu.c b/src/menu.c index 8623fe9330d..0293328c832 100644 --- a/src/menu.c +++ b/src/menu.c @@ -1594,9 +1594,10 @@ for instance using the window manager, then this produces a quit and Lisp_Object selection = FRAME_TERMINAL (f)->popup_dialog_hook (f, header, contents); #ifdef HAVE_NTGUI - /* NTGUI supports only simple dialogs with Yes/No choices. For - other dialogs, it returns the symbol 'unsupported--w32-dialog', - as a signal for the caller to fall back to the emulation code. */ + /* NTGUI on Windows versions before Vista supports only simple + dialogs with Yes/No choices. For other dialogs, it returns the + symbol 'unsupported--w32-dialog', as a signal for the caller to + fall back to the emulation code. */ if (!EQ (selection, Qunsupported__w32_dialog)) #endif return selection; diff --git a/src/minibuf.c b/src/minibuf.c index bf9fad48d88..bbbc4399ab0 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -160,16 +160,15 @@ zip_minibuffer_stacks (Lisp_Object dest_window, Lisp_Object source_window) set_window_buffer (dest_window, sw->contents, 0, 0); Fset_window_start (dest_window, Fwindow_start (source_window), Qnil); Fset_window_point (dest_window, Fwindow_point (source_window)); - dw->prev_buffers = sw->prev_buffers; + wset_prev_buffers (dw, sw->prev_buffers); set_window_buffer (source_window, nth_minibuffer (0), 0, 0); - sw->prev_buffers = Qnil; + wset_prev_buffers (sw, Qnil); return; } - if (live_minibuffer_p (dw->contents)) - call1 (Qpush_window_buffer_onto_prev, dest_window); - if (live_minibuffer_p (sw->contents)) - call1 (Qpush_window_buffer_onto_prev, source_window); + call1 (Qrecord_window_buffer, dest_window); + call1 (Qrecord_window_buffer, source_window); + acc = merge_c (dw->prev_buffers, sw->prev_buffers, minibuffer_ent_greater); if (!NILP (acc)) @@ -180,8 +179,9 @@ zip_minibuffer_stacks (Lisp_Object dest_window, Lisp_Object source_window) Fset_window_start (dest_window, Fcar (Fcdr (d_ent)), Qnil); Fset_window_point (dest_window, Fcar (Fcdr (Fcdr (d_ent)))); } - dw->prev_buffers = acc; - sw->prev_buffers = Qnil; + + wset_prev_buffers (dw, acc); + wset_prev_buffers (sw, Qnil); set_window_buffer (source_window, nth_minibuffer (0), 0, 0); } @@ -688,8 +688,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Fframe_first_window (MB_frame), Qnil); } MB_frame = XWINDOW (XFRAME (selected_frame)->minibuffer_window)->frame; - if (live_minibuffer_p (XWINDOW (minibuf_window)->contents)) - call1 (Qpush_window_buffer_onto_prev, minibuf_window); + + call1 (Qrecord_window_buffer, minibuf_window); record_unwind_protect_void (minibuffer_unwind); if (read_minibuffer_restore_windows) @@ -913,7 +913,11 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, XWINDOW (minibuf_window)->cursor.hpos = 0; XWINDOW (minibuf_window)->cursor.x = 0; XWINDOW (minibuf_window)->must_be_updated_p = true; - update_frame (XFRAME (selected_frame), true, true); + struct frame *sf = XFRAME (selected_frame); + update_frame (sf, true); + if (is_tty_frame (sf)) + combine_updates_for_frame (sf, true); + #ifndef HAVE_NTGUI flush_frame (XFRAME (XWINDOW (minibuf_window)->frame)); #else @@ -1826,7 +1830,7 @@ or from one of the possible completions. */) return Fsubstring (bestmatch, zero, end); } -DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0, +DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 3, 0, doc: /* Search for partial matches of STRING in COLLECTION. Test each possible completion specified by COLLECTION @@ -1859,12 +1863,8 @@ the string key and the associated value. To be acceptable, a possible completion must also match all the regexps in `completion-regexp-list' (unless COLLECTION is a function, in -which case that function should itself handle `completion-regexp-list'). - -An obsolete optional fourth argument HIDE-SPACES is still accepted for -backward compatibility. If non-nil, strings in COLLECTION that start -with a space are ignored unless STRING itself starts with a space. */) - (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate, Lisp_Object hide_spaces) +which case that function should itself handle `completion-regexp-list'). */) + (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { Lisp_Object tail, elt, eltstring; Lisp_Object allmatches; @@ -1932,12 +1932,6 @@ with a space are ignored unless STRING itself starts with a space. */) if (STRINGP (eltstring) && SCHARS (string) <= SCHARS (eltstring) - /* If HIDE_SPACES, reject alternatives that start with space - unless the input starts with space. */ - && (NILP (hide_spaces) - || (SBYTES (string) > 0 - && SREF (string, 0) == ' ') - || SREF (eltstring, 0) != ' ') && (tem = Fcompare_strings (eltstring, zero, make_fixnum (SCHARS (string)), string, zero, @@ -2160,7 +2154,7 @@ If FLAG is nil, invoke `try-completion'; if it is t, invoke return Ftry_completion (string, Vbuffer_alist, predicate); else if (EQ (flag, Qt)) { - Lisp_Object res = Fall_completions (string, Vbuffer_alist, predicate, Qnil); + Lisp_Object res = Fall_completions (string, Vbuffer_alist, predicate); if (SCHARS (string) > 0) return res; else diff --git a/src/module-env-30.h b/src/module-env-30.h index e75210c7f8e..e69de29bb2d 100644 --- a/src/module-env-30.h +++ b/src/module-env-30.h @@ -1,3 +0,0 @@ - /* Add module environment functions newly added in Emacs 30 here. - Before Emacs 30 is released, remove this comment and start - module-env-31.h on the master branch. */ diff --git a/src/module-env-31.h b/src/module-env-31.h new file mode 100644 index 00000000000..e9827b18382 --- /dev/null +++ b/src/module-env-31.h @@ -0,0 +1,3 @@ + /* Add module environment functions newly added in Emacs 31 here. + Before Emacs 31 is released, remove this comment and start + module-env-32.h on the master branch. */ diff --git a/src/msdos.c b/src/msdos.c index b01ea0ee13b..6ee35b9e853 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -237,11 +237,12 @@ static void mouse_get_xy (int *x, int *y) { union REGS regs; + struct frame *f = SELECTED_FRAME (); regs.x.ax = 0x0003; int86 (0x33, ®s, ®s); - *x = regs.x.cx / 8; - *y = regs.x.dx / 8; + *x = (regs.x.cx / 8) - f->left_pos; + *y = (regs.x.dx / 8) - f->top_pos; } void @@ -249,12 +250,15 @@ mouse_moveto (int x, int y) { union REGS regs; struct tty_display_info *tty = CURTTY (); + struct frame *f = SELECTED_FRAME (); if (tty->termscript) fprintf (tty->termscript, "<M_XY=%dx%d>", x, y); regs.x.ax = 0x0004; mouse_last_x = regs.x.cx = x * 8; mouse_last_y = regs.x.dx = y * 8; + regs.x.cx += f->left_pos * 8; + regs.x.dx += f->top_pos * 8; int86 (0x33, ®s, ®s); } @@ -262,6 +266,7 @@ static int mouse_pressed (int b, int *xp, int *yp) { union REGS regs; + struct frame *f = SELECTED_FRAME (); if (b >= mouse_button_count) return 0; @@ -269,7 +274,10 @@ mouse_pressed (int b, int *xp, int *yp) regs.x.bx = mouse_button_translate[b]; int86 (0x33, ®s, ®s); if (regs.x.bx) - *xp = regs.x.cx / 8, *yp = regs.x.dx / 8; + { + *xp = regs.x.cx / 8 - f->left_pos; + *yp = regs.x.dx / 8 - f->top_pos; + } return (regs.x.bx != 0); } @@ -789,19 +797,23 @@ IT_ring_bell (struct frame *f) } } +/* If otherwise than -1, a face ID that will override the FACE argument + to IT_set_face. */ +static int it_face_override = -1; + /* Given a face id FACE, extract the face parameters to be used for display until the face changes. The face parameters (actually, its color) are used to construct the video attribute byte for each glyph during the construction of the buffer that is then blitted to the video RAM. */ static void -IT_set_face (int face) +IT_set_face (struct frame *f, int face_id) { - struct frame *sf = SELECTED_FRAME (); - struct face *fp = FACE_FROM_ID_OR_NULL (sf, face); - struct face *dfp = FACE_FROM_ID_OR_NULL (sf, DEFAULT_FACE_ID); + int face = (it_face_override == -1 ? face_id : it_face_override); + struct face *fp = FACE_FROM_ID_OR_NULL (f, face); + struct face *dfp = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID); unsigned long fg, bg, dflt_fg, dflt_bg; - struct tty_display_info *tty = FRAME_TTY (sf); + struct tty_display_info *tty = FRAME_TTY (f); if (!fp) { @@ -822,13 +834,13 @@ IT_set_face (int face) 16 colors to be available for the background, since Emacs switches on this mode (and loses the blinking attribute) at startup. */ if (fg == FACE_TTY_DEFAULT_COLOR || fg == FACE_TTY_DEFAULT_FG_COLOR) - fg = FRAME_FOREGROUND_PIXEL (sf); + fg = FRAME_FOREGROUND_PIXEL (f); else if (fg == FACE_TTY_DEFAULT_BG_COLOR) - fg = FRAME_BACKGROUND_PIXEL (sf); + fg = FRAME_BACKGROUND_PIXEL (f); if (bg == FACE_TTY_DEFAULT_COLOR || bg == FACE_TTY_DEFAULT_BG_COLOR) - bg = FRAME_BACKGROUND_PIXEL (sf); + bg = FRAME_BACKGROUND_PIXEL (f); else if (bg == FACE_TTY_DEFAULT_FG_COLOR) - bg = FRAME_FOREGROUND_PIXEL (sf); + bg = FRAME_FOREGROUND_PIXEL (f); /* Make sure highlighted lines really stand out, come what may. */ if (fp->tty_reverse_p && (fg == dflt_fg && bg == dflt_bg)) @@ -876,8 +888,8 @@ IT_write_glyphs (struct frame *f, struct glyph *str, int str_len) int offset = 2 * (new_pos_X + screen_size_X * new_pos_Y); register int sl = str_len; struct tty_display_info *tty = FRAME_TTY (f); - struct frame *sf; unsigned char *conversion_buffer; + struct frame *cf_frame = f; /* If terminal_coding does any conversion, use it, otherwise use safe_terminal_coding. We can't use CODING_REQUIRE_ENCODING here @@ -889,14 +901,12 @@ IT_write_glyphs (struct frame *f, struct glyph *str, int str_len) if (str_len <= 0) return; - sf = SELECTED_FRAME (); - /* Since faces get cached and uncached behind our back, we can't rely on their indices in the cache being consistent across invocations. So always reset the screen face to the default face of the frame, before writing glyphs, and let the glyphs set the right face if it's different from the default. */ - IT_set_face (DEFAULT_FACE_ID); + IT_set_face (f, DEFAULT_FACE_ID); /* The mode bit CODING_MODE_LAST_BLOCK should be set to 1 only at the tail. */ @@ -910,8 +920,10 @@ IT_write_glyphs (struct frame *f, struct glyph *str, int str_len) /* If the face of this glyph is different from the current screen face, update the screen attribute byte. */ cf = str->face_id; - if (cf != screen_face) - IT_set_face (cf); /* handles invalid faces gracefully */ + if ((cf != screen_face && cf != it_face_override) + || cf_frame != str->frame) + IT_set_face (str->frame, cf); /* handles invalid faces gracefully */ + cf_frame = str->frame; /* Identify a run of glyphs with the same face. */ for (n = 1; n < sl; ++n) @@ -964,6 +976,18 @@ popup_activated (void) return mouse_preempted; } +/* Write a string of glyphs STRING of length LEN to F, disregarding + their invidiual faces in favor of FACE. */ + +static void +IT_write_glyphs_with_face (struct frame *f, struct glyph *string, + int len, int face_id) +{ + it_face_override = face_id; + IT_write_glyphs (f, string, len); + it_face_override = -1; +} + /* Draw TEXT_AREA glyphs between START and END of glyph row ROW on window W. X is relative to TEXT_AREA in W. HL is a face override for drawing the glyphs. */ @@ -975,70 +999,38 @@ tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row, struct frame *f = XFRAME (WINDOW_FRAME (w)); struct tty_display_info *tty = FRAME_TTY (f); Mouse_HLInfo *hlinfo = &tty->mouse_highlight; + int nglyphs = end_hpos - start_hpos; + int pos_y, pos_x, save_y, save_x; - if (hl == DRAW_MOUSE_FACE) - { - int vpos = row->y + WINDOW_TOP_EDGE_Y (w); - int kstart = (start_hpos + WINDOW_LEFT_EDGE_X (w) - + row->used[LEFT_MARGIN_AREA]); - int nglyphs = end_hpos - start_hpos; - int offset = ScreenPrimary + 2*(vpos*screen_size_X + kstart) + 1; - int start_offset = offset; + if (end_hpos >= row->used[TEXT_AREA]) + nglyphs = row->used[TEXT_AREA] - start_hpos; + pos_y = row->y + WINDOW_TOP_EDGE_Y (w); + pos_x = (row->used[LEFT_MARGIN_AREA] + start_hpos + + WINDOW_LEFT_EDGE_X (w)); - if (end_hpos >= row->used[TEXT_AREA]) - nglyphs = row->used[TEXT_AREA] - start_hpos; + /* Save current cursor position. */ + save_x = f->left_pos + new_pos_X; + save_y = f->top_pos + new_pos_Y; - if (tty->termscript) - fprintf (tty->termscript, "\n<MH+ %d-%d:%d>", - kstart, kstart + nglyphs - 1, vpos); + /* This applies child frame offsets. */ + cursor_to (f, pos_y, pos_x); + mouse_off (); - mouse_off (); - IT_set_face (hlinfo->mouse_face_face_id); - /* Since we are going to change only the _colors_ of already - displayed text, there's no need to go through all the pain of - generating and encoding the text from the glyphs. Instead, - we simply poke the attribute byte of each affected position - in video memory with the colors computed by IT_set_face! */ - _farsetsel (_dos_ds); - while (nglyphs--) - { - _farnspokeb (offset, ScreenAttrib); - offset += 2; - } - if (screen_virtual_segment) - dosv_refresh_virtual_screen (start_offset, end_hpos - start_hpos); - mouse_on (); - } - else if (hl == DRAW_NORMAL_TEXT) - { - /* We are removing a previously-drawn mouse highlight. The - safest way to do so is to redraw the glyphs anew, since all - kinds of faces and display tables could have changed behind - our back. */ - int nglyphs = end_hpos - start_hpos; - int save_x = new_pos_X, save_y = new_pos_Y; - - if (end_hpos >= row->used[TEXT_AREA]) - nglyphs = row->used[TEXT_AREA] - start_hpos; - - /* IT_write_glyphs writes at cursor position, so we need to - temporarily move cursor coordinates to the beginning of - the highlight region. */ - new_pos_X = start_hpos + WINDOW_LEFT_EDGE_X (w); - /* The coordinates supplied by the caller are relative to the - text area, not the window itself. */ - new_pos_X += row->used[LEFT_MARGIN_AREA]; - new_pos_Y = row->y + WINDOW_TOP_EDGE_Y (w); + /* Write the glyphs and restore cursor position. */ - if (tty->termscript) - fprintf (tty->termscript, "<MH- %d-%d:%d>", - new_pos_X, new_pos_X + nglyphs - 1, new_pos_Y); - IT_write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, nglyphs); - if (tty->termscript) - fputs ("\n", tty->termscript); - new_pos_X = save_x; - new_pos_Y = save_y; + if (hl == DRAW_MOUSE_FACE) + { + struct glyph *glyph = row->glyphs[TEXT_AREA] + start_hpos; + int face_id = tty->mouse_highlight.mouse_face_face_id; + IT_write_glyphs_with_face (f, glyph, nglyphs, face_id); } + else + IT_write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, + nglyphs); + + mouse_on (); + new_pos_X = save_x; + new_pos_Y = save_y; } static void @@ -1051,7 +1043,7 @@ IT_clear_end_of_line (struct frame *f, int first_unused) if (new_pos_X >= first_unused || fatal_error_in_progress) return; - IT_set_face (0); + IT_set_face (f, 0); i = (j = first_unused - new_pos_X) * 2; if (tty->termscript) fprintf (tty->termscript, "<CLR:EOL[%d..%d)>", new_pos_X, first_unused); @@ -1086,10 +1078,10 @@ IT_clear_screen (struct frame *f) any valid faces and will abort. Instead, use the initial screen colors; that should mimic what a Unix tty does, which simply clears the screen with whatever default colors are in use. */ - if (FACE_FROM_ID_OR_NULL (SELECTED_FRAME (), DEFAULT_FACE_ID) == NULL) + if (FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID) == NULL) ScreenAttrib = (initial_screen_colors[0] << 4) | initial_screen_colors[1]; else - IT_set_face (0); + IT_set_face (f, 0); mouse_off (); ScreenClear (); if (screen_virtual_segment) @@ -1720,6 +1712,33 @@ IT_set_frame_parameters (struct frame *f, Lisp_Object alist) store_frame_param (f, prop, val); } + /* If this frame has become a child frame, process its visibility and + a nuumber of other flags. */ + if (is_tty_child_frame (f)) + { + int x = tty_child_pos_param (f, Qleft, alist, f->left_pos); + int y = tty_child_pos_param (f, Qtop, alist, f->top_pos); + if (x != f->left_pos || y != f->top_pos) + { + f->left_pos = x; + f->top_pos = y; + SET_FRAME_GARBAGED (root_frame (f)); + } + + int w = tty_child_size_param (f, Qwidth, alist, f->total_cols); + int h = tty_child_size_param (f, Qheight, alist, f->total_lines); + if (w != f->total_cols || h != f->total_lines) + change_frame_size (f, w, h, false, false, false); + + Lisp_Object visible = Fassq (Qvisibility, alist); + if (CONSP (visible)) + SET_FRAME_VISIBLE (f, !NILP (Fcdr (visible))); + + Lisp_Object no_special = Fassq (Qno_special_glyphs, alist); + if (CONSP (no_special)) + FRAME_NO_SPECIAL_GLYPHS (f) = !NILP (Fcdr (no_special)); + } + /* If they specified "reverse", but not the colors, we need to swap the current frame colors. */ if (reverse) @@ -2861,13 +2880,13 @@ IT_menu_calc_size (XMenu *menu, int *width, int *height) /* Display MENU at (X,Y) using FACES. */ -#define BUILD_CHAR_GLYPH(GLYPH, CODE, FACE_ID, PADDING_P) \ - do \ - { \ - (GLYPH).type = CHAR_GLYPH; \ - SET_CHAR_GLYPH (GLYPH, CODE, FACE_ID, PADDING_P); \ - (GLYPH).charpos = -1; \ - } \ +#define BUILD_CHAR_GLYPH(F, GLYPH, CODE, FACE_ID, PADDING_P) \ + do \ + { \ + (GLYPH).type = CHAR_GLYPH; \ + SET_CHAR_GLYPH (F, GLYPH, CODE, FACE_ID, PADDING_P); \ + (GLYPH).charpos = -1; \ + } \ while (0) static void @@ -2891,7 +2910,7 @@ IT_menu_display (XMenu *menu, int y, int x, int pn, int *faces, int disp_help) { int max_width = width + 2; - IT_cursor_to (sf, y + i, x); + cursor_to (sf, y + i, x); enabled = (!menu->submenu[i] && menu->panenumber[i]) || (menu->submenu[i]); mousehere = (y + i == my && x <= mx && mx < x + max_width); @@ -2905,7 +2924,7 @@ IT_menu_display (XMenu *menu, int y, int x, int pn, int *faces, int disp_help) menu_help_itemno = i; } p = text; - BUILD_CHAR_GLYPH (*p, ' ', face, 0); + BUILD_CHAR_GLYPH (sf, *p, ' ', face, 0); p++; for (j = 0, q = menu->text[i]; *q; j++) { @@ -2913,15 +2932,15 @@ IT_menu_display (XMenu *menu, int y, int x, int pn, int *faces, int disp_help) if (c > 26) { - BUILD_CHAR_GLYPH (*p, c, face, 0); + BUILD_CHAR_GLYPH (sf, *p, c, face, 0); p++; } else /* make '^x' */ { - BUILD_CHAR_GLYPH (*p, '^', face, 0); + BUILD_CHAR_GLYPH (sf, *p, '^', face, 0); p++; j++; - BUILD_CHAR_GLYPH (*p, c + 64, face, 0); + BUILD_CHAR_GLYPH (sf, *p, c + 64, face, 0); p++; } } @@ -2932,16 +2951,16 @@ IT_menu_display (XMenu *menu, int y, int x, int pn, int *faces, int disp_help) text[max_width - 1].u.ch = '$'; /* indicate it's truncated */ } for (; j < max_width - 2; j++, p++) - BUILD_CHAR_GLYPH (*p, ' ', face, 0); + BUILD_CHAR_GLYPH (sf, *p, ' ', face, 0); /* 16 is the character code of a character that on DOS terminal produces a nice-looking right-pointing arrow glyph. */ - BUILD_CHAR_GLYPH (*p, menu->submenu[i] ? 16 : ' ', face, 0); + BUILD_CHAR_GLYPH (sf, *p, menu->submenu[i] ? 16 : ' ', face, 0); p++; IT_write_glyphs (sf, text, max_width); } IT_update_end (sf); - IT_cursor_to (sf, row, col); + cursor_to (sf, row, col); xfree (text); } diff --git a/src/msdos.h b/src/msdos.h index 7a7b3fa4225..55e7c9ee379 100644 --- a/src/msdos.h +++ b/src/msdos.h @@ -78,7 +78,6 @@ void syms_of_win16select (void); /* Constants. */ #define EINPROGRESS 112 -#define ENOTSUP ENOSYS /* Gnulib sets O_CLOEXEC to O_NOINHERIT, which gets in the way when we need to redirect standard handles for subprocesses using temporary files created by mkostemp, see callproc.c. */ diff --git a/src/nsfns.m b/src/nsfns.m index 29e3de44f35..721dc4995c0 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -3351,7 +3351,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, [nswindow orderFront: NSApp]; [nswindow display]; - SET_FRAME_VISIBLE (tip_f, 1); + SET_FRAME_VISIBLE (tip_f, true); unblock_input (); goto start_timer; @@ -3534,7 +3534,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, [nswindow orderFront: NSApp]; [nswindow display]; - SET_FRAME_VISIBLE (tip_f, YES); + SET_FRAME_VISIBLE (tip_f, true); FRAME_PIXEL_WIDTH (tip_f) = width; FRAME_PIXEL_HEIGHT (tip_f) = height; unblock_input (); diff --git a/src/nsgui.h b/src/nsgui.h index 72aee4c5f07..1e6f2aff7d0 100644 --- a/src/nsgui.h +++ b/src/nsgui.h @@ -29,8 +29,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #define Cursor FooFoo #endif /* NS_IMPL_COCOA */ -#undef verify - #import <AppKit/AppKit.h> #ifdef NS_IMPL_COCOA @@ -44,10 +42,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #endif /* __OBJC__ */ -#undef verify -#undef _GL_VERIFY_H -#include <verify.h> - /* Emulate XCharStruct. */ typedef struct _XCharStruct { diff --git a/src/nsterm.h b/src/nsterm.h index 1c86d6ea980..d03908eb521 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -704,26 +704,26 @@ enum ns_return_frame_mode ========================================================================== */ @interface EmacsScroller : NSScroller - { - struct window *window; - struct frame *frame; - NSResponder *prevResponder; +{ + struct window *window; + struct frame *frame; + NSResponder *prevResponder; - /* offset to the bottom of knob of last mouse down */ - CGFloat last_mouse_offset; - float min_portion; - int pixel_length; - enum scroll_bar_part last_hit_part; + /* offset to the bottom of knob of last mouse down */ + CGFloat last_mouse_offset; + float min_portion; + int pixel_length; + enum scroll_bar_part last_hit_part; - BOOL condemned; + BOOL condemned; - BOOL horizontal; + BOOL horizontal; - /* optimize against excessive positioning calls generated by emacs */ - int em_position; - int em_portion; - int em_whole; - } + /* optimize against excessive positioning calls generated by emacs */ + int em_position; + int em_portion; + int em_whole; +} - (void) mark; - (instancetype) initFrame: (NSRect )r window: (Lisp_Object)win; diff --git a/src/nsterm.m b/src/nsterm.m index 8b4374c7ff3..a4398e79211 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1505,7 +1505,7 @@ ns_make_frame_visible (struct frame *f) EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); EmacsWindow *window = (EmacsWindow *)[view window]; - SET_FRAME_VISIBLE (f, 1); + SET_FRAME_VISIBLE (f, true); ns_raise_frame (f, ! FRAME_NO_FOCUS_ON_MAP (f)); /* Making a new frame from a fullscreen frame will make the new frame @@ -1550,7 +1550,7 @@ ns_make_frame_invisible (struct frame *f) check_window_system (f); view = FRAME_NS_VIEW (f); [[view window] orderOut: NSApp]; - SET_FRAME_VISIBLE (f, 0); + SET_FRAME_VISIBLE (f, false); SET_FRAME_ICONIFIED (f, 0); } @@ -1984,16 +1984,6 @@ ns_fullscreen_hook (struct frame *f) if (!FRAME_VISIBLE_P (f)) return; - if (! [view fsIsNative] && f->want_fullscreen == FULLSCREEN_BOTH) - { - /* Old style fs don't initiate correctly if created from - init/default-frame alist, so use a timer (not nice...). */ - [NSTimer scheduledTimerWithTimeInterval: 0.5 target: view - selector: @selector (handleFS) - userInfo: nil repeats: NO]; - return; - } - block_input (); [view handleFS]; unblock_input (); @@ -2961,24 +2951,28 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row, NSTRACE_MSG ("which:%d cursor:%d overlay:%d width:%d height:%d period:%d", p->which, p->cursor_p, p->overlay_p, p->wd, p->h, p->dh); - /* Work out the rectangle we will need to clear. */ - clearRect = NSMakeRect (p->x, p->y, p->wd, p->h); + /* Clear screen unless overlay. */ + if (!p->overlay_p) + { + /* Work out the rectangle we will need to clear. */ + clearRect = NSMakeRect (p->x, p->y, p->wd, p->h); - if (p->bx >= 0 && !p->overlay_p) - clearRect = NSUnionRect (clearRect, NSMakeRect (p->bx, p->by, p->nx, p->ny)); + if (p->bx >= 0) + clearRect = NSUnionRect (clearRect, NSMakeRect (p->bx, p->by, p->nx, p->ny)); - /* Handle partially visible rows. */ - clearRect = NSIntersectionRect (clearRect, rowRect); + /* Handle partially visible rows. */ + clearRect = NSIntersectionRect (clearRect, rowRect); - /* The visible portion of imageRect will always be contained within - clearRect. */ - ns_focus (f, &clearRect, 1); - if (! NSIsEmptyRect (clearRect)) - { - NSTRACE_RECT ("clearRect", clearRect); + /* The visible portion of imageRect will always be contained + within clearRect. */ + ns_focus (f, &clearRect, 1); + if (!NSIsEmptyRect (clearRect)) + { + NSTRACE_RECT ("clearRect", clearRect); - [[NSColor colorWithUnsignedLong:face->background] set]; - NSRectFill (clearRect); + [[NSColor colorWithUnsignedLong:face->background] set]; + NSRectFill (clearRect); + } } NSBezierPath *bmp = [fringe_bmp objectForKey:[NSNumber numberWithInt:p->which]]; @@ -6961,8 +6955,12 @@ ns_create_font_panel_buttons (id target, SEL select, SEL cancel_action) #ifndef NS_IMPL_GNUSTEP if (NS_KEYLOG) - fprintf (stderr, "keyDown: code =%x\tfnKey =%x\tflags = %x\tmods = %x\n", - code, fnKeysym, flags, emacs_event->modifiers); + fprintf (stderr, + "keyDown: code = %x\tfnKey = %x\tflags = %x\tmods = " + "%x\n", + (unsigned int) code, (unsigned int) fnKeysym, + (unsigned int) flags, + (unsigned int) emacs_event->modifiers); #endif /* If it was a function key or had control-like modifiers, pass @@ -7895,6 +7893,9 @@ ns_in_echo_area (void) NSTRACE_RETURN_SIZE (frameSize); + /* Trigger `move-frame-functions' (Bug#74074). */ + [self windowDidMove:(NSNotification *)sender]; + return frameSize; } @@ -7973,6 +7974,7 @@ ns_in_echo_area (void) event.kind = FOCUS_IN_EVENT; XSETFRAME (event.frame_or_window, emacsframe); kbd_buffer_store_event (&event); + ns_send_appdefined (-1); // Kick main loop } @@ -8074,6 +8076,10 @@ ns_in_echo_area (void) #ifdef NS_IMPL_COCOA old_title = 0; maximizing_resize = NO; +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 140000 + /* Restore to default before macOS 14 (bug#72440). */ + [self setClipsToBounds: YES]; +#endif #endif #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 @@ -9364,7 +9370,10 @@ ns_in_echo_area (void) - (void)createToolbar: (struct frame *)f { - if (FRAME_UNDECORATED (f) || !FRAME_EXTERNAL_TOOL_BAR (f) || [self toolbar] != nil) + if (FRAME_UNDECORATED (f) + || [self styleMask] == NSWindowStyleMaskBorderless + || !FRAME_EXTERNAL_TOOL_BAR (f) + || [self toolbar] != nil) return; EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); @@ -10756,7 +10765,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) IOReturn lockStatus = IOSurfaceLock (surface, 0, nil); if (lockStatus != kIOReturnSuccess) - NSLog (@"Failed to lock surface: %x", lockStatus); + NSLog (@"Failed to lock surface: %x", (unsigned int)lockStatus); [self copyContentsTo:surface]; @@ -10803,7 +10812,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) IOReturn lockStatus = IOSurfaceUnlock (currentSurface, 0, nil); if (lockStatus != kIOReturnSuccess) - NSLog (@"Failed to unlock surface: %x", lockStatus); + NSLog (@"Failed to unlock surface: %x", (unsigned int)lockStatus); } @@ -10844,7 +10853,8 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) lockStatus = IOSurfaceLock (source, kIOSurfaceLockReadOnly, nil); if (lockStatus != kIOReturnSuccess) - NSLog (@"Failed to lock source surface: %x", lockStatus); + NSLog (@"Failed to lock source surface: %x", + (unsigned int) lockStatus); sourceData = IOSurfaceGetBaseAddress (source); destinationData = IOSurfaceGetBaseAddress (destination); @@ -10856,7 +10866,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) lockStatus = IOSurfaceUnlock (source, kIOSurfaceLockReadOnly, nil); if (lockStatus != kIOReturnSuccess) - NSLog (@"Failed to unlock source surface: %x", lockStatus); + NSLog (@"Failed to unlock source surface: %x", (unsigned int)lockStatus); } #undef CACHE_MAX_SIZE diff --git a/src/pdumper.c b/src/pdumper.c index bc7cfffeca2..7d6eabb4b15 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -44,6 +44,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "systime.h" #include "thread.h" #include "bignum.h" +#include "treesit.h" #ifdef CHECK_STRUCTS # include "dmpstruct.h" @@ -98,11 +99,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ are the same size and have the same layout, and where bytes have eight bits --- that is, a general-purpose computer made after 1990. Also require Lisp_Object to be at least as wide as pointers. */ -verify (sizeof (ptrdiff_t) == sizeof (void *)); -verify (sizeof (intptr_t) == sizeof (ptrdiff_t)); -verify (sizeof (void (*) (void)) == sizeof (void *)); -verify (sizeof (ptrdiff_t) <= sizeof (Lisp_Object)); -verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT)); +static_assert (sizeof (ptrdiff_t) == sizeof (void *)); +static_assert (sizeof (intptr_t) == sizeof (ptrdiff_t)); +static_assert (sizeof (void (*) (void)) == sizeof (void *)); +static_assert (sizeof (ptrdiff_t) <= sizeof (Lisp_Object)); +static_assert (sizeof (ptrdiff_t) <= sizeof (EMACS_INT)); static size_t divide_round_up (size_t x, size_t y) @@ -275,15 +276,15 @@ enum DUMP_RELOC_OFFSET_BITS = DUMP_OFF_WIDTH - DUMP_RELOC_TYPE_BITS }; -verify (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS)); -verify (DUMP_ALIGNMENT >= GCALIGNMENT); +static_assert (RELOC_DUMP_TO_EMACS_LV + 8 < (1 << DUMP_RELOC_TYPE_BITS)); +static_assert (DUMP_ALIGNMENT >= GCALIGNMENT); struct dump_reloc { unsigned int raw_offset : DUMP_RELOC_OFFSET_BITS; ENUM_BF (dump_reloc_type) type : DUMP_RELOC_TYPE_BITS; }; -verify (sizeof (struct dump_reloc) == sizeof (dump_off)); +static_assert (sizeof (struct dump_reloc) == sizeof (dump_off)); /* Set the type of a dump relocation. @@ -2125,10 +2126,9 @@ dump_marker (struct dump_context *ctx, const struct Lisp_Marker *marker) } static dump_off -dump_interval_node (struct dump_context *ctx, struct itree_node *node, - dump_off parent_offset) +dump_interval_node (struct dump_context *ctx, struct itree_node *node) { -#if CHECK_STRUCTS && !defined (HASH_itree_node_50DE304F13) +#if CHECK_STRUCTS && !defined (HASH_itree_node_03626AFCA9) # error "itree_node changed. See CHECK_STRUCTS comment in config.h." #endif struct itree_node out; @@ -2136,9 +2136,9 @@ dump_interval_node (struct dump_context *ctx, struct itree_node *node, if (node->parent) dump_field_fixup_later (ctx, &out, node, &node->parent); if (node->left) - dump_field_fixup_later (ctx, &out, node, &node->parent); + dump_field_fixup_later (ctx, &out, node, &node->left); if (node->right) - dump_field_fixup_later (ctx, &out, node, &node->parent); + dump_field_fixup_later (ctx, &out, node, &node->right); DUMP_FIELD_COPY (&out, node, begin); DUMP_FIELD_COPY (&out, node, end); DUMP_FIELD_COPY (&out, node, limit); @@ -2153,17 +2153,17 @@ dump_interval_node (struct dump_context *ctx, struct itree_node *node, dump_remember_fixup_ptr_raw (ctx, offset + dump_offsetof (struct itree_node, parent), - dump_interval_node (ctx, node->parent, offset)); + dump_interval_node (ctx, node->parent)); if (node->left) dump_remember_fixup_ptr_raw (ctx, offset + dump_offsetof (struct itree_node, left), - dump_interval_node (ctx, node->left, offset)); + dump_interval_node (ctx, node->left)); if (node->right) dump_remember_fixup_ptr_raw (ctx, offset + dump_offsetof (struct itree_node, right), - dump_interval_node (ctx, node->right, offset)); + dump_interval_node (ctx, node->right)); return offset; } @@ -2180,7 +2180,7 @@ dump_overlay (struct dump_context *ctx, const struct Lisp_Overlay *overlay) dump_remember_fixup_ptr_raw (ctx, offset + dump_offsetof (struct Lisp_Overlay, interval), - dump_interval_node (ctx, overlay->interval, offset)); + dump_interval_node (ctx, overlay->interval)); return offset; } @@ -2209,12 +2209,27 @@ dump_finalizer (struct dump_context *ctx, /* Do _not_ call dump_pseudovector_lisp_fields here: we dump the only Lisp field, finalizer->function, manually, so we can give it a low weight. */ - dump_field_lv (ctx, &out, finalizer, &finalizer->function, WEIGHT_NONE); - dump_field_finalizer_ref (ctx, &out, finalizer, &finalizer->prev); - dump_field_finalizer_ref (ctx, &out, finalizer, &finalizer->next); + dump_field_lv (ctx, out, finalizer, &finalizer->function, WEIGHT_NONE); + dump_field_finalizer_ref (ctx, out, finalizer, &finalizer->prev); + dump_field_finalizer_ref (ctx, out, finalizer, &finalizer->next); return finish_dump_pvec (ctx, &out->header); } +#ifdef HAVE_TREE_SITTER +static dump_off +dump_treesit_compiled_query (struct dump_context *ctx, + struct Lisp_TS_Query *query) +{ + START_DUMP_PVEC (ctx, &query->header, struct Lisp_TS_Query, out); + dump_field_lv (ctx, &out->language, query, &query->language, WEIGHT_STRONG); + dump_field_lv (ctx, &out->source, query, &query->source, WEIGHT_STRONG); + /* These will be recompiled after load from dump. */ + out->query = NULL; + out->cursor = NULL; + return finish_dump_pvec (ctx, &out->header); +} +#endif + struct bignum_reload_info { dump_off data_location; @@ -2229,7 +2244,7 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object) #endif const struct Lisp_Bignum *bignum = XBIGNUM (object); START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out); - verify (sizeof (out->value) >= sizeof (struct bignum_reload_info)); + static_assert (sizeof (out->value) >= sizeof (struct bignum_reload_info)); dump_field_fixup_later (ctx, out, bignum, xbignum_val (object)); dump_off bignum_offset = finish_dump_pvec (ctx, &out->header); if (ctx->flags.dump_object_contents) @@ -2951,7 +2966,7 @@ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v) static dump_off dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_20B7443AD7) +#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_EE5F7351CC) # error "Lisp_Subr changed. See CHECK_STRUCTS comment in config.h." #endif struct Lisp_Subr out; @@ -3108,6 +3123,10 @@ dump_vectorlike (struct dump_context *ctx, return DUMP_OBJECT_IS_RUNTIME_MAGIC; } break; + case PVEC_TS_COMPILED_QUERY: +#ifdef HAVE_TREE_SITTER + return dump_treesit_compiled_query (ctx, XTS_COMPILED_QUERY (lv)); +#endif case PVEC_WINDOW_CONFIGURATION: case PVEC_OTHER: case PVEC_XWIDGET: @@ -3122,7 +3141,6 @@ dump_vectorlike (struct dump_context *ctx, case PVEC_FREE: case PVEC_TS_PARSER: case PVEC_TS_NODE: - case PVEC_TS_COMPILED_QUERY: break; } char msg[60]; @@ -4230,11 +4248,11 @@ types. */) O_RDWR | O_TRUNC | O_CREAT, 0666); if (ctx->fd < 0) report_file_error ("Opening dump output", filename); - verify (sizeof (ctx->header.magic) == sizeof (dump_magic)); + static_assert (sizeof (ctx->header.magic) == sizeof (dump_magic)); memcpy (&ctx->header.magic, dump_magic, sizeof (dump_magic)); ctx->header.magic[0] = '!'; /* Note that dump is incomplete. */ - verify (sizeof (fingerprint) == sizeof (ctx->header.fingerprint)); + static_assert (sizeof (fingerprint) == sizeof (ctx->header.fingerprint)); for (int i = 0; i < sizeof fingerprint; i++) ctx->header.fingerprint[i] = fingerprint[i]; @@ -4835,11 +4853,14 @@ struct dump_memory_map_heap_control_block static void dump_mm_heap_cb_release (struct dump_memory_map_heap_control_block *cb) { - eassert (cb->refcount > 0); - if (--cb->refcount == 0) + if (cb) { - free (cb->mem); - free (cb); + eassert (cb->refcount > 0); + if (--cb->refcount == 0) + { + free (cb->mem); + free (cb); + } } } @@ -5504,7 +5525,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, { struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset); struct bignum_reload_info reload_info; - verify (sizeof (reload_info) <= sizeof (*bignum_val (bignum))); + static_assert (sizeof (reload_info) <= sizeof (*bignum_val (bignum))); memcpy (&reload_info, bignum_val (bignum), sizeof (reload_info)); const mp_limb_t *limbs = dump_ptr (dump_base, reload_info.data_location); @@ -5695,7 +5716,7 @@ pdumper_load (const char *dump_filename, char *argv0) } err = PDUMPER_LOAD_VERSION_MISMATCH; - verify (sizeof (header->fingerprint) == sizeof (fingerprint)); + static_assert (sizeof (header->fingerprint) == sizeof (fingerprint)); unsigned char desired[sizeof fingerprint]; for (int i = 0; i < sizeof fingerprint; i++) desired[i] = fingerprint[i]; diff --git a/src/pgtkfns.c b/src/pgtkfns.c index 1b2324d5c8f..4becb5492ac 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -71,7 +71,7 @@ pgtk_get_monitor_scale_factor (const char *model) else if (FLOATP (cdr)) return XFLOAT_DATA (cdr); else - error ("unknown type of scale-factor"); + error ("Unknown type of scale-factor"); } struct pgtk_display_info * @@ -826,7 +826,7 @@ pgtk_set_scroll_bar_foreground (struct frame *f, Lisp_Object new_value, Emacs_Color rgb; if (!pgtk_parse_color (f, SSDATA (new_value), &rgb)) - error ("Unknown color."); + error ("Unknown color"); char css[64]; sprintf (css, "scrollbar slider { background-color: #%06x; }", @@ -836,7 +836,7 @@ pgtk_set_scroll_bar_foreground (struct frame *f, Lisp_Object new_value, } else - error ("Invalid scroll-bar-foreground."); + error ("Invalid scroll-bar-foreground"); } static void @@ -856,7 +856,7 @@ pgtk_set_scroll_bar_background (struct frame *f, Lisp_Object new_value, Emacs_Color rgb; if (!pgtk_parse_color (f, SSDATA (new_value), &rgb)) - error ("Unknown color."); + error ("Unknown color"); /* On pgtk, this frame parameter should be ignored, and honor gtk theme. (It honors the GTK theme if not explicitly set, so @@ -869,7 +869,7 @@ pgtk_set_scroll_bar_background (struct frame *f, Lisp_Object new_value, } else - error ("Invalid scroll-bar-background."); + error ("Invalid scroll-bar-background"); } @@ -904,7 +904,7 @@ unless TYPE is `png'. */) XSETFRAME (frame, f); if (!FRAME_VISIBLE_P (f)) - error ("Frames to be exported must be visible."); + error ("Frames to be exported must be visible"); tmp = Fcons (frame, tmp); } frames = Fnreverse (tmp); @@ -918,7 +918,7 @@ unless TYPE is `png'. */) if (EQ (type, Qpng)) { if (!NILP (XCDR (frames))) - error ("PNG export cannot handle multiple frames."); + error ("PNG export cannot handle multiple frames"); surface_type = CAIRO_SURFACE_TYPE_IMAGE; } else @@ -933,7 +933,7 @@ unless TYPE is `png'. */) { /* For now, we stick to SVG 1.1. */ if (!NILP (XCDR (frames))) - error ("SVG export cannot handle multiple frames."); + error ("SVG export cannot handle multiple frames"); surface_type = CAIRO_SURFACE_TYPE_SVG; } else @@ -1153,15 +1153,15 @@ scale factor. */) if (FIXNUMP (scale_factor)) { if (XFIXNUM (scale_factor) <= 0) - error ("scale factor must be > 0."); + error ("Scale factor must be > 0"); } else if (FLOATP (scale_factor)) { if (XFLOAT_DATA (scale_factor) <= 0.0) - error ("scale factor must be > 0."); + error ("Scale factor must be > 0"); } else - error ("unknown type of scale-factor"); + error ("Unknown type of scale-factor"); } Lisp_Object tem = Fassoc (monitor_model, monitor_scale_factor_alist, Qnil); @@ -1781,6 +1781,9 @@ Some window managers may refuse to restack windows. */) #define SCHEMA_ID "org.gnu.emacs.defaults" #define PATH_FOR_CLASS_TYPE "/org/gnu/emacs/defaults-by-class/" #define PATH_PREFIX_FOR_NAME_TYPE "/org/gnu/emacs/defaults-by-name/" +#define PATH_MAX_LEN \ + (sizeof PATH_FOR_CLASS_TYPE > sizeof PATH_PREFIX_FOR_NAME_TYPE ? \ + sizeof PATH_FOR_CLASS_TYPE : sizeof PATH_PREFIX_FOR_NAME_TYPE) static inline int pgtk_is_lower_char (int c) @@ -1803,7 +1806,7 @@ pgtk_is_numeric_char (int c) static GSettings * parse_resource_key (const char *res_key, char *setting_key) { - char path[33 + RESOURCE_KEY_MAX_LEN]; + char path[PATH_MAX_LEN + RESOURCE_KEY_MAX_LEN]; const char *sp = res_key; char *dp; @@ -1822,7 +1825,7 @@ parse_resource_key (const char *res_key, char *setting_key) /* generate path */ if (pgtk_is_upper_char (*sp)) { - /* First letter is upper case. It should be "Emacs", + /* First letter is upper case. It should be "Emacs", * but don't care. */ strcpy (path, PATH_FOR_CLASS_TYPE); @@ -1901,19 +1904,23 @@ parse_resource_key (const char *res_key, char *setting_key) return gs; } +static void +pgtk_check_resource_key_length (const char *key) +{ + if (strnlen (key, RESOURCE_KEY_MAX_LEN) >= RESOURCE_KEY_MAX_LEN) + error ("Resource key too long"); +} + const char * pgtk_get_defaults_value (const char *key) { char skey[(RESOURCE_KEY_MAX_LEN + 1) * 2]; - if (strlen (key) >= RESOURCE_KEY_MAX_LEN) - error ("resource key too long."); + pgtk_check_resource_key_length (key); GSettings *gs = parse_resource_key (key, skey); if (gs == NULL) - { - return NULL; - } + return NULL; gchar *str = g_settings_get_string (gs, skey); @@ -1936,21 +1943,16 @@ pgtk_set_defaults_value (const char *key, const char *value) { char skey[(RESOURCE_KEY_MAX_LEN + 1) * 2]; - if (strlen (key) >= RESOURCE_KEY_MAX_LEN) - error ("resource key too long."); + pgtk_check_resource_key_length (key); GSettings *gs = parse_resource_key (key, skey); if (gs == NULL) - error ("unknown resource key."); + error ("Unknown resource key"); if (value != NULL) - { - g_settings_set_string (gs, skey, value); - } + g_settings_set_string (gs, skey, value); else - { - g_settings_reset (gs, skey); - } + g_settings_reset (gs, skey); g_object_unref (gs); } @@ -1959,6 +1961,7 @@ pgtk_set_defaults_value (const char *key, const char *value) #undef SCHEMA_ID #undef PATH_FOR_CLASS_TYPE #undef PATH_PREFIX_FOR_NAME_TYPE +#undef PATH_MAX_LEN #else /* not HAVE_GSETTINGS */ @@ -1971,7 +1974,7 @@ pgtk_get_defaults_value (const char *key) static void pgtk_set_defaults_value (const char *key, const char *value) { - error ("gsettings not supported."); + error ("gsettings not supported"); } #endif @@ -3659,16 +3662,13 @@ visible. */) XSETFRAME (frame, f); if (!FRAME_VISIBLE_P (f)) - error ("Frames to be printed must be visible."); + error ("Frames to be printed must be visible"); tmp = Fcons (frame, tmp); } frames = Fnreverse (tmp); /* Make sure the current matrices are up-to-date. */ - specpdl_ref count = SPECPDL_INDEX (); - specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (32); - unbind_to (count, Qnil); block_input (); xg_print_frames_dialog (frames); @@ -3819,6 +3819,44 @@ DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, return NILP (enable) ? Qnil : Qt; } +static void +unwind_gerror_ptr (void* data) +{ + GError* error = *(GError**)data; + if (error) + g_error_free (error); +} + +DEFUN ("x-gtk-launch-uri", Fx_gtk_launch_uri, Sx_gtk_launch_uri, 2, 2, 0, + doc: /* launch URI */) + (Lisp_Object frame, Lisp_Object uri) +{ + CHECK_FRAME (frame); + + if (!FRAME_LIVE_P (XFRAME (frame)) || + !FRAME_PGTK_P (XFRAME (frame)) || + !FRAME_GTK_OUTER_WIDGET (XFRAME (frame))) + error ("GTK URI launch not available for this frame"); + + CHECK_STRING (uri); + guint32 timestamp = gtk_get_current_event_time (); + + GError *err = NULL; + specpdl_ref count = SPECPDL_INDEX (); + + record_unwind_protect_ptr (unwind_gerror_ptr, &err); + + gtk_show_uri_on_window (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (XFRAME (frame))), + SSDATA (uri), + timestamp, + &err); + + if (err) + error ("Failed to launch URI via GTK: %s", err->message); + + return unbind_to (count, Qnil); +} + void syms_of_pgtkfns (void) { @@ -3890,6 +3928,7 @@ syms_of_pgtkfns (void) defsubr (&Sx_close_connection); defsubr (&Sx_display_list); defsubr (&Sx_gtk_debug); + defsubr (&Sx_gtk_launch_uri); defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); diff --git a/src/pgtkselect.c b/src/pgtkselect.c index ef21a8a74c1..f1a9214a6b4 100644 --- a/src/pgtkselect.c +++ b/src/pgtkselect.c @@ -1822,7 +1822,7 @@ targets) that can be dropped on top of FRAME. */) CHECK_LIST (targets); length = list_length (targets); n = 0; - entries = SAFE_ALLOCA (sizeof *entries * length); + SAFE_NALLOCA (entries, 1, length); memset (entries, 0, sizeof *entries * length); tem = targets; diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 321514fbf79..413cbd86c0d 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -928,7 +928,7 @@ pgtk_set_parent_frame (struct frame *f, Lisp_Object new_value, if (p != NULL) { if (FRAME_DISPLAY_INFO (f) != FRAME_DISPLAY_INFO (p)) - error ("Cross display reparent."); + error ("Cross display reparent"); } GtkWidget *fixed = FRAME_GTK_WIDGET (f); @@ -7632,7 +7632,6 @@ pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) Lisp_Object acc = Qnil; specpdl_ref count = SPECPDL_INDEX (); - specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (31); f = XFRAME (XCAR (frames)); diff --git a/src/print.c b/src/print.c index 51a5f7ab1f9..4694df98882 100644 --- a/src/print.c +++ b/src/print.c @@ -1617,7 +1617,7 @@ print_bool_vector (Lisp_Object obj, Lisp_Object printcharfun) ptrdiff_t real_size_in_bytes = size_in_bytes; unsigned char *data = bool_vector_uchar_data (obj); - char buf[sizeof "#&\"" + INT_STRLEN_BOUND (ptrdiff_t)]; + char buf[sizeof "#&\"" + INT_STRLEN_BOUND (EMACS_INT)]; int len = sprintf (buf, "#&%"pI"d\"", size); strout (buf, len, len, printcharfun); diff --git a/src/process.c b/src/process.c index fff9dfecb17..e25228b3d6a 100644 --- a/src/process.c +++ b/src/process.c @@ -38,6 +38,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <sys/socket.h> #include <netdb.h> #include <netinet/in.h> +#include <netinet/tcp.h> #include <arpa/inet.h> #else @@ -95,7 +96,6 @@ static struct rlimit nofile_limit; #include <flexmember.h> #include <nproc.h> #include <sig2str.h> -#include <verify.h> #endif /* subprocesses */ @@ -922,7 +922,7 @@ make_process (Lisp_Object name) p->open_fd[i] = -1; #ifdef HAVE_GNUTLS - verify (GNUTLS_STAGE_EMPTY == 0); + static_assert (GNUTLS_STAGE_EMPTY == 0); eassert (p->gnutls_initstage == GNUTLS_STAGE_EMPTY); eassert (NILP (p->gnutls_boot_parameters)); #endif @@ -1913,7 +1913,7 @@ usage: (make-process &rest ARGS) */) #ifdef HAVE_GNUTLS /* AKA GNUTLS_INITSTAGE(proc). */ - verify (GNUTLS_STAGE_EMPTY == 0); + static_assert (GNUTLS_STAGE_EMPTY == 0); eassert (XPROCESS (proc)->gnutls_initstage == GNUTLS_STAGE_EMPTY); eassert (NILP (XPROCESS (proc)->gnutls_cred_type)); #endif @@ -2143,7 +2143,7 @@ enum EXEC_MONITOR_OUTPUT }; -verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1); +static_assert (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1); static void create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) @@ -2862,6 +2862,9 @@ static const struct socket_options { #ifdef SO_REUSEADDR { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR }, #endif +#ifdef TCP_NODELAY + { ":nodelay", IPPROTO_TCP, TCP_NODELAY, SOPT_BOOL, OPIX_MISC }, +#endif { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE } }; @@ -3540,9 +3543,9 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, structures, but the standards don't guarantee that, so verify it here. */ struct sockaddr_in6 sa6; - verify ((offsetof (struct sockaddr_in, sin_port) - == offsetof (struct sockaddr_in6, sin6_port)) - && sizeof (sa1.sin_port) == sizeof (sa6.sin6_port)); + static_assert ((offsetof (struct sockaddr_in, sin_port) + == offsetof (struct sockaddr_in6, sin6_port)) + && sizeof (sa1.sin_port) == sizeof (sa6.sin6_port)); #endif DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1); if (getsockname (s, psa1, &len1) == 0) @@ -3900,6 +3903,7 @@ The following network options can be specified for this connection: :broadcast BOOL -- Allow send and receive of datagram broadcasts. :dontroute BOOL -- Only send to directly connected hosts. :keepalive BOOL -- Send keep-alive messages on network stream. +:nodelay BOOL -- Set TCP_NODELAY on the network socket. :linger BOOL or TIMEOUT -- Send queued messages before closing. :oobinline BOOL -- Place out-of-band data in receive data stream. :priority INT -- Set protocol defined priority for sent packets. @@ -4347,6 +4351,10 @@ network_interface_list (bool full, unsigned short match) if (full) { + /* Sometimes sa_family is only filled in correctly in the + interface address, not the netmask, so copy it across + (Bug#74907). */ + it->ifa_netmask->sa_family = it->ifa_addr->sa_family; elt = Fcons (conv_sockaddr_to_lisp (it->ifa_netmask, len), elt); /* There is an it->ifa_broadaddr field, but its contents are unreliable, so always calculate the broadcast address from @@ -4471,7 +4479,7 @@ network_interface_info (Lisp_Object ifname) CHECK_STRING (ifname); if (sizeof rq.ifr_name <= SBYTES (ifname)) - error ("interface name too long"); + error ("Interface name too long"); lispstpcpy (rq.ifr_name, ifname); s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0); @@ -4761,13 +4769,17 @@ returned from the lookup. */) { for (lres = res; lres; lres = lres->ai_next) { -#ifndef AF_INET6 - if (lres->ai_family != AF_INET) - continue; + /* Avoid converting non-IP addresses (Bug#74907). */ + if (lres->ai_family == AF_INET +#ifdef AF_INET6 + || lres->ai_family == AF_INET6 #endif - addresses = Fcons (conv_sockaddr_to_lisp (lres->ai_addr, - lres->ai_addrlen), - addresses); + ) + addresses = Fcons (conv_sockaddr_to_lisp (lres->ai_addr, + lres->ai_addrlen), + addresses); + else + continue; } addresses = Fnreverse (addresses); @@ -6859,7 +6871,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, pset_status (p, list2 (Qexit, make_fixnum (256))); p->tick = ++process_tick; deactivate_process (proc); - error ("process %s no longer connected to pipe; closed it", + error ("Process %s no longer connected to pipe; closed it", SDATA (p->name)); } else diff --git a/src/puresize.h b/src/puresize.h index e9cbdd86022..ee173e3595d 100644 --- a/src/puresize.h +++ b/src/puresize.h @@ -47,7 +47,7 @@ INLINE_HEADER_BEGIN #endif #ifndef BASE_PURESIZE -#define BASE_PURESIZE (3000000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) +#define BASE_PURESIZE (3100000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #endif /* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 6d16376f6fa..d3017f46751 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -1290,7 +1290,7 @@ typedef int regnum_t; /* Macros for the compile stack. */ typedef long pattern_offset_t; -verify (LONG_MIN <= -(MAX_BUF_SIZE - 1) && MAX_BUF_SIZE - 1 <= LONG_MAX); +static_assert (LONG_MIN <= -(MAX_BUF_SIZE - 1) && MAX_BUF_SIZE - 1 <= LONG_MAX); typedef struct { diff --git a/src/scroll.c b/src/scroll.c index b91750b1d7e..ee5b608c1c8 100644 --- a/src/scroll.c +++ b/src/scroll.c @@ -366,7 +366,7 @@ do_scrolling (struct frame *frame, struct glyph_matrix *current_matrix, eassert (copy_from[k] >= 0 && copy_from[k] < window_size); /* Perform the row swizzling. */ - mirrored_line_dance (current_matrix, unchanged_at_top, window_size, + mirrored_line_dance (frame, unchanged_at_top, window_size, copy_from, retained_p); /* Some sanity checks if GLYPH_DEBUG is defined. */ @@ -780,7 +780,7 @@ do_direct_scrolling (struct frame *frame, struct glyph_matrix *current_matrix, copy_from[i] gives the original line to copy to I, and retained_p[copy_from[i]] is zero if line I in the new display is empty. */ - mirrored_line_dance (current_matrix, unchanged_at_top, window_size, + mirrored_line_dance (frame, unchanged_at_top, window_size, copy_from, retained_p); if (terminal_window_p) diff --git a/src/search.c b/src/search.c index 6779a936b2c..f0672fca151 100644 --- a/src/search.c +++ b/src/search.c @@ -2762,6 +2762,7 @@ since only regular expressions have distinguished subexpressions. */) /* Replace the old text with the new in the cleanest possible way. */ replace_range (sub_start, sub_end, newtext, 1, 0, 1, true, true); + signal_after_change (sub_start, sub_end - sub_start, SCHARS (newtext)); if (case_action == all_caps) Fupcase_region (make_fixnum (search_regs.start[sub]), @@ -2771,22 +2772,11 @@ since only regular expressions have distinguished subexpressions. */) Fupcase_initials_region (make_fixnum (search_regs.start[sub]), make_fixnum (newpoint), Qnil); - /* The replace_range etc. functions can trigger modification hooks - (see signal_before_change and signal_after_change). Try to error - out if these hooks clobber the match data since clobbering can - result in confusing bugs. We used to check for changes in - search_regs start and end, but that fails if modification hooks - remove or add text earlier in the buffer, so just check num_regs - now. */ - if (search_regs.num_regs != num_regs) - error ("Match data clobbered by buffer modification hooks"); - /* Put point back where it was in the text, if possible. */ TEMP_SET_PT (clip_to_bounds (BEGV, opoint + (opoint <= 0 ? ZV : 0), ZV)); /* Now move point "officially" to the end of the inserted replacement. */ move_if_not_intangible (newpoint); - signal_after_change (sub_start, sub_end - sub_start, SCHARS (newtext)); update_compositions (sub_start, newpoint, CHECK_BORDER); return Qnil; @@ -3405,6 +3395,7 @@ DEFUN ("re--describe-compiled", Fre__describe_compiled, Sre__describe_compiled, If RAW is non-nil, just return the actual bytecode. */) (Lisp_Object regexp, Lisp_Object raw) { + CHECK_STRING (regexp); struct regexp_cache *cache_entry = compile_pattern (regexp, NULL, (!NILP (Vcase_fold_search) diff --git a/src/sfntfont.c b/src/sfntfont.c index 3c9d8599459..5752ff81c1c 100644 --- a/src/sfntfont.c +++ b/src/sfntfont.c @@ -20,7 +20,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> #include <fcntl.h> -#include <ctype.h> +#include <c-ctype.h> #include "lisp.h" @@ -534,12 +534,12 @@ sfnt_parse_style (Lisp_Object style_name, struct sfnt_font_desc *desc) } /* This token is extraneous or was not recognized. Capitalize - the first letter and set it as the adstyle. */ + the first letter if it's ASCII lowercase, then set the token as + the adstyle. */ if (strlen (single)) { - if (islower (single[0])) - single[0] = toupper (single[0]); + single[0] = c_toupper (single[0]); if (NILP (desc->adstyle)) desc->adstyle = build_string (single); diff --git a/src/sort.c b/src/sort.c index a3970add713..7f079cecd45 100644 --- a/src/sort.c +++ b/src/sort.c @@ -1113,7 +1113,7 @@ tim_sort (Lisp_Object predicate, Lisp_Object keyfunc, { /* Fill with valid Lisp values in case a GC occurs before all keys have been computed. */ - verify (NIL_IS_ZERO); + static_assert (NIL_IS_ZERO); keys = allocated_keys = xzalloc (length * word_size); } diff --git a/src/sound.c b/src/sound.c index 2aadc7412a1..67a1e99e31c 100644 --- a/src/sound.c +++ b/src/sound.c @@ -26,14 +26,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ implementation of the play-sound specification for Windows. Notes: - In the Windows implementation of play-sound-internal only the - :file and :volume keywords are supported. The :device keyword, - if present, is ignored. The :data keyword, if present, will - cause an error to be generated. + In the Windows implementation of play-sound-internal the :device + keyword, if present, is ignored. The Windows implementation of play-sound is implemented via the - Windows API functions mciSendString, waveOutGetVolume, and - waveOutSetVolume which are exported by Winmm.dll. + Windows API functions mciSendString, waveOutGetVolume, + waveOutSetVolume and PlaySound which are exported by Winmm.dll. */ #include <config.h> @@ -91,6 +89,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "w32.h" /* END: Windows Specific Includes */ +/* Missing in mingw32. */ +#ifndef SND_SENTRY +#define SND_SENTRY 0x00080000 +#endif + #endif /* WINDOWSNT */ /* BEGIN: Common Definitions */ @@ -278,7 +281,7 @@ static void au_play (struct sound *, struct sound_device *); #else /* WINDOWSNT */ /* BEGIN: Windows Specific Definitions */ -static int do_play_sound (const char *, unsigned long); +static int do_play_sound (const char *, unsigned long, bool); /* END: Windows Specific Definitions */ #endif /* WINDOWSNT */ @@ -366,21 +369,10 @@ parse_sound (Lisp_Object sound, Lisp_Object *attrs) attrs[SOUND_DEVICE] = plist_get (sound, QCdevice); attrs[SOUND_VOLUME] = plist_get (sound, QCvolume); -#ifndef WINDOWSNT /* File name or data must be specified. */ if (!STRINGP (attrs[SOUND_FILE]) && !STRINGP (attrs[SOUND_DATA])) return 0; -#else /* WINDOWSNT */ - /* - Data is not supported in Windows. Therefore a - File name MUST be supplied. - */ - if (!STRINGP (attrs[SOUND_FILE])) - { - return 0; - } -#endif /* WINDOWSNT */ /* Volume must be in the range 0..100 or unspecified. */ if (!NILP (attrs[SOUND_VOLUME])) @@ -1225,7 +1217,7 @@ alsa_init (struct sound_device *sd) } while (0) static int -do_play_sound (const char *psz_file, unsigned long ui_volume) +do_play_sound (const char *psz_file_or_data, unsigned long ui_volume, bool in_memory) { int i_result = 0; MCIERROR mci_error = 0; @@ -1236,65 +1228,7 @@ do_play_sound (const char *psz_file, unsigned long ui_volume) BOOL b_reset_volume = FALSE; char warn_text[560]; - /* Since UNICOWS.DLL includes only a stub for mciSendStringW, we - need to encode the file in the ANSI codepage on Windows 9X even - if w32_unicode_filenames is non-zero. */ - if (w32_major_version <= 4 || !w32_unicode_filenames) - { - char fname_a[MAX_PATH], shortname[MAX_PATH], *fname_to_use; - - filename_to_ansi (psz_file, fname_a); - fname_to_use = fname_a; - /* If the file name is not encodable in ANSI, try its short 8+3 - alias. This will only work if w32_unicode_filenames is - non-zero. */ - if (_mbspbrk ((const unsigned char *)fname_a, - (const unsigned char *)"?")) - { - if (w32_get_short_filename (psz_file, shortname, MAX_PATH)) - fname_to_use = shortname; - else - mci_error = MCIERR_FILE_NOT_FOUND; - } - - if (!mci_error) - { - memset (sz_cmd_buf_a, 0, sizeof (sz_cmd_buf_a)); - memset (sz_ret_buf_a, 0, sizeof (sz_ret_buf_a)); - sprintf (sz_cmd_buf_a, - "open \"%s\" alias GNUEmacs_PlaySound_Device wait", - fname_to_use); - mci_error = mciSendStringA (sz_cmd_buf_a, - sz_ret_buf_a, sizeof (sz_ret_buf_a), NULL); - } - } - else - { - wchar_t sz_cmd_buf_w[520]; - wchar_t sz_ret_buf_w[520]; - wchar_t fname_w[MAX_PATH]; - - filename_to_utf16 (psz_file, fname_w); - memset (sz_cmd_buf_w, 0, sizeof (sz_cmd_buf_w)); - memset (sz_ret_buf_w, 0, sizeof (sz_ret_buf_w)); - /* _swprintf is not available on Windows 9X, so we construct the - UTF-16 command string by hand. */ - wcscpy (sz_cmd_buf_w, L"open \""); - wcscat (sz_cmd_buf_w, fname_w); - wcscat (sz_cmd_buf_w, L"\" alias GNUEmacs_PlaySound_Device wait"); - mci_error = mciSendStringW (sz_cmd_buf_w, - sz_ret_buf_w, ARRAYELTS (sz_ret_buf_w) , NULL); - } - if (mci_error != 0) - { - strcpy (warn_text, - "mciSendString: 'open' command failed to open sound file "); - strcat (warn_text, psz_file); - SOUND_WARNING (mciGetErrorString, mci_error, warn_text); - i_result = (int) mci_error; - return i_result; - } - if ((ui_volume > 0) && (ui_volume != UINT_MAX)) + if (ui_volume > 0) { mm_result = waveOutGetVolume ((HWAVEOUT) WAVE_MAPPER, &ui_volume_org); if (mm_result == MMSYSERR_NOERROR) @@ -1319,34 +1253,105 @@ do_play_sound (const char *psz_file, unsigned long ui_volume) " not be used."); } } - memset (sz_cmd_buf_a, 0, sizeof (sz_cmd_buf_a)); - memset (sz_ret_buf_a, 0, sizeof (sz_ret_buf_a)); - strcpy (sz_cmd_buf_a, "play GNUEmacs_PlaySound_Device wait"); - mci_error = mciSendStringA (sz_cmd_buf_a, sz_ret_buf_a, sizeof (sz_ret_buf_a), - NULL); - if (mci_error != 0) + + if (in_memory) { - strcpy (warn_text, - "mciSendString: 'play' command failed to play sound file "); - strcat (warn_text, psz_file); - SOUND_WARNING (mciGetErrorString, mci_error, warn_text); - i_result = (int) mci_error; + int flags = SND_MEMORY; + if (w32_major_version >= 6) /* Vista and later */ + flags |= SND_SENTRY; + i_result = !PlaySound (psz_file_or_data, NULL, flags); } - memset (sz_cmd_buf_a, 0, sizeof (sz_cmd_buf_a)); - memset (sz_ret_buf_a, 0, sizeof (sz_ret_buf_a)); - strcpy (sz_cmd_buf_a, "close GNUEmacs_PlaySound_Device wait"); - mci_error = mciSendStringA (sz_cmd_buf_a, sz_ret_buf_a, sizeof (sz_ret_buf_a), - NULL); + else + { + /* Since UNICOWS.DLL includes only a stub for mciSendStringW, we + need to encode the file in the ANSI codepage on Windows 9X even + if w32_unicode_filenames is non-zero. */ + if (w32_major_version <= 4 || !w32_unicode_filenames) + { + char fname_a[MAX_PATH], shortname[MAX_PATH], *fname_to_use; + + filename_to_ansi (psz_file_or_data, fname_a); + fname_to_use = fname_a; + /* If the file name is not encodable in ANSI, try its short 8+3 + alias. This will only work if w32_unicode_filenames is + non-zero. */ + if (_mbspbrk ((const unsigned char *)fname_a, + (const unsigned char *)"?")) + { + if (w32_get_short_filename (psz_file_or_data, shortname, MAX_PATH)) + fname_to_use = shortname; + else + mci_error = MCIERR_FILE_NOT_FOUND; + } + + if (!mci_error) + { + memset (sz_cmd_buf_a, 0, sizeof (sz_cmd_buf_a)); + memset (sz_ret_buf_a, 0, sizeof (sz_ret_buf_a)); + sprintf (sz_cmd_buf_a, + "open \"%s\" alias GNUEmacs_PlaySound_Device wait", + fname_to_use); + mci_error = mciSendStringA (sz_cmd_buf_a, + sz_ret_buf_a, sizeof (sz_ret_buf_a), NULL); + } + } + else + { + wchar_t sz_cmd_buf_w[520]; + wchar_t sz_ret_buf_w[520]; + wchar_t fname_w[MAX_PATH]; + + filename_to_utf16 (psz_file_or_data, fname_w); + memset (sz_cmd_buf_w, 0, sizeof (sz_cmd_buf_w)); + memset (sz_ret_buf_w, 0, sizeof (sz_ret_buf_w)); + /* _swprintf is not available on Windows 9X, so we construct the + UTF-16 command string by hand. */ + wcscpy (sz_cmd_buf_w, L"open \""); + wcscat (sz_cmd_buf_w, fname_w); + wcscat (sz_cmd_buf_w, L"\" alias GNUEmacs_PlaySound_Device wait"); + mci_error = mciSendStringW (sz_cmd_buf_w, + sz_ret_buf_w, ARRAYELTS (sz_ret_buf_w) , NULL); + } + if (mci_error != 0) + { + strcpy (warn_text, + "mciSendString: 'open' command failed to open sound file "); + strcat (warn_text, psz_file_or_data); + SOUND_WARNING (mciGetErrorString, mci_error, warn_text); + i_result = (int) mci_error; + return i_result; + } + memset (sz_cmd_buf_a, 0, sizeof (sz_cmd_buf_a)); + memset (sz_ret_buf_a, 0, sizeof (sz_ret_buf_a)); + strcpy (sz_cmd_buf_a, "play GNUEmacs_PlaySound_Device wait"); + mci_error = mciSendStringA (sz_cmd_buf_a, sz_ret_buf_a, sizeof (sz_ret_buf_a), + NULL); + if (mci_error != 0) + { + strcpy (warn_text, + "mciSendString: 'play' command failed to play sound file "); + strcat (warn_text, psz_file_or_data); + SOUND_WARNING (mciGetErrorString, mci_error, warn_text); + i_result = (int) mci_error; + } + memset (sz_cmd_buf_a, 0, sizeof (sz_cmd_buf_a)); + memset (sz_ret_buf_a, 0, sizeof (sz_ret_buf_a)); + strcpy (sz_cmd_buf_a, "close GNUEmacs_PlaySound_Device wait"); + mci_error = mciSendStringA (sz_cmd_buf_a, sz_ret_buf_a, sizeof (sz_ret_buf_a), + NULL); + } + if (b_reset_volume == TRUE) { mm_result = waveOutSetVolume ((HWAVEOUT) WAVE_MAPPER, ui_volume_org); if (mm_result != MMSYSERR_NOERROR) - { - SOUND_WARNING (waveOutGetErrorText, mm_result, + { + SOUND_WARNING (waveOutGetErrorText, mm_result, "waveOutSetVolume: failed to reset the original" - " volume level of the WAVE_MAPPER device."); - } + " volume level of the WAVE_MAPPER device."); + } } + return i_result; } @@ -1364,8 +1369,7 @@ Internal use only, use `play-sound' instead. */) specpdl_ref count = SPECPDL_INDEX (); #ifdef WINDOWSNT - unsigned long ui_volume_tmp = UINT_MAX; - unsigned long ui_volume = UINT_MAX; + unsigned long ui_volume = 0; #endif /* WINDOWSNT */ /* Parse the sound specification. Give up if it is invalid. */ @@ -1432,33 +1436,31 @@ Internal use only, use `play-sound' instead. */) #else /* WINDOWSNT */ - file = Fexpand_file_name (attrs[SOUND_FILE], Vdata_directory); - file = ENCODE_FILE (file); + if (FIXNUMP (attrs[SOUND_VOLUME])) - { - ui_volume_tmp = XFIXNAT (attrs[SOUND_VOLUME]); - } + ui_volume = XFIXNAT (attrs[SOUND_VOLUME]); else if (FLOATP (attrs[SOUND_VOLUME])) - { - ui_volume_tmp = XFLOAT_DATA (attrs[SOUND_VOLUME]) * 100; - } + ui_volume = XFLOAT_DATA (attrs[SOUND_VOLUME]) * 100; + + if (ui_volume > 100) + ui_volume = 100; + + /* For volume (32 bits), low order 16 bits are the value for left + channel, and high order 16 bits for the right channel. We use the + specified volume on both channels. */ + ui_volume = ui_volume * 0xFFFF / 100; + ui_volume = (ui_volume << 16) + ui_volume; CALLN (Frun_hook_with_args, Qplay_sound_functions, sound); - /* - Based on some experiments I have conducted, a value of 100 or less - for the sound volume is much too low. You cannot even hear it. - A value of UINT_MAX indicates that you wish for the sound to played - at the maximum possible volume. A value of UINT_MAX/2 plays the - sound at 50% maximum volume. Therefore the value passed to do_play_sound - (and thus to waveOutSetVolume) must be some fraction of UINT_MAX. - The following code adjusts the user specified volume level appropriately. - */ - if ((ui_volume_tmp > 0) && (ui_volume_tmp <= 100)) + if (STRINGP (attrs[SOUND_FILE])) { - ui_volume = ui_volume_tmp * (UINT_MAX / 100); + file = Fexpand_file_name (attrs[SOUND_FILE], Vdata_directory); + file = ENCODE_FILE (file); + do_play_sound (SSDATA (file), ui_volume, false); } - (void)do_play_sound (SSDATA (file), ui_volume); + else + do_play_sound (SDATA (attrs[SOUND_DATA]), ui_volume, true); #endif /* WINDOWSNT */ diff --git a/src/sysdep.c b/src/sysdep.c index 92f6f732e23..188b3c3958a 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -33,7 +33,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <c-ctype.h> #include <close-stream.h> #include <pathmax.h> -#include <utimens.h> #include "lisp.h" #include "sysselect.h" @@ -2248,7 +2247,7 @@ init_random (void) /* FIXME: Perhaps getrandom can be used here too? */ success = w32_init_random (&v, sizeof v) == 0; #else - verify (sizeof v <= 256); + static_assert (sizeof v <= 256); success = getrandom (&v, sizeof v, 0) == sizeof v; #endif @@ -2742,16 +2741,16 @@ emacs_fchmodat (int fd, const char *path, mode_t mode, int flags) #ifndef SSIZE_MAX # define SSIZE_MAX TYPE_MAXIMUM (ssize_t) #endif -verify (MAX_RW_COUNT <= PTRDIFF_MAX); -verify (MAX_RW_COUNT <= SIZE_MAX); -verify (MAX_RW_COUNT <= SSIZE_MAX); +static_assert (MAX_RW_COUNT <= PTRDIFF_MAX); +static_assert (MAX_RW_COUNT <= SIZE_MAX); +static_assert (MAX_RW_COUNT <= SSIZE_MAX); #ifdef WINDOWSNT /* Verify that Emacs read requests cannot cause trouble, even in 64-bit builds. The last argument of 'read' is 'unsigned int', and the return value's type (see 'sys_read') is 'int'. */ -verify (MAX_RW_COUNT <= INT_MAX); -verify (MAX_RW_COUNT <= UINT_MAX); +static_assert (MAX_RW_COUNT <= INT_MAX); +static_assert (MAX_RW_COUNT <= UINT_MAX); #endif /* Read from FD to a buffer BUF with size NBYTE. @@ -3548,6 +3547,7 @@ procfs_ttyname (int rdev) } # endif /* GNU_LINUX || __ANDROID__ */ +/* Total usable RAM in KiB. */ static uintmax_t procfs_get_total_memory (void) { @@ -3737,8 +3737,13 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qnice, make_fixnum (niceness)), attrs); attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (thcount)), attrs); attrs = Fcons (Fcons (Qvsize, INT_TO_INTEGER (vsize / 1024)), attrs); - attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (4 * rss)), attrs); - pmem = 4.0 * 100 * rss / procfs_get_total_memory (); + + /* RSS in KiB. */ + uintmax_t rssk = rss; + rssk *= getpagesize () >> 10; + + attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (rssk)), attrs); + pmem = 100.0 * rssk / procfs_get_total_memory (); if (pmem > 100) pmem = 100; attrs = Fcons (Fcons (Qpmem, make_float (pmem)), attrs); @@ -4551,18 +4556,10 @@ does the same thing as `current-time'. */) # include <wchar.h> # include <wctype.h> -# if defined HAVE_NEWLOCALE || defined HAVE_SETLOCALE -# include <locale.h> -# endif -# ifndef LC_COLLATE -# define LC_COLLATE 0 -# endif +# include <locale.h> # ifndef LC_COLLATE_MASK # define LC_COLLATE_MASK 0 # endif -# ifndef LC_CTYPE -# define LC_CTYPE 0 -# endif # ifndef LC_CTYPE_MASK # define LC_CTYPE_MASK 0 # endif @@ -4595,15 +4592,11 @@ freelocale (locale_t loc) static char * emacs_setlocale (int category, char const *locale) { -# ifdef HAVE_SETLOCALE errno = 0; char *loc = setlocale (category, locale); if (loc || errno) return loc; errno = EINVAL; -# else - errno = ENOTSUP; -# endif return 0; } diff --git a/src/systime.h b/src/systime.h index 58156d71571..22ede456840 100644 --- a/src/systime.h +++ b/src/systime.h @@ -77,22 +77,12 @@ extern void set_waiting_for_input (struct timespec *); (HI << LO_TIME_BITS) + LO + US / 1e6 + PS / 1e12. */ enum { LO_TIME_BITS = 16 }; -/* Components of a new-format Lisp timestamp. */ -struct lisp_time -{ - /* Clock count as a Lisp integer. */ - Lisp_Object ticks; - - /* Clock frequency (ticks per second) as a positive Lisp integer. */ - Lisp_Object hz; -}; - /* defined in timefns.c */ extern struct timeval make_timeval (struct timespec) ATTRIBUTE_CONST; extern Lisp_Object make_lisp_time (struct timespec); extern Lisp_Object timespec_to_lisp (struct timespec); -extern bool list4_to_timespec (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object, struct timespec *); +extern struct timespec list4_to_timespec (Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); extern struct timespec lisp_time_argument (Lisp_Object); extern double float_time (Lisp_Object); extern void init_timefns (void); diff --git a/src/term.c b/src/term.c index 8ce68f0f768..10380eba4b9 100644 --- a/src/term.c +++ b/src/term.c @@ -65,11 +65,9 @@ static int been_here = -1; #ifndef HAVE_ANDROID static void tty_set_scroll_region (struct frame *f, int start, int stop); -static void turn_on_face (struct frame *, int face_id); -static void turn_off_face (struct frame *, int face_id); +static void turn_on_face (struct frame *f, struct face *face); +static void turn_off_face (struct frame *f, struct face *face); static void tty_turn_off_highlight (struct tty_display_info *); -static void tty_show_cursor (struct tty_display_info *); -static void tty_hide_cursor (struct tty_display_info *); static void tty_background_highlight (struct tty_display_info *tty); static void clear_tty_hooks (struct terminal *terminal); static void set_tty_hooks (struct terminal *terminal); @@ -143,6 +141,7 @@ static int max_frame_cols; struct tty_display_info *gpm_tty = NULL; /* Last recorded mouse coordinates. */ +static Lisp_Object last_mouse_frame; static int last_mouse_x, last_mouse_y; #endif /* HAVE_GPM */ @@ -336,7 +335,7 @@ tty_toggle_highlight (struct tty_display_info *tty) /* Make cursor invisible. */ -static void +void tty_hide_cursor (struct tty_display_info *tty) { if (tty->cursor_hidden == 0) @@ -353,7 +352,7 @@ tty_hide_cursor (struct tty_display_info *tty) /* Ensure that cursor is visible. */ -static void +void tty_show_cursor (struct tty_display_info *tty) { if (tty->cursor_hidden) @@ -753,18 +752,12 @@ encode_terminal_code (struct glyph *src, int src_len, static void tty_write_glyphs (struct frame *f, struct glyph *string, int len) { - unsigned char *conversion_buffer; - struct coding_system *coding; - int n, stringlen; - struct tty_display_info *tty = FRAME_TTY (f); - tty_turn_off_insert (tty); tty_hide_cursor (tty); /* Don't dare write in last column of bottom line, if Auto-Wrap, since that would scroll the whole frame on some terminals. */ - if (AutoWrap (tty) && curY (tty) + 1 == FRAME_TOTAL_LINES (f) && (curX (tty) + len) == FRAME_COLS (f)) @@ -777,29 +770,34 @@ tty_write_glyphs (struct frame *f, struct glyph *string, int len) /* If terminal_coding does any conversion, use it, otherwise use safe_terminal_coding. We can't use CODING_REQUIRE_ENCODING here because it always return 1 if the member src_multibyte is 1. */ - coding = (FRAME_TERMINAL_CODING (f)->common_flags & CODING_REQUIRE_ENCODING_MASK - ? FRAME_TERMINAL_CODING (f) : &safe_terminal_coding); + struct coding_system *coding + = (FRAME_TERMINAL_CODING (f)->common_flags & CODING_REQUIRE_ENCODING_MASK + ? FRAME_TERMINAL_CODING (f) : &safe_terminal_coding); + /* The mode bit CODING_MODE_LAST_BLOCK should be set to 1 only at the tail. */ coding->mode &= ~CODING_MODE_LAST_BLOCK; - for (stringlen = len; stringlen != 0; stringlen -= n) + for (int stringlen = len, n; stringlen; stringlen -= n, string += n) { /* Identify a run of glyphs with the same face. */ int face_id = string->face_id; + struct frame *face_id_frame = string->frame; for (n = 1; n < stringlen; ++n) - if (string[n].face_id != face_id) + if (string[n].face_id != face_id || string[n].frame != face_id_frame) break; /* Turn appearance modes of the face of the run on. */ tty_highlight_if_desired (tty); - turn_on_face (f, face_id); + struct face *face = FACE_FROM_ID (face_id_frame, face_id); + turn_on_face (f, face); if (n == stringlen) /* This is the last run. */ coding->mode |= CODING_MODE_LAST_BLOCK; - conversion_buffer = encode_terminal_code (string, n, coding); + unsigned char *conversion_buffer + = encode_terminal_code (string, n, coding); if (coding->produced > 0) { block_input (); @@ -809,10 +807,9 @@ tty_write_glyphs (struct frame *f, struct glyph *string, int len) fwrite (conversion_buffer, 1, coding->produced, tty->termscript); unblock_input (); } - string += n; /* Turn appearance modes off. */ - turn_off_face (f, face_id); + turn_off_face (f, face); tty_turn_off_highlight (tty); } @@ -822,8 +819,8 @@ tty_write_glyphs (struct frame *f, struct glyph *string, int len) #ifndef DOS_NT static void -tty_write_glyphs_with_face (register struct frame *f, register struct glyph *string, - register int len, register int face_id) +tty_write_glyphs_with_face (struct frame *f, struct glyph *string, + int len, struct face *face) { unsigned char *conversion_buffer; struct coding_system *coding; @@ -856,7 +853,7 @@ tty_write_glyphs_with_face (register struct frame *f, register struct glyph *str /* Turn appearance modes of the face. */ tty_highlight_if_desired (tty); - turn_on_face (f, face_id); + turn_on_face (f, face); coding->mode |= CODING_MODE_LAST_BLOCK; conversion_buffer = encode_terminal_code (string, len, coding); @@ -871,7 +868,7 @@ tty_write_glyphs_with_face (register struct frame *f, register struct glyph *str } /* Turn appearance modes off. */ - turn_off_face (f, face_id); + turn_off_face (f, face); tty_turn_off_highlight (tty); cmcheckmagic (tty); @@ -919,6 +916,7 @@ tty_insert_glyphs (struct frame *f, struct glyph *start, int len) while (len-- > 0) { + struct face *face = NULL; OUTPUT1_IF (tty, tty->TS_ins_char); if (!start) { @@ -928,7 +926,10 @@ tty_insert_glyphs (struct frame *f, struct glyph *start, int len) else { tty_highlight_if_desired (tty); - turn_on_face (f, start->face_id); + int face_id = start->face_id; + struct frame *face_id_frame = start->frame; + face = FACE_FROM_ID (face_id_frame, face_id); + turn_on_face (f, face); glyph = start; ++start; /* We must open sufficient space for a character which @@ -957,9 +958,9 @@ tty_insert_glyphs (struct frame *f, struct glyph *start, int len) } OUTPUT1_IF (tty, tty->TS_pad_inserted_char); - if (start) + if (face) { - turn_off_face (f, glyph->face_id); + turn_off_face (f, face); tty_turn_off_highlight (tty); } } @@ -1542,6 +1543,7 @@ append_glyph (struct it *it) glyph->type = CHAR_GLYPH; glyph->pixel_width = 1; glyph->u.ch = it->char_to_display; + glyph->frame = it->f; glyph->face_id = it->face_id; glyph->avoid_cursor_p = it->avoid_cursor_p; glyph->multibyte_p = it->multibyte_p; @@ -1769,6 +1771,7 @@ append_composite_glyph (struct it *it) glyph->avoid_cursor_p = it->avoid_cursor_p; glyph->multibyte_p = it->multibyte_p; + glyph->frame = it->f; glyph->face_id = it->face_id; glyph->padding_p = false; glyph->charpos = CHARPOS (it->position); @@ -1855,6 +1858,7 @@ append_glyphless_glyph (struct it *it, int face_id, const char *str) glyph->pixel_width = 1; glyph->avoid_cursor_p = it->avoid_cursor_p; glyph->multibyte_p = it->multibyte_p; + glyph->frame = it->f; glyph->face_id = face_id; glyph->padding_p = false; glyph->charpos = CHARPOS (it->position); @@ -1981,9 +1985,8 @@ produce_glyphless_glyph (struct it *it, Lisp_Object acronym) FACE_ID is a realized face ID number, in the face cache. */ static void -turn_on_face (struct frame *f, int face_id) +turn_on_face (struct frame *f, struct face *face) { - struct face *face = FACE_FROM_ID (f, face_id); unsigned long fg = face->foreground; unsigned long bg = face->background; struct tty_display_info *tty = FRAME_TTY (f); @@ -2064,9 +2067,8 @@ turn_on_face (struct frame *f, int face_id) /* Turn off appearances of face FACE_ID on tty frame F. */ static void -turn_off_face (struct frame *f, int face_id) +turn_off_face (struct frame *f, struct face *face) { - struct face *face = FACE_FROM_ID (f, face_id); struct tty_display_info *tty = FRAME_TTY (f); if (tty->TS_exit_attribute_mode) @@ -2399,8 +2401,10 @@ A suspended tty may be resumed by calling `resume-tty' on it. */) t->display_info.tty->output = 0; if (FRAMEP (t->display_info.tty->top_frame)) - SET_FRAME_VISIBLE (XFRAME (t->display_info.tty->top_frame), 0); - + { + struct frame *top = XFRAME (t->display_info.tty->top_frame); + SET_FRAME_VISIBLE (root_frame (top), false); + } } /* Clear display hooks to prevent further output. */ @@ -2472,7 +2476,8 @@ frame's terminal). */) if (FRAMEP (t->display_info.tty->top_frame)) { - struct frame *f = XFRAME (t->display_info.tty->top_frame); + struct frame *top = XFRAME (t->display_info.tty->top_frame); + struct frame *f = root_frame (top); int width, height; int old_height = FRAME_COLS (f); int old_width = FRAME_TOTAL_LINES (f); @@ -2482,7 +2487,7 @@ frame's terminal). */) get_tty_size (fileno (t->display_info.tty->input), &width, &height); if (width != old_width || height != old_height) change_frame_size (f, width, height, false, false, false); - SET_FRAME_VISIBLE (XFRAME (t->display_info.tty->top_frame), 1); + SET_FRAME_VISIBLE (f, true); } set_tty_hooks (t); @@ -2563,22 +2568,24 @@ tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row, struct frame *f = XFRAME (WINDOW_FRAME (w)); struct tty_display_info *tty = FRAME_TTY (f); int face_id = tty->mouse_highlight.mouse_face_face_id; - int save_x, save_y, pos_x, pos_y; if (end_hpos >= row->used[TEXT_AREA]) nglyphs = row->used[TEXT_AREA] - start_hpos; - pos_y = row->y + WINDOW_TOP_EDGE_Y (w); - pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos + WINDOW_LEFT_EDGE_X (w); + int pos_y = row->y + WINDOW_TOP_EDGE_Y (w); + int pos_x = row->used[LEFT_MARGIN_AREA] + start_hpos + WINDOW_LEFT_EDGE_X (w); /* Save current cursor coordinates. */ - save_y = curY (tty); - save_x = curX (tty); + int save_y = curY (tty); + int save_x = curX (tty); cursor_to (f, pos_y, pos_x); if (draw == DRAW_MOUSE_FACE) - tty_write_glyphs_with_face (f, row->glyphs[TEXT_AREA] + start_hpos, - nglyphs, face_id); + { + struct glyph *glyph = row->glyphs[TEXT_AREA] + start_hpos; + struct face *face = FACE_FROM_ID (f, face_id); + tty_write_glyphs_with_face (f, glyph, nglyphs, face); + } else if (draw == DRAW_NORMAL_TEXT) write_glyphs (f, row->glyphs[TEXT_AREA] + start_hpos, nglyphs); @@ -2587,6 +2594,35 @@ tty_draw_row_with_mouse_face (struct window *w, struct glyph_row *row, #endif +static Lisp_Object +tty_frame_at (int x, int y) +{ + for (Lisp_Object frames = Ftty_frame_list_z_order (Qnil); frames != Qnil; + frames = Fcdr (frames)) + { + Lisp_Object frame = Fcar (frames); + struct frame *f = XFRAME (frame); + + if (f->left_pos <= x && x < f->left_pos + f->pixel_width && + f->top_pos <= y && y < f->top_pos + f->pixel_height) + return frame; + } + + return Qnil; +} + +DEFUN ("tty-frame-at", Ftty_frame_at, Stty_frame_at, + 2, 2, 0, + doc: /* Return tty frame containing pixel position X, Y. */) + (Lisp_Object x, Lisp_Object y) +{ + if (! FIXNUMP (x) || ! FIXNUMP (y)) + /* Coordinates this big can not correspond to any frame. */ + return Qnil; + + return tty_frame_at (XFIXNUM (x), XFIXNUM (y)); +} + #ifdef HAVE_GPM void @@ -2632,7 +2668,12 @@ term_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, Time *timeptr) { - *fp = SELECTED_FRAME (); + /* If we've gotten no GPM mouse events yet, last_mouse_frame won't be + set. Perhaps `gpm-mouse-mode' was never active. */ + if (! FRAMEP (last_mouse_frame)) + return; + + *fp = XFRAME (last_mouse_frame); (*fp)->mouse_moved = 0; *bar_window = Qnil; @@ -2707,9 +2748,14 @@ term_mouse_click (struct input_event *result, Gpm_Event *event, } int -handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event) +handle_one_term_event (struct tty_display_info *tty, const Gpm_Event *event_in) { - struct frame *f = XFRAME (tty->top_frame); + Lisp_Object frame = tty_frame_at (event_in->x, event_in->y); + struct frame *f = decode_live_frame (frame); + Gpm_Event event = *event_in; + event.x -= f->left_pos; + event.y -= f->top_pos; + struct input_event ie; int count = 0; @@ -2717,30 +2763,34 @@ handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event) ie.kind = NO_EVENT; ie.arg = Qnil; - if (event->type & (GPM_MOVE | GPM_DRAG)) + if (event.type & (GPM_MOVE | GPM_DRAG)) { - Gpm_DrawPointer (event->x, event->y, fileno (tty->output)); + /* The pointer must be drawn using screen coordinates (x,y), not + frame coordinates. Use event_in which has an unmodified event + directly from GPM. */ + Gpm_DrawPointer (event_in->x, event_in->y, fileno (tty->output)); /* Has the mouse moved off the glyph it was on at the last sighting? */ - if (event->x != last_mouse_x || event->y != last_mouse_y) + if (event.x != last_mouse_x || event.y != last_mouse_y) { - /* FIXME: These three lines can not be moved into + /* FIXME: These four lines can not be moved into update_mouse_position unless xterm-mouse gets updated to generate mouse events via C code. See https://lists.gnu.org/archive/html/emacs-devel/2020-11/msg00163.html */ - last_mouse_x = event->x; - last_mouse_y = event->y; + last_mouse_frame = frame; + last_mouse_x = event.x; + last_mouse_y = event.y; f->mouse_moved = 1; - count += update_mouse_position (f, event->x, event->y); + count += update_mouse_position (f, event.x, event.y); } } else { f->mouse_moved = 0; - term_mouse_click (&ie, event, f); - ie.arg = tty_handle_tab_bar_click (f, event->x, event->y, + term_mouse_click (&ie, &event, f); + ie.arg = tty_handle_tab_bar_click (f, event.x, event.y, (ie.modifiers & down_modifier) != 0, &ie); kbd_buffer_store_event (&ie); count++; @@ -3115,9 +3165,7 @@ save_and_enable_current_matrix (struct frame *f) static void restore_desired_matrix (struct frame *f, struct glyph_matrix *saved) { - int i; - - for (i = 0; i < saved->nrows; ++i) + for (int i = 0; i < saved->nrows; ++i) { struct glyph_row *from = saved->rows + i; struct glyph_row *to = f->desired_matrix->rows + i; @@ -3127,7 +3175,23 @@ restore_desired_matrix (struct frame *f, struct glyph_matrix *saved) memcpy (to->glyphs[TEXT_AREA], from->glyphs[TEXT_AREA], nbytes); to->used[TEXT_AREA] = from->used[TEXT_AREA]; to->enabled_p = from->enabled_p; - to->hash = from->hash; + + bool need_new_hash = false; + for (int x = 0; x < f->desired_matrix->matrix_w; ++x) + { + struct glyph *glyph = to->glyphs[0] + x; + if (!FRAME_LIVE_P (glyph->frame)) + { + glyph->frame = f; + glyph->face_id = DEFAULT_FACE_ID; + need_new_hash = true; + } + } + + if (need_new_hash) + to->hash = row_hash (to); + else + to->hash = from->hash; } } @@ -3969,7 +4033,7 @@ tty_free_frame_resources (struct frame *f) #endif - + #ifndef HAVE_ANDROID @@ -4044,6 +4108,8 @@ set_tty_hooks (struct terminal *terminal) terminal->read_socket_hook = &tty_read_avail_input; /* keyboard.c */ terminal->delete_frame_hook = &tty_free_frame_resources; terminal->delete_terminal_hook = &delete_tty; + + terminal->frame_raise_lower_hook = tty_raise_lower_frame; /* Other hooks are NULL by default. */ } @@ -4714,6 +4780,186 @@ delete_tty (struct terminal *terminal) #endif +/* Return geometric attributes of FRAME. According to the value of + ATTRIBUTES return the outer edges of FRAME (Qouter_edges), the + native edges of FRAME (Qnative_edges), or the inner edges of frame + (Qinner_edges). Any other value means to return the geometry as + returned by Fx_frame_geometry. */ + +static Lisp_Object +tty_frame_geometry (Lisp_Object frame, Lisp_Object attribute) +{ + struct frame *f = decode_live_frame (frame); + if (FRAME_INITIAL_P (f) || !FRAME_TTY (f)) + return Qnil; + + int native_width = f->pixel_width; + int native_height = f->pixel_height; + + eassert (FRAME_PARENT_FRAME (f) || (f->left_pos == 0 && f->top_pos == 0)); + int outer_left = f->left_pos; + int outer_top = f->top_pos; + int outer_right = outer_left + native_width; + int outer_bottom = outer_top + native_height; + + int native_left = outer_left; + int native_top = outer_top; + int native_right = outer_right; + int native_bottom = outer_bottom; + + int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f); + int inner_left = native_left + internal_border_width; + int inner_top = native_top + internal_border_width; + int inner_right = native_right - internal_border_width; + int inner_bottom = native_bottom - internal_border_width; + + int menu_bar_height = FRAME_MENU_BAR_HEIGHT (f); + inner_top += menu_bar_height; + int menu_bar_width = menu_bar_height ? native_width : 0; + + int tab_bar_height = FRAME_TAB_BAR_HEIGHT (f); + int tab_bar_width = (tab_bar_height + ? native_width - 2 * internal_border_width + : 0); + inner_top += tab_bar_height; + + int tool_bar_height = FRAME_TOOL_BAR_HEIGHT (f); + int tool_bar_width = (tool_bar_height + ? native_width - 2 * internal_border_width + : 0); + + /* Subtract or add to the inner dimensions based on the tool bar + position. */ + if (EQ (FRAME_TOOL_BAR_POSITION (f), Qtop)) + inner_top += tool_bar_height; + else + inner_bottom -= tool_bar_height; + + /* Construct list. */ + if (EQ (attribute, Qouter_edges)) + return list4i (outer_left, outer_top, outer_right, outer_bottom); + else if (EQ (attribute, Qnative_edges)) + return list4i (native_left, native_top, native_right, native_bottom); + else if (EQ (attribute, Qinner_edges)) + return list4i (inner_left, inner_top, inner_right, inner_bottom); + else + return list (Fcons (Qouter_position, Fcons (make_fixnum (outer_left), + make_fixnum (outer_top))), + Fcons (Qouter_size, + Fcons (make_fixnum (outer_right - outer_left), + make_fixnum (outer_bottom - outer_top))), + Fcons (Qouter_border_width, make_fixnum (0)), + Fcons (Qexternal_border_size, + Fcons (make_fixnum (0), make_fixnum (0))), + Fcons (Qtitle_bar_size, + Fcons (make_fixnum (0), make_fixnum (0))), + Fcons (Qmenu_bar_external, Qnil), + Fcons (Qmenu_bar_size, + Fcons (make_fixnum (menu_bar_width), + make_fixnum (menu_bar_height))), + Fcons (Qtab_bar_size, + Fcons (make_fixnum (tab_bar_width), + make_fixnum (tab_bar_height))), + Fcons (Qtool_bar_external, Qnil), + Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)), + Fcons (Qtool_bar_size, + Fcons (make_fixnum (tool_bar_width), + make_fixnum (tool_bar_height))), + Fcons (Qinternal_border_width, + make_fixnum (internal_border_width))); +} + +DEFUN ("tty-frame-geometry", Ftty_frame_geometry, Stty_frame_geometry, 0, 1, 0, + doc: /* Return geometric attributes of terminal frame FRAME. +See also `frame-geometry'. */) + (Lisp_Object frame) +{ + return tty_frame_geometry (frame, Qnil); +} + +DEFUN ("tty-frame-edges", Ftty_frame_edges, Stty_frame_edges, 0, 2, 0, + doc: /* Return coordinates of FRAME's edges. +See also `frame-edges'. */) + (Lisp_Object frame, Lisp_Object type) +{ + if (!EQ (type, Qouter_edges) && !EQ (type, Qinner_edges)) + type = Qnative_edges; + return tty_frame_geometry (frame, type); +} + +DEFUN ("tty-frame-list-z-order", Ftty_frame_list_z_order, + Stty_frame_list_z_order, 0, 1, 0, + doc: /* Return list of Emacs's frames, in Z (stacking) order. +See also `frame-list-z-order'. */) + (Lisp_Object frame) +{ + struct frame *f = decode_tty_frame (frame); + Lisp_Object frames = frames_in_reverse_z_order (f, true); + return Fnreverse (frames); +} + +DEFUN ("tty-frame-restack", Ftty_frame_restack, + Stty_frame_restack, 2, 3, 0, + doc: /* Restack FRAME1 below FRAME2 on terminals. +See also `frame-restack'. */ + attributes: noreturn) + (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object above) +{ + /* FIXME/tty: tty-frame-restack implementation. */ + error ("tty-frame-restack is not implemented"); +} + +static void +tty_display_dimension (Lisp_Object frame, int *width, int *height) +{ + if (!FRAMEP (frame)) + frame = Fselected_frame (); + struct frame *f = XFRAME (frame); + switch (f->output_method) + { + case output_initial: + *width = 80; + *height = 25; + break; + case output_termcap: + *width = FrameCols (FRAME_TTY (f)); + *height = FrameRows (FRAME_TTY (f)); + break; + case output_x_window: + case output_msdos_raw: + case output_w32: + case output_ns: + case output_pgtk: + case output_haiku: + case output_android: + default: + emacs_abort (); + break; + } +} + +DEFUN ("tty-display-pixel-width", Ftty_display_pixel_width, + Stty_display_pixel_width, 0, 1, 0, + doc: /* Return the width of DISPLAY's screen in pixels. +See also `display-pixel-width'. */) + (Lisp_Object display) +{ + int width, height; + tty_display_dimension (display, &width, &height); + return make_fixnum (width); +} + +DEFUN ("tty-display-pixel-height", Ftty_display_pixel_height, + Stty_display_pixel_height, 0, 1, 0, + doc: /* Return the height of DISPLAY's screen in pixels. +See also `display-pixel-height'. */) + (Lisp_Object display) +{ + int width, height; + tty_display_dimension (display, &width, &height); + return make_fixnum (height); +} + void syms_of_term (void) { @@ -4765,11 +5011,20 @@ trigger redisplay. */); defsubr (&Stty__set_output_buffer_size); defsubr (&Stty__output_buffer_size); #endif /* !HAVE_ANDROID */ + defsubr (&Stty_frame_at); #ifdef HAVE_GPM defsubr (&Sgpm_mouse_start); defsubr (&Sgpm_mouse_stop); + staticpro (&last_mouse_frame); #endif /* HAVE_GPM */ + defsubr (&Stty_frame_geometry); + defsubr (&Stty_frame_edges); + defsubr (&Stty_frame_list_z_order); + defsubr (&Stty_frame_restack); + defsubr (&Stty_display_pixel_width); + defsubr (&Stty_display_pixel_height); + #if !defined DOS_NT && !defined HAVE_ANDROID default_orig_pair = NULL; default_set_foreground = NULL; diff --git a/src/termhooks.h b/src/termhooks.h index 8e8c2ba220e..0795148f1af 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -458,7 +458,7 @@ enum { #ifdef HAVE_GPM #include <gpm.h> -extern int handle_one_term_event (struct tty_display_info *, Gpm_Event *); +extern int handle_one_term_event (struct tty_display_info *, const Gpm_Event *); extern void term_mouse_moveto (int, int); /* The device for which we have enabled gpm support. */ @@ -974,6 +974,9 @@ extern int cursorY (struct tty_display_info *); #define cursorY(t) curY(t) #endif +void tty_hide_cursor (struct tty_display_info *tty); +void tty_show_cursor (struct tty_display_info *tty); + INLINE_HEADER_END #endif /* EMACS_TERMHOOKS_H */ diff --git a/src/terminal.c b/src/terminal.c index d1ffd02b038..db6d42d4b4f 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -111,7 +111,8 @@ void cursor_to (struct frame *f, int vpos, int hpos) { if (FRAME_TERMINAL (f)->cursor_to_hook) - (*FRAME_TERMINAL (f)->cursor_to_hook) (f, vpos, hpos); + (*FRAME_TERMINAL (f)->cursor_to_hook) (f, vpos + f->top_pos, + hpos + f->left_pos); } /* Similar but don't take any account of the wasted characters. */ @@ -120,7 +121,8 @@ void raw_cursor_to (struct frame *f, int row, int col) { if (FRAME_TERMINAL (f)->raw_cursor_to_hook) - (*FRAME_TERMINAL (f)->raw_cursor_to_hook) (f, row, col); + (*FRAME_TERMINAL (f)->raw_cursor_to_hook) (f, row + f->top_pos, + col + f->left_pos); } /* Erase operations. */ diff --git a/src/textconv.c b/src/textconv.c index 81d90872076..80b1a37f0fd 100644 --- a/src/textconv.c +++ b/src/textconv.c @@ -1741,7 +1741,7 @@ handle_pending_conversion_events (void) /* Return the confines of the field to which editing operations on frame F should be constrained in *BEG and *END. Should no field be active, - set *END to MOST_POSITIVE_FIXNUM. */ + set *END to PTRDIFF_MAX. */ void get_conversion_field (struct frame *f, ptrdiff_t *beg, ptrdiff_t *end) @@ -1769,7 +1769,7 @@ get_conversion_field (struct frame *f, ptrdiff_t *beg, ptrdiff_t *end) } *beg = 1; - *end = MOST_POSITIVE_FIXNUM; + *end = PTRDIFF_MAX; } /* Start a ``batch edit'' in frame F. During a batch edit, diff --git a/src/thread.c b/src/thread.c index 174956ee1b0..bb62283dd21 100644 --- a/src/thread.c +++ b/src/thread.c @@ -43,7 +43,7 @@ union aligned_thread_state struct thread_state s; GCALIGNED_UNION_MEMBER }; -verify (GCALIGNED (union aligned_thread_state)); +static_assert (GCALIGNED (union aligned_thread_state)); static union aligned_thread_state main_thread = {{ diff --git a/src/timefns.c b/src/timefns.c index c4eabf4be07..e2b39388606 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -60,13 +60,6 @@ enum { TM_YEAR_BASE = 1900 }; # define HAVE_TM_GMTOFF false #endif -#ifndef TIME_T_MIN -# define TIME_T_MIN TYPE_MINIMUM (time_t) -#endif -#ifndef TIME_T_MAX -# define TIME_T_MAX TYPE_MAXIMUM (time_t) -#endif - /* Compile with -DFASTER_TIMEFNS=0 to disable common optimizations and allow easier testing of some slow-path code. */ #ifndef FASTER_TIMEFNS @@ -80,20 +73,24 @@ enum { TM_YEAR_BASE = 1900 }; enum { CURRENT_TIME_LIST = true }; #endif -#if FIXNUM_OVERFLOW_P (1000000000) -static Lisp_Object timespec_hz; -#else +#if FASTER_TIMEFNS && !FIXNUM_OVERFLOW_P (1000000000) # define timespec_hz make_fixnum (TIMESPEC_HZ) +#else +static Lisp_Object timespec_hz; #endif #define TRILLION 1000000000000 -#if FIXNUM_OVERFLOW_P (TRILLION) -static Lisp_Object trillion; -# define ztrillion (*xbignum_val (trillion)) -#else +#if FASTER_TIMEFNS && !FIXNUM_OVERFLOW_P (TRILLION) # define trillion make_fixnum (TRILLION) -# if ULONG_MAX < TRILLION || !FASTER_TIMEFNS -mpz_t ztrillion; +#else +static Lisp_Object trillion; +#endif +#if ! (FASTER_TIMEFNS && TRILLION <= ULONG_MAX) +# if FIXNUM_OVERFLOW_P (TRILLION) +# define ztrillion (*xbignum_val (trillion)) +# else +static mpz_t ztrillion; +# define NEED_ZTRILLION_INIT # endif #endif @@ -108,7 +105,7 @@ trillion_factor (Lisp_Object hz) if (!FIXNUM_OVERFLOW_P (TRILLION)) return false; } - verify (TRILLION <= INTMAX_MAX); + static_assert (TRILLION <= INTMAX_MAX); intmax_t ihz; return integer_to_intmax (hz, &ihz) && TRILLION % ihz == 0; } @@ -127,10 +124,14 @@ make_timeval (struct timespec t) { if (tv.tv_usec < 999999) tv.tv_usec++; - else if (tv.tv_sec < TIME_T_MAX) + else { - tv.tv_sec++; - tv.tv_usec = 0; + time_t s1; + if (!ckd_add (&s1, tv.tv_sec, 1)) + { + tv.tv_sec = s1; + tv.tv_usec = 0; + } } } @@ -361,13 +362,19 @@ time_overflow (void) } static AVOID +time_spec_invalid (void) +{ + error ("Invalid time specification"); +} + +static AVOID time_error (int err) { switch (err) { case ENOMEM: memory_full (SIZE_MAX); case EOVERFLOW: time_overflow (); - default: error ("Invalid time specification"); + default: time_spec_invalid (); } } @@ -400,11 +407,218 @@ enum { flt_radix_power_size = DBL_MANT_DIG - DBL_MIN_EXP + 1 }; equals FLT_RADIX**P. */ static Lisp_Object flt_radix_power; -/* Convert the finite number T into an Emacs time *RESULT, truncating +/* Return NUMERATOR / DENOMINATOR, rounded to the nearest double. + Arguments must be Lisp integers, and DENOMINATOR must be positive. */ +static double +frac_to_double (Lisp_Object numerator, Lisp_Object denominator) +{ + intmax_t intmax_numerator, intmax_denominator; + if (FASTER_TIMEFNS + && integer_to_intmax (numerator, &intmax_numerator) + && integer_to_intmax (denominator, &intmax_denominator) + && intmax_numerator % intmax_denominator == 0) + return intmax_numerator / intmax_denominator; + + /* Compute number of base-FLT_RADIX digits in numerator and denominator. */ + mpz_t const *n = bignum_integer (&mpz[0], numerator); + mpz_t const *d = bignum_integer (&mpz[1], denominator); + ptrdiff_t ndig = mpz_sizeinbase (*n, FLT_RADIX); + ptrdiff_t ddig = mpz_sizeinbase (*d, FLT_RADIX); + + /* Scale with SCALE when doing integer division. That is, compute + (N * FLT_RADIX**SCALE) / D [or, if SCALE is negative, N / (D * + FLT_RADIX**-SCALE)] as a bignum, convert the bignum to double, + then divide the double by FLT_RADIX**SCALE. First scale N + (or scale D, if SCALE is negative) ... */ + ptrdiff_t scale = ddig - ndig + DBL_MANT_DIG; + if (scale < 0) + { + mpz_mul_2exp (mpz[1], *d, - (scale * LOG2_FLT_RADIX)); + d = &mpz[1]; + } + else + { + /* min so we don't scale tiny numbers as if they were normalized. */ + scale = min (scale, flt_radix_power_size - 1); + + mpz_mul_2exp (mpz[0], *n, scale * LOG2_FLT_RADIX); + n = &mpz[0]; + } + /* ... and then divide, with quotient Q and remainder R. */ + mpz_t *q = &mpz[2]; + mpz_t *r = &mpz[3]; + mpz_tdiv_qr (*q, *r, *n, *d); + + /* The amount to add to the absolute value of Q so that truncating + it to double will round correctly. */ + int incr; + + /* Round the quotient before converting it to double. + If the quotient is less than FLT_RADIX ** DBL_MANT_DIG, + round to the nearest integer; otherwise, it is less than + FLT_RADIX ** (DBL_MANT_DIG + 1) and round it to the nearest + multiple of FLT_RADIX. Break ties to even. */ + if (mpz_sizeinbase (*q, FLT_RADIX) <= DBL_MANT_DIG) + { + /* Converting to double will use the whole quotient so add 1 to + its absolute value as per round-to-even; i.e., if the doubled + remainder exceeds the denominator, or exactly equals the + denominator and adding 1 would make the quotient even. */ + mpz_mul_2exp (*r, *r, 1); + int cmp = mpz_cmpabs (*r, *d); + incr = cmp > 0 || (cmp == 0 && (FASTER_TIMEFNS && FLT_RADIX == 2 + ? mpz_odd_p (*q) + : mpz_tdiv_ui (*q, FLT_RADIX) & 1)); + } + else + { + /* Converting to double will discard the quotient's low-order digit, + so add FLT_RADIX to its absolute value as per round-to-even. */ + int lo_2digits = mpz_tdiv_ui (*q, FLT_RADIX * FLT_RADIX); + eassume (0 <= lo_2digits && lo_2digits < FLT_RADIX * FLT_RADIX); + int lo_digit = lo_2digits % FLT_RADIX; + incr = ((lo_digit > FLT_RADIX / 2 + || (lo_digit == FLT_RADIX / 2 && FLT_RADIX % 2 == 0 + && ((lo_2digits / FLT_RADIX) & 1 + || mpz_sgn (*r) != 0))) + ? FLT_RADIX : 0); + } + + /* Increment the absolute value of the quotient by INCR. */ + if (!FASTER_TIMEFNS || incr != 0) + (mpz_sgn (*n) < 0 ? mpz_sub_ui : mpz_add_ui) (*q, *q, incr); + + /* Rescale the integer Q back to double. This step does not round. */ + return scalbn (mpz_get_d (*q), -scale); +} + +/* Convert Z to time_t, returning true if it fits. */ +static bool +mpz_time (mpz_t const z, time_t *t) +{ + if (TYPE_SIGNED (time_t)) + { + intmax_t i; + return mpz_to_intmax (z, &i) && !ckd_add (t, i, 0); + } + else + { + uintmax_t i; + return mpz_to_uintmax (z, &i) && !ckd_add (t, i, 0); + } +} + +/* Return a valid timespec (S, N) if S is in time_t range, + an invalid timespec otherwise. */ +static struct timespec +s_ns_to_timespec (intmax_t s, long int ns) +{ + time_t sec; + long int nsec = ckd_add (&sec, s, 0) ? -1 : ns; + return make_timespec (sec, nsec); +} + +/* Components of a Lisp timestamp (TICKS . HZ). Using this C struct can + avoid the consing overhead of creating (TICKS . HZ). */ +struct ticks_hz +{ + /* Clock count as a Lisp integer. */ + Lisp_Object ticks; + + /* Clock frequency (ticks per second) as a positive Lisp integer. */ + Lisp_Object hz; +}; + +/* Convert (TICKS . HZ) to struct timespec, returning an invalid + timespec if the result would not fit. */ +static struct timespec +ticks_hz_to_timespec (Lisp_Object ticks, Lisp_Object hz) +{ + int ns; + mpz_t *q = &mpz[0]; + mpz_t const *qt = q; + + /* Floor-divide (TICKS * TIMESPEC_HZ) by HZ, + yielding quotient Q (tv_sec) and remainder NS (tv_nsec). + Return an invalid timespec if Q does not fit in time_t. + For speed, prefer fixnum arithmetic if it works. */ + if (FASTER_TIMEFNS && BASE_EQ (hz, timespec_hz)) + { + if (FIXNUMP (ticks)) + { + EMACS_INT s = XFIXNUM (ticks) / TIMESPEC_HZ; + ns = XFIXNUM (ticks) % TIMESPEC_HZ; + if (ns < 0) + s--, ns += TIMESPEC_HZ; + return s_ns_to_timespec (s, ns); + } + ns = mpz_fdiv_q_ui (*q, *xbignum_val (ticks), TIMESPEC_HZ); + } + else if (FASTER_TIMEFNS && BASE_EQ (hz, make_fixnum (1))) + { + ns = 0; + if (FIXNUMP (ticks)) + return s_ns_to_timespec (XFIXNUM (ticks), ns); + qt = xbignum_val (ticks); + } + else + { + mpz_mul_ui (*q, *bignum_integer (q, ticks), TIMESPEC_HZ); + mpz_fdiv_q (*q, *q, *bignum_integer (&mpz[1], hz)); + ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ); + } + + /* Check that Q fits in time_t, not merely in RESULT.tv_sec. With some MinGW + versions, tv_sec is a 64-bit type, whereas time_t is a 32-bit type. */ + time_t sec; + return mpz_time (*qt, &sec) ? make_timespec (sec, ns) : invalid_timespec (); +} + +/* C timestamp forms. This enum is passed to conversion functions to + specify the desired C timestamp form. */ +enum cform + { + CFORM_TICKS_HZ, /* struct ticks_hz */ + CFORM_TIMESPEC, /* struct timespec */ + CFORM_SECS_ONLY, /* struct timespec but tv_nsec irrelevant + if timespec valid */ + CFORM_DOUBLE /* double */ + }; + +/* A C timestamp in one of the forms specified by enum cform. */ +union c_time +{ + struct ticks_hz th; + struct timespec ts; + double d; +}; + +/* From a valid timestamp (TICKS . HZ), generate the corresponding + time value in CFORM form. */ +static union c_time +decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz, enum cform cform) +{ + switch (cform) + { + case CFORM_DOUBLE: + return (union c_time) { .d = frac_to_double (ticks, hz) }; + + case CFORM_TICKS_HZ: + return (union c_time) { .th = { .ticks = ticks, .hz = hz } }; + + default: + return (union c_time) { .ts = ticks_hz_to_timespec (ticks, hz) }; + } +} + +/* Convert the finite number T into a C time of form CFORM, truncating toward minus infinity. Signal an error if unsuccessful. */ -static void -decode_float_time (double t, struct lisp_time *result) +static union c_time +decode_float_time (double t, enum cform cform) { + if (FASTER_TIMEFNS && cform == CFORM_DOUBLE) + return (union c_time) { .d = t }; + Lisp_Object ticks, hz; if (t == 0) { @@ -447,8 +661,7 @@ decode_float_time (double t, struct lisp_time *result) ASET (flt_radix_power, scale, hz); } } - result->ticks = ticks; - result->hz = hz; + return decode_ticks_hz (ticks, hz, cform); } /* Make a 4-element timestamp (HI LO US PS) from TICKS and HZ. @@ -477,7 +690,7 @@ ticks_hz_list4 (Lisp_Object ticks, Lisp_Object hz) int us = mpz_get_ui (mpz[1]); #endif - /* mpz[0] = floor (mpz[0] / 1 << LO_TIME_BITS), with lo = remainder. */ + /* mpz[0] = floor (mpz[0] / (1 << LO_TIME_BITS)), with LO = remainder. */ unsigned long ulo = mpz_get_ui (mpz[0]); if (mpz_sgn (mpz[0]) < 0) ulo = -ulo; @@ -525,10 +738,19 @@ timespec_ticks (struct timespec t) return make_integer_mpz (); } +/* Return greatest common divisor of positive A and B. */ +static EMACS_INT +emacs_gcd (EMACS_INT a, EMACS_INT b) +{ + for (EMACS_INT r; (r = a % b) != 0; a = b, b = r) + continue; + return b; +} + /* Convert T to a Lisp integer counting HZ ticks, taking the floor. Assume T is valid, but check HZ. */ static Lisp_Object -lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz) +ticks_hz_hz_ticks (struct ticks_hz t, Lisp_Object hz) { /* The idea is to return the floor of ((T.ticks * HZ) / T.hz). */ @@ -542,39 +764,58 @@ lisp_time_hz_ticks (struct lisp_time t, Lisp_Object hz) if (XFIXNUM (hz) <= 0) invalid_hz (hz); - /* For speed, use intmax_t arithmetic if it will do. */ - intmax_t ticks; - if (FASTER_TIMEFNS && FIXNUMP (t.ticks) && FIXNUMP (t.hz) - && !ckd_mul (&ticks, XFIXNUM (t.ticks), XFIXNUM (hz))) - return make_int (ticks / XFIXNUM (t.hz) - - (ticks % XFIXNUM (t.hz) < 0)); + /* Prefer non-bignum arithmetic to speed up common cases. */ + if (FASTER_TIMEFNS && FIXNUMP (t.hz)) + { + /* Reduce T.hz and HZ by their GCD, to avoid some intmax_t + overflows that would occur in T.ticks * HZ. */ + EMACS_INT ithz = XFIXNUM (t.hz), ihz = XFIXNUM (hz); + EMACS_INT d = emacs_gcd (ithz, ihz); + ithz /= d; + ihz /= d; + + if (FIXNUMP (t.ticks)) + { + intmax_t ticks; + if (!ckd_mul (&ticks, XFIXNUM (t.ticks), ihz)) + return make_int (ticks / ithz - (ticks % ithz < 0)); + } + + t.hz = make_fixnum (ithz); + hz = make_fixnum (ihz); + } } else if (! (BIGNUMP (hz) && 0 < mpz_sgn (*xbignum_val (hz)))) invalid_hz (hz); /* Fall back on bignum arithmetic. */ - mpz_mul (mpz[0], - *bignum_integer (&mpz[0], t.ticks), - *bignum_integer (&mpz[1], hz)); - mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], t.hz)); + mpz_t const *zticks = bignum_integer (&mpz[0], t.ticks); + if (FASTER_TIMEFNS && FIXNUMP (hz) && XFIXNUM (hz) <= ULONG_MAX) + mpz_mul_ui (mpz[0], *zticks, XFIXNUM (hz)); + else + mpz_mul (mpz[0], *zticks, *bignum_integer (&mpz[1], hz)); + if (FASTER_TIMEFNS && FIXNUMP (t.hz) && XFIXNUM (t.hz) <= ULONG_MAX) + mpz_fdiv_q_ui (mpz[0], mpz[0], XFIXNUM (t.hz)); + else + mpz_fdiv_q (mpz[0], mpz[0], *bignum_integer (&mpz[1], t.hz)); return make_integer_mpz (); } /* Convert T to a Lisp integer counting seconds, taking the floor. */ static Lisp_Object -lisp_time_seconds (struct lisp_time t) +ticks_hz_seconds (struct ticks_hz t) { /* The idea is to return the floor of T.ticks / T.hz. */ if (!FASTER_TIMEFNS) - return lisp_time_hz_ticks (t, make_fixnum (1)); + return ticks_hz_hz_ticks (t, make_fixnum (1)); /* For speed, use EMACS_INT arithmetic if it will do. */ if (FIXNUMP (t.ticks) && FIXNUMP (t.hz)) return make_fixnum (XFIXNUM (t.ticks) / XFIXNUM (t.hz) - (XFIXNUM (t.ticks) % XFIXNUM (t.hz) < 0)); - /* For speed, inline what lisp_time_hz_ticks would do. */ + /* For speed, inline what ticks_hz_hz_ticks would do. */ mpz_fdiv_q (mpz[0], *bignum_integer (&mpz[0], t.ticks), *bignum_integer (&mpz[1], t.hz)); @@ -603,249 +844,161 @@ timespec_to_lisp (struct timespec t) return Fcons (timespec_ticks (t), timespec_hz); } -/* Return NUMERATOR / DENOMINATOR, rounded to the nearest double. - Arguments must be Lisp integers, and DENOMINATOR must be positive. */ -static double -frac_to_double (Lisp_Object numerator, Lisp_Object denominator) -{ - intmax_t intmax_numerator, intmax_denominator; - if (FASTER_TIMEFNS - && integer_to_intmax (numerator, &intmax_numerator) - && integer_to_intmax (denominator, &intmax_denominator) - && intmax_numerator % intmax_denominator == 0) - return intmax_numerator / intmax_denominator; - - /* Compute number of base-FLT_RADIX digits in numerator and denominator. */ - mpz_t const *n = bignum_integer (&mpz[0], numerator); - mpz_t const *d = bignum_integer (&mpz[1], denominator); - ptrdiff_t ndig = mpz_sizeinbase (*n, FLT_RADIX); - ptrdiff_t ddig = mpz_sizeinbase (*d, FLT_RADIX); - - /* Scale with SCALE when doing integer division. That is, compute - (N * FLT_RADIX**SCALE) / D [or, if SCALE is negative, N / (D * - FLT_RADIX**-SCALE)] as a bignum, convert the bignum to double, - then divide the double by FLT_RADIX**SCALE. First scale N - (or scale D, if SCALE is negative) ... */ - ptrdiff_t scale = ddig - ndig + DBL_MANT_DIG; - if (scale < 0) - { - mpz_mul_2exp (mpz[1], *d, - (scale * LOG2_FLT_RADIX)); - d = &mpz[1]; - } - else - { - /* min so we don't scale tiny numbers as if they were normalized. */ - scale = min (scale, flt_radix_power_size - 1); - - mpz_mul_2exp (mpz[0], *n, scale * LOG2_FLT_RADIX); - n = &mpz[0]; - } - /* ... and then divide, with quotient Q and remainder R. */ - mpz_t *q = &mpz[2]; - mpz_t *r = &mpz[3]; - mpz_tdiv_qr (*q, *r, *n, *d); - - /* The amount to add to the absolute value of Q so that truncating - it to double will round correctly. */ - int incr; - - /* Round the quotient before converting it to double. - If the quotient is less than FLT_RADIX ** DBL_MANT_DIG, - round to the nearest integer; otherwise, it is less than - FLT_RADIX ** (DBL_MANT_DIG + 1) and round it to the nearest - multiple of FLT_RADIX. Break ties to even. */ - if (mpz_sizeinbase (*q, FLT_RADIX) <= DBL_MANT_DIG) - { - /* Converting to double will use the whole quotient so add 1 to - its absolute value as per round-to-even; i.e., if the doubled - remainder exceeds the denominator, or exactly equals the - denominator and adding 1 would make the quotient even. */ - mpz_mul_2exp (*r, *r, 1); - int cmp = mpz_cmpabs (*r, *d); - incr = cmp > 0 || (cmp == 0 && (FASTER_TIMEFNS && FLT_RADIX == 2 - ? mpz_odd_p (*q) - : mpz_tdiv_ui (*q, FLT_RADIX) & 1)); - } - else - { - /* Converting to double will discard the quotient's low-order digit, - so add FLT_RADIX to its absolute value as per round-to-even. */ - int lo_2digits = mpz_tdiv_ui (*q, FLT_RADIX * FLT_RADIX); - eassume (0 <= lo_2digits && lo_2digits < FLT_RADIX * FLT_RADIX); - int lo_digit = lo_2digits % FLT_RADIX; - incr = ((lo_digit > FLT_RADIX / 2 - || (lo_digit == FLT_RADIX / 2 && FLT_RADIX % 2 == 0 - && ((lo_2digits / FLT_RADIX) & 1 - || mpz_sgn (*r) != 0))) - ? FLT_RADIX : 0); - } - - /* Increment the absolute value of the quotient by INCR. */ - if (!FASTER_TIMEFNS || incr != 0) - (mpz_sgn (*n) < 0 ? mpz_sub_ui : mpz_add_ui) (*q, *q, incr); - - /* Rescale the integer Q back to double. This step does not round. */ - return scalbn (mpz_get_d (*q), -scale); -} - -/* From a valid timestamp (TICKS . HZ), generate the corresponding - time values. - - If RESULT is not null, store into *RESULT the converted time. - Otherwise, store into *DRESULT the number of seconds since the - start of the POSIX Epoch. - - Return zero, which indicates success. */ -static int -decode_ticks_hz (Lisp_Object ticks, Lisp_Object hz, - struct lisp_time *result, double *dresult) +/* An (error number, C timestamp) pair. */ +struct err_time { - if (result) - { - result->ticks = ticks; - result->hz = hz; - } - else - *dresult = frac_to_double (ticks, hz); - return 0; -} - -/* Lisp timestamp classification. */ -enum timeform - { - TIMEFORM_INVALID = 0, - TIMEFORM_HI_LO, /* seconds in the form (HI << LO_TIME_BITS) + LO. */ - TIMEFORM_HI_LO_US, /* seconds plus microseconds (HI LO US) */ - TIMEFORM_NIL, /* current time in nanoseconds */ - TIMEFORM_HI_LO_US_PS, /* seconds plus micro and picoseconds (HI LO US PS) */ - TIMEFORM_FLOAT, /* time as a float */ - TIMEFORM_TICKS_HZ /* fractional time: HI is ticks, LO is ticks per second */ - }; - -/* From the non-float form FORM and the time components HIGH, LOW, USEC - and PSEC, generate the corresponding time value. If LOW is - floating point, the other components should be zero and FORM should - not be TIMEFORM_TICKS_HZ. - - If RESULT is not null, store into *RESULT the converted time. - Otherwise, store into *DRESULT the number of seconds since the - start of the POSIX Epoch. Unsuccessful calls may or may not store - results. - - Return zero if successful, an error number otherwise. */ -static int -decode_time_components (enum timeform form, - Lisp_Object high, Lisp_Object low, + int err; + union c_time time; +}; + +/* From the time components HIGH, LOW, USEC and PSEC and the timestamp + resolution HZ, generate the corresponding time value in CFORM form. + HZ should be either 1, 1000000, or 1000000000000. + Return a (0, valid timestamp) pair if successful, an (error number, + unspecified timestamp) pair otherwise. */ +static struct err_time +decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec, Lisp_Object psec, - struct lisp_time *result, double *dresult) + Lisp_Object hz, enum cform cform) { - switch (form) - { - case TIMEFORM_INVALID: - return EINVAL; - - case TIMEFORM_TICKS_HZ: - if (INTEGERP (high) - && !NILP (Fnatnump (low)) && !BASE_EQ (low, make_fixnum (0))) - return decode_ticks_hz (high, low, result, dresult); - return EINVAL; - - case TIMEFORM_FLOAT: - eassume (false); - - case TIMEFORM_NIL: - return decode_ticks_hz (timespec_ticks (current_timespec ()), - timespec_hz, result, dresult); - - default: - break; - } + if (!(FIXNUMP (usec) && FIXNUMP (psec))) + return (struct err_time) { .err = EINVAL }; - if (! (INTEGERP (high) && INTEGERP (low) - && FIXNUMP (usec) && FIXNUMP (psec))) - return EINVAL; EMACS_INT us = XFIXNUM (usec); EMACS_INT ps = XFIXNUM (psec); /* Normalize out-of-range lower-order components by carrying each overflow into the next higher-order component. */ us += ps / 1000000 - (ps % 1000000 < 0); - mpz_t *s = &mpz[1]; - mpz_set_intmax (*s, us / 1000000 - (us % 1000000 < 0)); - mpz_add (*s, *s, *bignum_integer (&mpz[0], low)); - mpz_addmul_ui (*s, *bignum_integer (&mpz[0], high), 1 << LO_TIME_BITS); + EMACS_INT s_from_us_ps = us / 1000000 - (us % 1000000 < 0); ps = ps % 1000000 + 1000000 * (ps % 1000000 < 0); us = us % 1000000 + 1000000 * (us % 1000000 < 0); - Lisp_Object hz; - switch (form) + if (FASTER_TIMEFNS && FIXNUMP (high) && FIXNUMP (low)) { - case TIMEFORM_HI_LO: - /* Floats and nil were handled above, so it was an integer. */ - mpz_swap (mpz[0], *s); - hz = make_fixnum (1); - break; + /* Use intmax_t arithmetic if the tick count fits. */ + intmax_t iticks; + bool v = false; + v |= ckd_mul (&iticks, XFIXNUM (high), 1 << LO_TIME_BITS); + v |= ckd_add (&iticks, iticks, XFIXNUM (low) + s_from_us_ps); + if (!v) + { + if (cform == CFORM_TIMESPEC || cform == CFORM_SECS_ONLY) + return (struct err_time) { + .time = { + .ts = s_ns_to_timespec (iticks, us * 1000 + ps / 1000) + } + }; + + if (BASE_EQ (hz, trillion)) + { + int_fast64_t million = 1000000; + v |= ckd_mul (&iticks, iticks, TRILLION); + v |= ckd_add (&iticks, iticks, us * million + ps); + } + else if (BASE_EQ (hz, make_fixnum (1000000))) + { + v |= ckd_mul (&iticks, iticks, 1000000); + v |= ckd_add (&iticks, iticks, us); + } + + if (!v) + return (struct err_time) { + .time = decode_ticks_hz (make_int (iticks), hz, cform) + }; + } + } + + if (! (INTEGERP (high) && INTEGERP (low))) + return (struct err_time) { .err = EINVAL }; - case TIMEFORM_HI_LO_US: + mpz_t *s = &mpz[1]; + mpz_set_intmax (*s, s_from_us_ps); + mpz_add (*s, *s, *bignum_integer (&mpz[0], low)); + mpz_addmul_ui (*s, *bignum_integer (&mpz[0], high), 1 << LO_TIME_BITS); + + if (BASE_EQ (hz, trillion)) + { + #if FASTER_TIMEFNS && TRILLION <= ULONG_MAX + unsigned long i = us; + mpz_set_ui (mpz[0], i * 1000000 + ps); + mpz_addmul_ui (mpz[0], *s, TRILLION); + #else + intmax_t i = us; + mpz_set_intmax (mpz[0], i * 1000000 + ps); + mpz_addmul (mpz[0], *s, ztrillion); + #endif + } + else if (BASE_EQ (hz, make_fixnum (1000000))) + { mpz_set_ui (mpz[0], us); mpz_addmul_ui (mpz[0], *s, 1000000); - hz = make_fixnum (1000000); - break; - - case TIMEFORM_HI_LO_US_PS: - { - #if FASTER_TIMEFNS && TRILLION <= ULONG_MAX - unsigned long i = us; - mpz_set_ui (mpz[0], i * 1000000 + ps); - mpz_addmul_ui (mpz[0], *s, TRILLION); - #else - intmax_t i = us; - mpz_set_intmax (mpz[0], i * 1000000 + ps); - mpz_addmul (mpz[0], *s, ztrillion); - #endif - hz = trillion; - } - break; - - default: - eassume (false); } + else + mpz_swap (mpz[0], *s); - return decode_ticks_hz (make_integer_mpz (), hz, result, dresult); + Lisp_Object ticks = make_integer_mpz (); + return (struct err_time) { .time = decode_ticks_hz (ticks, hz, cform) }; +} + +/* Current time (seconds since epoch) in form CFORM. */ +static union c_time +current_time_in_cform (enum cform cform) +{ + struct timespec now = current_timespec (); + return ((FASTER_TIMEFNS + && (cform == CFORM_TIMESPEC || cform == CFORM_SECS_ONLY)) + ? (union c_time) {.ts = now} + : decode_ticks_hz (timespec_ticks (now), timespec_hz, cform)); } /* Decode a Lisp timestamp SPECIFIED_TIME that represents a time. - If DECODE_SECS_ONLY, ignore and do not validate any sub-second + Return a (form, time) pair that is the form of SPECIFIED-TIME + and the resulting C timestamp in CFORM form. + If CFORM == CFORM_SECS_ONLY, ignore and do not validate any sub-second components of an old-format SPECIFIED_TIME. - If RESULT is not null, store into *RESULT the converted time; - otherwise, store into *DRESULT the number of seconds since the - start of the POSIX Epoch. Unsuccessful calls may or may not store - results. - - Return the form of SPECIFIED-TIME. Signal an error if unsuccessful. */ -static enum timeform -decode_lisp_time (Lisp_Object specified_time, bool decode_secs_only, - struct lisp_time *result, double *dresult) + Signal an error if unsuccessful. */ +static union c_time +decode_lisp_time (Lisp_Object specified_time, enum cform cform) { - Lisp_Object high = make_fixnum (0); - Lisp_Object low = specified_time; - Lisp_Object usec = make_fixnum (0); - Lisp_Object psec = make_fixnum (0); - enum timeform form = TIMEFORM_HI_LO; + /* specified_time is one of: + + nil + current time + NUMBER + that number of seconds + (A . B) ; A, B : integer, B>0 + A/B s + (A B C D) ; A, B : integer, C, D : fixnum + (A * 2**16 + B + C / 10**6 + D / 10**12) s + + The following specified_time forms are also supported, + for compatibility with older Emacs versions: + + (A B) + like (A B 0 0) + (A B . C) ; C : fixnum + like (A B C 0) + (A B C) + like (A B C 0) + */ if (NILP (specified_time)) - form = TIMEFORM_NIL; + return current_time_in_cform (cform); else if (CONSP (specified_time)) { - high = XCAR (specified_time); - low = XCDR (specified_time); + Lisp_Object high = XCAR (specified_time); + Lisp_Object low = XCDR (specified_time); + Lisp_Object usec = make_fixnum (0); + Lisp_Object psec = make_fixnum (0); if (CONSP (low)) { + Lisp_Object hz = make_fixnum (1); Lisp_Object low_tail = XCDR (low); low = XCAR (low); - if (! decode_secs_only) + if (cform != CFORM_SECS_ONLY) { if (CONSP (low_tail)) { @@ -854,50 +1007,44 @@ decode_lisp_time (Lisp_Object specified_time, bool decode_secs_only, if (CONSP (low_tail)) { psec = XCAR (low_tail); - form = TIMEFORM_HI_LO_US_PS; + hz = trillion; } else - form = TIMEFORM_HI_LO_US; + hz = make_fixnum (1000000); } else if (!NILP (low_tail)) { usec = low_tail; - form = TIMEFORM_HI_LO_US; + hz = make_fixnum (1000000); } } + + struct err_time err_time + = decode_time_components (high, low, usec, psec, hz, cform); + if (err_time.err) + time_error (err_time.err); + return err_time.time; } else { - form = TIMEFORM_TICKS_HZ; + /* (TICKS . HZ) */ + if (!(INTEGERP (high) && (FIXNUMP (low) ? XFIXNUM (low) > 0 + : !NILP (Fnatnump (low))))) + time_spec_invalid (); + return decode_ticks_hz (high, low, cform); } - - /* Require LOW to be an integer, as otherwise the computation - would be considerably trickier. */ - if (! INTEGERP (low)) - form = TIMEFORM_INVALID; - } - else if (FASTER_TIMEFNS && INTEGERP (specified_time)) - { - decode_ticks_hz (specified_time, make_fixnum (1), result, dresult); - return form; } + else if (INTEGERP (specified_time)) + return decode_ticks_hz (specified_time, make_fixnum (1), cform); else if (FLOATP (specified_time)) { double d = XFLOAT_DATA (specified_time); if (!isfinite (d)) time_error (isnan (d) ? EDOM : EOVERFLOW); - if (result) - decode_float_time (d, result); - else - *dresult = d; - return TIMEFORM_FLOAT; + return decode_float_time (d, cform); } - - int err = decode_time_components (form, high, low, usec, psec, - result, dresult); - if (err) - time_error (err); - return form; + else + time_spec_invalid (); } /* Convert a non-float Lisp timestamp SPECIFIED_TIME to double. @@ -905,138 +1052,28 @@ decode_lisp_time (Lisp_Object specified_time, bool decode_secs_only, double float_time (Lisp_Object specified_time) { - double t; - decode_lisp_time (specified_time, false, 0, &t); - return t; -} - -/* Convert Z to time_t, returning true if it fits. */ -static bool -mpz_time (mpz_t const z, time_t *t) -{ - if (TYPE_SIGNED (time_t)) - { - intmax_t i; - if (! (mpz_to_intmax (z, &i) && TIME_T_MIN <= i && i <= TIME_T_MAX)) - return false; - *t = i; - } - else - { - uintmax_t i; - if (! (mpz_to_uintmax (z, &i) && i <= TIME_T_MAX)) - return false; - *t = i; - } - return true; -} - -/* Convert T to struct timespec, returning an invalid timespec - if T does not fit. */ -static struct timespec -lisp_to_timespec (struct lisp_time t) -{ - struct timespec result = invalid_timespec (); - int ns; - mpz_t *q = &mpz[0]; - mpz_t const *qt = q; - - /* Floor-divide (T.ticks * TIMESPEC_HZ) by T.hz, - yielding quotient Q (tv_sec) and remainder NS (tv_nsec). - Return an invalid timespec if Q does not fit in time_t. - For speed, prefer fixnum arithmetic if it works. */ - if (FASTER_TIMEFNS && BASE_EQ (t.hz, timespec_hz)) - { - if (FIXNUMP (t.ticks)) - { - EMACS_INT s = XFIXNUM (t.ticks) / TIMESPEC_HZ; - ns = XFIXNUM (t.ticks) % TIMESPEC_HZ; - if (ns < 0) - s--, ns += TIMESPEC_HZ; - if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s) - && s <= TIME_T_MAX) - { - result.tv_sec = s; - result.tv_nsec = ns; - } - return result; - } - else - ns = mpz_fdiv_q_ui (*q, *xbignum_val (t.ticks), TIMESPEC_HZ); - } - else if (FASTER_TIMEFNS && BASE_EQ (t.hz, make_fixnum (1))) - { - ns = 0; - if (FIXNUMP (t.ticks)) - { - EMACS_INT s = XFIXNUM (t.ticks); - if ((TYPE_SIGNED (time_t) ? TIME_T_MIN <= s : 0 <= s) - && s <= TIME_T_MAX) - { - result.tv_sec = s; - result.tv_nsec = ns; - } - return result; - } - else - qt = xbignum_val (t.ticks); - } - else - { - mpz_mul_ui (*q, *bignum_integer (q, t.ticks), TIMESPEC_HZ); - mpz_fdiv_q (*q, *q, *bignum_integer (&mpz[1], t.hz)); - ns = mpz_fdiv_q_ui (*q, *q, TIMESPEC_HZ); - } - - /* Check that Q fits in time_t, not merely in T.tv_sec. With some versions - of MinGW, tv_sec is a 64-bit type, whereas time_t is a 32-bit type. */ - time_t sec; - if (mpz_time (*qt, &sec)) - { - result.tv_sec = sec; - result.tv_nsec = ns; - } - return result; + return decode_lisp_time (specified_time, CFORM_DOUBLE).d; } /* Convert (HIGH LOW USEC PSEC) to struct timespec. - Return true if successful. */ -bool + Return a valid timestamp if successful, an invalid one otherwise. */ +struct timespec list4_to_timespec (Lisp_Object high, Lisp_Object low, - Lisp_Object usec, Lisp_Object psec, - struct timespec *result) -{ - struct lisp_time t; - if (decode_time_components (TIMEFORM_HI_LO_US_PS, high, low, usec, psec, - &t, 0)) - return false; - *result = lisp_to_timespec (t); - return timespec_valid_p (*result); -} - -/* Decode a Lisp list SPECIFIED_TIME that represents a time. - If SPECIFIED_TIME is nil, use the current time. - Signal an error if SPECIFIED_TIME does not represent a time. - If PFORM, store the time's form into *PFORM. */ -static struct lisp_time -lisp_time_struct (Lisp_Object specified_time, enum timeform *pform) -{ - struct lisp_time t; - enum timeform form = decode_lisp_time (specified_time, false, &t, 0); - if (pform) - *pform = form; - return t; + Lisp_Object usec, Lisp_Object psec) +{ + struct err_time err_time + = decode_time_components (high, low, usec, psec, trillion, CFORM_TIMESPEC); + return err_time.err ? invalid_timespec () : err_time.time.ts; } -/* Decode a Lisp list SPECIFIED_TIME that represents a time. +/* Decode a Lisp time value SPECIFIED_TIME that represents a time. Discard any low-order (sub-ns) resolution. If SPECIFIED_TIME is nil, use the current time. Signal an error if SPECIFIED_TIME does not represent a timespec. */ struct timespec lisp_time_argument (Lisp_Object specified_time) { - struct lisp_time lt = lisp_time_struct (specified_time, 0); - struct timespec t = lisp_to_timespec (lt); + struct timespec t = decode_lisp_time (specified_time, CFORM_TIMESPEC).ts; if (! timespec_valid_p (t)) time_overflow (); return t; @@ -1047,9 +1084,7 @@ lisp_time_argument (Lisp_Object specified_time) static time_t lisp_seconds_argument (Lisp_Object specified_time) { - struct lisp_time lt; - decode_lisp_time (specified_time, true, <, 0); - struct timespec t = lisp_to_timespec (lt); + struct timespec t = decode_lisp_time (specified_time, CFORM_SECS_ONLY).ts; if (! timespec_valid_p (t)) time_overflow (); return t.tv_sec; @@ -1096,9 +1131,9 @@ lispint_arith (Lisp_Object a, Lisp_Object b, bool subtract) static Lisp_Object time_arith (Lisp_Object a, Lisp_Object b, bool subtract) { - enum timeform aform, bform; - struct lisp_time ta = lisp_time_struct (a, &aform); - struct lisp_time tb = lisp_time_struct (b, &bform); + struct ticks_hz + ta = decode_lisp_time (a, CFORM_TICKS_HZ).th, + tb = decode_lisp_time (b, CFORM_TICKS_HZ).th; Lisp_Object ticks, hz; if (FASTER_TIMEFNS && BASE_EQ (ta.hz, tb.hz)) @@ -1182,8 +1217,8 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) return (BASE_EQ (hz, make_fixnum (1)) ? ticks : (!current_time_list - || aform == TIMEFORM_TICKS_HZ - || bform == TIMEFORM_TICKS_HZ + || (CONSP (a) && !CONSP (XCDR (a))) + || (CONSP (b) && !CONSP (XCDR (b))) || !trillion_factor (hz)) ? Fcons (ticks, hz) : ticks_hz_list4 (ticks, hz)); @@ -1239,8 +1274,8 @@ time_cmp (Lisp_Object a, Lisp_Object b) /* Compare (ATICKS . AZ) to (BTICKS . BHZ) by comparing ATICKS * BHZ to BTICKS * AHZ. */ - struct lisp_time ta = lisp_time_struct (a, 0); - struct lisp_time tb = lisp_time_struct (b, 0); + struct ticks_hz ta = decode_lisp_time (a, CFORM_TICKS_HZ).th; + struct ticks_hz tb = decode_lisp_time (b, CFORM_TICKS_HZ).th; mpz_t const *za = bignum_integer (&mpz[0], ta.ticks); mpz_t const *zb = bignum_integer (&mpz[1], tb.ticks); if (! (FASTER_TIMEFNS && BASE_EQ (ta.hz, tb.hz))) @@ -1516,12 +1551,27 @@ SEC is always an integer between 0 and 59.) usage: (decode-time &optional TIME ZONE FORM) */) (Lisp_Object specified_time, Lisp_Object zone, Lisp_Object form) { - /* Compute broken-down local time LOCAL_TM from SPECIFIED_TIME and ZONE. */ - struct lisp_time lt = lisp_time_struct (specified_time, 0); - struct timespec ts = lisp_to_timespec (lt); - if (! timespec_valid_p (ts)) - time_overflow (); - time_t time_spec = ts.tv_sec; + /* Convert SPECIFIED_TIME to TIME_SPEC and HZ; + if HZ != 1 also set TH.ticks. */ + time_t time_spec; + Lisp_Object hz; + struct ticks_hz th UNINIT; + if (EQ (form, Qt)) + { + th = decode_lisp_time (specified_time, CFORM_TICKS_HZ).th; + struct timespec ts = ticks_hz_to_timespec (th.ticks, th.hz); + if (! timespec_valid_p (ts)) + time_overflow (); + time_spec = ts.tv_sec; + hz = th.hz; + } + else + { + time_spec = lisp_seconds_argument (specified_time); + hz = make_fixnum (1); + } + + /* Compute broken-down local time LOCAL_TM from TIME_SPEC and ZONE. */ struct tm local_tm, gmt_tm; timezone_t tz = tzlookup (zone, false); struct tm *tm = emacs_localtime_rz (tz, &time_spec, &local_tm); @@ -1549,25 +1599,25 @@ usage: (decode-time &optional TIME ZONE FORM) */) } /* Compute SEC from LOCAL_TM.tm_sec and HZ. */ - Lisp_Object hz = lt.hz, sec; - if (BASE_EQ (hz, make_fixnum (1)) || !EQ (form, Qt)) + Lisp_Object sec; + if (BASE_EQ (hz, make_fixnum (1))) sec = make_fixnum (local_tm.tm_sec); else { - /* Let TICKS = HZ * LOCAL_TM.tm_sec + mod (LT.ticks, HZ) + /* Let TICKS = HZ * LOCAL_TM.tm_sec + mod (TH.ticks, HZ) and SEC = (TICKS . HZ). */ Lisp_Object ticks; intmax_t n; - if (FASTER_TIMEFNS && FIXNUMP (lt.ticks) && FIXNUMP (hz) + if (FASTER_TIMEFNS && FIXNUMP (th.ticks) && FIXNUMP (hz) && !ckd_mul (&n, XFIXNUM (hz), local_tm.tm_sec) - && !ckd_add (&n, n, (XFIXNUM (lt.ticks) % XFIXNUM (hz) - + (XFIXNUM (lt.ticks) % XFIXNUM (hz) < 0 + && !ckd_add (&n, n, (XFIXNUM (th.ticks) % XFIXNUM (hz) + + (XFIXNUM (th.ticks) % XFIXNUM (hz) < 0 ? XFIXNUM (hz) : 0)))) ticks = make_int (n); else { mpz_fdiv_r (mpz[0], - *bignum_integer (&mpz[0], lt.ticks), + *bignum_integer (&mpz[0], th.ticks), *bignum_integer (&mpz[1], hz)); mpz_addmul_ui (mpz[0], *bignum_integer (&mpz[1], hz), local_tm.tm_sec); @@ -1611,10 +1661,9 @@ check_tm_member (Lisp_Object obj, int offset) { CHECK_INTEGER (obj); mpz_sub_ui (mpz[0], *bignum_integer (&mpz[0], obj), offset); - intmax_t i; - if (! (mpz_to_intmax (mpz[0], &i) && INT_MIN <= i && i <= INT_MAX)) + if (!mpz_fits_sint_p (mpz[0])) time_overflow (); - return i; + return mpz_get_si (mpz[0]); } } @@ -1694,19 +1743,18 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) yeararg = args[5]; } - /* Let SEC = floor (LT.ticks / HZ), with SUBSECTICKS the remainder. */ - struct lisp_time lt; - decode_lisp_time (secarg, false, <, 0); - Lisp_Object hz = lt.hz, sec, subsecticks; + /* Let SEC = floor (TH.ticks / HZ), with SUBSECTICKS the remainder. */ + struct ticks_hz th = decode_lisp_time (secarg, CFORM_TICKS_HZ).th; + Lisp_Object hz = th.hz, sec, subsecticks; if (FASTER_TIMEFNS && BASE_EQ (hz, make_fixnum (1))) { - sec = lt.ticks; + sec = th.ticks; subsecticks = make_fixnum (0); } else { mpz_fdiv_qr (mpz[0], mpz[1], - *bignum_integer (&mpz[0], lt.ticks), + *bignum_integer (&mpz[0], th.ticks), *bignum_integer (&mpz[1], hz)); sec = make_integer_mpz (); mpz_swap (mpz[0], mpz[1]); @@ -1734,8 +1782,8 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) : INT_TO_INTEGER (value)); else { - struct lisp_time val1 = { INT_TO_INTEGER (value), make_fixnum (1) }; - Lisp_Object secticks = lisp_time_hz_ticks (val1, hz); + struct ticks_hz val1 = { INT_TO_INTEGER (value), make_fixnum (1) }; + Lisp_Object secticks = ticks_hz_hz_ticks (val1, hz); Lisp_Object ticks = lispint_arith (secticks, subsecticks, false); return Fcons (ticks, hz); } @@ -1765,20 +1813,18 @@ but new code should not rely on it. */) { /* FIXME: Any reason why we don't offer a `float` output format option as well, since we accept it as input? */ - struct lisp_time t; - enum timeform input_form = decode_lisp_time (time, false, &t, 0); + struct ticks_hz t = decode_lisp_time (time, CFORM_TICKS_HZ).th; form = (!NILP (form) ? maybe_remove_pos_from_symbol (form) : current_time_list ? Qlist : Qt); if (BASE_EQ (form, Qlist)) return ticks_hz_list4 (t.ticks, t.hz); if (BASE_EQ (form, Qinteger)) - return FASTER_TIMEFNS && INTEGERP (time) ? time : lisp_time_seconds (t); + return FASTER_TIMEFNS && INTEGERP (time) ? time : ticks_hz_seconds (t); if (BASE_EQ (form, Qt)) form = t.hz; - if (FASTER_TIMEFNS - && input_form == TIMEFORM_TICKS_HZ && BASE_EQ (form, XCDR (time))) + if (FASTER_TIMEFNS && CONSP (time) && BASE_EQ (form, XCDR (time))) return time; - return Fcons (lisp_time_hz_ticks (t, form), form); + return Fcons (ticks_hz_hz_ticks (t, form), form); } DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, @@ -2020,10 +2066,6 @@ emacs_setenv_TZ (const char *tzstring) return 0; } -#if (ULONG_MAX < TRILLION || !FASTER_TIMEFNS) && !defined ztrillion -# define NEED_ZTRILLION_INIT 1 -#endif - #ifdef NEED_ZTRILLION_INIT static void syms_of_timefns_for_pdumper (void) diff --git a/src/treesit.c b/src/treesit.c index 2805fa69aed..878c1f0b340 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -22,6 +22,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> #include "lisp.h" #include "buffer.h" +#include "coding.h" #include "treesit.h" @@ -392,16 +393,20 @@ init_treesit_functions (void) These are all imaginary scenarios but they are not impossible :-) - Parsers in indirect buffers: We make indirect buffers to share the - parser of its base buffer. Indirect buffers and their base buffer + Parsers in indirect buffers: We make indirect buffers share the + parser of their base buffer. Indirect buffers and their base buffer share the same buffer content but not other buffer attributes. If they have separate parser lists, changes made in an indirect buffer - will only update parsers of that indirect buffer, and not parsers - in the base buffer or other indirect buffers, and vice versa. We - could keep track of all the base and indirect buffers, and update - all of their parsers, but ultimately decide to take a simpler - approach, which is to make indirect buffers share their base - buffer's parser list. The discussion can be found in bug#59693. */ + will only update parsers of that indirect buffer, and not parsers in + the base buffer or other indirect buffers, and vice versa. For that + reason, the base buffer and all ot its indirect buffers share a + single parser list. But each parser in this shared parser list still + points to their own buffer. On top of that, treesit-parser-list only + return parsers that belongs to the calling buffer. So ultimately, + from the user's POV, each buffer, regardless of indirect or not, + appears to have their own parser list. A discussion can be found in + bug#59693. Note that that discussion led to an earlier design, which + is different from the current one. */ /*** Initialization */ @@ -537,6 +542,15 @@ treesit_debug_print_parser_list (char *msg, Lisp_Object parser) /*** Loading language library */ +struct treesit_loaded_lang +{ + /* The language object, or NULL if the language failed to load. */ + TSLanguage *lang; + /* The absolute file name of the shared library, or NULL if access + failed. */ + const char *filename; +}; + /* Translate a symbol treesit-<lang> to a C name treesit_<lang>. */ static void treesit_symbol_to_c_name (char *symbol_name) @@ -621,7 +635,7 @@ treesit_load_language_push_for_each_suffix (Lisp_Object lib_base_name, If error occurs, return NULL and fill SIGNAL_SYMBOL and SIGNAL_DATA with values suitable for xsignal. */ -static TSLanguage * +static struct treesit_loaded_lang treesit_load_language (Lisp_Object language_symbol, Lisp_Object *signal_symbol, Lisp_Object *signal_data) { @@ -637,7 +651,7 @@ treesit_load_language (Lisp_Object language_symbol, /* Override the library name and C name, if appropriate. */ Lisp_Object override_name; - Lisp_Object override_c_name; + Lisp_Object override_c_name UNINIT; bool found_override = treesit_find_override_name (language_symbol, &override_name, &override_c_name); @@ -672,6 +686,7 @@ treesit_load_language (Lisp_Object language_symbol, dynlib_handle_ptr handle; const char *error; Lisp_Object error_list = Qnil; + struct treesit_loaded_lang loaded_lang = { NULL, NULL }; tail = path_candidates; error = NULL; @@ -696,7 +711,7 @@ treesit_load_language (Lisp_Object language_symbol, mismatch. */ *signal_symbol = Qtreesit_load_language_error; *signal_data = Fcons (Qnot_found, Fnreverse (error_list)); - return NULL; + return loaded_lang; } /* Load TSLanguage. */ @@ -718,7 +733,7 @@ treesit_load_language (Lisp_Object language_symbol, { *signal_symbol = Qtreesit_load_language_error; *signal_data = list2 (Qsymbol_error, build_string (error)); - return NULL; + return loaded_lang; } TSLanguage *lang = (*langfn) (); @@ -731,9 +746,14 @@ treesit_load_language (Lisp_Object language_symbol, *signal_symbol = Qtreesit_load_language_error; *signal_data = list2 (Qversion_mismatch, make_fixnum (ts_language_version (lang))); - return NULL; + return loaded_lang; } - return lang; + + const char *sym; + dynlib_addr ((void (*)) langfn, &loaded_lang.filename, &sym); + + loaded_lang.lang = lang; + return loaded_lang; } DEFUN ("treesit-language-available-p", Ftreesit_language_available_p, @@ -750,7 +770,9 @@ If DETAIL is non-nil, return (t . nil) when LANGUAGE is available, treesit_initialize (); Lisp_Object signal_symbol = Qnil; Lisp_Object signal_data = Qnil; - if (treesit_load_language (language, &signal_symbol, &signal_data) == NULL) + struct treesit_loaded_lang loaded_lang + = treesit_load_language (language, &signal_symbol, &signal_data); + if (loaded_lang.lang == NULL) { if (NILP (detail)) return Qnil; @@ -796,9 +818,9 @@ Return nil if a grammar library for LANGUAGE is not available. */) { Lisp_Object signal_symbol = Qnil; Lisp_Object signal_data = Qnil; - TSLanguage *ts_language = treesit_load_language (language, - &signal_symbol, - &signal_data); + struct treesit_loaded_lang lang + = treesit_load_language (language, &signal_symbol, &signal_data); + TSLanguage *ts_language = lang.lang; if (ts_language == NULL) return Qnil; uint32_t version = ts_language_version (ts_language); @@ -806,6 +828,30 @@ Return nil if a grammar library for LANGUAGE is not available. */) } } +/* This function isn't documented in the manual since it's mainly for + debugging. */ +DEFUN ("treesit-grammar-location", Ftreesit_grammar_location, + Streesit_grammar_location, + 1, 1, 0, + doc: /* Return the absolute file name of the grammar file for LANGUAGE. + +If LANGUAGE isn't loaded yet, load it first. If the language can't be +loaded or the file name couldn't be determined, return nil. */) + (Lisp_Object language) +{ + CHECK_SYMBOL (language); + + Lisp_Object signal_symbol = Qnil; + Lisp_Object signal_data = Qnil; + struct treesit_loaded_lang lang + = treesit_load_language (language, &signal_symbol, &signal_data); + + if (!lang.lang || !lang.filename) return Qnil; + + return DECODE_FILE (make_unibyte_string (lang.filename, + strlen (lang.filename))); +} + /*** Parsing functions */ @@ -1320,6 +1366,7 @@ make_treesit_parser (Lisp_Object buffer, TSParser *parser, lisp_parser->visible_end = BUF_ZV_BYTE (XBUFFER (buffer)); lisp_parser->timestamp = 0; lisp_parser->deleted = false; + lisp_parser->need_to_gc_buffer = false; lisp_parser->within_reparse = false; eassert (lisp_parser->visible_beg <= lisp_parser->visible_end); return make_lisp_ptr (lisp_parser, Lisp_Vectorlike); @@ -1344,7 +1391,6 @@ make_treesit_node (Lisp_Object parser, TSNode node) static Lisp_Object make_treesit_query (Lisp_Object query, Lisp_Object language) { - TSQueryCursor *treesit_cursor = ts_query_cursor_new (); struct Lisp_TS_Query *lisp_query; lisp_query = ALLOCATE_PSEUDOVECTOR (struct Lisp_TS_Query, @@ -1353,7 +1399,7 @@ make_treesit_query (Lisp_Object query, Lisp_Object language) lisp_query->language = language; lisp_query->source = query; lisp_query->query = NULL; - lisp_query->cursor = treesit_cursor; + lisp_query->cursor = NULL; return make_lisp_ptr (lisp_query, Lisp_Vectorlike); } @@ -1361,6 +1407,8 @@ make_treesit_query (Lisp_Object query, Lisp_Object language) void treesit_delete_parser (struct Lisp_TS_Parser *lisp_parser) { + if (lisp_parser->need_to_gc_buffer) + Fkill_buffer (lisp_parser->buffer); ts_tree_delete (lisp_parser->tree); ts_parser_delete (lisp_parser->parser); } @@ -1414,6 +1462,16 @@ treesit_compose_query_signal_data (uint32_t error_offset, build_string ("Debug the query with `treesit-query-validate'")); } +/* Ensure QUERY has a non-NULL cursor, and return it. */ +static TSQueryCursor * +treesit_ensure_query_cursor (Lisp_Object query) +{ + if (!XTS_COMPILED_QUERY (query)->cursor) + XTS_COMPILED_QUERY (query)->cursor = ts_query_cursor_new (); + + return XTS_COMPILED_QUERY (query)->cursor; +} + /* Ensure the QUERY is compiled. Return the TSQuery. It could be NULL if error occurs, in which case ERROR_OFFSET and ERROR_TYPE are bound. If error occurs, return NULL, and assign SIGNAL_SYMBOL and @@ -1433,8 +1491,9 @@ treesit_ensure_query_compiled (Lisp_Object query, Lisp_Object *signal_symbol, Lisp_Object language = XTS_COMPILED_QUERY (query)->language; /* This is the main reason why we compile query lazily: to avoid loading languages early. */ - TSLanguage *treesit_lang = treesit_load_language (language, signal_symbol, - signal_data); + struct treesit_loaded_lang lang + = treesit_load_language (language, signal_symbol, signal_data); + TSLanguage *treesit_lang = lang.lang; if (treesit_lang == NULL) return NULL; @@ -1444,9 +1503,7 @@ treesit_ensure_query_compiled (Lisp_Object query, Lisp_Object *signal_symbol, /* Create TSQuery. */ uint32_t error_offset; TSQueryError error_type; - char *treesit_source = SSDATA (source); - treesit_query = ts_query_new (treesit_lang, treesit_source, - strlen (treesit_source), + treesit_query = ts_query_new (treesit_lang, SSDATA (source), SBYTES (source), &error_offset, &error_type); if (treesit_query == NULL) { @@ -1459,6 +1516,31 @@ treesit_ensure_query_compiled (Lisp_Object query, Lisp_Object *signal_symbol, return treesit_query; } +/* Bsically treesit_ensure_query_compiled but can signal. */ +static +void treesit_ensure_query_compiled_signal (Lisp_Object lisp_query) +{ + Lisp_Object signal_symbol = Qnil; + Lisp_Object signal_data = Qnil; + TSQuery *treesit_query = treesit_ensure_query_compiled (lisp_query, + &signal_symbol, + &signal_data); + + if (treesit_query == NULL) + xsignal (signal_symbol, signal_data); +} + +/* Resolve language symbol LANG according to + treesit-language-remap-alist. */ +static +Lisp_Object resolve_language_symbol (Lisp_Object lang) +{ + Lisp_Object res = Fassoc (lang, Vtreesit_language_remap_alist, Qeq); + if (NILP (res)) + return lang; + return Fcdr (res); +} + /* Lisp definitions. */ @@ -1553,13 +1635,20 @@ an indirect buffer. */) CHECK_SYMBOL (language); CHECK_SYMBOL (tag); struct buffer *buf; + Lisp_Object buf_orig; + if (NILP (buffer)) - buf = current_buffer; + { + buf = current_buffer; + XSETBUFFER (buf_orig, current_buffer); + } else { CHECK_BUFFER (buffer); buf = XBUFFER (buffer); + buf_orig = buffer; } + if (buf->base_buffer) buf = buf->base_buffer; @@ -1568,6 +1657,9 @@ an indirect buffer. */) treesit_check_buffer_size (buf); + language = resolve_language_symbol (language); + CHECK_SYMBOL (language); + /* See if we can reuse a parser. */ if (NILP (no_reuse)) { @@ -1576,7 +1668,8 @@ an indirect buffer. */) { struct Lisp_TS_Parser *parser = XTS_PARSER (XCAR (tail)); if (EQ (parser->tag, tag) - && EQ (parser->language_symbol, language)) + && EQ (parser->language_symbol, language) + && EQ (parser->buffer, buf_orig)) return XCAR (tail); } } @@ -1585,8 +1678,9 @@ an indirect buffer. */) Lisp_Object signal_symbol = Qnil; Lisp_Object signal_data = Qnil; TSParser *parser = ts_parser_new (); - TSLanguage *lang = treesit_load_language (language, &signal_symbol, - &signal_data); + struct treesit_loaded_lang loaded_lang + = treesit_load_language (language, &signal_symbol, &signal_data); + TSLanguage *lang = loaded_lang.lang; if (lang == NULL) xsignal (signal_symbol, signal_data); /* We check language version when loading a language, so this should @@ -1594,9 +1688,7 @@ an indirect buffer. */) ts_parser_set_language (parser, lang); /* Create parser. */ - Lisp_Object lisp_buf; - XSETBUFFER (lisp_buf, buf); - Lisp_Object lisp_parser = make_treesit_parser (lisp_buf, + Lisp_Object lisp_parser = make_treesit_parser (buf_orig, parser, NULL, language, tag); @@ -1642,16 +1734,25 @@ tag. */) (Lisp_Object buffer, Lisp_Object language, Lisp_Object tag) { struct buffer *buf; + Lisp_Object buf_orig; + if (NILP (buffer)) - buf = current_buffer; + { + buf = current_buffer; + XSETBUFFER (buf_orig, current_buffer); + } else { CHECK_BUFFER (buffer); buf = XBUFFER (buffer); + buf_orig = buffer; } + if (buf->base_buffer) buf = buf->base_buffer; + language = resolve_language_symbol (language); + /* Return a fresh list so messing with that list doesn't affect our internal data. */ Lisp_Object return_list = Qnil; @@ -1663,7 +1764,10 @@ tag. */) { struct Lisp_TS_Parser *parser = XTS_PARSER (XCAR (tail)); if ((NILP (language) || EQ (language, parser->language_symbol)) - && (EQ (tag, Qt) || EQ (tag, parser->tag))) + && (EQ (tag, Qt) || EQ (tag, parser->tag)) + /* Indirect buffers and base buffer shares the same parser + * list, so we need the filtering here. */ + && (EQ (parser->buffer, buf_orig))) return_list = Fcons (XCAR (tail), return_list); } @@ -1959,6 +2063,49 @@ positions. PARSER is the parser issuing the notification. */) return Qnil; } +/* Why don't we use ts_parse_string? I tried, but it requires too much + change throughout treesit.c: we either return a root node that has no + associated parser, or one that has a parser but the parser doesn't + have associated buffer. Both routes require us to add checks and + branches everywhere we use the parser of a node or the buffer of a + parser. I tried route 1, and found that on top of the need to add a + bunch of branches to handle the no-parser case, many functions + require a parser alongside the node (getting the tree, or language + symbol, etc), and I would need to rewrite those as well. Overall, + it's just not worth it--this is just a convenience function. --yuan */ +DEFUN ("treesit-parse-string", + Ftreesit_parse_string, Streesit_parse_string, + 2, 2, 0, + doc: /* Parse STRING using a parser for LANGUAGE. + +Return the root node of the result parse tree. DO NOT use this function +in a loop: this function is intended for one-off use and isn't +optimized; for heavy workload, use a temporary buffer instead. */) + (Lisp_Object string, Lisp_Object language) +{ + CHECK_SYMBOL (language); + CHECK_STRING (string); + + Lisp_Object name_str = build_string (" *treesit-parse-string*"); + Lisp_Object buffer_name = Fgenerate_new_buffer_name (name_str, Qnil); + Lisp_Object buffer = Fget_buffer_create (buffer_name, Qnil); + + struct buffer *old_buffer = current_buffer; + set_buffer_internal (XBUFFER (buffer)); + insert1 (string); + set_buffer_internal (old_buffer); + + Lisp_Object parser = Ftreesit_parser_create (language, buffer, Qt, Qnil); + XTS_PARSER (parser)->need_to_gc_buffer = true; + + /* Make sure the temp buffer doesn't reference the parser, otherwise + the buffer and parser cross-reference each other and the parser is + never garbage-collected. */ + BVAR (XBUFFER (buffer), ts_parser_list) = Qnil; + + return Ftreesit_parser_root_node (parser); +} + /*** Node API */ @@ -2293,11 +2440,10 @@ Return nil if there is no such child. If NODE is nil, return nil. */) CHECK_STRING (field_name); treesit_initialize (); - char *name_str = SSDATA (field_name); TSNode treesit_node = XTS_NODE (node)->node; TSNode child - = ts_node_child_by_field_name (treesit_node, name_str, - strlen (name_str)); + = ts_node_child_by_field_name (treesit_node, SSDATA (field_name), + SBYTES (field_name)); if (ts_node_is_null (child)) return Qnil; @@ -2919,6 +3065,8 @@ DEFUN ("treesit-query-compile", doc: /* Compile QUERY to a compiled query. Querying with a compiled query is much faster than an uncompiled one. +So it's a good idea to use compiled query in tight loops, etc. + LANGUAGE is the language this query is for. If EAGER is non-nil, immediately load LANGUAGE and compile the query. @@ -2932,11 +3080,17 @@ You can use `treesit-query-validate' to validate and debug a query. */) if (NILP (Ftreesit_query_p (query))) wrong_type_argument (Qtreesit_query_p, query); CHECK_SYMBOL (language); - if (TS_COMPILED_QUERY_P (query)) - return query; treesit_initialize (); + if (TS_COMPILED_QUERY_P (query)) + { + if (NILP (eager)) + return query; + treesit_ensure_query_compiled_signal (query); + return query; + } + Lisp_Object lisp_query = make_treesit_query (query, language); /* Maybe actually compile. */ @@ -2944,15 +3098,7 @@ You can use `treesit-query-validate' to validate and debug a query. */) return lisp_query; else { - Lisp_Object signal_symbol = Qnil; - Lisp_Object signal_data = Qnil; - TSQuery *treesit_query = treesit_ensure_query_compiled (lisp_query, - &signal_symbol, - &signal_data); - - if (treesit_query == NULL) - xsignal (signal_symbol, signal_data); - + treesit_ensure_query_compiled_signal (lisp_query); return lisp_query; } } @@ -3010,7 +3156,7 @@ treesit_initialize_query (Lisp_Object query, const TSLanguage *lang, { *ts_query = treesit_ensure_query_compiled (query, signal_symbol, signal_data); - *cursor = XTS_COMPILED_QUERY (query)->cursor; + *cursor = treesit_ensure_query_cursor (query); /* 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; @@ -3022,10 +3168,9 @@ treesit_initialize_query (Lisp_Object query, const TSLanguage *lang, 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), + *ts_query = ts_query_new (lang, SSDATA (query), SBYTES (query), &error_offset, &error_type); if (*ts_query == NULL) { @@ -3473,7 +3618,8 @@ treesit_traverse_validate_predicate (Lisp_Object pred, } if (STRINGP (pred)) return true; - else if (FUNCTIONP (pred)) + else if (FUNCTIONP (pred) + && !(SYMBOLP (pred) && !NILP (Fget (pred, Qtreesit_thing_symbol)))) return true; else if (SYMBOLP (pred)) { @@ -3577,7 +3723,8 @@ 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 if (FUNCTIONP (pred)) + else if (FUNCTIONP (pred) + && !(SYMBOLP (pred) && !NILP (Fget (pred, Qtreesit_thing_symbol)))) { Lisp_Object lisp_node = make_treesit_node (parser, node); return !NILP (CALLN (Ffuncall, pred, lisp_node)); @@ -4188,6 +4335,8 @@ syms_of_treesit (void) DEFSYM (Qtreesit_invalid_predicate, "treesit-invalid-predicate"); DEFSYM (Qtreesit_predicate_not_found, "treesit-predicate-not-found"); + DEFSYM (Qtreesit_thing_symbol, "treesit-thing-symbol"); + DEFSYM (Qor, "or"); #ifdef WINDOWSNT @@ -4278,6 +4427,19 @@ Finally, PRED can refer to other THINGs defined in this list by using the symbol of that THING. For example, (or sexp sentence). */); Vtreesit_thing_settings = Qnil; + DEFVAR_LISP ("treesit-language-remap-alist", + Vtreesit_language_remap_alist, + doc: + /* An alist remapping language symbols. + +The value should be an alist of (LANGUAGE-A . LANGUAGE-B). When such +pair exists in the alist, creating a parser for LANGUAGE-A actually +creates a parser for LANGUAGE-B. Basically, anything that requires or +applies to LANGUAGE-A will be redirected to LANGUAGE-B instead. */); + Vtreesit_language_remap_alist = Qnil; + DEFSYM (Qtreesit_language_remap_alist, "treesit-language-remap-alist"); + Fmake_variable_buffer_local (Qtreesit_language_remap_alist); + staticpro (&Vtreesit_str_libtree_sitter); Vtreesit_str_libtree_sitter = build_pure_c_string ("libtree-sitter-"); staticpro (&Vtreesit_str_tree_sitter); @@ -4320,6 +4482,7 @@ the symbol of that THING. For example, (or sexp sentence). */); defsubr (&Streesit_language_available_p); defsubr (&Streesit_library_abi_version); defsubr (&Streesit_language_abi_version); + defsubr (&Streesit_grammar_location); defsubr (&Streesit_parser_p); defsubr (&Streesit_node_p); @@ -4337,7 +4500,7 @@ the symbol of that THING. For example, (or sexp sentence). */); defsubr (&Streesit_parser_tag); defsubr (&Streesit_parser_root_node); - /* defsubr (&Streesit_parse_string); */ + defsubr (&Streesit_parse_string); defsubr (&Streesit_parser_set_included_ranges); defsubr (&Streesit_parser_included_ranges); diff --git a/src/treesit.h b/src/treesit.h index b2e679f70e6..19dc28af246 100644 --- a/src/treesit.h +++ b/src/treesit.h @@ -96,6 +96,10 @@ struct Lisp_TS_Parser /* If this field is true, parser functions raises treesit-parser-deleted signal. */ bool deleted; + /* If this field is true, deleting the parser should also delete the + associated buffer. This is for parsers created by + treesit-parse-string, which uses a hidden temp buffer. */ + bool need_to_gc_buffer; /* This field is set to true when treesit_ensure_parsed runs, to prevent infinite recursion due to calling after change functions. */ @@ -137,12 +141,15 @@ struct Lisp_TS_Query Lisp_Object language; /* Source lisp (sexp or string) query. */ Lisp_Object source; - /* Pointer to the query object. This can be NULL, meaning this - query is not initialized/compiled. We compile the query when - it is used the first time (in treesit-query-capture). */ + /* Pointer to the query object. This can be NULL, meaning this query + is not initialized/compiled. We compile the query when it is used + the first time. (See treesit_ensure_query_compiled.) */ TSQuery *query; - /* Pointer to a cursor. If we are storing the query object, we - might as well store a cursor, too. */ + /* Pointer to a cursor. If we are storing the query object, we might + as well store a cursor, too. This can be NULL; caller should use + treesit_ensure_query_cursor to access the cursor. We made cursor + to be NULL-able because it makes dumping and loading queries + easy. */ TSQueryCursor *cursor; }; diff --git a/src/unexelf.c b/src/unexelf.c index c78d04afaff..1cb1476e267 100644 --- a/src/unexelf.c +++ b/src/unexelf.c @@ -181,10 +181,9 @@ typedef struct { /* The code often converts ElfW (Half) values like e_shentsize to ptrdiff_t; check that this doesn't lose information. */ #include <intprops.h> -#include <verify.h> -verify ((! TYPE_SIGNED (ElfW (Half)) - || PTRDIFF_MIN <= TYPE_MINIMUM (ElfW (Half))) - && TYPE_MAXIMUM (ElfW (Half)) <= PTRDIFF_MAX); +static_assert ((! TYPE_SIGNED (ElfW (Half)) + || PTRDIFF_MIN <= TYPE_MINIMUM (ElfW (Half))) + && TYPE_MAXIMUM (ElfW (Half)) <= PTRDIFF_MAX); #ifdef UNEXELF_DEBUG # define DEBUG_LOG(expr) fprintf (stderr, #expr " 0x%"PRIxMAX"\n", \ diff --git a/src/unexmacosx.c b/src/unexmacosx.c index c39fff78297..f453f8ea7bb 100644 --- a/src/unexmacosx.c +++ b/src/unexmacosx.c @@ -87,15 +87,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> -/* Although <config.h> redefines malloc to unexec_malloc, etc., this - file wants stdlib.h to declare the originals. */ -#undef malloc -#undef realloc -#undef free - #include <stdlib.h> #include "unexec.h" +#define UNEXMACOSX_C /* Tell lisp.h we want the system malloc, etc. */ #include "lisp.h" #include "sysstdio.h" diff --git a/src/w32.c b/src/w32.c index 6399d883544..deeca031f64 100644 --- a/src/w32.c +++ b/src/w32.c @@ -32,7 +32,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <io.h> #include <errno.h> #include <fcntl.h> -#include <ctype.h> #include <signal.h> #include <sys/file.h> #include <time.h> /* must be before nt/inc/sys/time.h, for MinGW64 */ @@ -264,6 +263,7 @@ typedef struct _REPARSE_DATA_BUFFER { #include <wincrypt.h> +#include <c-ctype.h> #include <c-strcase.h> #include <utimens.h> /* for fdutimens */ @@ -1685,6 +1685,19 @@ w32_init_file_name_codepage (void) { file_name_codepage = CP_ACP; w32_ansi_code_page = CP_ACP; +#ifdef HAVE_PDUMPER + /* If we were dumped with pdumper, this function will be called after + loading the pdumper file, and needs to reset the following + variables that come from the dump stage, which could be on a + different system with different default codepages. Then, the + correct value of w32-ansi-code-page will be assigned by + globals_of_w32fns, which is called from 'main'. Until that call + happens, w32-ansi-code-page will have the value of CP_ACP, which + stands for the default ANSI codepage. The other variables will be + computed by codepage_for_filenames below. */ + Vdefault_file_name_coding_system = Qnil; + Vfile_name_coding_system = Qnil; +#endif } /* Produce a Windows ANSI codepage suitable for encoding file names. @@ -2558,7 +2571,7 @@ parse_root (const char * name, const char ** pPath) return 0; /* find the root name of the volume if given */ - if (isalpha (name[0]) && name[1] == ':') + if (c_isalpha (name[0]) && name[1] == ':') { /* skip past drive specifier */ name += 2; @@ -3311,7 +3324,7 @@ static BOOL fixed_drives[26]; at least for non-local drives. Info for fixed drives is never stale. */ #define DRIVE_INDEX( c ) ( (c) <= 'Z' ? (c) - 'A' : (c) - 'a' ) #define VOLINFO_STILL_VALID( root_dir, info ) \ - ( ( isalpha (root_dir[0]) && \ + ( ( c_isalpha (root_dir[0]) && \ fixed_drives[ DRIVE_INDEX (root_dir[0]) ] ) \ || GetTickCount () - info->timestamp < 10000 ) @@ -3380,7 +3393,7 @@ GetCachedVolumeInformation (char * root_dir) involve network access, and so is extremely quick). */ /* Map drive letter to UNC if remote. */ - if (isalpha (root_dir[0]) && !fixed[DRIVE_INDEX (root_dir[0])]) + if (c_isalpha (root_dir[0]) && !fixed[DRIVE_INDEX (root_dir[0])]) { char remote_name[ 256 ]; char drive[3] = { root_dir[0], ':' }; @@ -3595,9 +3608,9 @@ map_w32_filename (const char * name, const char ** pPath) default: if ( left && 'A' <= c && c <= 'Z' ) { - *str++ = tolower (c); /* map to lower case (looks nicer) */ + *str++ = c_tolower (c); /* map to lower case (looks nicer) */ left--; - dots = 0; /* started a path component */ + dots = 0; /* started a path component */ } break; } @@ -4761,6 +4774,15 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) strcpy (temp, map_w32_filename (oldname, NULL)); + /* 'rename' (which calls MoveFileW) renames the _target_ of the + symlink, which is different from Posix behavior and not what we + want here. So in that case we pretend this is a cross-device move, + for which Frename_file already has a workaround. */ + if (is_symlink (temp)) + { + errno = EXDEV; + return -1; + } /* volume_info is set indirectly by map_w32_filename. */ oldname_dev = volume_info.serialnum; @@ -10212,7 +10234,7 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey, Lisp_Object lname) retval = Fnreverse (val); break; default: - error ("unsupported registry data type: %d", (int)vtype); + error ("Unsupported registry data type: %d", (int)vtype); } xfree (pvalue); @@ -10471,6 +10493,21 @@ init_ntproc (int dumping) /* Initial preparation for subprocess support: replace our standard handles with non-inheritable versions. */ { + +#ifdef _UCRT + /* The non-UCRT code below relies on MSVCRT-only behavior, whereby + _fdopen reuses the first unused FILE slot, whereas UCRT skips the + first 3 slots, which correspond to stdin/stdout/stderr. That + makes it impossible in the UCRT build to open these 3 streams + once they are closed. So we use SetHandleInformation instead, + which is available on all versions of Windows that have UCRT. */ + SetHandleInformation (GetStdHandle(STD_INPUT_HANDLE), + HANDLE_FLAG_INHERIT, 0); + SetHandleInformation (GetStdHandle(STD_OUTPUT_HANDLE), + HANDLE_FLAG_INHERIT, 0); + SetHandleInformation (GetStdHandle(STD_ERROR_HANDLE), + HANDLE_FLAG_INHERIT, 0); +#else /* !_UCRT */ HANDLE parent; HANDLE stdin_save = INVALID_HANDLE_VALUE; HANDLE stdout_save = INVALID_HANDLE_VALUE; @@ -10478,8 +10515,8 @@ init_ntproc (int dumping) parent = GetCurrentProcess (); - /* ignore errors when duplicating and closing; typically the - handles will be invalid when running as a gui program. */ + /* Ignore errors when duplicating and closing; typically the + handles will be invalid when running as a gui program. */ DuplicateHandle (parent, GetStdHandle (STD_INPUT_HANDLE), parent, @@ -10525,6 +10562,7 @@ init_ntproc (int dumping) else _open ("nul", O_TEXT | O_NOINHERIT | O_WRONLY); _fdopen (2, "w"); +#endif /* !_UCRT */ } /* unfortunately, atexit depends on implementation of malloc */ diff --git a/src/w32console.c b/src/w32console.c index ba022382f09..9cfedde3b3f 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -167,6 +167,7 @@ w32con_clear_end_of_line (struct frame *f, int end) for (i = 0; i < glyphs_len; i++) { memcpy (&glyphs[i], &space_glyph, sizeof (struct glyph)); + glyphs[i].frame = f; } ceol_initialized = TRUE; } @@ -327,14 +328,19 @@ w32con_write_glyphs (struct frame *f, register struct glyph *string, { /* Identify a run of glyphs with the same face. */ int face_id = string->face_id; + /* Since this is called to deliver the frame glyph matrix to the + glass, some of the glyphs might be from a child frame, which + affects the interpretation of face ID. */ + struct frame *face_id_frame = string->frame; int n; for (n = 1; n < len; ++n) - if (string[n].face_id != face_id) + if (!(string[n].face_id == face_id + && string[n].frame == face_id_frame)) break; /* Turn appearance modes of the face of the run on. */ - char_attr = w32_face_attributes (f, face_id); + char_attr = w32_face_attributes (face_id_frame, face_id); if (n == len) /* This is the last run. */ @@ -530,6 +536,11 @@ static void w32con_update_end (struct frame * f) { SetConsoleCursorPosition (cur_screen, cursor_coords); + if (!XWINDOW (selected_window)->cursor_off_p + && cursor_coords.X < FRAME_COLS (f)) + w32con_show_cursor (); + else + w32con_hide_cursor (); } /*********************************************************************** diff --git a/src/w32dwrite.c b/src/w32dwrite.c new file mode 100644 index 00000000000..4dc65b15db7 --- /dev/null +++ b/src/w32dwrite.c @@ -0,0 +1,1110 @@ +/* Support for using DirectWrite on MS-Windows to draw text. This + allows for color fonts. + Copyright (C) 2024-2025 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/>. */ + +/* This requires the HarfBuzz font backend to be available. + + It works by modifying the HarfBuzz backend to use DirectWrite at + some points, if it is available: + + - When encoding characters: w32hb_encode_char + - When measuring text: w32font_text_extents + - When drawing text: w32font_draw + + DirectWrite is setup by calling w32_initialize_direct_write. From + that point, the function w32_use_direct_write will return true if + DirectWrite is to be used. + + DirectWrite is available since Windows 7, but we don't activate it on + versions before 8.1, because color fonts are only available since that. */ + +#include <config.h> +#include <math.h> +#include <windows.h> + +#if !defined MINGW_W64 && !defined CYGWIN +# define INITGUID +#endif +#include <initguid.h> +#include <ole2.h> +#include <unknwn.h> + +#include "frame.h" +#include "w32font.h" +#include "w32common.h" +#include "w32term.h" + +#ifndef MINGW_W64 + +/* The following definitions would be included from dwrite_3.h, but it + is not available when building with mingw.org's MinGW. Methods that + we don't use are declared with the EMACS_DWRITE_UNUSED macro, to + avoid bringing in more types that would need to be declared. */ + +#define EMACS_DWRITE_UNUSED(name) void (STDMETHODCALLTYPE *name) (void) + +#define DWRITE_E_NOCOLOR _HRESULT_TYPEDEF_(0x8898500CL) + +typedef enum DWRITE_PIXEL_GEOMETRY { + DWRITE_PIXEL_GEOMETRY_FLAT = 0, + DWRITE_PIXEL_GEOMETRY_RGB = 1, + DWRITE_PIXEL_GEOMETRY_BGR = 2 +} DWRITE_PIXEL_GEOMETRY; + +typedef enum DWRITE_RENDERING_MODE { + DWRITE_RENDERING_MODE_DEFAULT = 0, + DWRITE_RENDERING_MODE_ALIASED = 1, + DWRITE_RENDERING_MODE_GDI_CLASSIC = 2, + DWRITE_RENDERING_MODE_GDI_NATURAL = 3, + DWRITE_RENDERING_MODE_NATURAL = 4, + DWRITE_RENDERING_MODE_NATURAL_SYMMETRIC = 5, + DWRITE_RENDERING_MODE_OUTLINE = 6 +} DWRITE_RENDERING_MODE; + +typedef enum DWRITE_MEASURING_MODE { + DWRITE_MEASURING_MODE_NATURAL = 0, + DWRITE_MEASURING_MODE_GDI_CLASSIC = 1, + DWRITE_MEASURING_MODE_GDI_NATURAL = 2 +} DWRITE_MEASURING_MODE; + +typedef enum DWRITE_TEXT_ANTIALIAS_MODE { + DWRITE_TEXT_ANTIALIAS_MODE_CLEARTYPE = 0, + DWRITE_TEXT_ANTIALIAS_MODE_GRAYSCALE = 1 +} DWRITE_TEXT_ANTIALIAS_MODE; + +typedef enum DWRITE_FACTORY_TYPE { + DWRITE_FACTORY_TYPE_SHARED = 0, + DWRITE_FACTORY_TYPE_ISOLATED = 1 +} DWRITE_FACTORY_TYPE; + +typedef struct DWRITE_FONT_METRICS { + UINT16 designUnitsPerEm; + UINT16 ascent; + UINT16 descent; + INT16 lineGap; + UINT16 capHeight; + UINT16 xHeight; + INT16 underlinePosition; + UINT16 underlineThickness; + INT16 strikethroughPosition; + UINT16 strikethroughThickness; +} DWRITE_FONT_METRICS; + +typedef struct DWRITE_GLYPH_METRICS { + INT32 leftSideBearing; + UINT32 advanceWidth; + INT32 rightSideBearing; + INT32 topSideBearing; + UINT32 advanceHeight; + INT32 bottomSideBearing; + INT32 verticalOriginY; +} DWRITE_GLYPH_METRICS; + +typedef interface IDWriteRenderingParams IDWriteRenderingParams; +typedef interface IDWriteFont IDWriteFont; +typedef interface IDWriteGdiInterop IDWriteGdiInterop; +typedef interface IDWriteFactory IDWriteFactory; +typedef interface IDWriteFactory2 IDWriteFactory2; +typedef interface IDWriteFontFace IDWriteFontFace; +typedef interface IDWriteBitmapRenderTarget IDWriteBitmapRenderTarget; +typedef interface IDWriteBitmapRenderTarget1 IDWriteBitmapRenderTarget1; +typedef interface IDWriteColorGlyphRunEnumerator IDWriteColorGlyphRunEnumerator; + +DEFINE_GUID (IID_IDWriteBitmapRenderTarget1, 0x791e8298, 0x3ef3, 0x4230, 0x98, + 0x80, 0xc9, 0xbd, 0xec, 0xc4, 0x20, 0x64); +DEFINE_GUID (IID_IDWriteFactory2, 0x0439fc60, 0xca44, 0x4994, 0x8d, 0xee, + 0x3a, 0x9a, 0xf7, 0xb7, 0x32, 0xec); +DEFINE_GUID (IID_IDWriteFactory, 0xb859ee5a, 0xd838, 0x4b5b, 0xa2, 0xe8, 0x1a, + 0xdc, 0x7d, 0x93, 0xdb, 0x48); + +typedef struct DWRITE_GLYPH_OFFSET { + FLOAT advanceOffset; + FLOAT ascenderOffset; +} DWRITE_GLYPH_OFFSET; + +typedef struct DWRITE_GLYPH_RUN { + IDWriteFontFace *fontFace; + FLOAT fontEmSize; + UINT32 glyphCount; + const UINT16 *glyphIndices; + const FLOAT *glyphAdvances; + const DWRITE_GLYPH_OFFSET *glyphOffsets; + WINBOOL isSideways; + UINT32 bidiLevel; +} DWRITE_GLYPH_RUN; + +typedef struct _D3DCOLORVALUE { + float r; + float g; + float b; + float a; +} D3DCOLORVALUE; + +typedef D3DCOLORVALUE DWRITE_COLOR_F; + +typedef struct DWRITE_COLOR_GLYPH_RUN { + DWRITE_GLYPH_RUN glyphRun; + void *glyphRunDescription; + FLOAT baselineOriginX; + FLOAT baselineOriginY; + DWRITE_COLOR_F runColor; + UINT16 paletteIndex; +} DWRITE_COLOR_GLYPH_RUN; + +typedef struct IDWriteFontFaceVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteFontFace *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteFontFace *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteFontFace *This); + + EMACS_DWRITE_UNUSED (GetType); + EMACS_DWRITE_UNUSED (GetFiles); + EMACS_DWRITE_UNUSED (GetIndex); + EMACS_DWRITE_UNUSED (GetSimulations); + EMACS_DWRITE_UNUSED (IsSymbolFont); + + void (STDMETHODCALLTYPE *GetMetrics) + (IDWriteFontFace *This, DWRITE_FONT_METRICS *metrics); + + EMACS_DWRITE_UNUSED (GetGlyphCount); + EMACS_DWRITE_UNUSED (GetDesignGlyphMetrics); + + HRESULT (STDMETHODCALLTYPE *GetGlyphIndices) + (IDWriteFontFace *This, const UINT32 *codepoints, UINT32 count, + UINT16 *glyph_indices); + + EMACS_DWRITE_UNUSED (TryGetFontTable); + EMACS_DWRITE_UNUSED (ReleaseFontTable); + EMACS_DWRITE_UNUSED (GetGlyphRunOutline); + EMACS_DWRITE_UNUSED (GetRecommendedRenderingMode); + EMACS_DWRITE_UNUSED (GetGdiCompatibleMetrics); + + HRESULT (STDMETHODCALLTYPE *GetGdiCompatibleGlyphMetrics) + (IDWriteFontFace *This, + FLOAT emSize, + FLOAT pixels_per_dip, + void *transform, + WINBOOL use_gdi_natural, + const UINT16 *glyph_indices, + UINT32 glyph_count, + DWRITE_GLYPH_METRICS *metrics, + WINBOOL is_sideways); + END_INTERFACE +} IDWriteFontFaceVtbl; + +interface IDWriteFontFace { + CONST_VTBL IDWriteFontFaceVtbl *lpVtbl; +}; + +typedef struct IDWriteRenderingParamsVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteRenderingParams *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteRenderingParams *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteRenderingParams *This); + + FLOAT (STDMETHODCALLTYPE *GetGamma) + (IDWriteRenderingParams *This); + FLOAT (STDMETHODCALLTYPE *GetEnhancedContrast) + (IDWriteRenderingParams *This); + FLOAT (STDMETHODCALLTYPE *GetClearTypeLevel) + (IDWriteRenderingParams *This); + int (STDMETHODCALLTYPE *GetPixelGeometry) + (IDWriteRenderingParams *This); + END_INTERFACE +} IDWriteRenderingParamsVtbl; + +interface IDWriteRenderingParams { + CONST_VTBL IDWriteRenderingParamsVtbl *lpVtbl; +}; + +typedef struct IDWriteFontVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteFont *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteFont *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteFont *This); + + EMACS_DWRITE_UNUSED (GetFontFamily); + EMACS_DWRITE_UNUSED (GetWeight); + EMACS_DWRITE_UNUSED (GetStretch); + EMACS_DWRITE_UNUSED (GetStyle); + EMACS_DWRITE_UNUSED (IsSymbolFont); + EMACS_DWRITE_UNUSED (GetFaceNames); + EMACS_DWRITE_UNUSED (GetInformationalStrings); + EMACS_DWRITE_UNUSED (GetSimulations); + + void (STDMETHODCALLTYPE *GetMetrics) + (IDWriteFont *This, DWRITE_FONT_METRICS *metrics); + + EMACS_DWRITE_UNUSED (HasCharacter); + + HRESULT (STDMETHODCALLTYPE *CreateFontFace) + (IDWriteFont *This, IDWriteFontFace **face); + + END_INTERFACE +} IDWriteFontVtbl; + +interface IDWriteFont { + CONST_VTBL IDWriteFontVtbl *lpVtbl; +}; + +typedef struct IDWriteBitmapRenderTargetVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteBitmapRenderTarget *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteBitmapRenderTarget *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteBitmapRenderTarget *This); + + HRESULT (STDMETHODCALLTYPE *DrawGlyphRun) + (IDWriteBitmapRenderTarget *This, + FLOAT baselineOriginX, + FLOAT baselineOriginY, + DWRITE_MEASURING_MODE measuring_mode, + const DWRITE_GLYPH_RUN *glyph_run, + IDWriteRenderingParams *params, + COLORREF textColor, + RECT *blackbox_rect); + + HDC (STDMETHODCALLTYPE *GetMemoryDC) (IDWriteBitmapRenderTarget *This); + + EMACS_DWRITE_UNUSED (GetPixelsPerDip); + + HRESULT (STDMETHODCALLTYPE *SetPixelsPerDip) + (IDWriteBitmapRenderTarget *This, FLOAT pixels_per_dip); + + EMACS_DWRITE_UNUSED (GetCurrentTransform); + EMACS_DWRITE_UNUSED (SetCurrentTransform); + EMACS_DWRITE_UNUSED (GetSize); + EMACS_DWRITE_UNUSED (Resize); + END_INTERFACE +} IDWriteBitmapRenderTargetVtbl; + +interface IDWriteBitmapRenderTarget { + CONST_VTBL IDWriteBitmapRenderTargetVtbl *lpVtbl; +}; + +typedef struct IDWriteBitmapRenderTarget1Vtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteBitmapRenderTarget1 *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteBitmapRenderTarget1 *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteBitmapRenderTarget1 *This); + + EMACS_DWRITE_UNUSED (DrawGlyphRun); + EMACS_DWRITE_UNUSED (GetMemoryDC); + EMACS_DWRITE_UNUSED (GetPixelsPerDip); + EMACS_DWRITE_UNUSED (SetPixelsPerDip); + EMACS_DWRITE_UNUSED (GetCurrentTransform); + EMACS_DWRITE_UNUSED (SetCurrentTransform); + EMACS_DWRITE_UNUSED (GetSize); + EMACS_DWRITE_UNUSED (Resize); + EMACS_DWRITE_UNUSED (GetTextAntialiasMode); + + HRESULT (STDMETHODCALLTYPE *SetTextAntialiasMode) + (IDWriteBitmapRenderTarget1 *This, DWRITE_TEXT_ANTIALIAS_MODE mode); + + END_INTERFACE +} IDWriteBitmapRenderTarget1Vtbl; + +interface IDWriteBitmapRenderTarget1 { + CONST_VTBL IDWriteBitmapRenderTarget1Vtbl *lpVtbl; +}; + +typedef struct IDWriteGdiInteropVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteGdiInterop *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteGdiInterop *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteGdiInterop *This); + + HRESULT (STDMETHODCALLTYPE *CreateFontFromLOGFONT) + (IDWriteGdiInterop *This, const LOGFONTW *logfont, + IDWriteFont **font); + + EMACS_DWRITE_UNUSED (ConvertFontToLOGFONT); + EMACS_DWRITE_UNUSED (ConvertFontFaceToLOGFONT); + EMACS_DWRITE_UNUSED (CreateFontFaceFromHdc); + + HRESULT (STDMETHODCALLTYPE *CreateBitmapRenderTarget) + (IDWriteGdiInterop *This, HDC hdc, UINT32 width, UINT32 height, + IDWriteBitmapRenderTarget **target); + END_INTERFACE +} IDWriteGdiInteropVtbl; + +interface IDWriteGdiInterop { + CONST_VTBL IDWriteGdiInteropVtbl *lpVtbl; +}; + +typedef struct IDWriteFactoryVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteFactory *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteFactory *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteFactory *This); + + EMACS_DWRITE_UNUSED (GetSystemFontCollection); + EMACS_DWRITE_UNUSED (CreateCustomFontCollection); + EMACS_DWRITE_UNUSED (RegisterFontCollectionLoader); + EMACS_DWRITE_UNUSED (UnregisterFontCollectionLoader); + EMACS_DWRITE_UNUSED (CreateFontFileReference); + EMACS_DWRITE_UNUSED (CreateCustomFontFileReference); + EMACS_DWRITE_UNUSED (CreateFontFace); + HRESULT (STDMETHODCALLTYPE *CreateRenderingParams) + (IDWriteFactory *This, IDWriteRenderingParams **params); + EMACS_DWRITE_UNUSED (CreateMonitorRenderingParams); + HRESULT (STDMETHODCALLTYPE *CreateCustomRenderingParams) + (IDWriteFactory *This, FLOAT gamma, FLOAT enhancedContrast, + FLOAT cleartype_level, DWRITE_PIXEL_GEOMETRY geometry, + DWRITE_RENDERING_MODE mode, IDWriteRenderingParams **params); + EMACS_DWRITE_UNUSED (RegisterFontFileLoader); + EMACS_DWRITE_UNUSED (UnregisterFontFileLoader); + EMACS_DWRITE_UNUSED (CreateTextFormat); + EMACS_DWRITE_UNUSED (CreateTypography); + HRESULT (STDMETHODCALLTYPE *GetGdiInterop) + (IDWriteFactory *This, IDWriteGdiInterop **gdi_interop); + EMACS_DWRITE_UNUSED (CreateTextLayout); + EMACS_DWRITE_UNUSED (CreateGdiCompatibleTextLayout); + EMACS_DWRITE_UNUSED (CreateEllipsisTrimmingSign); + EMACS_DWRITE_UNUSED (CreateTextAnalyzer); + EMACS_DWRITE_UNUSED (CreateNumberSubstitution); + EMACS_DWRITE_UNUSED (CreateGlyphRunAnalysis); + END_INTERFACE +} IDWriteFactoryVtbl; + +interface IDWriteFactory { CONST_VTBL IDWriteFactoryVtbl *lpVtbl; }; + +typedef struct IDWriteColorGlyphRunEnumeratorVtbl { + BEGIN_INTERFACE + + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteColorGlyphRunEnumerator *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteColorGlyphRunEnumerator *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteColorGlyphRunEnumerator *This); + + HRESULT (STDMETHODCALLTYPE *MoveNext) (IDWriteColorGlyphRunEnumerator *This, + WINBOOL *hasRun); + + HRESULT (STDMETHODCALLTYPE *GetCurrentRun) (IDWriteColorGlyphRunEnumerator *This, + const DWRITE_COLOR_GLYPH_RUN **run); + + END_INTERFACE +} IDWriteColorGlyphRunEnumeratorVtbl; + +interface IDWriteColorGlyphRunEnumerator { + CONST_VTBL IDWriteColorGlyphRunEnumeratorVtbl *lpVtbl; +}; + +typedef struct IDWriteFactory2Vtbl { + BEGIN_INTERFACE + HRESULT (STDMETHODCALLTYPE *QueryInterface) + (IDWriteFactory2 *This, REFIID riid, void **ppvObject); + ULONG (STDMETHODCALLTYPE *AddRef) (IDWriteFactory2 *This); + ULONG (STDMETHODCALLTYPE *Release) (IDWriteFactory2 *This); + EMACS_DWRITE_UNUSED (GetSystemFontCollection); + EMACS_DWRITE_UNUSED (CreateCustomFontCollection); + EMACS_DWRITE_UNUSED (RegisterFontCollectionLoader); + EMACS_DWRITE_UNUSED (UnregisterFontCollectionLoader); + EMACS_DWRITE_UNUSED (CreateFontFileReference); + EMACS_DWRITE_UNUSED (CreateCustomFontFileReference); + EMACS_DWRITE_UNUSED (CreateFontFace); + EMACS_DWRITE_UNUSED (CreateRenderingParams); + EMACS_DWRITE_UNUSED (CreateMonitorRenderingParams); + EMACS_DWRITE_UNUSED (CreateCustomRenderingParams); + EMACS_DWRITE_UNUSED (RegisterFontFileLoader); + EMACS_DWRITE_UNUSED (UnregisterFontFileLoader); + EMACS_DWRITE_UNUSED (CreateTextFormat); + EMACS_DWRITE_UNUSED (CreateTypography); + EMACS_DWRITE_UNUSED (GetGdiInterop); + EMACS_DWRITE_UNUSED (CreateTextLayout); + EMACS_DWRITE_UNUSED (CreateGdiCompatibleTextLayout); + EMACS_DWRITE_UNUSED (CreateEllipsisTrimmingSign); + EMACS_DWRITE_UNUSED (CreateTextAnalyzer); + EMACS_DWRITE_UNUSED (CreateNumberSubstitution); + EMACS_DWRITE_UNUSED (CreateGlyphRunAnalysis); + + EMACS_DWRITE_UNUSED (GetEudcFontCollection); + EMACS_DWRITE_UNUSED (IDWriteFactory1_CreateCustomRenderingParams); + + EMACS_DWRITE_UNUSED (GetSystemFontFallback); + EMACS_DWRITE_UNUSED (CreateFontFallbackBuilder); + HRESULT (STDMETHODCALLTYPE *TranslateColorGlyphRun) + (IDWriteFactory2 *This, + FLOAT originX, + FLOAT originY, + const DWRITE_GLYPH_RUN *run, + void *rundescr, + DWRITE_MEASURING_MODE mode, + void *transform, + UINT32 palette_index, + IDWriteColorGlyphRunEnumerator **colorlayers); + + EMACS_DWRITE_UNUSED (IDWriteFactory2_CreateCustomRenderingParams); + EMACS_DWRITE_UNUSED (IDWriteFactory2_CreateGlyphRunAnalysis); + END_INTERFACE +} IDWriteFactory2Vtbl; + +interface IDWriteFactory2 { + CONST_VTBL IDWriteFactory2Vtbl *lpVtbl; +}; +#else /* MINGW_W64 */ +# include <dwrite_3.h> +#endif + +/* User configurable variables. If they are smaller than 0, use + DirectWrite's defaults, or our defaults. To set them, the user calls + 'w32-dwrite-reinit' */ +static float config_enhanced_contrast = -1.0f; +static float config_clear_type_level = -1.0f; +static float config_gamma = -1.0f; + +/* Values to use for DirectWrite rendering. */ +#define MEASURING_MODE DWRITE_MEASURING_MODE_NATURAL +#define RENDERING_MODE DWRITE_RENDERING_MODE_NATURAL_SYMMETRIC +#define ANTIALIAS_MODE DWRITE_TEXT_ANTIALIAS_MODE_CLEARTYPE + +static void +release_com (IUnknown **i) +{ + if ( *i ) + { + ((IUnknown *) (*i))->lpVtbl->Release (*i); + *i = NULL; + } +} + +#define RELEASE_COM(i) release_com ((IUnknown **) &i) + +/* Global variables for DirectWrite. */ +static bool direct_write_available = false; +static IDWriteFactory *dwrite_factory = NULL; +static IDWriteFactory2 *dwrite_factory2 = NULL; +static IDWriteGdiInterop *gdi_interop = NULL; +static IDWriteRenderingParams *rendering_params = NULL; + +static bool +verify_hr (HRESULT hr, const char *msg) +{ + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d) %s\n", hr, msg)); + eassert (SUCCEEDED (hr)); + return false; + } + return true; +} + +/* Gets a IDWriteFontFace from a struct font (its HFONT). Returns the + font size in points. It may fail to get a DirectWrite font, and face + will be NULL on return. This happens for some fonts like Courier. + + Never call Release on the result, as it is cached for reuse on the + struct font. */ +static float +get_font_face (struct font *infont, IDWriteFontFace **face) +{ + HRESULT hr; + LOGFONTW logfont; + IDWriteFont *font; + + struct uniscribe_font_info *uniscribe_font + = (struct uniscribe_font_info *) infont; + + /* Check the cache. */ + *face = uniscribe_font->dwrite_cache; + if (*face) + return uniscribe_font->dwrite_font_size; + + GetObjectW (FONT_HANDLE (infont), sizeof (LOGFONTW), &logfont); + + hr = gdi_interop->lpVtbl->CreateFontFromLOGFONT (gdi_interop, + (const LOGFONTW *) &logfont, + &font); + + if (!verify_hr (hr, "Failed to CreateFontFromLOGFONT")) + { + uniscribe_font->dwrite_skip_font = true; + *face = NULL; + return 0.0; + } + + hr = font->lpVtbl->CreateFontFace (font, face); + RELEASE_COM (font); + if (!verify_hr (hr, "Failed to create DWriteFontFace")) + { + uniscribe_font->dwrite_skip_font = true; + *face = NULL; + return 0.0; + } + + /* Cache this FontFace. */ + uniscribe_font->dwrite_font_size = eabs (logfont.lfHeight); + uniscribe_font->dwrite_cache = *face; + + return eabs (logfont.lfHeight); +} + +void +w32_dwrite_free_cached_face (void *cache) +{ + if (cache) + RELEASE_COM (cache); +} + +static float +convert_metrics_sz (int sz, float font_size, int units_per_em) +{ + return (float) sz * font_size / units_per_em; +} + +/* Does not fill in the ascent and descent fields of metrics. */ +static bool +text_extents_internal (IDWriteFontFace *dwrite_font_face, + float font_size, const unsigned *code, + int nglyphs, struct font_metrics *metrics) +{ + HRESULT hr; + + USE_SAFE_ALLOCA; + + DWRITE_FONT_METRICS dwrite_font_metrics; + dwrite_font_face->lpVtbl->GetMetrics (dwrite_font_face, + &dwrite_font_metrics); + + UINT16 *indices = SAFE_ALLOCA (nglyphs * sizeof (UINT16)); + for (int i = 0; i < nglyphs; i++) + indices[i] = code[i]; + + DWRITE_GLYPH_METRICS *gmetrics + = SAFE_ALLOCA (nglyphs * sizeof (DWRITE_GLYPH_METRICS)); + + hr = dwrite_font_face->lpVtbl->GetGdiCompatibleGlyphMetrics (dwrite_font_face, + font_size, + 1.0, + NULL, + TRUE, + indices, + nglyphs, + gmetrics, + false); + if (!verify_hr (hr, "Failed to GetGdiCompatibleGlyphMetrics")) + { + SAFE_FREE (); + return false; + } + + float width = 0; + int du_per_em = dwrite_font_metrics.designUnitsPerEm; + + for (int i = 0; i < nglyphs; i++) + { + float advance + = convert_metrics_sz (gmetrics[i].advanceWidth, font_size, du_per_em); + + width += advance; + + float lbearing + = round (convert_metrics_sz (gmetrics[i].leftSideBearing, font_size, + du_per_em)); + float rbearing + = round (advance - + convert_metrics_sz (gmetrics[i].rightSideBearing, + font_size, du_per_em)); + if (i == 0) + { + metrics->lbearing = lbearing; + metrics->rbearing = rbearing; + } + if (metrics->lbearing > lbearing) + metrics->lbearing = lbearing; + if (metrics->rbearing < rbearing) + metrics->rbearing = rbearing; + } + metrics->width = round (width); + SAFE_FREE (); + return true; +} + +unsigned +w32_dwrite_encode_char (struct font *font, int c) +{ + HRESULT hr; + IDWriteFontFace *dwrite_font_face; + UINT16 index; + + get_font_face (font, &dwrite_font_face); + if (dwrite_font_face == NULL) + return FONT_INVALID_CODE; + hr = dwrite_font_face->lpVtbl->GetGlyphIndices (dwrite_font_face, + (UINT32 *) &c, 1, &index); + if (verify_hr (hr, "Failed to GetGlyphIndices")) + { + if (index == 0) + return FONT_INVALID_CODE; + return index; + } + ((struct uniscribe_font_info *) font)->dwrite_skip_font = true; + return FONT_INVALID_CODE; +} + +bool +w32_dwrite_text_extents (struct font *font, const unsigned *code, int nglyphs, + struct font_metrics *metrics) +{ + IDWriteFontFace *dwrite_font_face; + + float font_size = get_font_face (font, &dwrite_font_face); + + if (dwrite_font_face == NULL) + return false; + + /* We can get fonts with a size of 0. GDI handles this by using a default + size. We do the same. */ + if (font_size <= 0.0f) + font_size = FRAME_LINE_HEIGHT (SELECTED_FRAME ()); + + metrics->ascent = font->ascent; + metrics->descent = font->descent; + + return text_extents_internal (dwrite_font_face, font_size, code, nglyphs, + metrics); +} + +/* Never call Release on the value returned by this function, as it is + reused. */ +static IDWriteBitmapRenderTarget * +get_bitmap_render_target (HDC hdc, int width, int height) +{ + HRESULT hr; + static IDWriteBitmapRenderTarget *brt = NULL; + static SIZE size = {0, 0}; + + if (brt) + { + /* Check if we need to make a bigger one. */ + if (width <= size.cx && height <= size.cy) + return brt; + RELEASE_COM (brt); + } + + if (width > size.cx) + size.cx = width; + if (height > size.cy) + size.cy = height; + + hr = gdi_interop->lpVtbl->CreateBitmapRenderTarget (gdi_interop, + hdc, + size.cx, size.cy, + &brt); + if (!verify_hr (hr, "Failed to CreateBitmapRenderTarget")) + return NULL; + + /* We handle high dpi displays by increasing font size, so override + PixelsPerDip. */ + brt->lpVtbl->SetPixelsPerDip (brt, 1.0); + + /* The SetTextAntialiasMode method is only available in + IDWriteBitmapRenderTarget1. */ + IDWriteBitmapRenderTarget1 *brt1; + hr = brt->lpVtbl->QueryInterface (brt, + &IID_IDWriteBitmapRenderTarget1, + (void **) &brt1); + /* This error should not happen, but is not catastrofic */ + if (verify_hr (hr, "Failed to QueryInterface for IDWriteBitmapRenderTarget1")) + { + brt1->lpVtbl->SetTextAntialiasMode (brt1, ANTIALIAS_MODE); + RELEASE_COM (brt1); + } + + return brt; +} + +void +w32_initialize_direct_write (void) +{ + direct_write_available = false; + + if (dwrite_factory) + { + RELEASE_COM (dwrite_factory); + RELEASE_COM (dwrite_factory2); + RELEASE_COM (gdi_interop); + RELEASE_COM (rendering_params); + } + + HMODULE direct_write = LoadLibrary ("dwrite.dll"); + if (!direct_write) + return; + + /* This is only used here, no need to define it globally. */ + typedef HRESULT (WINAPI *DWCreateFactory) (DWRITE_FACTORY_TYPE, + REFIID, IUnknown **); + + DWCreateFactory dw_create_factory + = (DWCreateFactory) get_proc_addr (direct_write, + "DWriteCreateFactory"); + + if (!dw_create_factory) + { + FreeLibrary (direct_write); + return; + } + + HRESULT hr = dw_create_factory (DWRITE_FACTORY_TYPE_SHARED, + &IID_IDWriteFactory, + (IUnknown **) &dwrite_factory); + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d) CreateFactory\n", hr)); + FreeLibrary (direct_write); + eassert (SUCCEEDED (hr)); + return; + } + + /* IDWriteFactory2 is only available on Windows 8.1 and later. + Without this, we can't use color fonts. So we disable DirectWrite + if it is not available. */ + hr = dwrite_factory->lpVtbl->QueryInterface (dwrite_factory, + &IID_IDWriteFactory2, + (void **) &dwrite_factory2); + + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d) QueryInterface IDWriteFactory2\n", hr)); + RELEASE_COM (dwrite_factory); + FreeLibrary (direct_write); + return; + } + + hr = dwrite_factory->lpVtbl->GetGdiInterop (dwrite_factory, + &gdi_interop); + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d) GetGdiInterop\n", hr)); + RELEASE_COM (dwrite_factory); + RELEASE_COM (dwrite_factory2); + FreeLibrary (direct_write); + eassert (SUCCEEDED (hr)); + return; + } + + IDWriteRenderingParams *def; + + hr = dwrite_factory->lpVtbl->CreateRenderingParams (dwrite_factory, + &def); + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d) CreateRenderingParams\n", hr)); + RELEASE_COM (dwrite_factory); + RELEASE_COM (dwrite_factory2); + RELEASE_COM (gdi_interop); + FreeLibrary (direct_write); + eassert (SUCCEEDED (hr)); + return; + } + + /* range: [0.0, 1.0] */ + if (config_enhanced_contrast < 0.0f || config_enhanced_contrast > 1.0f) + config_enhanced_contrast = def->lpVtbl->GetEnhancedContrast (def); + + /* range: [0.0, 1.0] */ + if (config_clear_type_level < 0.0f || config_clear_type_level > 1.0f) + config_clear_type_level = def->lpVtbl->GetClearTypeLevel (def); + + /* range: (0.0, 256.0] */ + /* We change the default value of 2.2 for gamma to 1.4, that looks + very similar to GDI. The default looks too dim for emacs, + subjectively. */ + if (config_gamma <= 0.0f || config_gamma > 256.0f) + config_gamma = 1.4; /* def->lpVtbl->GetGamma (def); */ + + hr = dwrite_factory->lpVtbl->CreateCustomRenderingParams (dwrite_factory, + config_gamma, + config_enhanced_contrast, + config_clear_type_level, + def->lpVtbl->GetPixelGeometry (def), + RENDERING_MODE, + &rendering_params); + + RELEASE_COM (def); + + if (FAILED (hr)) + { + DebPrint (("DirectWrite HRESULT failed: (%d)" + " CreateCustomRenderingParams\n", hr)); + RELEASE_COM (dwrite_factory); + RELEASE_COM (dwrite_factory2); + RELEASE_COM (gdi_interop); + FreeLibrary (direct_write); + eassert (SUCCEEDED (hr)); + return; + } + + direct_write_available = true; + + w32_inhibit_dwrite = false; +} + +bool +w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, + COLORREF color, struct font *font) +{ + HRESULT hr; + IDWriteFontFace *dwrite_font_face; + + USE_SAFE_ALLOCA; + + struct uniscribe_font_info *uniscribe_font + = (struct uniscribe_font_info *) font; + + /* What we get as y is the baseline position. */ + y -= font->ascent; + + float font_size = get_font_face (font, &dwrite_font_face); + if (dwrite_font_face == NULL) + return false; + + struct font_metrics metrics; + if (!text_extents_internal (dwrite_font_face, font_size, glyphs, len, + &metrics)) + { + uniscribe_font->dwrite_skip_font = true; + return false; + } + + int left_margin = metrics.lbearing < 0 ? -metrics.lbearing : 0; + + int bitmap_width = left_margin + metrics.width + metrics.rbearing; + int bitmap_height = font->ascent + font->descent; + + /* We never release this, get_bitmap_render_target reuses it. */ + IDWriteBitmapRenderTarget *bitmap_render_target = + get_bitmap_render_target (hdc, bitmap_width, bitmap_height); + + /* If this fails, completely disable DirectWrite. */ + if (bitmap_render_target == NULL) + { + direct_write_available = false; + return false; + } + + /* This DC can't be released. */ + HDC text_dc + = bitmap_render_target->lpVtbl->GetMemoryDC (bitmap_render_target); + + /* Copy the background pixel to the render target bitmap. */ + BitBlt (text_dc, 0, 0, bitmap_width, bitmap_height, hdc, x - left_margin, y, SRCCOPY); + + UINT16 *indices = SAFE_ALLOCA (len * sizeof (UINT16)); + + for (int i = 0; i < len; i++) + indices[i] = glyphs[i]; + + FLOAT *advances = SAFE_ALLOCA (len * sizeof (FLOAT)); + + for (int i = 0; i < len; i++) + { + if (!text_extents_internal (dwrite_font_face, font_size, glyphs + i, 1, + &metrics)) + { + uniscribe_font->dwrite_skip_font = true; + SAFE_FREE (); + return false; + } + advances[i] = metrics.width; + } + + DWRITE_GLYPH_RUN glyph_run; + glyph_run.fontFace = dwrite_font_face; + glyph_run.fontEmSize = font_size; + glyph_run.glyphIndices = indices; + glyph_run.glyphCount = len; + glyph_run.isSideways = false; + glyph_run.bidiLevel = 0; /* we reorder bidi text ourselves */ + glyph_run.glyphOffsets = NULL; + glyph_run.glyphAdvances = advances; + + IDWriteColorGlyphRunEnumerator *layers; + /* This call will tell us if we have to handle any color glyphs. */ + hr = dwrite_factory2->lpVtbl->TranslateColorGlyphRun (dwrite_factory2, + left_margin, font->ascent, + &glyph_run, + NULL, + MEASURING_MODE, + NULL, + 0, + &layers); + + /* No color. Just draw the GlyphRun. */ + if (hr == DWRITE_E_NOCOLOR) + bitmap_render_target->lpVtbl->DrawGlyphRun (bitmap_render_target, + left_margin, font->ascent, + MEASURING_MODE, + &glyph_run, + rendering_params, + color, + NULL); + else + { + /* If there were color glyphs, 'layers' contains a list of + GlyphRun with a color and a position for each. We draw them + individually. */ + if (!verify_hr (hr, "Failed at TranslateColorGlyphRun")) + { + uniscribe_font->dwrite_skip_font = true; + RELEASE_COM (layers); + SAFE_FREE (); + return false; + } + for (;;) + { + HRESULT hr; + BOOL more_layers; + const DWRITE_COLOR_GLYPH_RUN *layer; + + hr = layers->lpVtbl->MoveNext (layers, &more_layers); + if (!verify_hr (hr, "Failed at MoveNext")) + { + uniscribe_font->dwrite_skip_font = true; + RELEASE_COM (layers); + SAFE_FREE (); + return false; + } + if (!more_layers) + break; + hr = layers->lpVtbl->GetCurrentRun (layers, &layer); + if (!verify_hr (hr, "Failed at GetCurrentRun")) + { + uniscribe_font->dwrite_skip_font = true; + RELEASE_COM (layers); + SAFE_FREE (); + return false; + } + hr = bitmap_render_target->lpVtbl->DrawGlyphRun + (bitmap_render_target, + layer->baselineOriginX, + layer->baselineOriginY, + MEASURING_MODE, + &layer->glyphRun, + rendering_params, + RGB (layer->runColor.r * 255, + layer->runColor.g * 255, + layer->runColor.b * 255), + NULL); + if (!verify_hr (hr, "Failed at GetCurrentRun")) + { + uniscribe_font->dwrite_skip_font = true; + RELEASE_COM (layers); + SAFE_FREE (); + return false; + } + } + RELEASE_COM (layers); + } + + /* Finally, copy the rendered text back to the original DC. */ + BitBlt (hdc, x - left_margin, y, bitmap_width, bitmap_height, text_dc, 0, 0, SRCCOPY); + SAFE_FREE (); + return true; +} + +/* Returns true if DirectWrite is to be used: + - It is available. + - The font is handled by HarfBuzz. + - w32-inhibit-dwrite is false. + - The font has not been marked after a failed DirectWrite operation. +*/ +bool +w32_use_direct_write (struct w32font_info *w32font) +{ +#ifdef HAVE_HARFBUZZ + return (direct_write_available + && w32font->font.driver == &harfbuzz_font_driver + && !w32_inhibit_dwrite + && !((struct uniscribe_font_info *) w32font)->dwrite_skip_font); +#else + return false; +#endif +} + +DEFUN ("w32-dwrite-available", Fw32_dwrite_available, Sw32_dwrite_available, 0, 0, 0, + doc: /* Returns t if DirectWrite is available. +DirectWrite will be used if it is available and 'w32-inhibit-dwrite' is nil. */) + (void) +{ + return direct_write_available ? Qt : Qnil; +} + +DEFUN ("w32-dwrite-reinit", Fw32_dwrite_reinit, Sw32_dwrite_reinit, 0, 3, 0, + doc: /* Reinitialize DirectWrite with the given parameters. +If a parameter is not specified, or is out of range, it will take a default +value. + +Return value is nil. + +ENHANCED_CONTRAST is in the range [0.0, 1.0], and defaults to 0.5. +CLEAR_TYPE_LEVEL is in the range [0.0, 1.0], and defaults to 1.0. +GAMMA is in the range (0.0, 256.0], and defaults to a system-dependent value + around 2.0 (sometimes 1.8, sometimes 2.2). */) + (Lisp_Object enhanced_contrast, Lisp_Object clear_type_level, + Lisp_Object gamma) +{ + config_enhanced_contrast = -1.0f; + if (FLOATP (enhanced_contrast)) + config_enhanced_contrast = XFLOAT_DATA (enhanced_contrast); + if (FIXNUMP (enhanced_contrast)) + config_enhanced_contrast = XFIXNUM (enhanced_contrast); + + config_clear_type_level = -1.0f; + if (FLOATP (clear_type_level)) + config_clear_type_level = XFLOAT_DATA (clear_type_level); + if (FIXNUMP (clear_type_level)) + config_clear_type_level = XFIXNUM (clear_type_level); + + config_gamma = -1.0f; + if (FLOATP (gamma)) + config_gamma = XFLOAT_DATA (gamma); + if (FIXNUMP (gamma)) + config_gamma = XFIXNUM (gamma); + + w32_initialize_direct_write (); + + return Qnil; +} + +void +syms_of_w32dwrite (void) +{ + DEFVAR_BOOL ("w32-inhibit-dwrite", w32_inhibit_dwrite, + doc: /* If t, don't use DirectWrite. */); + /* The actual value is determined at startup in + w32_initialize_direct_write, which is called from + syms_of_w32uniscribe_for_pdumper. */ + w32_inhibit_dwrite = false; + + defsubr (&Sw32_dwrite_reinit); + defsubr (&Sw32_dwrite_available); +} diff --git a/src/w32fns.c b/src/w32fns.c index 1d79f0618fa..c7963d2c616 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -34,6 +34,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <c-ctype.h> +#define COBJMACROS /* Ask for C definitions for COM. */ +#include <shlobj.h> +#include <oleidl.h> +#include <objidl.h> +#include <ole2.h> + #include "lisp.h" #include "w32term.h" #include "frame.h" @@ -359,6 +365,9 @@ extern HANDLE keyboard_handle; static struct w32_display_info *w32_display_info_for_name (Lisp_Object); +static void my_post_msg (W32Msg *, HWND, UINT, WPARAM, LPARAM); +static unsigned int w32_get_modifiers (void); + /* Let the user specify a display with a frame. nil stands for the selected frame--or, if that is not a w32 frame, the first display on the list. */ @@ -937,13 +946,13 @@ x_to_w32_color (const char * colorname) { int len = strlen (colorname); - if (isdigit (colorname[len - 1])) + if (c_isdigit (colorname[len - 1])) { char *ptr, *approx = alloca (len + 1); strcpy (approx, colorname); ptr = &approx[len - 1]; - while (ptr > approx && isdigit (*ptr)) + while (ptr > approx && c_isdigit (*ptr)) *ptr-- = '\0'; ret = w32_color_map_lookup (approx); @@ -2464,6 +2473,214 @@ w32_createhscrollbar (struct frame *f, struct scroll_bar * bar) return hwnd; } +/* From the DROPFILES struct, extract the filenames and return as a list + of strings. */ +static Lisp_Object +process_dropfiles (DROPFILES *files) +{ + char *start_of_files = (char *) files + files->pFiles; +#ifndef NTGUI_UNICODE + char filename[MAX_UTF8_PATH]; +#endif + Lisp_Object lisp_files = Qnil; + +#ifdef NTGUI_UNICODE + WCHAR *p = (WCHAR *) start_of_files; + for (; *p; p += wcslen (p) + 1) + { + Lisp_Object fn = from_unicode_buffer (p); +#ifdef CYGWIN + fn = Fcygwin_convert_file_name_to_windows (fn, Qt); +#endif + lisp_files = Fcons (fn, lisp_files); + } +#else + if (files->fWide) + { + WCHAR *p = (WCHAR *) start_of_files; + for (; *p; p += wcslen (p) + 1) + { + filename_from_utf16 (p, filename); + lisp_files = Fcons (DECODE_FILE (build_unibyte_string (filename)), + lisp_files); + } + } + else + { + char *p = start_of_files; + for (; *p; p += strlen (p) + 1) + { + filename_from_ansi (p, filename); + lisp_files = Fcons (DECODE_FILE (build_unibyte_string (filename)), + lisp_files); + } + } +#endif + return lisp_files; +} + +/* This function can be called ONLY between calls to + block_input/unblock_input. It is used in w32_read_socket. */ +Lisp_Object +w32_process_dnd_data (int format, void *hGlobal) +{ + Lisp_Object result = Qnil; + HGLOBAL hg = (HGLOBAL) hGlobal; + + switch (format) + { + case CF_HDROP: + { + DROPFILES *files = (DROPFILES *) GlobalLock (hg); + if (files) + result = process_dropfiles (files); + GlobalUnlock (hg); + break; + } + case CF_UNICODETEXT: + { + WCHAR *text = (WCHAR *) GlobalLock (hg); + result = from_unicode_buffer (text); + GlobalUnlock (hg); + break; + } + case CF_TEXT: + { + char *text = (char *) GlobalLock (hg); + result = DECODE_SYSTEM (build_unibyte_string (text)); + GlobalUnlock (hg); + break; + } + } + + GlobalFree (hg); + + return result; +} + +struct w32_drop_target { + /* i_drop_target must be the first member. */ + IDropTarget i_drop_target; + HWND hwnd; + int ref_count; +}; + +static HRESULT STDMETHODCALLTYPE +w32_drop_target_QueryInterface (IDropTarget *t, REFIID ri, void **r) +{ + return E_NOINTERFACE; +} + +static ULONG STDMETHODCALLTYPE +w32_drop_target_AddRef (IDropTarget *This) +{ + struct w32_drop_target *target = (struct w32_drop_target *) This; + return ++target->ref_count; +} + +static ULONG STDMETHODCALLTYPE +w32_drop_target_Release (IDropTarget *This) +{ + struct w32_drop_target *target = (struct w32_drop_target *) This; + if (--target->ref_count > 0) + return target->ref_count; + free (target->i_drop_target.lpVtbl); + free (target); + return 0; +} + +static void +w32_handle_drag_movement (IDropTarget *This, POINTL pt) +{ + struct w32_drop_target *target = (struct w32_drop_target *)This; + + W32Msg msg = {0}; + msg.dwModifiers = w32_get_modifiers (); + msg.msg.time = GetMessageTime (); + msg.msg.pt.x = pt.x; + msg.msg.pt.y = pt.y; + my_post_msg (&msg, target->hwnd, WM_EMACS_DRAGOVER, 0, 0 ); +} + +static HRESULT STDMETHODCALLTYPE +w32_drop_target_DragEnter (IDropTarget *This, IDataObject *pDataObj, + DWORD grfKeyState, POINTL pt, DWORD *pdwEffect) +{ + /* Possible 'effect' values are COPY, MOVE, LINK or NONE. This choice + changes the mouse pointer shape to inform the user of what will + happen on drop. We send COPY because our use cases don't modify + or link to the original data. */ + *pdwEffect = DROPEFFECT_COPY; + w32_handle_drag_movement (This, pt); + return S_OK; +} + +static HRESULT STDMETHODCALLTYPE +w32_drop_target_DragOver (IDropTarget *This, DWORD grfKeyState, POINTL pt, + DWORD *pdwEffect) +{ + /* See comment in w32_drop_target_DragEnter. */ + *pdwEffect = DROPEFFECT_COPY; + w32_handle_drag_movement (This, pt); + return S_OK; +} + +static HRESULT STDMETHODCALLTYPE +w32_drop_target_DragLeave (IDropTarget *This) +{ + return S_OK; +} + +static HGLOBAL w32_try_get_data (IDataObject *pDataObj, int format) +{ + FORMATETC formatetc = { format, NULL, DVASPECT_CONTENT, -1, + TYMED_HGLOBAL }; + STGMEDIUM stgmedium; + HRESULT r = IDataObject_GetData (pDataObj, &formatetc, &stgmedium); + if (SUCCEEDED (r)) + { + if (stgmedium.tymed == TYMED_HGLOBAL) + return stgmedium.hGlobal; + ReleaseStgMedium (&stgmedium); + } + return NULL; +} + +static HRESULT STDMETHODCALLTYPE +w32_drop_target_Drop (IDropTarget *This, IDataObject *pDataObj, + DWORD grfKeyState, POINTL pt, DWORD *pdwEffect) +{ + struct w32_drop_target *target = (struct w32_drop_target *)This; + *pdwEffect = DROPEFFECT_COPY; + + W32Msg msg = {0}; + msg.dwModifiers = w32_get_modifiers (); + msg.msg.time = GetMessageTime (); + msg.msg.pt.x = pt.x; + msg.msg.pt.y = pt.y; + + int format = CF_HDROP; + HGLOBAL hGlobal = w32_try_get_data (pDataObj, format); + + if (!hGlobal) + { + format = CF_UNICODETEXT; + hGlobal = w32_try_get_data (pDataObj, format); + } + + if (!hGlobal) + { + format = CF_TEXT; + hGlobal = w32_try_get_data (pDataObj, format); + } + + if (hGlobal) + my_post_msg (&msg, target->hwnd, WM_EMACS_DROP, format, + (LPARAM) hGlobal); + + return S_OK; +} + static void w32_createwindow (struct frame *f, int *coords) { @@ -2548,7 +2765,31 @@ w32_createwindow (struct frame *f, int *coords) SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f)); /* Enable drag-n-drop. */ - DragAcceptFiles (hwnd, TRUE); + struct w32_drop_target *drop_target + = malloc (sizeof (struct w32_drop_target)); + + if (drop_target != NULL) + { + IDropTargetVtbl *vtbl = malloc (sizeof (IDropTargetVtbl)); + if (vtbl != NULL) + { + drop_target->hwnd = hwnd; + drop_target->ref_count = 0; + drop_target->i_drop_target.lpVtbl = vtbl; + vtbl->QueryInterface = w32_drop_target_QueryInterface; + vtbl->AddRef = w32_drop_target_AddRef; + vtbl->Release = w32_drop_target_Release; + vtbl->DragEnter = w32_drop_target_DragEnter; + vtbl->DragOver = w32_drop_target_DragOver; + vtbl->DragLeave = w32_drop_target_DragLeave; + vtbl->Drop = w32_drop_target_Drop; + RegisterDragDrop (hwnd, &drop_target->i_drop_target); + } + else + { + free (drop_target); + } + } /* Enable system light/dark theme. */ w32_applytheme (hwnd); @@ -3399,6 +3640,8 @@ w32_name_of_message (UINT msg) M (WM_EMACS_PAINT), M (WM_EMACS_IME_STATUS), M (WM_CHAR), + M (WM_EMACS_DRAGOVER), + M (WM_EMACS_DROP), #undef M { 0, 0 } }; @@ -3465,13 +3708,14 @@ w32_msg_pump (deferred_msg * msg_buf) /* Produced by complete_deferred_msg; just ignore. */ break; case WM_EMACS_CREATEWINDOW: - /* Initialize COM for this window. Even though we don't use it, - some third party shell extensions can cause it to be used in + /* Initialize COM for this window. Needed for RegisterDragDrop. + Some third party shell extensions can cause it to be used in system dialogs, which causes a crash if it is not initialized. This is a known bug in Windows, which was fixed long ago, but the patch for XP is not publicly available until XP SP3, and older versions will never be patched. */ - CoInitialize (NULL); + OleInitialize (NULL); + w32_createwindow ((struct frame *) msg.wParam, (int *) msg.lParam); if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0)) @@ -3725,7 +3969,7 @@ post_character_message (HWND hwnd, UINT msg, message that has no particular effect. */ { int c = wParam; - if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier) + if (c_isalpha (c) && wmsg.dwModifiers == ctrl_modifier) c = make_ctrl_char (c) & 0377; if (c == quit_char || (wmsg.dwModifiers == 0 @@ -5106,7 +5350,6 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) return 0; case WM_MOUSEWHEEL: - case WM_DROPFILES: wmsg.dwModifiers = w32_get_modifiers (); my_post_msg (&wmsg, hwnd, msg, wParam, lParam); signal_user_input (); @@ -5597,7 +5840,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) } case WM_EMACS_DESTROYWINDOW: - DragAcceptFiles ((HWND) wParam, FALSE); + RevokeDragDrop ((HWND) wParam); return DestroyWindow ((HWND) wParam); case WM_EMACS_HIDE_CARET: @@ -8748,7 +8991,7 @@ lookup_vk_code (char *key) || (key[0] >= '0' && key[0] <= '9')) return key[0]; if (key[0] >= 'a' && key[0] <= 'z') - return toupper(key[0]); + return c_toupper (key[0]); } } @@ -9518,7 +9761,7 @@ DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0, BOOL result; /* find the root name of the volume if given */ - if (isalpha (name[0]) && name[1] == ':') + if (c_isalpha (name[0]) && name[1] == ':') { rootname[0] = name[0]; rootname[1] = name[1]; @@ -10583,7 +10826,7 @@ to be converted to forward slashes by the caller. */) else if (EQ (root, QHKCC)) rootkey = HKEY_CURRENT_CONFIG; else if (!NILP (root)) - error ("unknown root key: %s", SDATA (SYMBOL_NAME (root))); + error ("Unknown root key: %s", SDATA (SYMBOL_NAME (root))); Lisp_Object val = w32_read_registry (rootkey, key, name); if (NILP (val) && NILP (root)) diff --git a/src/w32font.c b/src/w32font.c index 665e8510c7e..f44a7c124c9 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -229,14 +229,6 @@ get_char_width_32_w (HDC hdc, UINT uFirstChar, UINT uLastChar, LPINT lpBuffer) #endif /* Cygwin */ -static int -memq_no_quit (Lisp_Object elt, Lisp_Object list) -{ - while (CONSP (list) && ! EQ (XCAR (list), elt)) - list = XCDR (list); - return (CONSP (list)); -} - Lisp_Object intern_font_name (char * string) { @@ -398,7 +390,7 @@ w32font_has_char (Lisp_Object entity, int c) certain until we open it. Also if the font claims support for the script the character is from, it may only have partial coverage, so we still can't be certain until we open the font. */ - if (NILP (script) || memq_no_quit (script, supported_scripts)) + if (NILP (script) || !NILP (memq_no_quit (script, supported_scripts))) return -1; /* Font reports what scripts it supports, and none of them are the script @@ -452,6 +444,10 @@ w32font_text_extents (struct font *font, const unsigned *code, memset (metrics, 0, sizeof (struct font_metrics)); + if (w32_use_direct_write (w32_font) + && w32_dwrite_text_extents (font, code, nglyphs, metrics)) + return; + for (i = 0, first = true; i < nglyphs; i++) { struct w32_metric_cache *char_metric; @@ -706,22 +702,31 @@ w32font_draw (struct glyph_string *s, int from, int to, int i; for (i = 0; i < len; i++) - { - WCHAR c = s->char2b[from + i] & 0xFFFF; - ExtTextOutW (s->hdc, x + i, y, options, NULL, &c, 1, NULL); - } + if (!w32_use_direct_write (w32font) + || !w32_dwrite_draw (s->hdc, x, y, s->char2b + from, 1, + GetTextColor (s->hdc), s->font)) + { + WCHAR c = s->char2b[from + i] & 0xFFFF; + ExtTextOutW (s->hdc, x + i, y, options, NULL, &c, 1, NULL); + } } else { - /* The number of glyphs in a glyph_string cannot be larger than - the maximum value of the 'used' member of a glyph_row, so we - are OK using alloca here. */ - eassert (len <= SHRT_MAX); - WCHAR *chars = alloca (len * sizeof (WCHAR)); - int j; - for (j = 0; j < len; j++) - chars[j] = s->char2b[from + j] & 0xFFFF; - ExtTextOutW (s->hdc, x, y, options, NULL, chars, len, NULL); + if (!w32_use_direct_write (w32font) + || !w32_dwrite_draw (s->hdc, x, y, + s->char2b + from, len, GetTextColor (s->hdc), + s->font)) + { + /* The number of glyphs in a glyph_string cannot be larger than + the maximum value of the 'used' member of a glyph_row, so we + are OK using alloca here. */ + eassert (len <= SHRT_MAX); + WCHAR *chars = alloca (len * sizeof (WCHAR)); + int j; + for (j = 0; j < len; j++) + chars[j] = s->char2b[from + j] & 0xFFFF; + ExtTextOutW (s->hdc, x, y, options, NULL, chars, len, NULL); + } } /* Restore clip region. */ @@ -809,6 +814,93 @@ w32font_otf_drive (struct font *font, Lisp_Object features, bool alternate_subst); */ +/* Notes about the way fonts are found on MS-Windows when we have a + character unsupported by the default font. + + Since we don't use Fontconfig on MS-Windows, we cannot efficiently + search for fonts which support certain characters, because Windows + doesn't store this information anywhere, and we can only know whether + a font supports some character if we actually open the font, which is + expensive and slow. Instead, we rely on font information Windows + exposes to the API we use to enumerate available fonts, + EnumFontFamiliesEx. This information includes two bitmapped attributes: + + USB (which stands for Unicode Subset Bitfields) -- this is an array + of 4 32-bit values, 128 bits in total, where each bit + corresponds to some block (sometimes several related blocks) of + Unicode codepoints which the font claims to support. + CSB (which stands for Codepage Bitfields) -- this is an array of 2 + 32-bit values (64 bits), where each bit corresponds to some + codepage whose characters the font claims to support. + + When Emacs needs to find a font for a character, it enumerates the + available fonts, filtering the fonts by examining these bitmaps and a + few other font attributes. The script of the character is converted + to the corresponding bits in USB, and a font that has any of these + bits set is deemed as a candidate; see font_supported_scripts, which + is called by font_matches_spec. The problem with this strategy is + twofold: + + - Some Unicode blocks have no USB bits. For the scripts + corresponding to those blocks we use a small cache of fonts known + to support those script. This cache is calculated once, and needs + not be recalculated as long as no fonts are installed or deleted + (it can be saved in your init file and reused for the following + sessions). See the function w32-find-non-USB-fonts. Note that + for that function to work well, 'script-representative-chars' + should include the important characters for each script which has + no USB bits defined. + + - Some fonts claim support for a block, but don't support it well. + Other fonts support some blocks very well, but don't set the + corresponding USB bits for the blocks. For these we use some + heuristics: + + . For few fonts that claim coverage, but don't provide it, we + either recognize them by name and reject their false claims, or + let users set face-ignored-fonts to ignore those fonts. + + . For fonts that support some blocks very well, but don't set + their USB bits, we examine the CSB bits instead. This is + particularly important for some CJK fonts with good support in + the SIP area: they only set the SIP bit (bit 57) in the USB. We + consider those as candidates for CJK scripts ('han', 'kana', + etc.) if the CSB bits are set for the corresponding CJK + codepages. + + Eventually, some characters could still appear as "tofu" (a box with + the character's hex codepoint), even though a font might be available + on the system which supports the character. This is because the + above strategy, with all its heuristics and tricks, sometimes fails. + For example, it could fail if the system has several fonts installed + whose coverage of some blocks is incomplete -- Emacs could select + such a font based on its USB bits, and realize the font has no glyph + for a character only when it's too late. This happens because when + several fonts claim coverage of the same Unicode block, Emacs on + Windows has no way of preferring one over the other, if they all + support the same values of size, weight, and slant. So Emacs usually + selects the first such candidate, which could lack glyphs for the + characters Emacs needs to display. Since we avoid naming non-free + Windows fonts in Emacs's sources, this cannot be fixed in the the + default fontset setup provided by Emacs: we cannot arrange for the + "good" fonts to be used in all such cases, because that would mean + naming those fonts. The solution for these issues is to customize the + default fontset using set-fontset-font, to force Emacs to use a font + known to support some characters. + + One other Windows-specific issue is the fact that some Windows fonts + have hyphens in their names. Emacs generally follows the XLFD + specifications, where a hyphen is used as separator between segments + of a font spec. There are few places in the code in font.c where + Emacs handles such font names specially, and it currently knows about + font names documented for Windows versions up to and including 11. + See this page for the latest update: + + https://learn.microsoft.com/en-us/typography/fonts/windows_11_font_list + + If more fonts are added to Windows that have hyphens in their names, + the code in font.c will need to be updated. */ + /* Internal implementation of w32font_list. Additional parameter opentype_only restricts the returned fonts to opentype fonts, which can be used with the Uniscribe backend. */ @@ -1092,7 +1184,7 @@ add_font_name_to_list (ENUMLOGFONTEX *logical_font, return 1; family = intern_font_name (logical_font->elfLogFont.lfFaceName); - if (! memq_no_quit (family, *list)) + if (NILP (memq_no_quit (family, *list))) *list = Fcons (family, *list); return 1; @@ -1316,7 +1408,7 @@ font_matches_spec (DWORD type, NEWTEXTMETRICEX *font, { Lisp_Object support = font_supported_scripts (&font->ntmFontSig); - if (! memq_no_quit (val, support)) + if (NILP (memq_no_quit (val, support))) return 0; /* Avoid using non-Japanese fonts for Japanese, even @@ -1455,22 +1547,34 @@ static int w32font_coverage_ok (FONTSIGNATURE * coverage, BYTE charset) { DWORD subrange1 = coverage->fsUsb[1]; + DWORD codepages0 = coverage->fsCsb[0]; #define SUBRANGE1_HAN_MASK 0x08000000 #define SUBRANGE1_HANGEUL_MASK 0x01000000 #define SUBRANGE1_JAPANESE_MASK (0x00060000 | SUBRANGE1_HAN_MASK) +#define SUBRANGE1_SIP_MASK 0x02000000 +/* We consider the coverage to be OK if either (a) subrange1 has the + bits set that correspond to CHARSET, or (b) subrange1 indicates SIP + support and codepages0 has one or more bits set corresponding to + CHARSET. */ if (charset == GB2312_CHARSET || charset == CHINESEBIG5_CHARSET) { - return (subrange1 & SUBRANGE1_HAN_MASK) == SUBRANGE1_HAN_MASK; + return ((subrange1 & SUBRANGE1_HAN_MASK) == SUBRANGE1_HAN_MASK + || ((subrange1 & SUBRANGE1_SIP_MASK) != 0 + && (codepages0 & CSB_CHINESE) != 0)); } else if (charset == SHIFTJIS_CHARSET) { - return (subrange1 & SUBRANGE1_JAPANESE_MASK) == SUBRANGE1_JAPANESE_MASK; + return ((subrange1 & SUBRANGE1_JAPANESE_MASK) == SUBRANGE1_JAPANESE_MASK + || ((subrange1 & SUBRANGE1_SIP_MASK) != 0 + && (codepages0 & CSB_JAPANESE) != 0)); } else if (charset == HANGEUL_CHARSET) { - return (subrange1 & SUBRANGE1_HANGEUL_MASK) == SUBRANGE1_HANGEUL_MASK; + return ((subrange1 & SUBRANGE1_HANGEUL_MASK) == SUBRANGE1_HANGEUL_MASK + || ((subrange1 & SUBRANGE1_SIP_MASK) != 0 + && (codepages0 & CSB_KOREAN) != 0)); } return 1; @@ -1569,9 +1673,9 @@ add_font_entity_to_list (ENUMLOGFONTEX *logical_font, match_data->orig_font_spec, backend, &logical_font->elfLogFont) || (!NILP (match_data->known_fonts) - && memq_no_quit - (intern_font_name (logical_font->elfLogFont.lfFaceName), - match_data->known_fonts))) + && !NILP (memq_no_quit + (intern_font_name (logical_font->elfLogFont.lfFaceName), + match_data->known_fonts)))) || !w32font_coverage_ok (&physical_font->ntmFontSig, match_data->pattern.lfCharSet)) return 1; @@ -1620,11 +1724,18 @@ add_font_entity_to_list (ENUMLOGFONTEX *logical_font, } /* unicode-sip fonts must contain characters in Unicode plane 2. so look for bit 57 (surrogates) in the Unicode subranges, plus - the bits for CJK ranges that include those characters. */ + the bits for CJK ranges that include those characters or CJK + bits in code-page bit fields.. */ else if (EQ (spec_charset, Qunicode_sip)) { - if (!(physical_font->ntmFontSig.fsUsb[1] & 0x02000000) - || !(physical_font->ntmFontSig.fsUsb[1] & 0x28000000)) + if (!((physical_font->ntmFontSig.fsUsb[1] & 0x02000000) + && ((physical_font->ntmFontSig.fsUsb[1] & 0x28000000) + /* Some CJK fonts with very good coverage of SIP + characters have only the 0x02000000 bit in USB + set, so we allow them if their code-page bits + indicate support for CJK character sets. */ + || (physical_font->ntmFontSig.fsCsb[0] + & (CSB_CHINESE | CSB_JAPANESE | CSB_KOREAN))))) return 1; } @@ -2328,7 +2439,18 @@ font_supported_scripts (FONTSIGNATURE * sig) SUBRANGE (53, Qphags_pa); /* 54: Enclosed CJK letters and months, 55: CJK Compatibility. */ SUBRANGE (56, Qhangul); - /* 57: Surrogates. */ + /* 57: Non-BMP. Processed specially: Several fonts that support CJK + Ideographs Extensions and other extensions, set just this bit and + Latin, and nothing else. */ + if (subranges[57 / 32] & (1U << (57 % 32))) + { + if ((sig->fsCsb[0] & CSB_CHINESE)) + supported = Fcons (Qhan, supported); + if ((sig->fsCsb[0] & CSB_JAPANESE)) + supported = Fcons (Qkana, supported); + if ((sig->fsCsb[0] & CSB_KOREAN)) + supported = Fcons (Qhangul, supported); + } SUBRANGE (58, Qphoenician); SUBRANGE (59, Qhan); /* There are others, but this is the main one. */ SUBRANGE (59, Qideographic_description); /* Windows lumps this in. */ @@ -2385,7 +2507,7 @@ font_supported_scripts (FONTSIGNATURE * sig) SUBRANGE (97, Qglagolitic); SUBRANGE (98, Qtifinagh); /* 99: Yijing Hexagrams. */ - SUBRANGE (99, Qhan); + SUBRANGE (99, Qcjk_misc); SUBRANGE (100, Qsyloti_nagri); SUBRANGE (101, Qlinear_b); SUBRANGE (101, Qaegean_number); diff --git a/src/w32font.h b/src/w32font.h index b97a95c545d..9447dc27d1a 100644 --- a/src/w32font.h +++ b/src/w32font.h @@ -57,6 +57,26 @@ struct w32font_info HFONT hfont; }; +/* Extension of w32font_info used by Uniscribe and HarfBuzz backends. */ +struct uniscribe_font_info +{ + struct w32font_info w32_font; + /* This is used by the Uniscribe backend as a pointer to the script + cache, and by the HarfBuzz backend as a pointer to a hb_font_t + object. */ + void *cache; + /* This is used by the HarfBuzz backend to store the font scale. */ + double scale; + /* This is used by DirectWrite to store the FontFace object. + DirectWrite works on top of the HarfBuzz backend, modifying some + calls. If there are problems manipulating this font, + dwrite_skip_font is set to true. Future operations will not use + DirectWrite and fall back to the HarfBuzz backend. */ + void *dwrite_cache; + float dwrite_font_size; + bool dwrite_skip_font; +}; + /* Macros for getting OS specific information from a font struct. */ #define FONT_HANDLE(f) (((struct w32font_info *)(f))->hfont) #define FONT_TEXTMETRIC(f) (((struct w32font_info *)(f))->metrics) @@ -84,6 +104,17 @@ int uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec); Lisp_Object intern_font_name (char *); +/* Function prototypes for DirectWrite. */ +void w32_initialize_direct_write (void); +bool w32_use_direct_write (struct w32font_info *w32font); +bool w32_dwrite_draw (HDC hdc, int x, int y, unsigned *glyphs, int len, + COLORREF color, struct font *font ); +bool w32_dwrite_text_extents (struct font *font, const unsigned *code, + int nglyphs, struct font_metrics *metrics); +unsigned w32_dwrite_encode_char (struct font *font, int c); +void w32_dwrite_free_cached_face (void *cache); +void syms_of_w32dwrite (void); + extern void globals_of_w32font (void); #endif diff --git a/src/w32gdiplus.h b/src/w32gdiplus.h new file mode 100644 index 00000000000..b438b1a64f8 --- /dev/null +++ b/src/w32gdiplus.h @@ -0,0 +1,139 @@ +#ifdef WINDOWSNT +typedef GpStatus (WINGDIPAPI *GdiplusStartup_Proc) + (ULONG_PTR *, GdiplusStartupInput *, GdiplusStartupOutput *); +typedef VOID (WINGDIPAPI *GdiplusShutdown_Proc) (ULONG_PTR); +typedef GpStatus (WINGDIPAPI *GdipCreateFromHDC_Proc) + (HDC hdc, GpGraphics **graphics); +typedef GpStatus (WINGDIPAPI *GdipDeleteGraphics_Proc) (GpGraphics *graphics); +typedef GpStatus (WINGDIPAPI *GdipGetPropertyItemSize_Proc) + (GpImage *, PROPID, UINT *); +typedef GpStatus (WINGDIPAPI *GdipGetPropertyItem_Proc) + (GpImage *, PROPID, UINT, PropertyItem *); +typedef GpStatus (WINGDIPAPI *GdipImageGetFrameDimensionsCount_Proc) + (GpImage *, UINT *); +typedef GpStatus (WINGDIPAPI *GdipImageGetFrameDimensionsList_Proc) + (GpImage *, GUID *, UINT); +typedef GpStatus (WINGDIPAPI *GdipImageGetFrameCount_Proc) + (GpImage *, GDIPCONST GUID *, UINT *); +typedef GpStatus (WINGDIPAPI *GdipImageSelectActiveFrame_Proc) + (GpImage*, GDIPCONST GUID *, UINT); +typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromFile_Proc) + (WCHAR *, GpBitmap **); +typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromStream_Proc) + (IStream *, GpBitmap **); +typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromScan0_Proc) + (INT, INT, INT, PixelFormat, BYTE*, GpBitmap**); +typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromHBITMAP_Proc) + (HBITMAP hbm, HPALETTE hpal, GpBitmap** bitmap); +typedef GpStatus (WINGDIPAPI *GdipSetInterpolationMode_Proc) + (GpGraphics *graphics, InterpolationMode interpolationMode); +typedef GpStatus (WINGDIPAPI *GdipDrawImageRectRectI_Proc) + (GpGraphics *graphics, GpImage *image, INT dstx, INT dsty, INT dstwidth, + INT dstheight, INT srcx, INT srcy, INT srcwidth, INT srcheight, + GpUnit srcUnit, GDIPCONST GpImageAttributes* imageAttributes, + DrawImageAbort callback, VOID * callbackData); +typedef IStream * (WINAPI *SHCreateMemStream_Proc) (const BYTE *, UINT); +typedef GpStatus (WINGDIPAPI *GdipCreateHBITMAPFromBitmap_Proc) + (GpBitmap *, HBITMAP *, ARGB); +typedef GpStatus (WINGDIPAPI *GdipDisposeImage_Proc) (GpImage *); +typedef GpStatus (WINGDIPAPI *GdipGetImageHeight_Proc) (GpImage *, UINT *); +typedef GpStatus (WINGDIPAPI *GdipGetImageWidth_Proc) (GpImage *, UINT *); +typedef GpStatus (WINGDIPAPI *GdipGetImageEncodersSize_Proc) (UINT *, UINT *); +typedef GpStatus (WINGDIPAPI *GdipGetImageEncoders_Proc) + (UINT, UINT, ImageCodecInfo *); +typedef GpStatus (WINGDIPAPI *GdipLoadImageFromFile_Proc) + (GDIPCONST WCHAR *,GpImage **); +typedef GpStatus (WINGDIPAPI *GdipGetImageThumbnail_Proc) + (GpImage *, UINT, UINT, GpImage**, GetThumbnailImageAbort, VOID *); +typedef GpStatus (WINGDIPAPI *GdipSaveImageToFile_Proc) + (GpImage *, GDIPCONST WCHAR *, GDIPCONST CLSID *, + GDIPCONST EncoderParameters *); +typedef GpStatus (WINGDIPAPI *GdipImageRotateFlip_Proc) + (GpImage *image, RotateFlipType rfType); + +extern GdiplusStartup_Proc fn_GdiplusStartup; +extern GdiplusShutdown_Proc fn_GdiplusShutdown; +extern GdipCreateFromHDC_Proc fn_GdipCreateFromHDC; +extern GdipDeleteGraphics_Proc fn_GdipDeleteGraphics; +extern GdipGetPropertyItemSize_Proc fn_GdipGetPropertyItemSize; +extern GdipGetPropertyItem_Proc fn_GdipGetPropertyItem; +extern GdipImageGetFrameDimensionsCount_Proc fn_GdipImageGetFrameDimensionsCount; +extern GdipImageGetFrameDimensionsList_Proc fn_GdipImageGetFrameDimensionsList; +extern GdipImageGetFrameCount_Proc fn_GdipImageGetFrameCount; +extern GdipImageSelectActiveFrame_Proc fn_GdipImageSelectActiveFrame; +extern GdipCreateBitmapFromFile_Proc fn_GdipCreateBitmapFromFile; +extern GdipCreateBitmapFromStream_Proc fn_GdipCreateBitmapFromStream; +extern GdipCreateBitmapFromHBITMAP_Proc fn_GdipCreateBitmapFromHBITMAP; +extern GdipDrawImageRectRectI_Proc fn_GdipDrawImageRectRectI; +extern GdipSetInterpolationMode_Proc fn_GdipSetInterpolationMode; +extern GdipCreateBitmapFromScan0_Proc fn_GdipCreateBitmapFromScan0; +extern SHCreateMemStream_Proc fn_SHCreateMemStream; +extern GdipCreateHBITMAPFromBitmap_Proc fn_GdipCreateHBITMAPFromBitmap; +extern GdipDisposeImage_Proc fn_GdipDisposeImage; +extern GdipGetImageHeight_Proc fn_GdipGetImageHeight; +extern GdipGetImageWidth_Proc fn_GdipGetImageWidth; +extern GdipGetImageEncodersSize_Proc fn_GdipGetImageEncodersSize; +extern GdipGetImageEncoders_Proc fn_GdipGetImageEncoders; +extern GdipLoadImageFromFile_Proc fn_GdipLoadImageFromFile; +extern GdipGetImageThumbnail_Proc fn_GdipGetImageThumbnail; +extern GdipSaveImageToFile_Proc fn_GdipSaveImageToFile; +extern GdipImageRotateFlip_Proc fn_GdipImageRotateFlip; + +# undef GdiplusStartup +# undef GdiplusShutdown +# undef GdipGetPropertyItemSize +# undef GdipGetPropertyItem +# undef GdipImageGetFrameDimensionsCount +# undef GdipImageGetFrameDimensionsList +# undef GdipImageGetFrameCount +# undef GdipImageSelectActiveFrame +# undef GdipCreateBitmapFromFile +# undef GdipCreateBitmapFromStream +# undef GdipCreateBitmapFromScan0 +# undef GdipCreateBitmapFromHBITMAP +# undef GdipCreateFromHDC +# undef GdipDrawImageRectRectI +# undef GdipSetInterpolationMode +# undef GdipDeleteGraphics +# undef SHCreateMemStream +# undef GdipCreateHBITMAPFromBitmap +# undef GdipDisposeImage +# undef GdipGetImageHeight +# undef GdipGetImageWidth +# undef GdipGetImageEncodersSize +# undef GdipGetImageEncoders +# undef GdipLoadImageFromFile +# undef GdipGetImageThumbnail +# undef GdipSaveImageToFile +# undef GdipSaveImageRotateFlip + +# define GdiplusStartup fn_GdiplusStartup +# define GdiplusShutdown fn_GdiplusShutdown +# define GdipGetPropertyItemSize fn_GdipGetPropertyItemSize +# define GdipGetPropertyItem fn_GdipGetPropertyItem +# define GdipImageGetFrameDimensionsCount fn_GdipImageGetFrameDimensionsCount +# define GdipImageGetFrameDimensionsList fn_GdipImageGetFrameDimensionsList +# define GdipImageGetFrameCount fn_GdipImageGetFrameCount +# define GdipImageSelectActiveFrame fn_GdipImageSelectActiveFrame +# define GdipCreateBitmapFromFile fn_GdipCreateBitmapFromFile +# define GdipCreateBitmapFromStream fn_GdipCreateBitmapFromStream +# define GdipCreateBitmapFromScan0 fn_GdipCreateBitmapFromScan0 +# define GdipCreateBitmapFromHBITMAP fn_GdipCreateBitmapFromHBITMAP +# define GdipCreateFromHDC fn_GdipCreateFromHDC +# define GdipDrawImageRectRectI fn_GdipDrawImageRectRectI +# define GdipSetInterpolationMode fn_GdipSetInterpolationMode +# define GdipDeleteGraphics fn_GdipDeleteGraphics +# define SHCreateMemStream fn_SHCreateMemStream +# define GdipCreateHBITMAPFromBitmap fn_GdipCreateHBITMAPFromBitmap +# define GdipDisposeImage fn_GdipDisposeImage +# define GdipGetImageHeight fn_GdipGetImageHeight +# define GdipGetImageWidth fn_GdipGetImageWidth +# define GdipGetImageEncodersSize fn_GdipGetImageEncodersSize +# define GdipGetImageEncoders fn_GdipGetImageEncoders +# define GdipLoadImageFromFile fn_GdipLoadImageFromFile +# define GdipGetImageThumbnail fn_GdipGetImageThumbnail +# define GdipSaveImageToFile fn_GdipSaveImageToFile +# define GdipImageRotateFlip fn_GdipImageRotateFlip +#endif + +int w32_gdip_get_encoder_clsid (const char *type, CLSID *clsid); diff --git a/src/w32gui.h b/src/w32gui.h index de351eaf5e2..a1bfb552afd 100644 --- a/src/w32gui.h +++ b/src/w32gui.h @@ -45,7 +45,9 @@ struct image; extern int w32_load_image (struct frame *f, struct image *img, Lisp_Object spec_file, Lisp_Object spec_data); extern bool w32_can_use_native_image_api (Lisp_Object); +extern bool w32_gdiplus_startup (void); extern void w32_gdiplus_shutdown (void); + extern size_t w32_image_size (Emacs_Pixmap); #define FACE_DEFAULT (~0) diff --git a/src/w32image.c b/src/w32image.c index 41a2e14e166..ed3803051b4 100644 --- a/src/w32image.c +++ b/src/w32image.c @@ -38,46 +38,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "frame.h" #include "coding.h" +#include "w32gdiplus.h" #ifdef WINDOWSNT - -typedef GpStatus (WINGDIPAPI *GdiplusStartup_Proc) - (ULONG_PTR *, GdiplusStartupInput *, GdiplusStartupOutput *); -typedef VOID (WINGDIPAPI *GdiplusShutdown_Proc) (ULONG_PTR); -typedef GpStatus (WINGDIPAPI *GdipGetPropertyItemSize_Proc) - (GpImage *, PROPID, UINT *); -typedef GpStatus (WINGDIPAPI *GdipGetPropertyItem_Proc) - (GpImage *, PROPID, UINT, PropertyItem *); -typedef GpStatus (WINGDIPAPI *GdipImageGetFrameDimensionsCount_Proc) - (GpImage *, UINT *); -typedef GpStatus (WINGDIPAPI *GdipImageGetFrameDimensionsList_Proc) - (GpImage *, GUID *, UINT); -typedef GpStatus (WINGDIPAPI *GdipImageGetFrameCount_Proc) - (GpImage *, GDIPCONST GUID *, UINT *); -typedef GpStatus (WINGDIPAPI *GdipImageSelectActiveFrame_Proc) - (GpImage*, GDIPCONST GUID *, UINT); -typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromFile_Proc) - (WCHAR *, GpBitmap **); -typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromStream_Proc) - (IStream *, GpBitmap **); -typedef IStream * (WINAPI *SHCreateMemStream_Proc) (const BYTE *, UINT); -typedef GpStatus (WINGDIPAPI *GdipCreateHBITMAPFromBitmap_Proc) - (GpBitmap *, HBITMAP *, ARGB); -typedef GpStatus (WINGDIPAPI *GdipDisposeImage_Proc) (GpImage *); -typedef GpStatus (WINGDIPAPI *GdipGetImageHeight_Proc) (GpImage *, UINT *); -typedef GpStatus (WINGDIPAPI *GdipGetImageWidth_Proc) (GpImage *, UINT *); -typedef GpStatus (WINGDIPAPI *GdipGetImageEncodersSize_Proc) (UINT *, UINT *); -typedef GpStatus (WINGDIPAPI *GdipGetImageEncoders_Proc) - (UINT, UINT, ImageCodecInfo *); -typedef GpStatus (WINGDIPAPI *GdipLoadImageFromFile_Proc) - (GDIPCONST WCHAR *,GpImage **); -typedef GpStatus (WINGDIPAPI *GdipGetImageThumbnail_Proc) - (GpImage *, UINT, UINT, GpImage**, GetThumbnailImageAbort, VOID *); -typedef GpStatus (WINGDIPAPI *GdipSaveImageToFile_Proc) - (GpImage *, GDIPCONST WCHAR *, GDIPCONST CLSID *, - GDIPCONST EncoderParameters *); - GdiplusStartup_Proc fn_GdiplusStartup; GdiplusShutdown_Proc fn_GdiplusShutdown; +GdipCreateFromHDC_Proc fn_GdipCreateFromHDC; +GdipDeleteGraphics_Proc fn_GdipDeleteGraphics; GdipGetPropertyItemSize_Proc fn_GdipGetPropertyItemSize; GdipGetPropertyItem_Proc fn_GdipGetPropertyItem; GdipImageGetFrameDimensionsCount_Proc fn_GdipImageGetFrameDimensionsCount; @@ -86,8 +52,12 @@ GdipImageGetFrameCount_Proc fn_GdipImageGetFrameCount; GdipImageSelectActiveFrame_Proc fn_GdipImageSelectActiveFrame; GdipCreateBitmapFromFile_Proc fn_GdipCreateBitmapFromFile; GdipCreateBitmapFromStream_Proc fn_GdipCreateBitmapFromStream; +GdipCreateBitmapFromScan0_Proc fn_GdipCreateBitmapFromScan0; SHCreateMemStream_Proc fn_SHCreateMemStream; GdipCreateHBITMAPFromBitmap_Proc fn_GdipCreateHBITMAPFromBitmap; +GdipCreateBitmapFromHBITMAP_Proc fn_GdipCreateBitmapFromHBITMAP; +GdipDrawImageRectRectI_Proc fn_GdipDrawImageRectRectI; +GdipSetInterpolationMode_Proc fn_GdipSetInterpolationMode; GdipDisposeImage_Proc fn_GdipDisposeImage; GdipGetImageHeight_Proc fn_GdipGetImageHeight; GdipGetImageWidth_Proc fn_GdipGetImageWidth; @@ -96,6 +66,7 @@ GdipGetImageEncoders_Proc fn_GdipGetImageEncoders; GdipLoadImageFromFile_Proc fn_GdipLoadImageFromFile; GdipGetImageThumbnail_Proc fn_GdipGetImageThumbnail; GdipSaveImageToFile_Proc fn_GdipSaveImageToFile; +GdipImageRotateFlip_Proc fn_GdipImageRotateFlip; static bool gdiplus_init (void) @@ -114,6 +85,14 @@ gdiplus_init (void) get_proc_addr (gdiplus_lib, "GdiplusShutdown"); if (!fn_GdiplusShutdown) return false; + fn_GdipCreateFromHDC = (GdipCreateFromHDC_Proc) + get_proc_addr (gdiplus_lib, "GdipCreateFromHDC"); + if (!fn_GdipCreateFromHDC) + return false; + fn_GdipDeleteGraphics = (GdipDeleteGraphics_Proc) + get_proc_addr (gdiplus_lib, "GdipDeleteGraphics"); + if (!fn_GdipDeleteGraphics) + return false; fn_GdipGetPropertyItemSize = (GdipGetPropertyItemSize_Proc) get_proc_addr (gdiplus_lib, "GdipGetPropertyItemSize"); if (!fn_GdipGetPropertyItemSize) @@ -146,10 +125,26 @@ gdiplus_init (void) get_proc_addr (gdiplus_lib, "GdipCreateBitmapFromStream"); if (!fn_GdipCreateBitmapFromStream) return false; + fn_GdipCreateBitmapFromScan0 = (GdipCreateBitmapFromScan0_Proc) + get_proc_addr (gdiplus_lib, "GdipCreateBitmapFromScan0"); + if (!fn_GdipCreateBitmapFromScan0) + return false; fn_GdipCreateHBITMAPFromBitmap = (GdipCreateHBITMAPFromBitmap_Proc) get_proc_addr (gdiplus_lib, "GdipCreateHBITMAPFromBitmap"); if (!fn_GdipCreateHBITMAPFromBitmap) return false; + fn_GdipCreateBitmapFromHBITMAP = (GdipCreateBitmapFromHBITMAP_Proc) + get_proc_addr (gdiplus_lib, "GdipCreateBitmapFromHBITMAP"); + if (!fn_GdipCreateBitmapFromHBITMAP) + return false; + fn_GdipDrawImageRectRectI = (GdipDrawImageRectRectI_Proc) + get_proc_addr (gdiplus_lib, "GdipDrawImageRectRectI"); + if (!fn_GdipDrawImageRectRectI) + return false; + fn_GdipSetInterpolationMode = (GdipSetInterpolationMode_Proc) + get_proc_addr (gdiplus_lib, "GdipSetInterpolationMode"); + if (!fn_GdipSetInterpolationMode) + return false; fn_GdipDisposeImage = (GdipDisposeImage_Proc) get_proc_addr (gdiplus_lib, "GdipDisposeImage"); if (!fn_GdipDisposeImage) @@ -196,52 +191,14 @@ gdiplus_init (void) get_proc_addr (gdiplus_lib, "GdipSaveImageToFile"); if (!fn_GdipSaveImageToFile) return false; + fn_GdipImageRotateFlip = (GdipImageRotateFlip_Proc) + get_proc_addr (gdiplus_lib, "GdipImageRotateFlip"); + if (!fn_GdipImageRotateFlip) + return false; return true; } -# undef GdiplusStartup -# undef GdiplusShutdown -# undef GdipGetPropertyItemSize -# undef GdipGetPropertyItem -# undef GdipImageGetFrameDimensionsCount -# undef GdipImageGetFrameDimensionsList -# undef GdipImageGetFrameCount -# undef GdipImageSelectActiveFrame -# undef GdipCreateBitmapFromFile -# undef GdipCreateBitmapFromStream -# undef SHCreateMemStream -# undef GdipCreateHBITMAPFromBitmap -# undef GdipDisposeImage -# undef GdipGetImageHeight -# undef GdipGetImageWidth -# undef GdipGetImageEncodersSize -# undef GdipGetImageEncoders -# undef GdipLoadImageFromFile -# undef GdipGetImageThumbnail -# undef GdipSaveImageToFile - -# define GdiplusStartup fn_GdiplusStartup -# define GdiplusShutdown fn_GdiplusShutdown -# define GdipGetPropertyItemSize fn_GdipGetPropertyItemSize -# define GdipGetPropertyItem fn_GdipGetPropertyItem -# define GdipImageGetFrameDimensionsCount fn_GdipImageGetFrameDimensionsCount -# define GdipImageGetFrameDimensionsList fn_GdipImageGetFrameDimensionsList -# define GdipImageGetFrameCount fn_GdipImageGetFrameCount -# define GdipImageSelectActiveFrame fn_GdipImageSelectActiveFrame -# define GdipCreateBitmapFromFile fn_GdipCreateBitmapFromFile -# define GdipCreateBitmapFromStream fn_GdipCreateBitmapFromStream -# define SHCreateMemStream fn_SHCreateMemStream -# define GdipCreateHBITMAPFromBitmap fn_GdipCreateHBITMAPFromBitmap -# define GdipDisposeImage fn_GdipDisposeImage -# define GdipGetImageHeight fn_GdipGetImageHeight -# define GdipGetImageWidth fn_GdipGetImageWidth -# define GdipGetImageEncodersSize fn_GdipGetImageEncodersSize -# define GdipGetImageEncoders fn_GdipGetImageEncoders -# define GdipLoadImageFromFile fn_GdipLoadImageFromFile -# define GdipGetImageThumbnail fn_GdipGetImageThumbnail -# define GdipSaveImageToFile fn_GdipSaveImageToFile - #endif /* WINDOWSNT */ static int gdip_initialized; @@ -252,8 +209,8 @@ static GdiplusStartupOutput output; /* Initialize GDI+, return true if successful. */ -static bool -gdiplus_startup (void) +bool +w32_gdiplus_startup (void) { GpStatus status; @@ -305,7 +262,7 @@ w32_can_use_native_image_api (Lisp_Object type) But we don't yet support these in image.c. */ return false; } - return gdiplus_startup (); + return w32_gdiplus_startup (); } enum PropertyItem_type { @@ -549,8 +506,8 @@ static struct thumb_type_data thumb_types [] = }; -static int -get_encoder_clsid (const char *type, CLSID *clsid) +int +w32_gdip_get_encoder_clsid (const char *type, CLSID *clsid) { /* A simple cache based on the assumptions that many thumbnails will be generated using the same TYPE. */ @@ -625,7 +582,7 @@ Return non-nil if thumbnail creation succeeds, nil otherwise. */) if (!gdiplus_started) { - if (!gdiplus_startup ()) + if (!w32_gdiplus_startup ()) return Qnil; } @@ -649,7 +606,7 @@ Return non-nil if thumbnail creation succeeds, nil otherwise. */) CLSID thumb_clsid; if (status == Ok /* Get the GUID of the TYPE's encoder. */ - && get_encoder_clsid (SSDATA (type), &thumb_clsid) >= 0) + && w32_gdip_get_encoder_clsid (SSDATA (type), &thumb_clsid) >= 0) { /* Save the thumbnail image to a file of specified TYPE. */ wchar_t thumb_file_w[MAX_PATH]; diff --git a/src/w32inevt.c b/src/w32inevt.c index e0facd876ba..1c80f7c6db7 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -471,8 +471,13 @@ do_mouse_event (MOUSE_EVENT_RECORD *event, DWORD but_change, mask, flags = event->dwEventFlags; int i; - /* Mouse didn't move unless MOUSE_MOVED says it did. */ struct frame *f = get_frame (); + + /* For now, mouse events on child frames are ignored, because the + coordinate conversion is not in place; FIXME. */ + if (FRAMEP (f->parent_frame)) + return 0; + /* Mouse didn't move unless MOUSE_MOVED says it did. */ f->mouse_moved = 0; switch (flags) @@ -619,6 +624,10 @@ maybe_generate_resize_event (void) CONSOLE_SCREEN_BUFFER_INFO info; struct frame *f = get_frame (); + /* Only resize the root frame. */ + if (FRAMEP (f->parent_frame)) + return; + GetConsoleScreenBufferInfo (GetStdHandle (STD_OUTPUT_HANDLE), &info); /* It is okay to call this unconditionally, since it will do nothing diff --git a/src/w32menu.c b/src/w32menu.c index 238fb2f30f8..df38c41b0f2 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -52,6 +52,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "w32common.h" /* for osinfo_cache */ +#include "commctrl.h" + +/* This only applies to OS versions prior to Vista. */ #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */ #ifndef TRUE @@ -77,6 +80,66 @@ typedef int (WINAPI * MessageBoxW_Proc) ( IN const WCHAR *caption, IN UINT type); +#ifndef MINGW_W64 +/* mingw.org's MinGW doesn't have this in its header files. */ + typedef int TASKDIALOG_COMMON_BUTTON_FLAGS; + + typedef int TASKDIALOG_FLAGS; + + typedef HRESULT (CALLBACK *PFTASKDIALOGCALLBACK) ( + HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam, LONG_PTR lpRefData); + + typedef struct _TASKDIALOG_BUTTON { + int nButtonID; + PCWSTR pszButtonText; + } TASKDIALOG_BUTTON; + + typedef struct _TASKDIALOGCONFIG { + UINT cbSize; + HWND hwndParent; + HINSTANCE hInstance; + TASKDIALOG_FLAGS dwFlags; + TASKDIALOG_COMMON_BUTTON_FLAGS dwCommonButtons; + PCWSTR pszWindowTitle; + union { + HICON hMainIcon; + PCWSTR pszMainIcon; + } DUMMYUNIONNAME; + PCWSTR pszMainInstruction; + PCWSTR pszContent; + UINT cButtons; + const TASKDIALOG_BUTTON *pButtons; + int nDefaultButton; + UINT cRadioButtons; + const TASKDIALOG_BUTTON *pRadioButtons; + int nDefaultRadioButton; + PCWSTR pszVerificationText; + PCWSTR pszExpandedInformation; + PCWSTR pszExpandedControlText; + PCWSTR pszCollapsedControlText; + union { + HICON hFooterIcon; + PCWSTR pszFooterIcon; + } DUMMYUNIONNAME2; + PCWSTR pszFooter; + PFTASKDIALOGCALLBACK pfCallback; + LONG_PTR lpCallbackData; + UINT cxWidth; + } TASKDIALOGCONFIG; + +# define TDN_CREATED 0 +# define TDM_ENABLE_BUTTON (WM_USER+111) +# define TDF_ALLOW_DIALOG_CANCELLATION 0x8 +# define TD_INFORMATION_ICON MAKEINTRESOURCEW (-3) + +#endif + +typedef HRESULT (WINAPI *TaskDialogIndirect_Proc) ( + IN const TASKDIALOGCONFIG *pTaskConfig, + OUT int *pnButton, + OUT int *pnRadioButton, + OUT BOOL *pfVerificationFlagChecked); + #ifdef NTGUI_UNICODE GetMenuItemInfoA_Proc get_menu_item_info = GetMenuItemInfoA; SetMenuItemInfoA_Proc set_menu_item_info = SetMenuItemInfoA; @@ -89,6 +152,8 @@ AppendMenuW_Proc unicode_append_menu = NULL; MessageBoxW_Proc unicode_message_box = NULL; #endif /* NTGUI_UNICODE */ +static TaskDialogIndirect_Proc task_dialog_indirect; + #ifdef HAVE_DIALOGS static Lisp_Object w32_dialog_show (struct frame *, Lisp_Object, Lisp_Object, char **); #else @@ -101,14 +166,160 @@ static int fill_in_menu (HMENU, widget_value *); void w32_free_menu_strings (HWND); +#define TASK_DIALOG_MAX_BUTTONS 10 + +static HRESULT CALLBACK +task_dialog_callback (HWND hwnd, UINT msg, WPARAM wParam, + LPARAM lParam, LONG_PTR callback_data) +{ + switch (msg) + { + case TDN_CREATED: + /* Disable all buttons with ID >= 2000 */ + for (int i = 0; i < TASK_DIALOG_MAX_BUTTONS; i++) + SendMessage (hwnd, TDM_ENABLE_BUTTON, 2000 + i, FALSE); + break; + } + return S_OK; +} + Lisp_Object w32_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) { - +#ifdef NTGUI_UNICODE + typedef int (WINAPI *MultiByteToWideChar_Proc)(UINT,DWORD,LPCSTR,int, + LPWSTR, int); + static MultiByteToWideChar_Proc pMultiByteToWideChar = MultiByteToWideChar; +#endif /* NTGUI_UNICODE */ check_window_system (f); -#ifndef HAVE_DIALOGS + if (task_dialog_indirect) + { + int wide_len; + + CHECK_CONS (contents); + + /* Get the title as an UTF-16 string. */ + char *title = SSDATA (ENCODE_UTF_8 (XCAR (contents))); + wide_len = (sizeof (WCHAR) + * pMultiByteToWideChar (CP_UTF8, 0, title, -1, NULL, 0)); + WCHAR *title_w = alloca (wide_len); + pMultiByteToWideChar (CP_UTF8, 0, title, -1, title_w, wide_len); + + /* Prepare the arrays with the dialog's buttons and return values. */ + TASKDIALOG_BUTTON buttons[TASK_DIALOG_MAX_BUTTONS]; + Lisp_Object button_values[TASK_DIALOG_MAX_BUTTONS]; + int button_count = 0; + Lisp_Object b = XCDR (contents); + + while (!NILP (b)) + { + if (button_count >= TASK_DIALOG_MAX_BUTTONS) + { + /* We have too many buttons. We ignore the rest. */ + break; + } + + Lisp_Object item = XCAR (b); + if (CONSP (item)) + { + /* A normal item (text . value) */ + Lisp_Object item_name = XCAR (item); + Lisp_Object item_value = XCDR (item); + + CHECK_STRING (item_name); + + item_name = ENCODE_UTF_8 (item_name); + wide_len = (sizeof (WCHAR) + * pMultiByteToWideChar (CP_UTF8, 0, SSDATA (item_name), + -1, NULL, 0)); + buttons[button_count].pszButtonText = alloca (wide_len); + pMultiByteToWideChar (CP_UTF8, 0, SSDATA (item_name), -1, + (LPWSTR) + buttons[button_count].pszButtonText, + wide_len); + buttons[button_count].nButtonID = 1000 + button_count; + button_values[button_count++] = item_value; + } + else if (NILP (item)) + { + /* A nil item means to put all following items on the + right. We ignore this. */ + } + else if (STRINGP (item)) + { + /* A string item means an unselectable button. We add a + button, and then need to disable it on the callback. We + use ids based on 2000 to mark these buttons. */ + Lisp_Object item_name = ENCODE_UTF_8 (item); + wide_len = (sizeof (WCHAR) + * pMultiByteToWideChar (CP_UTF8, 0, + SSDATA (item_name), + -1, NULL, 0)); + buttons[button_count].pszButtonText = alloca (wide_len); + pMultiByteToWideChar (CP_UTF8, 0, SSDATA (item_name), -1, + (LPWSTR) + buttons[button_count].pszButtonText, + wide_len); + buttons[button_count].nButtonID = 2000 + button_count; + button_values[button_count++] = Qnil; + } + else + { + error ("Incorrect dialog button specification"); + return Qnil; + } + + b = XCDR (b); + } + + int pressed_button = 0; + + TASKDIALOGCONFIG config = { 0 }; + config.hwndParent = FRAME_W32_WINDOW (f); + config.cbSize = sizeof (config); + config.hInstance = hinst; + config.dwFlags = TDF_ALLOW_DIALOG_CANCELLATION; + config.pfCallback = task_dialog_callback; + config.pszWindowTitle = L"Question"; + if (!NILP (header)) + { + config.pszWindowTitle = L"Information"; + config.pszMainIcon = TD_INFORMATION_ICON; + } + + config.pszMainInstruction = title_w; + config.pButtons = buttons; + config.cButtons = button_count; + + if (!SUCCEEDED (task_dialog_indirect (&config, &pressed_button, + NULL, NULL))) + quit (); + + int button_index; + switch (pressed_button) + { + case IDOK: + /* This can only happen if no buttons were provided. The OK + button is automatically added by TaskDialogIndirect in that + case. */ + return Qt; + case IDCANCEL: + /* The user closed the dialog without using the buttons. */ + return quit (); + default: + /* One of the specified buttons. */ + button_index = pressed_button - 1000; + if (button_index >= 0 && button_index < button_count) + return button_values[button_index]; + return quit (); + } + } + + /* If we get here, TaskDialog is not supported. Use MessageBox/Menu. */ + +#ifndef HAVE_DIALOGS /* Handle simple Yes/No choices as MessageBox popups. */ if (is_simple_dialog (contents)) return simple_dialog_show (f, contents, header); @@ -1618,6 +1829,10 @@ syms_of_w32menu (void) void globals_of_w32menu (void) { + HMODULE comctrl32 = GetModuleHandle ("comctl32.dll"); + task_dialog_indirect = (TaskDialogIndirect_Proc) + get_proc_addr (comctrl32, "TaskDialogIndirect"); + #ifndef NTGUI_UNICODE /* See if Get/SetMenuItemInfo functions are available. */ HMODULE user32 = GetModuleHandle ("user32.dll"); diff --git a/src/w32select.c b/src/w32select.c index f1a35862624..9219a5fce16 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -73,12 +73,22 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ */ #include <config.h> +#include <windows.h> +#include <wingdi.h> +#include <wtypes.h> +#include <gdiplus.h> +#ifndef CF_DIBV5 +# define CF_DIBV5 17 +# undef CF_MAX +# define CF_MAX 18 +#endif #include "lisp.h" #include "w32common.h" /* os_subtype */ #include "w32term.h" /* for all of the w32 includes */ #include "w32select.h" #include "blockinput.h" #include "coding.h" +#include "w32gdiplus.h" #ifdef CYGWIN #include <string.h> @@ -787,6 +797,170 @@ DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data, return (ok ? string : Qnil); } +/* Xlib-like names for standard Windows clipboard data formats. + They are in upper-case to mimic xselect.c. A couple of the names + were changed to be more like their X counterparts. */ +static const char *stdfmt_name[] = { + "UNDEFINED", + "STRING", + "BITMAP", + "METAFILE", + "SYMLINK", + "DIF", + "TIFF", + "OEM_STRING", + "DIB", + "PALETTE", + "PENDATA", + "RIFF", + "WAVE", + "UTF8_STRING", + "ENHMETAFILE", + "FILE_NAMES", /* DND */ + "LOCALE", /* not used */ + "DIBV5" +}; + +/* Must be called with block_input() active. */ +static bool +convert_dibv5_to_png (char *data, int size, char *temp_file) +{ +#ifdef HAVE_NATIVE_IMAGE_API + CLSID clsid_png; + + if (!w32_gdiplus_startup () + || !w32_gdip_get_encoder_clsid ("png", &clsid_png)) + return false; + + BITMAPV5HEADER *bmi = (void *) data; + int stride = bmi->bV5SizeImage / bmi->bV5Height; + long offset = bmi->bV5Size + bmi->bV5ClrUsed * sizeof (RGBQUAD); + if (bmi->bV5Compression == BI_BITFIELDS) + offset += 12; + BYTE *scan0 = data + offset; + + GpBitmap *bitmap = NULL; + + GpStatus status + = GdipCreateBitmapFromScan0 (bmi->bV5Width, bmi->bV5Height, stride, + PixelFormat32bppARGB, scan0, &bitmap); + + if (status != Ok) + return false; + + /* The bitmap comes upside down. */ + GdipImageRotateFlip (bitmap, RotateNoneFlipY); + + WCHAR wide_filename[MAX_PATH]; + filename_to_utf16 (temp_file, wide_filename); + + status = GdipSaveImageToFile (bitmap, wide_filename, &clsid_png, NULL); + GdipDisposeImage (bitmap); + if (status != Ok) + return false; + return true; +#else /* !HAVE_NATIVE_IMAGE_API */ + return false; +#endif +} + +static int +get_clipboard_format_name (int format_index, char *name) +{ + *name = 0; + format_index = EnumClipboardFormats (format_index); + if (format_index == 0) + return 0; + if (format_index < CF_MAX) + strcpy (name, stdfmt_name[format_index]); + GetClipboardFormatName (format_index, name, 256); + return format_index; +} + +DEFUN ("w32--get-clipboard-data-media", Fw32__get_clipboard_data_media, + Sw32__get_clipboard_data_media, 3, 3, 0, + doc: /* Gets media (not plain text) clipboard data in one of the given formats. + +FORMATS is a list of formats. +TEMP-FILE-IN is the name of the file to store the data. + +Elements in FORMATS are symbols naming a format, such a image/png, or +image/jpeg. For compatibility with X systems, some conventional +format names are translated to equivalent MIME types, as configured with +the variable 'w32--selection-target-translations'. + +The file named in TEMP-FILE-IN must be created by the caller, and also +deleted if required. + +Returns nil it there is no such format, or something failed. +If it returns t, then the caller should read the file to get the data. +If it returns a string, then that is the data and the file is not used. + +When returning a string, it will be unibyte if IS-TEXTUAL is nil (the +content is binary data). */) + (Lisp_Object formats, Lisp_Object temp_file_in, Lisp_Object is_textual) +{ + CHECK_LIST (formats); + CHECK_STRING (temp_file_in); + + temp_file_in = Fexpand_file_name (temp_file_in, Qnil); + char *temp_file = SSDATA (ENCODE_FILE (temp_file_in)); + + Lisp_Object result = Qnil; + + block_input(); + if (!OpenClipboard (NULL)) + { + unblock_input(); + return Qnil; + } + + for (int format_index = 0;;) + { + static char name[256]; + format_index = get_clipboard_format_name (format_index, name); + if (format_index == 0) + break; + + /* If name doesn't match any of the formats, try the next format. */ + bool match = false; + for (Lisp_Object tail = formats; CONSP (tail); tail = XCDR (tail)) + if (strcmp (name, SSDATA (SYMBOL_NAME (XCAR (tail)))) == 0) + match = true; + if (!match) + continue; + + /* Of the standard formats, only DIBV5 is supported. */ + if (format_index < CF_MAX && format_index != CF_DIBV5) + continue; + + /* Found the format. */ + HANDLE d = GetClipboardData (format_index); + if (!d) + break; + int size = GlobalSize (d); + char *data = GlobalLock (d); + if (!data) + break; + if (strcmp (name, "DIBV5") == 0) + { + if (convert_dibv5_to_png (data, size, temp_file)) + result = Qt; + } + else + { + if (NILP (is_textual)) + result = make_unibyte_string (data, size); + else + result = make_string (data, size); + } + GlobalUnlock (d); + break; + } + CloseClipboard (); + unblock_input (); + return result; +} DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, Sw32_get_clipboard_data, 0, 1, 0, @@ -1069,29 +1243,6 @@ for `CLIPBOARD'. The return value is a vector of symbols, each symbol representing a data format that is currently available in the clipboard. */) (Lisp_Object selection, Lisp_Object terminal) { - /* Xlib-like names for standard Windows clipboard data formats. - They are in upper-case to mimic xselect.c. A couple of the names - were changed to be more like their X counterparts. */ - static const char *stdfmt_name[] = { - "UNDEFINED", - "STRING", - "BITMAP", - "METAFILE", - "SYMLINK", - "DIF", - "TIFF", - "OEM_STRING", - "DIB", - "PALETTE", - "PENDATA", - "RIFF", - "WAVE", - "UTF8_STRING", - "ENHMETAFILE", - "FILE_NAMES", /* DND */ - "LOCALE", /* not used */ - "DIBV5" - }; CHECK_SYMBOL (selection); /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check @@ -1166,6 +1317,7 @@ syms_of_w32select (void) { defsubr (&Sw32_set_clipboard_data); defsubr (&Sw32_get_clipboard_data); + defsubr (&Sw32__get_clipboard_data_media); defsubr (&Sw32_selection_exists_p); defsubr (&Sw32_selection_targets); diff --git a/src/w32term.c b/src/w32term.c index add07911cec..c81779b8517 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -24,6 +24,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "blockinput.h" #include "w32term.h" #include "w32common.h" /* for OS version info */ +#include <wtypes.h> +#include <gdiplus.h> +#include "w32gdiplus.h" #include <ctype.h> #include <errno.h> @@ -2106,16 +2109,53 @@ w32_draw_image_foreground (struct glyph_string *s) compat_hdc, s->slice.x, s->slice.y, SRCCOPY); else { - int pmode = 0; - /* Windows 9X doesn't support HALFTONE. */ - if (os_subtype == OS_SUBTYPE_NT - && (pmode = SetStretchBltMode (s->hdc, HALFTONE)) != 0) - SetBrushOrgEx (s->hdc, 0, 0, NULL); - StretchBlt (s->hdc, x, y, s->slice.width, s->slice.height, - compat_hdc, orig_slice_x, orig_slice_y, - orig_slice_width, orig_slice_height, SRCCOPY); - if (pmode) - SetStretchBltMode (s->hdc, pmode); +#ifdef HAVE_NATIVE_IMAGE_API + if (s->img->smoothing && w32_gdiplus_startup ()) + { + GpGraphics *graphics; + if (GdipCreateFromHDC (s->hdc, &graphics) == Ok) + { + GpBitmap *gp_bitmap; + /* Can't create a GpBitmap from a HBITMAP that was + ever selected into a DC, so we need to copy. */ + HBITMAP copy + = CopyImage (GetCurrentObject (compat_hdc, OBJ_BITMAP), + IMAGE_BITMAP, 0, 0, 0); + if (GdipCreateBitmapFromHBITMAP (copy, NULL, + &gp_bitmap) == Ok) + { + GdipSetInterpolationMode (graphics, + InterpolationModeHighQualityBilinear); + GdipDrawImageRectRectI (graphics, + gp_bitmap, x, y, + s->slice.width, + s->slice.height, + orig_slice_x, + orig_slice_y, + orig_slice_width, + orig_slice_height, + UnitPixel, + NULL, NULL, NULL); + GdipDisposeImage (gp_bitmap); + } + DeleteObject (copy); + GdipDeleteGraphics (graphics); + } + } + else +#endif + { + int pmode = 0; + /* Windows 9X doesn't support HALFTONE. */ + if (os_subtype == OS_SUBTYPE_NT + && (pmode = SetStretchBltMode (s->hdc, HALFTONE)) != 0) + SetBrushOrgEx (s->hdc, 0, 0, NULL); + StretchBlt (s->hdc, x, y, s->slice.width, s->slice.height, + compat_hdc, orig_slice_x, orig_slice_y, + orig_slice_width, orig_slice_height, SRCCOPY); + if (pmode) + SetStretchBltMode (s->hdc, pmode); + } } /* When the image has a mask, we can expect that at @@ -3576,81 +3616,6 @@ w32_construct_mouse_wheel (struct input_event *result, W32Msg *msg, return Qnil; } -static Lisp_Object -w32_construct_drag_n_drop (struct input_event *result, W32Msg *msg, - struct frame *f) -{ - Lisp_Object files; - Lisp_Object frame; - HDROP hdrop; - POINT p; - WORD num_files; - wchar_t name_w[MAX_PATH]; -#ifdef NTGUI_UNICODE - const int use_unicode = 1; -#else - int use_unicode = w32_unicode_filenames; - char name_a[MAX_PATH]; - char file[MAX_UTF8_PATH]; -#endif - int i; - - result->kind = DRAG_N_DROP_EVENT; - result->code = 0; - result->timestamp = msg->msg.time; - result->modifiers = msg->dwModifiers; - - hdrop = (HDROP) msg->msg.wParam; - DragQueryPoint (hdrop, &p); - -#if 0 - p.x = LOWORD (msg->msg.lParam); - p.y = HIWORD (msg->msg.lParam); - ScreenToClient (msg->msg.hwnd, &p); -#endif - - XSETINT (result->x, p.x); - XSETINT (result->y, p.y); - - num_files = DragQueryFile (hdrop, 0xFFFFFFFF, NULL, 0); - files = Qnil; - - for (i = 0; i < num_files; i++) - { - if (use_unicode) - { - eassert (DragQueryFileW (hdrop, i, NULL, 0) < MAX_PATH); - /* If DragQueryFile returns zero, it failed to fetch a file - name. */ - if (DragQueryFileW (hdrop, i, name_w, MAX_PATH) == 0) - continue; -#ifdef NTGUI_UNICODE - files = Fcons (from_unicode_buffer (name_w), files); -#else - filename_from_utf16 (name_w, file); - files = Fcons (DECODE_FILE (build_unibyte_string (file)), files); -#endif /* NTGUI_UNICODE */ - } -#ifndef NTGUI_UNICODE - else - { - eassert (DragQueryFileA (hdrop, i, NULL, 0) < MAX_PATH); - if (DragQueryFileA (hdrop, i, name_a, MAX_PATH) == 0) - continue; - filename_from_ansi (name_a, file); - files = Fcons (DECODE_FILE (build_unibyte_string (file)), files); - } -#endif - } - - DragFinish (hdrop); - - XSETFRAME (frame, f); - result->frame_or_window = frame; - result->arg = files; - return Qnil; -} - #if HAVE_W32NOTIFY @@ -5682,13 +5647,46 @@ w32_read_socket (struct terminal *terminal, } break; - case WM_DROPFILES: - f = w32_window_to_frame (dpyinfo, msg.msg.hwnd); + case WM_EMACS_DROP: + { + int format = msg.msg.wParam; + Lisp_Object drop_object = + w32_process_dnd_data (format, (void *) msg.msg.lParam); - if (f) - w32_construct_drag_n_drop (&inev, &msg, f); + f = w32_window_to_frame (dpyinfo, msg.msg.hwnd); + if (!f || NILP (drop_object)) + break; + + XSETFRAME (inev.frame_or_window, f); + inev.kind = DRAG_N_DROP_EVENT; + inev.code = 0; + inev.timestamp = msg.msg.time; + inev.modifiers = msg.dwModifiers; + ScreenToClient (msg.msg.hwnd, &msg.msg.pt); + XSETINT (inev.x, msg.msg.pt.x); + XSETINT (inev.y, msg.msg.pt.y); + inev.arg = drop_object; + } break; + case WM_EMACS_DRAGOVER: + { + f = w32_window_to_frame (dpyinfo, msg.msg.hwnd); + if (!f) + break; + XSETFRAME (inev.frame_or_window, f); + inev.kind = DRAG_N_DROP_EVENT; + inev.code = 0; + inev.timestamp = msg.msg.time; + inev.modifiers = msg.dwModifiers; + ScreenToClient (msg.msg.hwnd, &msg.msg.pt); + XSETINT (inev.x, msg.msg.pt.x); + XSETINT (inev.y, msg.msg.pt.y); + /* This is a drag movement. */ + inev.arg = Qnil; + break; + } + case WM_HSCROLL: { struct scroll_bar *bar = @@ -6407,14 +6405,13 @@ w32_read_socket (struct terminal *terminal, if (FRAME_TOOLTIP_P (f)) continue; - /* Check "visible" frames and mark each as obscured or not. + /* Check "visible" frames and mark each as visible or not. Note that visible is nonzero for unobscured and obscured frames, but zero for hidden and iconified frames. */ if (FRAME_W32_P (f) && FRAME_VISIBLE_P (f)) { RECT clipbox; HDC hdc; - bool obscured; enter_crit (); /* Query clipping rectangle for the entire window area @@ -6428,29 +6425,11 @@ w32_read_socket (struct terminal *terminal, ReleaseDC (FRAME_W32_WINDOW (f), hdc); leave_crit (); - obscured = FRAME_OBSCURED_P (f); - - if (clipbox.right == clipbox.left || clipbox.bottom == clipbox.top) - { - /* Frame has become completely obscured so mark as such (we - do this by setting visible to 2 so that FRAME_VISIBLE_P - is still true, but redisplay will skip it). */ - SET_FRAME_VISIBLE (f, 2); - - if (!obscured) - DebPrint (("frame %p (%s) obscured\n", f, SDATA (f->name))); - } - else + if (!(clipbox.right == clipbox.left + || clipbox.bottom == clipbox.top)) { /* Frame is not obscured, so mark it as such. */ SET_FRAME_VISIBLE (f, 1); - - if (obscured) - { - SET_FRAME_GARBAGED (f); - DebPrint (("obscured frame %p (%s) found to be visible\n", - f, SDATA (f->name))); - } } } } diff --git a/src/w32term.h b/src/w32term.h index f045033b8b3..2483ca9036c 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -272,6 +272,7 @@ extern const char *w32_get_string_resource (void *v_rdb, /* w32fns.c */ extern void w32_default_font_parameter (struct frame* f, Lisp_Object parms); +extern Lisp_Object w32_process_dnd_data (int format, void *pDataObj); #define PIX_TYPE COLORREF @@ -710,7 +711,9 @@ do { \ #define WM_EMACS_INPUT_READY (WM_EMACS_START + 24) #define WM_EMACS_FILENOTIFY (WM_EMACS_START + 25) #define WM_EMACS_IME_STATUS (WM_EMACS_START + 26) -#define WM_EMACS_END (WM_EMACS_START + 27) +#define WM_EMACS_DRAGOVER (WM_EMACS_START + 27) +#define WM_EMACS_DROP (WM_EMACS_START + 28) +#define WM_EMACS_END (WM_EMACS_START + 29) #define WND_FONTWIDTH_INDEX (0) #define WND_LINEHEIGHT_INDEX (4) diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index f43547198bf..9986c9dc2f9 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -44,18 +44,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "pdumper.h" #include "w32common.h" -/* Extension of w32font_info used by Uniscribe and HarfBuzz backends. */ -struct uniscribe_font_info -{ - struct w32font_info w32_font; - /* This is used by the Uniscribe backend as a pointer to the script - cache, and by the HarfBuzz backend as a pointer to a hb_font_t - object. */ - void *cache; - /* This is used by the HarfBuzz backend to store the font scale. */ - double scale; -}; - int uniscribe_available = 0; /* EnumFontFamiliesEx callback. */ @@ -100,14 +88,6 @@ DEF_DLL_FN (void, hb_ot_font_set_funcs, (hb_font_t *)); /* Used by uniscribe_otf_capability. */ static Lisp_Object otf_features (HDC context, const char *table); -static int -memq_no_quit (Lisp_Object elt, Lisp_Object list) -{ - while (CONSP (list) && ! EQ (XCAR (list), elt)) - list = XCDR (list); - return (CONSP (list)); -} - /* Uniscribe function pointers. */ static HRESULT (WINAPI * pfnScriptItemize) (const WCHAR *, @@ -200,6 +180,8 @@ uniscribe_open (struct frame *f, Lisp_Object font_entity, int pixel_size) /* Initialize the cache for this font. */ uniscribe_font->cache = NULL; + uniscribe_font->dwrite_cache = NULL; + uniscribe_font->dwrite_skip_font = false; /* Uniscribe and HarfBuzz backends use glyph indices. */ uniscribe_font->w32_font.glyph_idx = ETO_GLYPH_INDEX; @@ -221,6 +203,7 @@ uniscribe_close (struct font *font) = (struct uniscribe_font_info *) font; #ifdef HAVE_HARFBUZZ + w32_dwrite_free_cached_face (uniscribe_font->dwrite_cache); if (uniscribe_font->w32_font.font.driver == &harfbuzz_font_driver && uniscribe_font->cache) hb_font_destroy ((hb_font_t *) uniscribe_font->cache); @@ -775,7 +758,7 @@ add_opentype_font_name_to_list (ENUMLOGFONTEX *logical_font, return 1; family = intern_font_name (logical_font->elfLogFont.lfFaceName); - if (! memq_no_quit (family, *list)) + if (NILP (memq_no_quit (family, *list))) *list = Fcons (family, *list); return 1; @@ -895,7 +878,7 @@ uniscribe_check_otf_1 (HDC context, Lisp_Object script, Lisp_Object lang, Lisp_Object features[2], int *retval) { SCRIPT_CACHE cache = NULL; - OPENTYPE_TAG tags[32], script_tag, lang_tag; + OPENTYPE_TAG tags[128], script_tag, lang_tag; int max_tags = ARRAYELTS (tags); int ntags, i, ret = 0; HRESULT rslt; @@ -1372,6 +1355,17 @@ w32hb_encode_char (struct font *font, int c) struct uniscribe_font_info *uniscribe_font = (struct uniscribe_font_info *) font; eassert (uniscribe_font->w32_font.font.driver == &harfbuzz_font_driver); + + if (w32_use_direct_write (&uniscribe_font->w32_font)) + { + unsigned encoded = w32_dwrite_encode_char (font, c); + + /* The call to w32_dwrite_encode_char may fail, disabling + DirectWrite for this font. So check again. */ + if (w32_use_direct_write (&uniscribe_font->w32_font)) + return encoded; + } + hb_font_t *hb_font = uniscribe_font->cache; /* First time we use this font with HarfBuzz, create the hb_font_t @@ -1624,5 +1618,8 @@ syms_of_w32uniscribe_for_pdumper (void) harfbuzz_font_driver.combining_capability = hbfont_combining_capability; harfbuzz_font_driver.begin_hb_font = w32hb_begin_font; register_font_driver (&harfbuzz_font_driver, NULL); + + w32_initialize_direct_write (); + #endif /* HAVE_HARFBUZZ */ } diff --git a/src/window.c b/src/window.c index 558554a7b54..ff58eb12ee0 100644 --- a/src/window.c +++ b/src/window.c @@ -652,15 +652,16 @@ Return nil for an internal window or a deleted window. */) DEFUN ("window-old-buffer", Fwindow_old_buffer, Swindow_old_buffer, 0, 1, 0, doc: /* Return the old buffer displayed by WINDOW. -WINDOW must be a live window and defaults to the selected one. +WINDOW can be any window and defaults to the selected one. The return value is the buffer shown in WINDOW at the last time window -change functions were run. It is nil if WINDOW was created after -that. It is t if WINDOW has been restored from a window configuration -after that. */) +change functions were run or WINDOW is a former live window that was +deleted. It is nil if WINDOW was created after that. It is t if WINDOW +has been restored from a window configuration after that. It is always +nil if WINDOW is an internal window. */) (Lisp_Object window) { - struct window *w = decode_live_window (window); + struct window *w = decode_any_window (window); return (NILP (w->old_buffer) /* A new window. */ @@ -668,8 +669,8 @@ after that. */) : (w->change_stamp != WINDOW_XFRAME (w)->change_stamp) /* A window restored from a configuration. */ ? Qt - /* A window that was live the last time seen by window - change functions. */ + /* A window that was live the last time seen by window change + functions or was deleted. */ : w->old_buffer); } @@ -2394,8 +2395,41 @@ Return VALUE. */) { register struct window *w = decode_any_window (window); Lisp_Object old_alist_elt; + struct frame* f; old_alist_elt = Fassq (parameter, w->window_parameters); + + /* If this window parameter has been used in a face remapping filter + expression anywhere at any time and we changed its value, force a + from-scratch redisplay to make sure that everything that depends on + a face filtered on the window parameter value is up-to-date. + + We compare with Qt here instead of using !NILP so that users can + set this property to a non-nil, non-t value to inhibit this + mechanism for a specific window parameter. + + FIXME: instead of taking a sledgehammer to redisplay, we could be + more precise in tracking which display bits depend on which + remapped faces. In particular, 1) if a window parameter named in a + face filter affects only faces used in drawing fringes, we don't + need to redraw TTY frames, but if the filter is ever used in a + non-fringe context (e.g. the 'face' text property), we need to + redraw TTY frames too. 2) In the fringe case, we should limit the + redraw damage to the fringes of the affected window and not the + whole frame containing the window. Today, we seldom change window + parameters named in face filters. We should implement the + optimizations above when this assumption no longer holds. */ + if (SYMBOLP (parameter) + && WINDOW_LIVE_P (window) + && EQ (Fget (parameter, QCfiltered), Qt) + && FRAME_WINDOW_P ((f = WINDOW_XFRAME (w))) + && !EQ (CDR_SAFE (old_alist_elt), value) + && window_auto_redraw_on_parameter_change) + { + f->face_change = 1; + fset_redisplay (f); + } + if (NILP (old_alist_elt)) wset_window_parameters (w, Fcons (Fcons (parameter, value), w->window_parameters)); @@ -3277,6 +3311,113 @@ window_pixel_to_total (Lisp_Object frame, Lisp_Object horizontal) } +/** Remove all occurrences of element whose car is BUFFER from ALIST. + Return changed ALIST. */ +static Lisp_Object +window_discard_buffer_from_alist (Lisp_Object buffer, Lisp_Object alist) +{ + Lisp_Object tail, *prev = &alist; + + for (tail = alist; CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object tem = XCAR (tail); + + tem = XCAR (tem); + + if (EQ (tem, buffer)) + *prev = XCDR (tail); + else + prev = xcdr_addr (tail); + } + + return alist; +} + +/** Remove all occurrences of BUFFER from LIST. Return changed + LIST. */ +static Lisp_Object +window_discard_buffer_from_list (Lisp_Object buffer, Lisp_Object list) +{ + Lisp_Object tail, *prev = &list; + + for (tail = list; CONSP (tail); tail = XCDR (tail)) + if (EQ (XCAR (tail), buffer)) + *prev = XCDR (tail); + else + prev = xcdr_addr (tail); + + return list; +} + +/** Remove BUFFER from the lists of previous and next buffers of object + WINDOW. ALL true means remove any `quit-restore' and + `quit-restore-prev' parameter of WINDOW referencing BUFFER too. */ +static void +window_discard_buffer_from_window (Lisp_Object buffer, Lisp_Object window, bool all) +{ + struct window *w = XWINDOW (window); + + wset_prev_buffers + (w, window_discard_buffer_from_alist (buffer, w->prev_buffers)); + wset_next_buffers + (w, window_discard_buffer_from_list (buffer, w->next_buffers)); + + if (all) + { + Lisp_Object quit_restore = window_parameter (w, Qquit_restore); + Lisp_Object quit_restore_prev = window_parameter (w, Qquit_restore_prev); + Lisp_Object quad; + + if (EQ (buffer, Fnth (make_fixnum (3), quit_restore_prev)) + || (CONSP (quad = Fcar (Fcdr (quit_restore_prev))) + && EQ (Fcar (quad), buffer))) + Fset_window_parameter (window, Qquit_restore_prev, Qnil); + + if (EQ (buffer, Fnth (make_fixnum (3), quit_restore)) + || (CONSP (quad = Fcar (Fcdr (quit_restore))) + && EQ (Fcar (quad), buffer))) + { + Fset_window_parameter (window, Qquit_restore, + window_parameter (w, Qquit_restore_prev)); + Fset_window_parameter (window, Qquit_restore_prev, Qnil); + } + } +} + +/** Remove BUFFER from the lists of previous and next buffers and the + `quit-restore' and `quit-restore-prev' parameters of any dead + WINDOW. */ +void +window_discard_buffer_from_dead_windows (Lisp_Object buffer) +{ + struct Lisp_Hash_Table *h = XHASH_TABLE (window_dead_windows_table); + + DOHASH (h, k, v) + window_discard_buffer_from_window (buffer, v, true); +} + +DEFUN ("window-discard-buffer-from-window", Fwindow_discard_buffer, + Swindow_discard_buffer, 2, 3, 0, + doc: /* Discard BUFFER from WINDOW. +Discard specified live BUFFER from the lists of previous and next +buffers of specified live WINDOW. + +Optional argument ALL non-nil means discard any `quit-restore' and +`quit-restore-prev' parameters of WINDOW referencing BUFFER too. */) + (Lisp_Object buffer, Lisp_Object window, Lisp_Object all) +{ + if (!BUFFER_LIVE_P (XBUFFER (buffer))) + error ("Not a live buffer"); + + if (!WINDOW_LIVE_P (window)) + error ("Not a live window"); + + window_discard_buffer_from_window (buffer, window, !NILP (all)); + + return Qnil; +} + + DEFUN ("delete-other-windows-internal", Fdelete_other_windows_internal, Sdelete_other_windows_internal, 0, 2, "", doc: /* Make WINDOW fill its frame. @@ -3540,9 +3681,17 @@ replace_buffer_in_windows (Lisp_Object buffer) call1 (Qreplace_buffer_in_windows, buffer); } -/* If BUFFER is shown in a window, safely replace it with some other - buffer in all windows of all frames, even those on other keyboards. */ +/** If BUFFER is shown in any window, safely replace it with some other + buffer in all windows of all frames, even those on other keyboards. + Do not delete any window. + This function is called by Fkill_buffer when it detects that + replacing BUFFER in some window showing BUFFER has failed. It + assumes that ‘replace-buffer-in-windows’ has removed any entry + referencing BUFFER from any window's lists of previous and next + buffers and that window's ‘quit-restore’ and 'quit-restore-prev' + parameters. +*/ void replace_buffer_in_windows_safely (Lisp_Object buffer) { @@ -4143,6 +4292,9 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, w->window_end_vpos = 0; w->last_cursor_vpos = 0; + /* Discard BUFFER from WINDOW's previous and next buffers. */ + window_discard_buffer_from_window (buffer, window, false); + if (!(keep_margins_p && samebuf)) { /* If we're not actually changing the buffer, don't reset hscroll and vscroll. Resetting hscroll and vscroll here is problematic @@ -4373,41 +4525,6 @@ allocate_window (void) PVEC_WINDOW); } -/* Make new window, have it replace WINDOW in window-tree, and make - WINDOW its only vertical child (HORFLAG means make WINDOW its only - horizontal child). */ -static void -make_parent_window (Lisp_Object window, bool horflag) -{ - Lisp_Object parent; - register struct window *o, *p; - - o = XWINDOW (window); - p = allocate_window (); - memcpy ((char *) p + sizeof (union vectorlike_header), - (char *) o + sizeof (union vectorlike_header), - word_size * VECSIZE (struct window)); - /* P's buffer slot may change from nil to a buffer... */ - adjust_window_count (p, 1); - XSETWINDOW (parent, p); - - p->sequence_number = ++sequence_number; - - replace_window (window, parent, true); - - wset_next (o, Qnil); - wset_prev (o, Qnil); - wset_parent (o, parent); - /* ...but now P becomes an internal window. */ - wset_start (p, Qnil); - wset_pointm (p, Qnil); - wset_old_pointm (p, Qnil); - wset_buffer (p, Qnil); - wset_combination (p, horflag, window); - wset_combination_limit (p, Qnil); - wset_window_parameters (p, Qnil); -} - /* Make new window from scratch. */ Lisp_Object make_window (void) @@ -4429,10 +4546,6 @@ make_window (void) wset_vertical_scroll_bar_type (w, Qt); wset_horizontal_scroll_bar_type (w, Qt); wset_cursor_type (w, Qt); - /* These Lisp fields are marked specially so they're not set to nil by - allocate_window. */ - wset_prev_buffers (w, Qnil); - wset_next_buffers (w, Qnil); /* Initialize non-Lisp data. Note that allocate_window zeroes out all non-Lisp data, so do it only for slots which should not be zero. */ @@ -4955,7 +5068,7 @@ resize_frame_windows (struct frame *f, int size, bool horflag) } -DEFUN ("split-window-internal", Fsplit_window_internal, Ssplit_window_internal, 4, 4, 0, +DEFUN ("split-window-internal", Fsplit_window_internal, Ssplit_window_internal, 4, 5, 0, doc: /* Split window OLD. Second argument PIXEL-SIZE specifies the number of pixels of the new window. It must be a positive integer. @@ -4970,32 +5083,33 @@ SIDE t (or `right') specifies that the new window shall be located on the right side of WINDOW. SIDE `left' means the new window shall be located on the left of WINDOW. In both cases PIXEL-SIZE specifies the width of the new window including space reserved for fringes and the -scrollbar or a divider column. +scroll bar or a divider column. Fourth argument NORMAL-SIZE specifies the normal size of the new window -according to the SIDE argument. +according to the SIDE argument. Optional fifth argument REFER is as for +'split-window'. The new pixel and normal sizes of all involved windows must have been set correctly. See the code of `split-window' for how this is done. */) - (Lisp_Object old, Lisp_Object pixel_size, Lisp_Object side, Lisp_Object normal_size) -{ - /* OLD (*o) is the window we have to split. (*p) is either OLD's - parent window or an internal window we have to install as OLD's new - parent. REFERENCE (*r) must denote a live window, or is set to OLD - provided OLD is a leaf window, or to the frame's selected window. - NEW (*n) is the new window created with some parameters taken from - REFERENCE (*r). */ - Lisp_Object new, frame, reference; - struct window *o, *p, *n, *r, *c; - struct frame *f; + (Lisp_Object old, Lisp_Object pixel_size, Lisp_Object side, + Lisp_Object normal_size, Lisp_Object refer) +{ + /* OLD (*o) is the window to split. REFER (*r) is a reference window, + either an arbitrary live window or a former live, now deleted + window on the same frame as OLD. NEW (*n) is the new window + created anew or resurrected from REFER (*r), if specified. *p + refers either to OLD's parent window that will become NEW's parent + window too or to a new internal window that becomes OLD's and NEW's + new parent. */ + struct window *o = decode_valid_window (old); + Lisp_Object frame = WINDOW_FRAME (o); + struct frame *f = XFRAME (frame); + struct window *p, *n, *r, *c; bool horflag /* HORFLAG is true when we split side-by-side, false otherwise. */ = EQ (side, Qt) || EQ (side, Qleft) || EQ (side, Qright); - - CHECK_WINDOW (old); - o = XWINDOW (old); - frame = WINDOW_FRAME (o); - f = XFRAME (frame); + Lisp_Object new, parent = Qnil; + bool dead = false; CHECK_FIXNUM (pixel_size); EMACS_INT total_size @@ -5013,14 +5127,74 @@ set correctly. See the code of `split-window' for how this is done. */) ? WINDOW_VERTICAL_COMBINATION_P (XWINDOW (o->parent)) : WINDOW_HORIZONTAL_COMBINATION_P (XWINDOW (o->parent)))); - /* We need a live reference window to initialize some parameters. */ - if (WINDOW_LIVE_P (old)) - /* OLD is live, use it as reference window. */ - reference = old; + /* Set up reference window. */ + if (NILP (refer)) + { + if (WINDOW_LIVE_P (old)) + /* OLD is live, use it as reference window. */ + refer = old; + else + /* Use the frame's selected window as reference window. */ + refer = FRAME_SELECTED_WINDOW (f); + + r = XWINDOW (refer); + } + else if (CONSP (refer)) + { + /* If REFER is a cons, then its car must be a deleted, former live + window and its cdr must be a deleted former parent window. Set + PARENT to the cdr of REFER and REFER to its car. WINDOW and + REFER end up as the sole children of PARENT which replaces + WINDOW in the window tree. As a special case, if REFER's cdr + is t, reuse REFER's car's old parent as new parent provided it + is a deleted fromer parent window. */ + parent = Fcdr (refer); + refer = Fcar (refer); + r = decode_any_window (refer); + + if (!NILP (r->contents) || !BUFFERP (r->old_buffer)) + error ("REFER's car must specify a deleted, former live window"); + else if (!BUFFER_LIVE_P (XBUFFER (r->old_buffer))) + error ("The buffer formerly shown by REFER's car has been killed"); + else if (!EQ (r->frame, frame)) + error ("REFER's car must specify a window on same frame as WINDOW"); + + if (EQ (parent, Qt)) + /* If REFER's cdr is t, use the old parent of REFER's car as new + parent. */ + parent = r->parent; + + p = decode_any_window (parent); + + if (!NILP (p->contents) || BUFFERP (p->old_buffer)) + error ("REFER's cdr must specify a deleted, former parent window"); + else if (!EQ (p->frame, frame)) + error ("REFER's cdr must specify window on same frame as WINDOW"); + + dead = true; + } else - /* Use the frame's selected window as reference window. */ - reference = FRAME_SELECTED_WINDOW (f); - r = XWINDOW (reference); + { + r = decode_any_window (refer); + + if (NILP (r->contents)) + /* Presumably a deleted, former live window. Check whether its + contents can be used. */ + { + if (!BUFFERP (r->old_buffer)) + error ("REFER must specify a former live window (must have shown a buffer)"); + else if (!BUFFER_LIVE_P (XBUFFER (r->old_buffer))) + error ("The buffer formerly shown by REFER has been killed"); + else if (!EQ (r->frame, frame)) + error ("REFER must specify a window on same frame as WINDOW"); + + dead = true; + } + else if (!NILP (parent)) + error ("If REFER is a cons, its car must not specify a live window"); + else if (!WINDOW_LIVE_P (refer)) + error ("REFER is not a live window (does not show a buffer)"); + } /* The following bugs are caught by `split-window'. */ if (MINI_WINDOW_P (o)) @@ -5031,16 +5205,18 @@ set correctly. See the code of `split-window' for how this is done. */) /* `window-combination-resize' non-nil means try to resize OLD's siblings proportionally. */ { - p = XWINDOW (o->parent); + struct window *op = XWINDOW (o->parent); + /* Temporarily pretend we split the parent window. */ wset_new_pixel - (p, make_fixnum ((horflag ? p->pixel_width : p->pixel_height) + (op, make_fixnum ((horflag ? op->pixel_width : op->pixel_height) - XFIXNUM (pixel_size))); - if (!window_resize_check (p, horflag)) + if (!window_resize_check (op, horflag)) error ("Window sizes don't fit"); else /* Undo the temporary pretension. */ - wset_new_pixel (p, make_fixnum (horflag ? p->pixel_width : p->pixel_height)); + wset_new_pixel + (op, make_fixnum (horflag ? op->pixel_width : op->pixel_height)); } else { @@ -5060,8 +5236,24 @@ set correctly. See the code of `split-window' for how this is done. */) Lisp_Object new_normal = horflag ? o->normal_cols : o->normal_lines; - make_parent_window (old, horflag); - p = XWINDOW (o->parent); + if (NILP (parent)) + /* This is the crux of the old make_parent_window. */ + { + p = allocate_window (); + XSETWINDOW (parent, p); + p->sequence_number = ++sequence_number; + wset_frame (p, frame); + } + else + /* Pacify GCC. */ + p = XWINDOW (parent); + + replace_window (old, parent, true); + wset_next (o, Qnil); + wset_prev (o, Qnil); + wset_parent (o, parent); + wset_combination (p, horflag, old); + if (EQ (Vwindow_combination_limit, Qt)) /* Store t in the new parent's combination_limit slot to avoid that its children get merged into another window. */ @@ -5077,7 +5269,12 @@ set correctly. See the code of `split-window' for how this is done. */) p = XWINDOW (o->parent); fset_redisplay (f); - new = make_window (); + + if (dead) + new = refer; + else + new = make_window (); + n = XWINDOW (new); wset_frame (n, frame); wset_parent (n, o->parent); @@ -5104,16 +5301,19 @@ set correctly. See the code of `split-window' for how this is done. */) n->window_end_valid = false; n->last_cursor_vpos = 0; - /* Get special geometry settings from reference window. */ - n->left_margin_cols = r->left_margin_cols; - n->right_margin_cols = r->right_margin_cols; - n->left_fringe_width = r->left_fringe_width; - n->right_fringe_width = r->right_fringe_width; - n->fringes_outside_margins = r->fringes_outside_margins; - n->scroll_bar_width = r->scroll_bar_width; - n->scroll_bar_height = r->scroll_bar_height; - wset_vertical_scroll_bar_type (n, r->vertical_scroll_bar_type); - wset_horizontal_scroll_bar_type (n, r->horizontal_scroll_bar_type); + if (!dead) + { + /* Get special geometry settings from reference window. */ + n->left_margin_cols = r->left_margin_cols; + n->right_margin_cols = r->right_margin_cols; + n->left_fringe_width = r->left_fringe_width; + n->right_fringe_width = r->right_fringe_width; + n->fringes_outside_margins = r->fringes_outside_margins; + n->scroll_bar_width = r->scroll_bar_width; + n->scroll_bar_height = r->scroll_bar_height; + wset_vertical_scroll_bar_type (n, r->vertical_scroll_bar_type); + wset_horizontal_scroll_bar_type (n, r->horizontal_scroll_bar_type); + } /* Directly assign orthogonal coordinates and sizes. */ if (horflag) @@ -5142,6 +5342,7 @@ set correctly. See the code of `split-window' for how this is done. */) sum = sum + XFIXNUM (c->new_total); c = NILP (c->next) ? 0 : XWINDOW (c->next); } + wset_new_total (n, make_fixnum ((horflag ? p->total_cols : p->total_lines) @@ -5149,10 +5350,30 @@ set correctly. See the code of `split-window' for how this is done. */) wset_new_normal (n, normal_size); block_input (); + + if (dead) + { + /* Get dead window back its old buffer and markers. */ + wset_buffer (n, n->old_buffer); + set_marker_restricted + (n->start, make_fixnum (XMARKER (n->start)->charpos), n->contents); + set_marker_restricted + (n->pointm, make_fixnum (XMARKER (n->pointm)->charpos), n->contents); + set_marker_restricted + (n->old_pointm, make_fixnum (XMARKER (n->old_pointm)->charpos), + n->contents); + + Vwindow_list = Qnil; + /* Remove window from the table of dead windows. */ + Fremhash (make_fixnum (n->sequence_number), + window_dead_windows_table); + } + window_resize_apply (p, horflag); adjust_frame_glyphs (f); - /* Set buffer of NEW to buffer of reference window. */ + set_window_buffer (new, r->contents, true, true); + FRAME_WINDOW_CHANGE (f) = true; unblock_input (); @@ -5250,11 +5471,18 @@ Signal an error when WINDOW is the only window on its frame. */) } else { + /* Store WINDOW's buffer in old_buffer. */ + wset_old_buffer (w, w->contents); unshow_buffer (w); unchain_marker (XMARKER (w->pointm)); unchain_marker (XMARKER (w->old_pointm)); unchain_marker (XMARKER (w->start)); wset_buffer (w, Qnil); + /* Add WINDOW to table of dead windows so when killing a buffer + WINDOW mentions, all references to that buffer can be removed + and the buffer be collected. */ + Fputhash (make_fixnum (w->sequence_number), + window, window_dead_windows_table); } if (NILP (s->prev) && NILP (s->next)) @@ -6714,7 +6942,7 @@ and redisplay normally--don't erase and redraw the frame. */) https://lists.gnu.org/r/emacs-devel/2014-06/msg00053.html, https://lists.gnu.org/r/emacs-devel/2014-06/msg00094.html. */ if (buf != current_buffer) - error ("`recenter'ing a window that does not display current-buffer."); + error ("`recenter'ing a window that does not display current-buffer"); /* If redisplay is suppressed due to an error, try again. */ buf->display_error_modiff = 0; @@ -7359,12 +7587,21 @@ the return value is nil. Otherwise the value is t. */) } } + /* Remove window from the table of dead windows. */ + Fremhash (make_fixnum (w->sequence_number), + window_dead_windows_table); + if ((NILP (dont_set_miniwindow) || !MINI_WINDOW_P (w)) && BUFFERP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer))) /* If saved buffer is alive, install it, unless it's a minibuffer we explicitly prohibit. */ { - wset_buffer (w, p->buffer); + if (!EQ (w->contents, p->buffer)) + { + wset_buffer (w, p->buffer); + window_discard_buffer_from_window (w->contents, window, false); + } + w->start_at_line_beg = !NILP (p->start_at_line_beg); set_marker_restricted (w->start, p->start, w->contents); set_marker_restricted (w->pointm, p->pointm, w->contents); @@ -7409,6 +7646,7 @@ the return value is nil. Otherwise the value is t. */) recreate *scratch* in the course (part of Juanma's bs-show scenario from March 2011). */ wset_buffer (w, other_buffer_safely (Fcurrent_buffer ())); + window_discard_buffer_from_window (w->contents, window, false); /* This will set the markers to beginning of visible range. */ set_marker_restricted_both (w->start, w->contents, 0, 0); @@ -7579,6 +7817,8 @@ delete_all_child_windows (Lisp_Object window) } else if (BUFFERP (w->contents)) { + /* Store WINDOW's buffer in old_buffer. */ + wset_old_buffer (w, w->contents); unshow_buffer (w); unchain_marker (XMARKER (w->pointm)); unchain_marker (XMARKER (w->old_pointm)); @@ -7588,6 +7828,11 @@ delete_all_child_windows (Lisp_Object window) possible resurrection in Fset_window_configuration. */ wset_combination_limit (w, w->contents); wset_buffer (w, Qnil); + /* Add WINDOW to table of dead windows so when killing a buffer + WINDOW mentions, all references to that buffer can be removed + and the buffer be collected. */ + Fputhash (make_fixnum (w->sequence_number), + window, window_dead_windows_table); } Vwindow_list = Qnil; @@ -8597,6 +8842,8 @@ syms_of_window (void) DEFSYM (Qconfiguration, "configuration"); DEFSYM (Qdelete, "delete"); DEFSYM (Qdedicated, "dedicated"); + DEFSYM (Qquit_restore, "quit-restore"); + DEFSYM (Qquit_restore_prev, "quit-restore-prev"); DEFVAR_LISP ("temp-buffer-show-function", Vtemp_buffer_show_function, doc: /* Non-nil means call as function to display a help buffer. @@ -8920,6 +9167,28 @@ Note that this optimization can cause the portion of the buffer displayed after a scrolling operation to be somewhat inaccurate. */); fast_but_imprecise_scrolling = false; + DEFVAR_LISP ("window-dead-windows-table", window_dead_windows_table, + doc: /* Hash table of dead windows. +Each entry in this table maps a window number to a window object. +Entries are added by `delete-window-internal' and are removed by the +garbage collector. */); + window_dead_windows_table + = CALLN (Fmake_hash_table, QCweakness, Qvalue); + + DEFVAR_BOOL ("window-auto-redraw-on-parameter-change", + window_auto_redraw_on_parameter_change, + doc: /* When non-nil, redraw based on face filters. +When this variable is non-nil, force a potentially expensive redraw when +a window parameter named in a `:window' expression for ':filtered' +changes. This redraw is necessary for correctness; this variable is an +escape hatch to recover performance in the case that our assumption that +these parameter changes are rare does not hold. + +You can also inhibit the automatic redraw for a specific window +parameter by setting the `:filtered` symbol property of the parameter +name to `'ignore'. */); + window_auto_redraw_on_parameter_change = true; + defsubr (&Sselected_window); defsubr (&Sold_selected_window); defsubr (&Sminibuffer_window); @@ -9035,6 +9304,7 @@ displayed after a scrolling operation to be somewhat inaccurate. */); defsubr (&Swindow_parameters); defsubr (&Swindow_parameter); defsubr (&Sset_window_parameter); + defsubr (&Swindow_discard_buffer); defsubr (&Swindow_cursor_type); defsubr (&Sset_window_cursor_type); } diff --git a/src/window.h b/src/window.h index b1e5c4c6d58..39356f80df7 100644 --- a/src/window.h +++ b/src/window.h @@ -142,6 +142,12 @@ struct window as well. */ Lisp_Object contents; + /* A list of <buffer, window-start, window-point> triples listing + buffers previously shown in this window. */ + Lisp_Object prev_buffers; + /* List of buffers re-shown in this window. */ + Lisp_Object next_buffers; + /* The old buffer of this window, set to this window's buffer by run_window_change_functions every time it sees this window. Unused for internal windows. */ @@ -218,14 +224,6 @@ struct window struct glyph_matrix *current_matrix; struct glyph_matrix *desired_matrix; - /* The two Lisp_Object fields below are marked in a special way, - which is why they're placed after `current_matrix'. */ - /* A list of <buffer, window-start, window-point> triples listing - buffers previously shown in this window. */ - Lisp_Object prev_buffers; - /* List of buffers re-shown in this window. */ - Lisp_Object next_buffers; - /* Number saying how recently window was selected. */ EMACS_INT use_time; @@ -1228,6 +1226,7 @@ extern void replace_buffer_in_windows_safely (Lisp_Object); extern void wset_buffer (struct window *, Lisp_Object); extern bool window_outdated (struct window *); extern ptrdiff_t window_point (struct window *w); +extern void window_discard_buffer_from_dead_windows (Lisp_Object); extern void init_window_once (void); extern void init_window (void); extern void syms_of_window (void); diff --git a/src/xdisp.c b/src/xdisp.c index 19ce5b74b01..4087ff975ee 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -943,7 +943,7 @@ redisplay_trace (char const *fmt, ...) { va_list ap; va_start (ap, fmt); - vprintf (fmt, ap); + vfprintf (stderr, fmt, ap); va_end (ap); } } @@ -961,7 +961,7 @@ move_trace (char const *fmt, ...) { va_list ap; va_start (ap, fmt); - vprintf (fmt, ap); + vfprintf (stderr, fmt, ap); va_end (ap); } } @@ -1116,7 +1116,6 @@ static void set_iterator_to_next (struct it *, bool); static void mark_window_display_accurate_1 (struct window *, bool); static bool row_for_charpos_p (struct glyph_row *, ptrdiff_t); static bool cursor_row_p (struct glyph_row *); -static int redisplay_mode_lines (Lisp_Object, bool); static void handle_line_prefix (struct it *); @@ -1358,7 +1357,7 @@ window_box_height (struct window *w) if (hl_row && hl_row->mode_line_p) height -= hl_row->height; else - height -= estimate_mode_line_height (f, HEADER_LINE_FACE_ID); + height -= estimate_mode_line_height (f, CURRENT_HEADER_LINE_ACTIVE_FACE_ID (w)); } } @@ -1753,7 +1752,7 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, = window_parameter (w, Qheader_line_format); w->header_line_height - = display_mode_line (w, HEADER_LINE_FACE_ID, + = display_mode_line (w, CURRENT_HEADER_LINE_ACTIVE_FACE_ID (w), NILP (window_header_line_format) ? BVAR (current_buffer, header_line_format) : window_header_line_format); @@ -3006,6 +3005,32 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) #endif } +DEFUN ("remember-mouse-glyph", Fremember_mouse_glyph, Sremember_mouse_glyph, + 3, 3, 0, + doc: /* Return the extents of glyph in FRAME for mouse event generation. +Return a rectangle (X Y WIDTH HEIGHT) representing the confines, in +pixel coordinates, of the glyph at X, Y and in FRAME, or, should +`mouse-fine-grained-tracking' or `window-resize-pixelwise` be enabled, +an approximation thereof. All coordinates are relative to the origin +point of FRAME. */) + (Lisp_Object frame, Lisp_Object x, Lisp_Object y) +{ + struct frame *f = decode_window_system_frame (frame); + NativeRectangle rect; +#ifdef CONVERT_TO_EMACS_RECT + Emacs_Rectangle xrect; +#endif /* CONVERT_TO_EMACS_RECT */ + + CHECK_FIXNUM (x); + CHECK_FIXNUM (y); + remember_mouse_glyph (f, XFIXNUM (x), XFIXNUM (y), &rect); +#ifdef CONVERT_TO_EMACS_RECT + CONVERT_TO_EMACS_RECT (xrect, rect); + return list4i (xrect.x, xrect.y, xrect.width, xrect.height); +#else /* !defined CONVERT_TO_EMACS_RECT */ + return list4i (rect.x, rect.y, rect.width, rect.height); +#endif /* !defined CONVERT_TO_EMACS_RECT */ +} #endif /* HAVE_WINDOW_SYSTEM */ @@ -3171,13 +3196,14 @@ CHECK_WINDOW_END (struct window *w) BASE_FACE_ID is the id of a base face to use. It must be one of DEFAULT_FACE_ID for normal text, MODE_LINE_ACTIVE_FACE_ID, - MODE_LINE_INACTIVE_FACE_ID, or HEADER_LINE_FACE_ID for displaying - mode lines, or TOOL_BAR_FACE_ID for displaying the tool-bar. + MODE_LINE_INACTIVE_FACE_ID, HEADER_LINE_ACTIVE_FACE_ID, or + HEADER_LINE_INACTIVE_FACE_ID for displaying mode lines, or + TOOL_BAR_FACE_ID for displaying the tool-bar. If ROW is null and BASE_FACE_ID is equal to MODE_LINE_ACTIVE_FACE_ID, - MODE_LINE_INACTIVE_FACE_ID, or HEADER_LINE_FACE_ID, the iterator - will be initialized to use the corresponding mode line glyph row of - the desired matrix of W. */ + MODE_LINE_INACTIVE_FACE_ID, HEADER_LINE_ACTIVE_FACE_ID, or + HEADER_LINE_INACTIVE_FACE_ID the iterator will be initialized to use + the corresponding mode line glyph row of the desired matrix of W. */ void init_iterator (struct it *it, struct window *w, @@ -3225,7 +3251,8 @@ init_iterator (struct it *it, struct window *w, row = MATRIX_MODE_LINE_ROW (w->desired_matrix); else if (base_face_id == TAB_LINE_FACE_ID) row = MATRIX_TAB_LINE_ROW (w->desired_matrix); - else if (base_face_id == HEADER_LINE_FACE_ID) + else if (base_face_id == HEADER_LINE_ACTIVE_FACE_ID + || base_face_id == HEADER_LINE_INACTIVE_FACE_ID) { /* Header line row depends on whether tab line is enabled. */ w->desired_matrix->tab_line_p = window_wants_tab_line (w); @@ -3322,9 +3349,7 @@ init_iterator (struct it *it, struct window *w, of the iterator's frame, when set, suppresses their display - by default for tooltip frames and when set via the 'no-special-glyphs' frame parameter. */ -#ifdef HAVE_WINDOW_SYSTEM - if (!(FRAME_WINDOW_P (it->f) && it->f->no_special_glyphs)) -#endif + if (!it->f->no_special_glyphs) { if (it->line_wrap == TRUNCATE) { @@ -5549,6 +5574,7 @@ setup_for_ellipsis (struct it *it, int len) static Lisp_Object find_display_property (Lisp_Object disp, Lisp_Object prop) { + Lisp_Object elem; if (NILP (disp)) return Qnil; /* We have a vector of display specs. */ @@ -5556,11 +5582,11 @@ find_display_property (Lisp_Object disp, Lisp_Object prop) { for (ptrdiff_t i = 0; i < ASIZE (disp); i++) { - Lisp_Object elem = AREF (disp, i); + elem = AREF (disp, i); if (CONSP (elem) && CONSP (XCDR (elem)) && EQ (XCAR (elem), prop)) - return XCAR (XCDR (elem)); + goto found; } return Qnil; } @@ -5570,11 +5596,11 @@ find_display_property (Lisp_Object disp, Lisp_Object prop) { while (!NILP (disp)) { - Lisp_Object elem = XCAR (disp); + elem = XCAR (disp); if (CONSP (elem) && CONSP (XCDR (elem)) && EQ (XCAR (elem), prop)) - return XCAR (XCDR (elem)); + goto found; /* Check that we have a proper list before going to the next element. */ @@ -5589,21 +5615,41 @@ find_display_property (Lisp_Object disp, Lisp_Object prop) else if (CONSP (disp) && CONSP (XCDR (disp)) && EQ (XCAR (disp), prop)) - return XCAR (XCDR (disp)); + { + elem = disp; + goto found; + } + + return Qnil; + + found: + /* If the property value is a list of one element, just return the + CAR. */ + if (NILP (XCDR (XCDR (elem)))) + return XCAR (XCDR (elem)); else - return Qnil; + return XCDR (elem); } +/* Return the value of 'display' text or overlay property PROP of + character at CHARPOS in OBJECT. Return nil if character at CHARPOS + has no 'display' property or if the 'display' property of that + character does not include PROP. OBJECT can be a buffer or a window + or a string. */ static Lisp_Object -get_display_property (ptrdiff_t bufpos, Lisp_Object prop, Lisp_Object object) +get_display_property (ptrdiff_t charpos, Lisp_Object prop, Lisp_Object object) { - return find_display_property (Fget_text_property (make_fixnum (bufpos), + return find_display_property (Fget_char_property (make_fixnum (charpos), Qdisplay, object), prop); } +/* Handle 'display' property '(min-width (WIDTH))' at CHARPOS in OBJECT. + OBJECT can be a buffer (or nil, which means the current buffer) or a + string. MIN_WIDTH is the value of min-width spec that we expect to + process. */ static void -display_min_width (struct it *it, ptrdiff_t bufpos, +display_min_width (struct it *it, ptrdiff_t charpos, Lisp_Object object, Lisp_Object width_spec) { /* We're being called at the end of the `min-width' sequence, @@ -5614,15 +5660,21 @@ display_min_width (struct it *it, ptrdiff_t bufpos, /* When called from display_string (i.e., the mode line), we're being called with a string as the object, and we may be called with many sub-strings belonging to the same - :propertize run. */ - if ((bufpos == 0 - && !EQ (it->min_width_property, - get_display_property (0, Qmin_width, object))) + :propertize run. */ + if ((STRINGP (object) + && ((charpos == 0 + && !EQ (it->min_width_property, + get_display_property (0, Qmin_width, object))) + || (charpos > 0 + && EQ (it->min_width_property, + get_display_property (charpos - 1, Qmin_width, + object))))) /* In a buffer -- check that we're really right after the sequence of characters covered by this `min-width'. */ - || (bufpos > BEGV + || (!STRINGP (object) + && charpos > BEGV && EQ (it->min_width_property, - get_display_property (bufpos - 1, Qmin_width, object)))) + get_display_property (charpos - 1, Qmin_width, object)))) { Lisp_Object w = Qnil; double width; @@ -5636,7 +5688,13 @@ display_min_width (struct it *it, ptrdiff_t bufpos, XCAR (it->min_width_property), font, true, NULL); width -= it->current_x - it->min_width_start; - w = list1 (make_int (width)); + /* It makes no sense to try to obey min-width which yields + a stretch that ends beyond the visible portion of the + window if we are truncating screen lines. If we are + requested to do that, some Lisp program went awry. */ + if (!(it->line_wrap == TRUNCATE + && it->current_x + width > it->last_visible_x)) + w = list1 (make_int (width)); } else #endif @@ -5646,19 +5704,24 @@ display_min_width (struct it *it, ptrdiff_t bufpos, NULL, true, NULL); width -= (it->current_x - it->min_width_start) / FRAME_COLUMN_WIDTH (it->f); - w = make_int (width); + if (!(it->line_wrap == TRUNCATE + && it->current_x + width > it->last_visible_x)) + w = make_int (width); } /* Insert the stretch glyph. */ - it->object = list3 (Qspace, QCwidth, w); - produce_stretch_glyph (it); - if (it->area == TEXT_AREA) + if (!NILP (w)) { - it->current_x += it->pixel_width; + it->object = list3 (Qspace, QCwidth, w); + produce_stretch_glyph (it); + if (it->area == TEXT_AREA) + { + it->current_x += it->pixel_width; - if (it->continuation_lines_width - && it->string_from_prefix_prop_p) - it->wrap_prefix_width = it->current_x; + if (it->continuation_lines_width + && it->string_from_prefix_prop_p) + it->wrap_prefix_width = it->current_x; + } } it->min_width_property = Qnil; } @@ -5669,15 +5732,18 @@ display_min_width (struct it *it, ptrdiff_t bufpos, the end. */ if (CONSP (width_spec)) { - if (bufpos == BEGV + if ((!STRINGP (object) + && charpos == BEGV) /* Mode line (see above). */ - || (bufpos == 0 + || (STRINGP (object) + && charpos == 0 && !EQ (it->min_width_property, get_display_property (0, Qmin_width, object))) /* Buffer. */ - || (bufpos > BEGV + || (!STRINGP (object) + && charpos > BEGV && !EQ (width_spec, - get_display_property (bufpos - 1, Qmin_width, object)))) + get_display_property (charpos - 1, Qmin_width, object)))) { it->min_width_property = width_spec; it->min_width_start = it->current_x; @@ -5754,13 +5820,24 @@ handle_display_prop (struct it *it) Qdisplay, object, &overlay); /* Rest of the code must have OBJECT be either a string or a buffer. */ + Lisp_Object objwin = object; if (!STRINGP (it->string)) object = it->w->contents; /* Handle min-width ends. */ if (!NILP (it->min_width_property) && NILP (find_display_property (propval, Qmin_width))) - display_min_width (it, bufpos, object, Qnil); + { + ptrdiff_t pos = bufpos, start = BEGV; + + if (STRINGP (object)) + { + pos = IT_STRING_CHARPOS (*it); + start = 0; + } + if (pos > start) + display_min_width (it, pos, objwin, Qnil); + } if (NILP (propval)) return HANDLED_NORMALLY; @@ -6061,7 +6138,13 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, && CONSP (XCAR (XCDR (spec)))) { if (it) - display_min_width (it, bufpos, object, XCAR (XCDR (spec))); + { + ptrdiff_t pos = bufpos; + + if (STRINGP (object)) + pos = IT_STRING_CHARPOS (*it); + display_min_width (it, pos, object, XCAR (XCDR (spec))); + } return 0; } @@ -6317,6 +6400,12 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, return retval; } + /* We want the string to inherit the paragraph direction of the + parent object, so we need to calculate that if not yet done. */ + ptrdiff_t eob = (BUFFERP (object) ? ZV : it->end_charpos); + if (it->bidi_it.first_elt && it->bidi_it.charpos < eob) + bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true); + /* Save current settings of IT so that we can restore them when we are finished with the glyph property value. */ push_it (it, position); @@ -6349,9 +6438,10 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, if (BUFFERP (object)) *position = start_pos; - /* Force paragraph direction to be that of the parent - object. If the parent object's paragraph direction is - not yet determined, default to L2R. */ + /* Force paragraph direction to be that of the parent object. + If the parent object's paragraph direction is not yet + determined (which shouldn not happen, since we called + bidi_paragraph_init above), default to L2R. */ if (it->bidi_p && it->bidi_it.paragraph_dir == R2L) it->paragraph_embedding = it->bidi_it.paragraph_dir; else @@ -7006,6 +7096,11 @@ get_overlay_strings_1 (struct it *it, ptrdiff_t charpos, bool compute_stop_p) strings have been processed. */ eassert (!compute_stop_p || it->sp == 0); + /* We want the string to inherit the paragraph direction of the + parent object, so we need to calculate that if not yet done. */ + if (it->bidi_it.first_elt && it->bidi_it.charpos < ZV) + bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true); + /* When called from handle_stop, there might be an empty display string loaded. In that case, don't bother saving it. But don't use this optimization with the bidi iterator, since we @@ -7159,7 +7254,7 @@ iterate_out_of_display_property (struct it *it) eassert (eob >= CHARPOS (it->position) && CHARPOS (it->position) >= bob); /* Maybe initialize paragraph direction. If we are at the beginning - of a new paragraph, next_element_from_buffer may not have a + of a new paragraph, next_element_from_buffer may not have had a chance to do that. */ if (it->bidi_it.first_elt && it->bidi_it.charpos < eob) bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true); @@ -8954,6 +9049,10 @@ set_iterator_to_next (struct it *it, bool reseat_p) next, if there is one. */ if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string)) { + /* Maybe add a stretch glyph if the string had 'min-width' + display spec. */ + display_min_width (it, IT_STRING_CHARPOS (*it), it->string, + Qnil); it->ellipsis_p = false; next_overlay_string (it); if (it->ellipsis_p) @@ -8969,6 +9068,12 @@ set_iterator_to_next (struct it *it, bool reseat_p) if (IT_STRING_CHARPOS (*it) == SCHARS (it->string) && it->sp > 0) { + /* Maybe add a stretch glyph if the string had 'min-width' + display spec. We only do this if it->sp > 0 because + mode-line strings are handled differently, see + display_min_width. */ + display_min_width (it, IT_STRING_CHARPOS (*it), it->string, + Qnil); pop_it (it); if (it->method == GET_FROM_STRING) goto consider_string_end; @@ -11748,7 +11853,7 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object window_header_line_format = window_parameter (w, Qheader_line_format); - y = y + display_mode_line (w, HEADER_LINE_FACE_ID, + y = y + display_mode_line (w, CURRENT_HEADER_LINE_ACTIVE_FACE_ID (w), NILP (window_header_line_format) ? BVAR (current_buffer, header_line_format) : window_header_line_format); @@ -13309,18 +13414,22 @@ clear_message (bool current_p, bool last_displayed_p) message_buf_print = false; } -/* Clear garbaged frames. +/* Clear garbaged frames. Value is true if current matrices have been + cleared on at least one tty frame. This information is needed to + determine if more than one window has to be updated on ttys, whose + update requires building a frame matrix from window matrices. This function is used where the old redisplay called redraw_garbaged_frames which in turn called redraw_frame which in turn called clear_frame. The call to clear_frame was a source of flickering. I believe a clear_frame is not necessary. It should suffice in the new redisplay to invalidate all current matrices, - and ensure a complete redisplay of all windows. */ + and ensure a complete redisplay of all windows. */ -static void +static bool clear_garbaged_frames (void) { + bool current_matrices_cleared = false; if (frame_garbaged) { Lisp_Object tail, frame; @@ -13342,6 +13451,8 @@ clear_garbaged_frames (void) redraw_frame (f); else clear_current_matrices (f); + if (is_tty_frame (f)) + current_matrices_cleared = true; #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f) @@ -13356,6 +13467,8 @@ clear_garbaged_frames (void) frame_garbaged = false; } + + return current_matrices_cleared; } @@ -13407,24 +13520,6 @@ echo_area_display (bool update_frame_p) here could cause confusion. */ if (update_frame_p && !redisplaying_p) { - int n = 0; - - /* If the display update has been interrupted by pending - input, update mode lines in the frame. Due to the - pending input, it might have been that redisplay hasn't - been called, so that mode lines above the echo area are - garbaged. This looks odd, so we prevent it here. */ - if (!display_completed) - { - n = redisplay_mode_lines (FRAME_ROOT_WINDOW (f), false); - -#ifdef HAVE_WINDOW_SYSTEM - if (FRAME_WINDOW_P (f) - && FRAME_RIF (f)->clear_under_internal_border) - FRAME_RIF (f)->clear_under_internal_border (f); -#endif - } - if (window_height_changed_p /* Don't do this if Emacs is shutting down. Redisplay needs to run hooks. */ @@ -13433,13 +13528,10 @@ echo_area_display (bool update_frame_p) /* Must update other windows. Likewise as in other cases, don't let this update be interrupted by pending input. */ - specpdl_ref count = SPECPDL_INDEX (); - specbind (Qredisplay_dont_pause, Qt); fset_redisplay (f); redisplay_internal (); - unbind_to (count, Qnil); } - else if (FRAME_WINDOW_P (f) && n == 0) + else if (FRAME_WINDOW_P (f)) { /* Window configuration is the same as before. Can do with a display update of the echo area, @@ -13448,7 +13540,11 @@ echo_area_display (bool update_frame_p) flush_frame (f); } else - update_frame (f, true, true); + { + update_frame (f, true); + if (is_tty_frame (f)) + combine_updates_for_frame (f, true); + } /* If cursor is in the echo area, make sure that the next redisplay displays the minibuffer, so that the cursor will @@ -15060,8 +15156,6 @@ note_tab_bar_highlight (struct frame *f, int x, int y) help_echo_object = help_echo_window = Qnil; help_echo_pos = -1; help_echo_string = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_HELP); - if (NILP (help_echo_string)) - help_echo_string = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_CAPTION); } #endif /* HAVE_WINDOW_SYSTEM */ @@ -16832,7 +16926,6 @@ redisplay_internal (void) struct window *w = XWINDOW (selected_window); struct window *sw; struct frame *fr; - bool pending; bool must_finish = false, match_p; struct text_pos tlbufpos, tlendpos; int number_of_visible_frames; @@ -16918,7 +17011,6 @@ redisplay_internal (void) /* Remember the currently selected window. */ sw = w; - pending = false; forget_escape_and_glyphless_faces (); inhibit_free_realized_faces = false; @@ -16929,16 +17021,22 @@ redisplay_internal (void) if (face_change) windows_or_buffers_changed = 47; + struct frame *previous_frame; if ((FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)) - && FRAME_TTY (sf)->previous_frame != sf) + && (previous_frame = FRAME_TTY (sf)->previous_frame, + previous_frame != sf)) { - /* Since frames on a single ASCII terminal share the same - display area, displaying a different frame means redisplay - the whole thing. */ - SET_FRAME_GARBAGED (sf); + if (previous_frame == NULL + || root_frame (previous_frame) != root_frame (sf)) + { + /* Since frames on a single terminal share the same display + area, displaying a different frame means redisplay the + whole thing. */ + SET_FRAME_GARBAGED (sf); #if !defined DOS_NT && !defined HAVE_ANDROID - set_tty_color_mode (FRAME_TTY (sf), sf); + set_tty_color_mode (FRAME_TTY (sf), sf); #endif + } FRAME_TTY (sf)->previous_frame = sf; } @@ -16951,6 +17049,7 @@ redisplay_internal (void) { struct frame *f = XFRAME (frame); + /* FRAME_REDISPLAY_P true basically means the frame is visible. */ if (FRAME_REDISPLAY_P (f)) { ++number_of_visible_frames; @@ -16979,7 +17078,7 @@ redisplay_internal (void) do_pending_window_change (true); /* Clear frames marked as garbaged. */ - clear_garbaged_frames (); + bool current_matrices_cleared = clear_garbaged_frames (); /* Build menubar and tool-bar items. */ if (NILP (Vmemory_full)) @@ -17070,7 +17169,8 @@ redisplay_internal (void) overlay_arrows_changed_p (true); consider_all_windows_p = (update_mode_lines - || windows_or_buffers_changed); + || windows_or_buffers_changed + || current_matrices_cleared); #define AINC(a,i) \ { \ @@ -17094,7 +17194,6 @@ redisplay_internal (void) && !current_buffer->clip_changed && !current_buffer->prevent_redisplay_optimizations_p && FRAME_REDISPLAY_P (XFRAME (w->frame)) - && !FRAME_OBSCURED_P (XFRAME (w->frame)) && !XFRAME (w->frame)->cursor_type_changed && !XFRAME (w->frame)->face_change /* Make sure recorded data applies to current buffer, etc. */ @@ -17343,22 +17442,29 @@ redisplay_internal (void) propagate_buffer_redisplay (); + Lisp_Object tty_root_frames = Qnil; FOR_EACH_FRAME (tail, frame) { struct frame *f = XFRAME (frame); - /* We don't have to do anything for unselected terminal - frames. */ - if ((FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) - && !EQ (FRAME_TTY (f)->top_frame, frame)) - continue; + if (is_tty_frame (f)) + { + /* Ignore all invisble tty frames, children or root. */ + if (!FRAME_VISIBLE_P (root_frame (f))) + continue; + + /* Remember tty root frames which we've seen. */ + if (!FRAME_PARENT_FRAME (f) + && NILP (memq_no_quit (frame, tty_root_frames))) + tty_root_frames = Fcons (frame, tty_root_frames); + } retry_frame: - if (FRAME_WINDOW_P (f) || FRAME_TERMCAP_P (f) || f == sf) + if (FRAME_WINDOW_P (f) + || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f) || f == sf) { - bool gcscrollbars - /* Only GC scrollbars when we redisplay the whole frame. */ - = f->redisplay || !REDISPLAY_SOME_P (); + /* Only GC scrollbars when we redisplay the whole frame. */ + bool gcscrollbars = f->redisplay || !REDISPLAY_SOME_P (); bool f_redisplay_flag = f->redisplay; /* The X error handler may have deleted that frame before @@ -17375,7 +17481,7 @@ redisplay_internal (void) if (gcscrollbars && FRAME_TERMINAL (f)->condemn_scroll_bars_hook) FRAME_TERMINAL (f)->condemn_scroll_bars_hook (f); - if (FRAME_REDISPLAY_P (f) && !FRAME_OBSCURED_P (f)) + if (FRAME_REDISPLAY_P (f)) { /* Don't allow freeing images and faces for this frame as long as the frame's update wasn't @@ -17401,7 +17507,7 @@ redisplay_internal (void) if (gcscrollbars && FRAME_TERMINAL (f)->judge_scroll_bars_hook) FRAME_TERMINAL (f)->judge_scroll_bars_hook (f); - if (FRAME_REDISPLAY_P (f) && !FRAME_OBSCURED_P (f)) + if (FRAME_REDISPLAY_P (f)) { /* If fonts changed on visible frame, display again. */ if (f->fonts_changed) @@ -17465,7 +17571,7 @@ redisplay_internal (void) unrequest_sigio (); STOP_POLLING; - pending |= update_frame (f, false, false); + update_frame (f, false); /* On some platforms (at least MS-Windows), the scroll_run_hook called from scrolling_window called from update_frame could set the frame's @@ -17486,28 +17592,28 @@ redisplay_internal (void) } } + if (CONSP (tty_root_frames)) + combine_updates (tty_root_frames); + eassert (EQ (XFRAME (selected_frame)->selected_window, selected_window)); - if (!pending) + /* Do the mark_window_display_accurate after all windows have + been redisplayed because this call resets flags in buffers + which are needed for proper redisplay. */ + FOR_EACH_FRAME (tail, frame) { - /* Do the mark_window_display_accurate after all windows have - been redisplayed because this call resets flags in buffers - which are needed for proper redisplay. */ - FOR_EACH_FRAME (tail, frame) - { - struct frame *f = XFRAME (frame); - if (f->updated_p) - { - f->redisplay = false; - f->garbaged = false; - mark_window_display_accurate (f->root_window, true); - if (FRAME_TERMINAL (f)->frame_up_to_date_hook) - FRAME_TERMINAL (f)->frame_up_to_date_hook (f); - } - } + struct frame *f = XFRAME (frame); + if (f->updated_p) + { + f->redisplay = false; + f->garbaged = false; + mark_window_display_accurate (f->root_window, true); + if (FRAME_TERMINAL (f)->frame_up_to_date_hook) + FRAME_TERMINAL (f)->frame_up_to_date_hook (f); + } } } - else if (FRAME_REDISPLAY_P (sf) && !FRAME_OBSCURED_P (sf)) + else if (FRAME_REDISPLAY_P (sf)) { sf->inhibit_clear_image_cache = true; displayed_buffer = XBUFFER (XWINDOW (selected_window)->contents); @@ -17558,7 +17664,7 @@ redisplay_internal (void) unrequest_sigio (); STOP_POLLING; - if (FRAME_REDISPLAY_P (sf) && !FRAME_OBSCURED_P (sf)) + if (FRAME_REDISPLAY_P (sf)) { if (hscroll_retries <= MAX_HSCROLL_RETRIES && hscroll_windows (selected_window)) @@ -17568,7 +17674,11 @@ redisplay_internal (void) } XWINDOW (selected_window)->must_be_updated_p = true; - pending = update_frame (sf, false, false); + update_frame (sf, false); + + if (is_tty_frame (sf)) + combine_updates_for_frame (sf, false); + sf->cursor_type_changed = false; sf->inhibit_clear_image_cache = false; } @@ -17581,12 +17691,14 @@ redisplay_internal (void) Lisp_Object mini_window = FRAME_MINIBUF_WINDOW (sf); struct frame *mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (mini_window))); - if (mini_frame != sf && FRAME_WINDOW_P (mini_frame)) + if (mini_frame != sf) { XWINDOW (mini_window)->must_be_updated_p = true; - pending |= update_frame (mini_frame, false, false); + update_frame (mini_frame, false); + if (is_tty_frame (mini_frame)) + combine_updates_for_frame (mini_frame, false); mini_frame->cursor_type_changed = false; - if (!pending && hscroll_retries <= MAX_HSCROLL_RETRIES + if (hscroll_retries <= MAX_HSCROLL_RETRIES && hscroll_windows (mini_window)) { hscroll_retries++; @@ -17595,47 +17707,26 @@ redisplay_internal (void) } } - /* If display was paused because of pending input, make sure we do a - thorough update the next time. */ - if (pending) + if (!consider_all_windows_p) { - /* Prevent the optimization at the beginning of - redisplay_internal that tries a single-line update of the - line containing the cursor in the selected window. */ - CHARPOS (this_line_start_pos) = 0; + /* This has already been done above if + consider_all_windows_p is set. */ + if (XBUFFER (w->contents)->text->redisplay + && buffer_window_count (XBUFFER (w->contents)) > 1) + /* This can happen if b->text->redisplay was set during + jit-lock. */ + propagate_buffer_redisplay (); + mark_window_display_accurate_1 (w, true); - /* Let the overlay arrow be updated the next time. */ - update_overlay_arrows (0); + /* Say overlay arrows are up to date. */ + update_overlay_arrows (1); - /* If we pause after scrolling, some rows in the current - matrices of some windows are not valid. */ - if (!WINDOW_FULL_WIDTH_P (w) - && !FRAME_WINDOW_P (XFRAME (w->frame))) - update_mode_lines = 36; + if (FRAME_TERMINAL (sf)->frame_up_to_date_hook != 0) + FRAME_TERMINAL (sf)->frame_up_to_date_hook (sf); } - else - { - if (!consider_all_windows_p) - { - /* This has already been done above if - consider_all_windows_p is set. */ - if (XBUFFER (w->contents)->text->redisplay - && buffer_window_count (XBUFFER (w->contents)) > 1) - /* This can happen if b->text->redisplay was set during - jit-lock. */ - propagate_buffer_redisplay (); - mark_window_display_accurate_1 (w, true); - - /* Say overlay arrows are up to date. */ - update_overlay_arrows (1); - - if (FRAME_TERMINAL (sf)->frame_up_to_date_hook != 0) - FRAME_TERMINAL (sf)->frame_up_to_date_hook (sf); - } - update_mode_lines = 0; - windows_or_buffers_changed = 0; - } + update_mode_lines = 0; + windows_or_buffers_changed = 0; /* Start SIGIO interrupts coming again. Having them off during the code above makes it less likely one will discard output, but not @@ -17651,26 +17742,23 @@ redisplay_internal (void) redisplay constructing glyphs, so simply exposing a frame won't display anything in this case. So, we have to display these frames here explicitly. */ - if (!pending) - { - int new_count = 0; - - FOR_EACH_FRAME (tail, frame) - { - if (FRAME_REDISPLAY_P (XFRAME (frame))) - new_count++; - } + int new_count = 0; - if (new_count != number_of_visible_frames) - windows_or_buffers_changed = 52; + FOR_EACH_FRAME (tail, frame) + { + if (FRAME_REDISPLAY_P (XFRAME (frame))) + new_count++; } + if (new_count != number_of_visible_frames) + windows_or_buffers_changed = 52; + /* Change frame size now if a change is pending. */ do_pending_window_change (true); /* If we just did a pending size change, or have additional visible frames, or selected_window changed, redisplay again. */ - if ((windows_or_buffers_changed && !pending) + if (windows_or_buffers_changed || (WINDOWP (selected_window) && (w = XWINDOW (selected_window)) != sw)) goto retry; @@ -23871,6 +23959,7 @@ extend_face_to_end_of_line (struct it *it) { it->glyph_row->glyphs[TEXT_AREA][0] = space_glyph; it->glyph_row->glyphs[TEXT_AREA][0].face_id = face->id; + it->glyph_row->glyphs[TEXT_AREA][0].frame = f; it->glyph_row->used[TEXT_AREA] = 1; } /* Mode line and the header line don't have margins, and @@ -23890,6 +23979,7 @@ extend_face_to_end_of_line (struct it *it) it->glyph_row->glyphs[LEFT_MARGIN_AREA][0] = space_glyph; it->glyph_row->glyphs[LEFT_MARGIN_AREA][0].face_id = default_face->id; + it->glyph_row->glyphs[LEFT_MARGIN_AREA][0].frame = f; it->glyph_row->used[LEFT_MARGIN_AREA] = 1; } if (WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0 @@ -23898,6 +23988,7 @@ extend_face_to_end_of_line (struct it *it) it->glyph_row->glyphs[RIGHT_MARGIN_AREA][0] = space_glyph; it->glyph_row->glyphs[RIGHT_MARGIN_AREA][0].face_id = default_face->id; + it->glyph_row->glyphs[RIGHT_MARGIN_AREA][0].frame = f; it->glyph_row->used[RIGHT_MARGIN_AREA] = 1; } @@ -24262,9 +24353,11 @@ highlight_trailing_whitespace (struct it *it) while (glyph >= start && BUFFERP (glyph->object) && (glyph->type == STRETCH_GLYPH - || (glyph->type == CHAR_GLYPH - && glyph->u.ch == ' '))) - (glyph--)->face_id = face_id; + || (glyph->type == CHAR_GLYPH && glyph->u.ch == ' '))) + { + glyph->frame = it->f; + (glyph--)->face_id = face_id; + } } else { @@ -24273,7 +24366,10 @@ highlight_trailing_whitespace (struct it *it) && (glyph->type == STRETCH_GLYPH || (glyph->type == CHAR_GLYPH && glyph->u.ch == ' '))) - (glyph++)->face_id = face_id; + { + glyph->frame = it->f; + (glyph++)->face_id = face_id; + } } } } @@ -24394,6 +24490,12 @@ push_prefix_prop (struct it *it, Lisp_Object prop) || it->method == GET_FROM_STRING || it->method == GET_FROM_IMAGE); + /* We want the string to inherit the paragraph direction of the parent + object, so we need to calculate that if not yet done. */ + ptrdiff_t eob = (STRINGP (it->string) ? SCHARS (it->string) : ZV); + if (it->bidi_it.first_elt && it->bidi_it.charpos < eob) + bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true); + /* We need to save the current buffer/string position, so it will be restored by pop_it, because iterate_out_of_display_property depends on that being set correctly, but some situations leave @@ -25922,6 +26024,18 @@ display_line (struct it *it, int cursor_vpos) } it->hpos = hpos_before; } + /* If the default face is remapped, and the window has + display margins, and no glyphs were written yet to the + margins on this screen line, we must add one space + glyph to the margin area to make sure the margins use + the background of the remapped default face. */ + if (lookup_basic_face (it->w, it->f, DEFAULT_FACE_ID) + != DEFAULT_FACE_ID /* default face is remapped */ + && ((WINDOW_LEFT_MARGIN_WIDTH (it->w) > 0 + && it->glyph_row->used[LEFT_MARGIN_AREA] == 0) + || (WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0 + && it->glyph_row->used[RIGHT_MARGIN_AREA] == 0))) + extend_face_to_end_of_line (it); } else if (IT_OVERFLOW_NEWLINE_INTO_FRINGE (it)) { @@ -27108,7 +27222,7 @@ display_menu_bar (struct window *w) /* Deep copy of a glyph row, including the glyphs. */ static void -deep_copy_glyph_row (struct glyph_row *to, struct glyph_row *from) +deep_copy_glyph_row (struct frame *f, struct glyph_row *to, struct glyph_row *from) { struct glyph *pointers[1 + LAST_AREA]; int to_used = to->used[TEXT_AREA]; @@ -27129,7 +27243,36 @@ deep_copy_glyph_row (struct glyph_row *to, struct glyph_row *from) /* If we filled only part of the TO row, fill the rest with space_glyph (which will display as empty space). */ if (to_used > from->used[TEXT_AREA]) - fill_up_frame_row_with_spaces (to, to_used); + fill_up_frame_row_with_spaces (f, to, to_used); +} + +/* Produce glyphs for a menu separator on a tty. + + FIXME: This is only a "good enough for now" implementation of menu + separators as described in the Elisp info manual. We should probably + ignore menu separators when computing the width of a menu. Secondly, + optionally using Unicode characters via display table entries would + be nice. Patches very welcome. */ + +static void +display_tty_menu_separator (struct it *it, const char *label, int width) +{ + USE_SAFE_ALLOCA; + char c; + if (strcmp (label, "--space") == 0) + c = ' '; + else if (strcmp (label, "--double-line") == 0) + c = '='; + else + c = '-'; + char *sep = SAFE_ALLOCA (width); + memset (sep, c, width - 1); + sep[width - 1] = 0; + display_string (sep, Qnil, Qnil, 0, 0, it, width - 1, width - 1, + FRAME_COLS (it->f) - 1, -1); + display_string (" ", Qnil, Qnil, 0, 0, it, 1, 0, + FRAME_COLS (it->f) - 1, -1); + SAFE_FREE (); } /* Display one menu item on a TTY, by overwriting the glyphs in the @@ -27178,7 +27321,7 @@ display_tty_menu_item (const char *item_text, int width, int face_id, it.last_visible_x = FRAME_COLS (f) - 1; row = it.glyph_row; /* Start with the row contents from the current matrix. */ - deep_copy_glyph_row (row, f->current_matrix->rows + y); + deep_copy_glyph_row (f, row, f->current_matrix->rows + y); bool saved_width = row->full_width_p; row->full_width_p = true; bool saved_reversed = row->reversed_p; @@ -27206,6 +27349,7 @@ display_tty_menu_item (const char *item_text, int width, int face_id, /* Pad with a space on the left. */ display_string (" ", Qnil, Qnil, 0, 0, &it, 1, 0, FRAME_COLS (f) - 1, -1); width--; + /* Display the menu item, pad with spaces to WIDTH. */ if (submenu) { @@ -27216,9 +27360,13 @@ display_tty_menu_item (const char *item_text, int width, int face_id, display_string (" >", Qnil, Qnil, 0, 0, &it, width, 0, FRAME_COLS (f) - 1, -1); } + else if (menu_separator_name_p (item_text)) + { + display_tty_menu_separator (&it, item_text, width); + } else - display_string (item_text, Qnil, Qnil, 0, 0, &it, - width, 0, FRAME_COLS (f) - 1, -1); + display_string (item_text, Qnil, Qnil, 0, 0, &it, width, 0, + FRAME_COLS (f) - 1, -1); row->used[TEXT_AREA] = max (saved_used, row->used[TEXT_AREA]); row->truncated_on_right_p = saved_truncated; @@ -27234,60 +27382,6 @@ display_tty_menu_item (const char *item_text, int width, int face_id, Mode Line ***********************************************************************/ -/* Redisplay mode lines in the window tree whose root is WINDOW. - If FORCE, redisplay mode lines unconditionally. - Otherwise, redisplay only mode lines that are garbaged. Value is - the number of windows whose mode lines were redisplayed. */ - -static int -redisplay_mode_lines (Lisp_Object window, bool force) -{ - int nwindows = 0; - - while (!NILP (window)) - { - struct window *w = XWINDOW (window); - - if (WINDOWP (w->contents)) - nwindows += redisplay_mode_lines (w->contents, force); - else if (force - || FRAME_GARBAGED_P (XFRAME (w->frame)) - || !MATRIX_MODE_LINE_ROW (w->current_matrix)->enabled_p) - { - struct text_pos lpoint; - struct buffer *old = current_buffer; - - /* Set the window's buffer for the mode line display. */ - SET_TEXT_POS (lpoint, PT, PT_BYTE); - set_buffer_internal_1 (XBUFFER (w->contents)); - - /* Point refers normally to the selected window. For any - other window, set up appropriate value. */ - if (!EQ (window, selected_window)) - { - struct text_pos pt; - - CLIP_TEXT_POS_FROM_MARKER (pt, w->pointm); - TEMP_SET_PT_BOTH (CHARPOS (pt), BYTEPOS (pt)); - } - - /* Display mode lines. */ - clear_glyph_matrix (w->desired_matrix); - if (display_mode_lines (w)) - ++nwindows; - - /* Restore old settings. */ - set_buffer_internal_1 (old); - TEMP_SET_PT_BOTH (CHARPOS (lpoint), BYTEPOS (lpoint)); - } - - window = w->next; - } - - return nwindows; -} - - /* Display the mode line, the header line, and the tab-line of window W. Value is the sum number of mode lines, header lines, and tab lines actually displayed. */ @@ -27331,11 +27425,11 @@ display_mode_lines (struct window *w) line_number_displayed = false; w->column_number_displayed = -1; + struct window *sel_w = XWINDOW (old_selected_window); if (window_wants_mode_line (w)) { Lisp_Object window_mode_line_format = window_parameter (w, Qmode_line_format); - struct window *sel_w = XWINDOW (old_selected_window); /* Select mode line face based on the real selected window. */ display_mode_line (w, @@ -27363,7 +27457,7 @@ display_mode_lines (struct window *w) Lisp_Object window_header_line_format = window_parameter (w, Qheader_line_format); - display_mode_line (w, HEADER_LINE_FACE_ID, + display_mode_line (w, CURRENT_HEADER_LINE_ACTIVE_FACE_ID_3 (sel_w, sel_w, w), NILP (window_header_line_format) ? BVAR (current_buffer, header_line_format) : window_header_line_format); @@ -27378,11 +27472,12 @@ display_mode_lines (struct window *w) } -/* Display mode or header/tab line of window W. FACE_ID specifies - which line to display; it is either MODE_LINE_ACTIVE_FACE_ID, - HEADER_LINE_FACE_ID or TAB_LINE_FACE_ID. FORMAT is the - mode/header/tab line format to display. Value is the pixel height - of the mode/header/tab line displayed. */ +/* Display mode or header/tab line of window W. FACE_ID specifies which + line to display; it is either MODE_LINE_ACTIVE_FACE_ID, + HEADER_LINE_ACTIVE_FACE_ID, HEADER_LINE_INACTIVE_FACE_ID, or + TAB_LINE_FACE_ID. FORMAT is the mode/header/tab line format to + display. Value is the pixel height of the mode/header/tab line + displayed. */ static int display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) @@ -27403,7 +27498,8 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) it.glyph_row->tab_line_p = true; w->desired_matrix->tab_line_p = true; } - else if (face_id == HEADER_LINE_FACE_ID) + else if (face_id == HEADER_LINE_ACTIVE_FACE_ID + || face_id == HEADER_LINE_INACTIVE_FACE_ID) w->desired_matrix->header_line_p = true; /* FIXME: This should be controlled by a user option. But @@ -27422,7 +27518,9 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) record_unwind_save_match_data (); if (NILP (Vmode_line_compact) - || face_id == HEADER_LINE_FACE_ID || face_id == TAB_LINE_FACE_ID) + || face_id == HEADER_LINE_ACTIVE_FACE_ID + || face_id == HEADER_LINE_INACTIVE_FACE_ID + || face_id == TAB_LINE_FACE_ID) { mode_line_target = MODE_LINE_DISPLAY; display_mode_element (&it, 0, 0, 0, format, Qnil, false); @@ -28070,18 +28168,7 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, if (string != NULL) { -#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY \ - && __ANDROID_API__ < 22 - /* Circumvent a bug in memchr preventing strnlen from returning - valid values when a large limit is specified. - - https://issuetracker.google.com/issues/37020957 */ - if (precision <= 0 || ((uintptr_t) string - > (UINTPTR_MAX - precision))) - len = strlen (string); - else -#endif /* HAVE_ANDROID && !ANDROID_STUBIFY && __ANDROID_API__ < 22 */ - len = strnlen (string, precision <= 0 ? SIZE_MAX : precision); + len = strnlen (string, precision <= 0 ? SIZE_MAX : precision); lisp_string = make_string (string, len); if (NILP (props)) props = mode_line_string_face_prop; @@ -28202,7 +28289,8 @@ are the selected window and the WINDOW's buffer). */) ? MODE_LINE_ACTIVE_FACE_ID : MODE_LINE_INACTIVE_FACE_ID) : EQ (face, Qmode_line_active) ? MODE_LINE_ACTIVE_FACE_ID : EQ (face, Qmode_line_inactive) ? MODE_LINE_INACTIVE_FACE_ID - : EQ (face, Qheader_line) ? HEADER_LINE_FACE_ID + : EQ (face, Qheader_line_active) ? HEADER_LINE_ACTIVE_FACE_ID + : EQ (face, Qheader_line_inactive) ? HEADER_LINE_INACTIVE_FACE_ID : EQ (face, Qtab_line) ? TAB_LINE_FACE_ID : EQ (face, Qtab_bar) ? TAB_BAR_FACE_ID : EQ (face, Qtool_bar) ? TOOL_BAR_FACE_ID @@ -32151,6 +32239,8 @@ produce_special_glyphs (struct it *it, enum display_element_type what) struct it temp_it; Lisp_Object gc; GLYPH glyph; + /* Take face-remapping into consideration. */ + int face_id = lookup_basic_face (it->w, it->f, DEFAULT_FACE_ID); temp_it = *it; temp_it.object = Qnil; @@ -32160,27 +32250,27 @@ produce_special_glyphs (struct it *it, enum display_element_type what) { /* Continuation glyph. For R2L lines, we mirror it by hand. */ if (it->bidi_it.paragraph_dir == R2L) - SET_GLYPH_FROM_CHAR (glyph, '/'); + SET_GLYPH (glyph, '/', face_id); else - SET_GLYPH_FROM_CHAR (glyph, '\\'); + SET_GLYPH (glyph, '\\', face_id); if (it->dp && (gc = DISP_CONTINUE_GLYPH (it->dp), GLYPH_CODE_P (gc))) { /* FIXME: Should we mirror GC for R2L lines? */ SET_GLYPH_FROM_GLYPH_CODE (glyph, gc); - spec_glyph_lookup_face (XWINDOW (it->window), &glyph); + spec_glyph_lookup_face (it->w, &glyph); } } else if (what == IT_TRUNCATION) { /* Truncation glyph. */ - SET_GLYPH_FROM_CHAR (glyph, '$'); + SET_GLYPH (glyph, '$', face_id); if (it->dp && (gc = DISP_TRUNC_GLYPH (it->dp), GLYPH_CODE_P (gc))) { /* FIXME: Should we mirror GC for R2L lines? */ SET_GLYPH_FROM_GLYPH_CODE (glyph, gc); - spec_glyph_lookup_face (XWINDOW (it->window), &glyph); + spec_glyph_lookup_face (it->w, &glyph); } } else @@ -37279,6 +37369,7 @@ be let-bound around code that needs to disable messages temporarily. */); defsubr (&Strace_to_stderr); #endif #ifdef HAVE_WINDOW_SYSTEM + defsubr (&Sremember_mouse_glyph); defsubr (&Stab_bar_height); defsubr (&Stool_bar_height); defsubr (&Slookup_image_map); diff --git a/src/xfaces.c b/src/xfaces.c index 6a30f348ee9..5c1300309dd 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -696,7 +696,6 @@ void free_frame_faces (struct frame *f) { struct face_cache *face_cache = FRAME_FACE_CACHE (f); - if (face_cache) { free_face_cache (face_cache); @@ -2513,6 +2512,9 @@ evaluate_face_filter (Lisp_Object filter, struct window *w, if (!NILP (filter)) goto err; + if (NILP (Fget (parameter, QCfiltered))) + Fput (parameter, QCfiltered, Qt); + bool match = false; if (w) { @@ -2693,9 +2695,7 @@ merge_face_ref (struct window *w, Lisp_Object keyword = XCAR (face_ref_tem); Lisp_Object value = XCAR (XCDR (face_ref_tem)); - if (EQ (keyword, face_attr_sym[attr_filter]) - || (attr_filter == LFACE_INVERSE_INDEX - && EQ (keyword, QCreverse_video))) + if (EQ (keyword, face_attr_sym[attr_filter])) { attr_filter_seen = true; if (NILP (value)) @@ -2831,8 +2831,7 @@ merge_face_ref (struct window *w, else err = true; } - else if (EQ (keyword, QCinverse_video) - || EQ (keyword, QCreverse_video)) + else if (EQ (keyword, QCinverse_video)) { if (EQ (value, Qt) || NILP (value)) to[LFACE_INVERSE_INDEX] = value; @@ -3461,8 +3460,7 @@ FRAME 0 means change the face on all frames, and change the default old_value = LFACE_BOX (lface); ASET (lface, LFACE_BOX_INDEX, value); } - else if (EQ (attr, QCinverse_video) - || EQ (attr, QCreverse_video)) + else if (EQ (attr, QCinverse_video)) { if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value) @@ -3980,8 +3978,7 @@ DEFUN ("internal-set-lisp-face-attribute-from-resource", value = face_boolean_x_resource_value (value, true); else if (EQ (attr, QCweight) || EQ (attr, QCslant) || EQ (attr, QCwidth)) value = intern (SSDATA (value)); - else if (EQ (attr, QCreverse_video) - || EQ (attr, QCinverse_video) + else if (EQ (attr, QCinverse_video) || EQ (attr, QCextend)) value = face_boolean_x_resource_value (value, true); else if (EQ (attr, QCunderline) @@ -4192,8 +4189,7 @@ frames). If FRAME is omitted or nil, use the selected frame. */) value = LFACE_STRIKE_THROUGH (lface); else if (EQ (keyword, QCbox)) value = LFACE_BOX (lface); - else if (EQ (keyword, QCinverse_video) - || EQ (keyword, QCreverse_video)) + else if (EQ (keyword, QCinverse_video)) value = LFACE_INVERSE (lface); else if (EQ (keyword, QCforeground)) value = LFACE_FOREGROUND (lface); @@ -4237,7 +4233,6 @@ Value is nil if ATTR doesn't have a discrete set of valid values. */) if (EQ (attr, QCunderline) || EQ (attr, QCoverline) || EQ (attr, QCstrike_through) || EQ (attr, QCinverse_video) - || EQ (attr, QCreverse_video) || EQ (attr, QCextend)) result = list2 (Qt, Qnil); @@ -5124,7 +5119,8 @@ lookup_basic_face (struct window *w, struct frame *f, int face_id) case DEFAULT_FACE_ID: name = Qdefault; break; case MODE_LINE_ACTIVE_FACE_ID: name = Qmode_line_active; break; case MODE_LINE_INACTIVE_FACE_ID: name = Qmode_line_inactive; break; - case HEADER_LINE_FACE_ID: name = Qheader_line; break; + case HEADER_LINE_ACTIVE_FACE_ID: name = Qheader_line_active; break; + case HEADER_LINE_INACTIVE_FACE_ID: name = Qheader_line_inactive; break; case TAB_LINE_FACE_ID: name = Qtab_line; break; case TAB_BAR_FACE_ID: name = Qtab_bar; break; case TOOL_BAR_FACE_ID: name = Qtool_bar; break; @@ -5150,10 +5146,19 @@ lookup_basic_face (struct window *w, struct frame *f, int face_id) for the very common no-remapping case. */ mapping = assq_no_quit (name, Vface_remapping_alist); if (NILP (mapping)) - return face_id; /* Give up. */ + { + Lisp_Object face_attrs[LFACE_VECTOR_SIZE]; + + /* If the face inherits from another, we need to realize it, + because the parent face could be remapped. */ + if (!get_lface_attributes (w, f, name, face_attrs, false, 0) + || NILP (face_attrs[LFACE_INHERIT_INDEX]) + || UNSPECIFIEDP (face_attrs[LFACE_INHERIT_INDEX])) + return face_id; /* Give up. */ + } - /* If there is a remapping entry, lookup the face using NAME, which will - handle the remapping too. */ + /* If there is a remapping entry, or the face inherits from another, + lookup the face using NAME, which will handle the remapping too. */ remapped_face_id = lookup_named_face (w, f, name, false); if (remapped_face_id < 0) return face_id; /* Give up. */ @@ -5870,11 +5875,18 @@ realize_basic_faces (struct frame *f) if (realize_default_face (f)) { + /* Basic faces must be realized disregarding face-remapping-alist, + since otherwise face-remapping might affect the basic faces in the + face cache, if this function happens to be invoked with current + buffer set to a buffer with a non-nil face-remapping-alist. */ + specpdl_ref count = SPECPDL_INDEX (); + specbind (Qface_remapping_alist, Qnil); realize_named_face (f, Qmode_line_active, MODE_LINE_ACTIVE_FACE_ID); realize_named_face (f, Qmode_line_inactive, MODE_LINE_INACTIVE_FACE_ID); realize_named_face (f, Qtool_bar, TOOL_BAR_FACE_ID); realize_named_face (f, Qfringe, FRINGE_FACE_ID); - realize_named_face (f, Qheader_line, HEADER_LINE_FACE_ID); + realize_named_face (f, Qheader_line_active, HEADER_LINE_ACTIVE_FACE_ID); + realize_named_face (f, Qheader_line_inactive, HEADER_LINE_INACTIVE_FACE_ID); realize_named_face (f, Qscroll_bar, SCROLL_BAR_FACE_ID); realize_named_face (f, Qborder, BORDER_FACE_ID); realize_named_face (f, Qcursor, CURSOR_FACE_ID); @@ -5890,6 +5902,7 @@ realize_basic_faces (struct frame *f) realize_named_face (f, Qchild_frame_border, CHILD_FRAME_BORDER_FACE_ID); realize_named_face (f, Qtab_bar, TAB_BAR_FACE_ID); realize_named_face (f, Qtab_line, TAB_LINE_FACE_ID); + unbind_to (count, Qnil); /* Reflect changes in the `menu' face in menu bars. */ if (FRAME_FACE_CACHE (f)->menu_face_changed_p) @@ -7372,7 +7385,6 @@ syms_of_xfaces (void) DEFSYM (QCslant, ":slant"); DEFSYM (QCunderline, ":underline"); DEFSYM (QCinverse_video, ":inverse-video"); - DEFSYM (QCreverse_video, ":reverse-video"); DEFSYM (QCforeground, ":foreground"); DEFSYM (QCbackground, ":background"); DEFSYM (QCstipple, ":stipple"); @@ -7446,6 +7458,8 @@ syms_of_xfaces (void) DEFSYM (Qfringe, "fringe"); DEFSYM (Qtab_line, "tab-line"); DEFSYM (Qheader_line, "header-line"); + DEFSYM (Qheader_line_inactive, "header-line-inactive"); + DEFSYM (Qheader_line_active, "header-line-active"); DEFSYM (Qscroll_bar, "scroll-bar"); DEFSYM (Qmenu, "menu"); DEFSYM (Qcursor, "cursor"); diff --git a/src/xfns.c b/src/xfns.c index bcc8361cb65..b4d08bfc202 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1406,9 +1406,9 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (cursor_data.error_cursor >= 0) bad_cursor_name = mouse_cursor_types[cursor_data.error_cursor].name; if (bad_cursor_name) - error ("bad %s pointer cursor: %s", bad_cursor_name, xmessage); + error ("Bad %s pointer cursor: %s", bad_cursor_name, xmessage); else - error ("can't set cursor shape: %s", xmessage); + error ("Can't set cursor shape: %s", xmessage); } x_uncatch_errors_after_check (); @@ -7361,7 +7361,7 @@ that mouse buttons are being held down, such as immediately after a else signal_error ("Invalid drag-and-drop action", action); - target_atoms = SAFE_ALLOCA (ntargets * sizeof *target_atoms); + SAFE_NALLOCA (target_atoms, 1, ntargets); /* Catch errors since interning lots of targets can potentially generate a BadAlloc error. */ @@ -9854,7 +9854,7 @@ unless TYPE is `png'. */) XSETFRAME (frame, f); if (!FRAME_VISIBLE_P (f)) - error ("Frames to be exported must be visible."); + error ("Frames to be exported must be visible"); tmp = Fcons (frame, tmp); } frames = Fnreverse (tmp); @@ -9868,7 +9868,7 @@ unless TYPE is `png'. */) if (EQ (type, Qpng)) { if (!NILP (XCDR (frames))) - error ("PNG export cannot handle multiple frames."); + error ("PNG export cannot handle multiple frames"); surface_type = CAIRO_SURFACE_TYPE_IMAGE; } else @@ -9883,7 +9883,7 @@ unless TYPE is `png'. */) { /* For now, we stick to SVG 1.1. */ if (!NILP (XCDR (frames))) - error ("SVG export cannot handle multiple frames."); + error ("SVG export cannot handle multiple frames"); surface_type = CAIRO_SURFACE_TYPE_SVG; } else @@ -9957,16 +9957,13 @@ Note: Text drawn with the `x' font backend is shown with hollow boxes. */) XSETFRAME (frame, f); if (!FRAME_VISIBLE_P (f)) - error ("Frames to be printed must be visible."); + error ("Frames to be printed must be visible"); tmp = Fcons (frame, tmp); } frames = Fnreverse (tmp); /* Make sure the current matrices are up-to-date. */ - specpdl_ref count = SPECPDL_INDEX (); - specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (32); - unbind_to (count, Qnil); block_input (); xg_print_frames_dialog (frames); diff --git a/src/xfont.c b/src/xfont.c index 19dffb04374..d0062802314 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -487,9 +487,9 @@ xfont_list (struct frame *f, Lisp_Object spec) if (NILP (list) && NILP (registry)) { /* Try iso10646-1 */ - char *r = name + len - 9; /* 9 == strlen (iso8859-1) */ + char *r = name + len - (sizeof "iso8859-1" - 1); - if (r - name + 10 < 256) /* 10 == strlen (iso10646-1) */ + if (r - name + (sizeof "iso10646-1" - 1) < 256) { strcpy (r, "iso10646-1"); list = xfont_list_pattern (display, name, Qiso10646_1, script); diff --git a/src/xmenu.c b/src/xmenu.c index 3f09edb8c56..848ff6e21cf 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1902,10 +1902,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, USE_SAFE_ALLOCA; - submenu_stack = SAFE_ALLOCA (menu_items_used - * sizeof *submenu_stack); - subprefix_stack = SAFE_ALLOCA (menu_items_used - * sizeof *subprefix_stack); + SAFE_NALLOCA (submenu_stack, 1, menu_items_used); + SAFE_NALLOCA (subprefix_stack, 1, menu_items_used); specpdl_count = SPECPDL_INDEX (); diff --git a/src/xterm.c b/src/xterm.c index ac115c4ba1a..0692abbbb0b 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3099,27 +3099,19 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) #ifdef USE_XCB USE_SAFE_ALLOCA; - window_attribute_cookies - = SAFE_ALLOCA (sizeof *window_attribute_cookies * nitems); - translate_coordinate_cookies - = SAFE_ALLOCA (sizeof *translate_coordinate_cookies * nitems); - get_property_cookies - = SAFE_ALLOCA (sizeof *get_property_cookies * nitems); - xm_property_cookies - = SAFE_ALLOCA (sizeof *xm_property_cookies * nitems); - extent_property_cookies - = SAFE_ALLOCA (sizeof *extent_property_cookies * nitems); - get_geometry_cookies - = SAFE_ALLOCA (sizeof *get_geometry_cookies * nitems); + SAFE_NALLOCA (window_attribute_cookies, 1, nitems); + SAFE_NALLOCA (translate_coordinate_cookies, 1, nitems); + SAFE_NALLOCA (get_property_cookies, 1, nitems); + SAFE_NALLOCA (xm_property_cookies, 1, nitems); + SAFE_NALLOCA (extent_property_cookies, 1, nitems); + SAFE_NALLOCA (get_geometry_cookies, 1, nitems); #ifdef HAVE_XCB_SHAPE - bounding_rect_cookies - = SAFE_ALLOCA (sizeof *bounding_rect_cookies * nitems); + SAFE_NALLOCA (bounding_rect_cookies, 1, nitems); #endif #ifdef HAVE_XCB_SHAPE_INPUT_RECTS - input_rect_cookies - = SAFE_ALLOCA (sizeof *input_rect_cookies * nitems); + SAFE_NALLOCA (input_rect_cookies, 1, nitems); #endif for (i = 0; i < nitems; ++i) @@ -6377,7 +6369,6 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) Lisp_Object acc = Qnil; specpdl_ref count = SPECPDL_INDEX (); - specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (31); f = XFRAME (XCAR (frames)); @@ -15474,7 +15465,7 @@ xt_action_hook (Widget widget, XtPointer client_data, String action_name, if (scroll_bar_p && strcmp (action_name, end_action) == 0 - && WINDOWP (window_being_scrolled)) + && WINDOW_LIVE_P (window_being_scrolled)) { struct window *w; struct scroll_bar *bar; @@ -15593,7 +15584,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); - verify (INTPTR_WIDTH <= 64); + static_assert (INTPTR_WIDTH <= 64); /* Don't do anything if too many scroll bar events have been sent but not received. */ @@ -20410,8 +20401,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (overflow) { - copy_bufptr = SAFE_ALLOCA ((copy_bufsiz += overflow) - * sizeof *copy_bufptr); + copy_bufsiz += overflow; + copy_bufptr = SAFE_ALLOCA (copy_bufsiz); overflow = 0; /* Use the original keysym derived from the @@ -24325,9 +24316,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, &overflow); if (overflow) { - copy_bufptr - = SAFE_ALLOCA ((copy_bufsiz += overflow) - * sizeof *copy_bufptr); + copy_bufsiz += overflow; + copy_bufptr = SAFE_ALLOCA (copy_bufsiz); overflow = 0; /* Use the original keysym derived from @@ -24668,7 +24658,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, any_changed = false; #endif /* !USE_X_TOOLKIT && (!USE_GTK || HAVE_GTK3) */ hev = (XIHierarchyEvent *) xi_event; - disabled = SAFE_ALLOCA (sizeof *disabled * hev->num_info); + SAFE_NALLOCA (disabled, 1, hev->num_info); n_disabled = 0; for (i = 0; i < hev->num_info; ++i) @@ -31690,8 +31680,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) } #ifdef USE_XCB - selection_cookies = SAFE_ALLOCA (sizeof *selection_cookies - * num_fast_selections); + SAFE_NALLOCA (selection_cookies, 1, num_fast_selections); #endif /* Now, ask for the current owners of all those selections. */ |