diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Makefile.in | 79 | ||||
| -rw-r--r-- | src/alloc.c | 46 | ||||
| -rw-r--r-- | src/atimer.c | 42 | ||||
| -rw-r--r-- | src/bidi.c | 29 | ||||
| -rw-r--r-- | src/buffer.c | 83 | ||||
| -rw-r--r-- | src/buffer.h | 11 | ||||
| -rw-r--r-- | src/callint.c | 10 | ||||
| -rw-r--r-- | src/callproc.c | 2 | ||||
| -rw-r--r-- | src/casefiddle.c | 57 | ||||
| -rw-r--r-- | src/character.h | 2 | ||||
| -rw-r--r-- | src/cmds.c | 2 | ||||
| -rw-r--r-- | src/coding.c | 47 | ||||
| -rw-r--r-- | src/comp.c | 369 | ||||
| -rw-r--r-- | src/composite.c | 55 | ||||
| -rw-r--r-- | src/composite.h | 4 | ||||
| -rw-r--r-- | src/conf_post.h | 1 | ||||
| -rw-r--r-- | src/data.c | 4 | ||||
| -rw-r--r-- | src/dispextern.h | 18 | ||||
| -rw-r--r-- | src/dispnew.c | 21 | ||||
| -rw-r--r-- | src/editfns.c | 7 | ||||
| -rw-r--r-- | src/emacs-module.h.in | 13 | ||||
| -rw-r--r-- | src/emacs.c | 50 | ||||
| -rw-r--r-- | src/eval.c | 97 | ||||
| -rw-r--r-- | src/fileio.c | 8 | ||||
| -rw-r--r-- | src/fns.c | 24 | ||||
| -rw-r--r-- | src/font.c | 155 | ||||
| -rw-r--r-- | src/font.h | 2 | ||||
| -rw-r--r-- | src/fontset.c | 6 | ||||
| -rw-r--r-- | src/frame.c | 45 | ||||
| -rw-r--r-- | src/frame.h | 4 | ||||
| -rw-r--r-- | src/fringe.c | 10 | ||||
| -rw-r--r-- | src/gtkutil.c | 51 | ||||
| -rw-r--r-- | src/image.c | 466 | ||||
| -rw-r--r-- | src/insdel.c | 9 | ||||
| -rw-r--r-- | src/intervals.c | 20 | ||||
| -rw-r--r-- | src/keyboard.c | 303 | ||||
| -rw-r--r-- | src/keyboard.h | 2 | ||||
| -rw-r--r-- | src/keymap.c | 278 | ||||
| -rw-r--r-- | src/lisp.h | 76 | ||||
| -rw-r--r-- | src/lread.c | 187 | ||||
| -rw-r--r-- | src/macfont.m | 44 | ||||
| -rw-r--r-- | src/menu.c | 23 | ||||
| -rw-r--r-- | src/minibuf.c | 151 | ||||
| -rw-r--r-- | src/module-env-28.h | 4 | ||||
| -rw-r--r-- | src/module-env-29.h | 3 | ||||
| -rw-r--r-- | src/msdos.c | 2 | ||||
| -rw-r--r-- | src/nsfns.m | 80 | ||||
| -rw-r--r-- | src/nsfont.m | 1215 | ||||
| -rw-r--r-- | src/nsimage.m | 49 | ||||
| -rw-r--r-- | src/nsmenu.m | 122 | ||||
| -rw-r--r-- | src/nsterm.h | 102 | ||||
| -rw-r--r-- | src/nsterm.m | 1990 | ||||
| -rw-r--r-- | src/pdumper.c | 53 | ||||
| -rw-r--r-- | src/pdumper.h | 5 | ||||
| -rw-r--r-- | src/print.c | 30 | ||||
| -rw-r--r-- | src/process.c | 63 | ||||
| -rw-r--r-- | src/regex-emacs.c | 4 | ||||
| -rw-r--r-- | src/search.c | 101 | ||||
| -rw-r--r-- | src/syntax.c | 10 | ||||
| -rw-r--r-- | src/sysstdio.h | 2 | ||||
| -rw-r--r-- | src/systhread.h | 13 | ||||
| -rw-r--r-- | src/term.c | 35 | ||||
| -rw-r--r-- | src/termchar.h | 4 | ||||
| -rw-r--r-- | src/termhooks.h | 2 | ||||
| -rw-r--r-- | src/timefns.c | 5 | ||||
| -rw-r--r-- | src/unexcw.c | 6 | ||||
| -rw-r--r-- | src/verbose.mk.in | 4 | ||||
| -rw-r--r-- | src/vm-limit.c | 2 | ||||
| -rw-r--r-- | src/w16select.c | 2 | ||||
| -rw-r--r-- | src/w32.c | 69 | ||||
| -rw-r--r-- | src/w32.h | 9 | ||||
| -rw-r--r-- | src/w32fns.c | 148 | ||||
| -rw-r--r-- | src/w32font.c | 4 | ||||
| -rw-r--r-- | src/w32heap.c | 42 | ||||
| -rw-r--r-- | src/w32inevt.c | 6 | ||||
| -rw-r--r-- | src/w32proc.c | 10 | ||||
| -rw-r--r-- | src/w32term.c | 79 | ||||
| -rw-r--r-- | src/window.c | 68 | ||||
| -rw-r--r-- | src/xdisp.c | 604 | ||||
| -rw-r--r-- | src/xfaces.c | 24 | ||||
| -rw-r--r-- | src/xfns.c | 17 | ||||
| -rw-r--r-- | src/xmenu.c | 8 | ||||
| -rw-r--r-- | src/xterm.c | 259 | ||||
| -rw-r--r-- | src/xterm.h | 1 | ||||
| -rw-r--r-- | src/xwidget.c | 1492 | ||||
| -rw-r--r-- | src/xwidget.h | 29 |
86 files changed, 6720 insertions, 2970 deletions
diff --git a/src/Makefile.in b/src/Makefile.in index 8c28e825da2..d646001ccea 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -55,6 +55,8 @@ lwlibdir = ../lwlib # Configuration files for .o files to depend on. config_h = config.h $(srcdir)/conf_post.h +HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@ + ## ns-app if NS self contained app, else empty. OTHER_FILES = @OTHER_FILES@ @@ -122,7 +124,7 @@ LIB_MATH=@LIB_MATH@ ## -lpthread, or empty. LIB_PTHREAD=@LIB_PTHREAD@ -LIBIMAGE=@LIBTIFF@ @LIBJPEG@ @LIBPNG@ @LIBGIF@ @LIBXPM@ +LIBIMAGE=@LIBTIFF@ @LIBJPEG@ @LIBPNG@ @LIBGIF@ @LIBXPM@ @WEBP_LIBS@ XCB_LIBS=@XCB_LIBS@ XFT_LIBS=@XFT_LIBS@ @@ -221,6 +223,8 @@ CFLAGS_SOUND= @CFLAGS_SOUND@ RSVG_LIBS= @RSVG_LIBS@ RSVG_CFLAGS= @RSVG_CFLAGS@ +WEBP_CFLAGS= @WEBP_CFLAGS@ + WEBKIT_LIBS= @WEBKIT_LIBS@ WEBKIT_CFLAGS= @WEBKIT_CFLAGS@ @@ -329,7 +333,8 @@ GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ LIBGMP = @LIBGMP@ -LIBGCCJIT = @LIBGCCJIT_LIB@ +LIBGCCJIT_LIBS = @LIBGCCJIT_LIBS@ +LIBGCCJIT_CFLAGS = @LIBGCCJIT_CFLAGS@ ## dynlib.o if necessary, else empty DYNLIB_OBJ = @DYNLIB_OBJ@ @@ -370,9 +375,9 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ -I$(lib) -I$(top_srcdir)/lib \ $(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \ $(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \ - $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \ + $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(LIBGCCJIT_CFLAGS) $(DBUS_CFLAGS) \ $(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) $(XDBE_CFLAGS) \ - $(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \ + $(WEBKIT_CFLAGS) $(WEBP_CFLAGS) $(LCMS2_CFLAGS) \ $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ $(HARFBUZZ_CFLAGS) $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) \ @@ -451,6 +456,9 @@ ALLOBJS = $(FIRSTFILE_OBJ) $(VMLIMIT_OBJ) $(obj) $(otherobj) # Must be first, before dep inclusion! all: emacs$(EXEEXT) $(pdmp) $(OTHER_FILES) +ifeq ($(HAVE_NATIVE_COMP):$(NATIVE_DISABLED),yes:) +all: ../native-lisp +endif .PHONY: all dmpstruct_headers=$(srcdir)/lisp.h $(srcdir)/buffer.h \ @@ -519,7 +527,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(PGTK_LIBS) $(LIBX_BASE) $(LIBIMAGE $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \ - $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT) + $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) ## FORCE it so that admin/unidata can decide whether this file is ## up-to-date. Although since charprop depends on bootstrap-emacs, @@ -547,7 +555,13 @@ charscript = ${lispintdir}/charscript.el ${charscript}: FORCE $(MAKE) -C ../admin/unidata $(notdir $@) -${lispintdir}/characters.elc: ${charscript:.el=.elc} +emoji-zwj = ${lispintdir}/emoji-zwj.el +${emoji-zwj}: FORCE + $(MAKE) -C ../admin/unidata $(notdir $@) + +${lispintdir}/characters.elc: ${charscript:.el=.elc} ${emoji-zwj:.el=.elc} + +SYSTEM_TYPE = @SYSTEM_TYPE@ ## The dumped Emacs is as functional and more efficient than ## bootstrap-emacs, so we replace the latter with the former. @@ -557,6 +571,9 @@ ${lispintdir}/characters.elc: ${charscript:.el=.elc} emacs$(EXEEXT): temacs$(EXEEXT) \ lisp.mk $(etc)/DOC $(lisp) \ $(lispsource)/international/charprop.el ${charsets} +ifeq ($(SYSTEM_TYPE),cygwin) + find ${top_builddir} -name '*.eln' | rebase -v -O -T - +endif ifeq ($(DUMPING),unexec) LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=dump ifneq ($(PAXCTL_dumped),) @@ -631,7 +648,7 @@ endif ## This goes on to affect various things, and the emacs binary fails ## to start if Vinstallation_directory has the wrong value. temacs$(EXEEXT): $(LIBXMENU) $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(EMACSRES) \ - $(charsets) $(charscript) $(MAKE_PDUMPER_FINGERPRINT) + $(charsets) $(charscript) ${emoji-zwj} $(MAKE_PDUMPER_FINGERPRINT) $(AM_V_CCLD)$(CC) -o $@.tmp \ $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \ $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES) @@ -768,6 +785,51 @@ tags: TAGS ../lisp/TAGS $(lwlibdir)/TAGS @$(MAKE) $(AM_V_NO_PD) -C ../lisp EMACS="$(bootstrap_exe)"\ THEFILE=$< $<c +ifeq ($(HAVE_NATIVE_COMP):$(NATIVE_DISABLED),yes:) +## The following rules are used only when building a source tarball +## for the first time, when the native-lisp/ directory doesn't yet +## exist and needs to be created and populated with the preloaded +## *.eln files. + +## List of *.eln files we need to produce in addition to the preloaded +## ones in $(lisp). +elnlisp := \ + emacs-lisp/autoload.eln \ + emacs-lisp/byte-opt.eln \ + emacs-lisp/bytecomp.eln \ + emacs-lisp/cconv.eln \ + international/charscript.eln \ + emacs-lisp/comp.eln \ + emacs-lisp/comp-cstr.eln \ + international/emoji-zwj.eln +elnlisp := $(addprefix ${lispsource}/,${elnlisp}) $(lisp:.elc=.eln) + +%.eln: %.el | emacs$(EXEEXT) $(pdmp) + @$(MAKE) $(AM_V_NO_PD) -C ../lisp EMACS="../src/emacs$(EXEEXT)"\ + THEFILE=$< $<n + +## FIXME: this is fragile! We lie to Make about the files produced by +## this rule, and we rely on the absence of the native-lisp directory +## to trigger it. This means that if anything goes wrong during +## native compilation, the only way to trigger it again is to remove +## the directory and re-native-compile everything. The main +## underlying problem is that the name of the subdirectory of +## native-lisp where the *.eln files will be produced, and the exact +## names of those *.eln files, cannot be known in advance; we must ask +## Emacs to produce them. +../native-lisp: | $(pdmp) + @if test ! -d $@; then \ + mkdir $@ && $(MAKE) $(AM_V_NO_PD) $(elnlisp); \ + if test $(SYSTEM_TYPE) = cygwin; then \ + 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) \ + && cp -f emacs$(EXEEXT) bootstrap-emacs$(EXEEXT) \ + && cp -f $(pdmp) $(bootstrap_pdmp); \ + fi +endif + ## VCSWITNESS points to the file that holds info about the current checkout. ## We use it as a heuristic to decide when to rebuild loaddefs.el. ## If empty it is ignored; the parent makefile can set it to some other value. @@ -793,6 +855,9 @@ ifeq ($(DUMPING),unexec) else @: In the pdumper case, make compile-first after the dump cp -f temacs$(EXEEXT) bootstrap-emacs$(EXEEXT) +ifeq ($(DO_CODESIGN),yes) + codesign -s - -f bootstrap-emacs$(EXEEXT) +endif endif ifeq ($(DUMPING),pdumper) diff --git a/src/alloc.c b/src/alloc.c index ff3670eeb1d..2d25f8205ae 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -765,7 +765,7 @@ xmalloc (size_t size) val = lmalloc (size, false); MALLOC_UNBLOCK_INPUT; - if (!val && size) + if (!val) memory_full (size); MALLOC_PROBE (size); return val; @@ -782,7 +782,7 @@ xzalloc (size_t size) val = lmalloc (size, true); MALLOC_UNBLOCK_INPUT; - if (!val && size) + if (!val) memory_full (size); MALLOC_PROBE (size); return val; @@ -796,15 +796,15 @@ xrealloc (void *block, size_t size) void *val; MALLOC_BLOCK_INPUT; - /* We must call malloc explicitly when BLOCK is 0, since some - reallocs don't do this. */ + /* Call lmalloc when BLOCK is null, for the benefit of long-obsolete + platforms lacking support for realloc (NULL, size). */ if (! block) val = lmalloc (size, false); else val = lrealloc (block, size); MALLOC_UNBLOCK_INPUT; - if (!val && size) + if (!val) memory_full (size); MALLOC_PROBE (size); return val; @@ -1030,7 +1030,7 @@ lisp_malloc (size_t nbytes, bool clearit, enum mem_type type) #endif MALLOC_UNBLOCK_INPUT; - if (!val && nbytes) + if (!val) memory_full (nbytes); MALLOC_PROBE (nbytes); return val; @@ -1329,16 +1329,20 @@ laligned (void *p, size_t size) || size % LISP_ALIGNMENT != 0); } -/* Like malloc and realloc except that if SIZE is Lisp-aligned, make - sure the result is too, if necessary by reallocating (typically - with larger and larger sizes) until the allocator returns a - Lisp-aligned pointer. Code that needs to allocate C heap memory +/* Like malloc and realloc except return null only on failure, + the result is Lisp-aligned if SIZE is, and lrealloc's pointer + argument must be nonnull. Code allocating C heap memory for a Lisp object should use one of these functions to obtain a pointer P; that way, if T is an enum Lisp_Type value and L == make_lisp_ptr (P, T), then XPNTR (L) == P and XTYPE (L) == T. + If CLEARIT, arrange for the allocated memory to be cleared. + This might use calloc, as calloc can be faster than malloc+memset. + On typical modern platforms these functions' loops do not iterate. - On now-rare (and perhaps nonexistent) platforms, the loops in + On now-rare (and perhaps nonexistent) platforms, the code can loop, + reallocating (typically with larger and larger sizes) until the + allocator returns a Lisp-aligned pointer. This loop in theory could repeat forever. If an infinite loop is possible on a platform, a build would surely loop and the builder can then send us a bug report. Adding a counter to try to detect any such loop @@ -1352,8 +1356,13 @@ lmalloc (size_t size, bool clearit) if (! MALLOC_IS_LISP_ALIGNED && size % LISP_ALIGNMENT == 0) { void *p = aligned_alloc (LISP_ALIGNMENT, size); - if (clearit && p) - memclear (p, size); + if (p) + { + if (clearit) + memclear (p, size); + } + else if (! (MALLOC_0_IS_NONNULL || size)) + return aligned_alloc (LISP_ALIGNMENT, LISP_ALIGNMENT); return p; } #endif @@ -1361,7 +1370,7 @@ lmalloc (size_t size, bool clearit) while (true) { void *p = clearit ? calloc (1, size) : malloc (size); - if (laligned (p, size)) + if (laligned (p, size) && (MALLOC_0_IS_NONNULL || size || p)) return p; free (p); size_t bigger = size + LISP_ALIGNMENT; @@ -1376,7 +1385,7 @@ lrealloc (void *p, size_t size) while (true) { p = realloc (p, size); - if (laligned (p, size)) + if (laligned (p, size) && (size || p)) return p; size_t bigger = size + LISP_ALIGNMENT; if (size < bigger) @@ -1929,8 +1938,7 @@ allocate_string_data (struct Lisp_String *s, The character is at byte offset CIDX_BYTE in the string. The character being replaced is CLEN bytes long, and the character that will replace it is NEW_CLEN bytes long. - Return the address of where the caller should store the - the new character. */ + Return the address where the caller should store the new character. */ unsigned char * resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte, @@ -7321,7 +7329,7 @@ Frames, windows, buffers, and subprocesses count as vectors make_int (strings_consed)); } -#ifdef GNU_LINUX +#if defined GNU_LINUX && defined __GLIBC__ DEFUN ("malloc-info", Fmalloc_info, Smalloc_info, 0, 0, "", doc: /* Report malloc information to stderr. This function outputs to stderr an XML-formatted @@ -7681,7 +7689,7 @@ N should be nonnegative. */); defsubr (&Sgarbage_collect_maybe); defsubr (&Smemory_info); defsubr (&Smemory_use_counts); -#ifdef GNU_LINUX +#if defined GNU_LINUX && defined __GLIBC__ defsubr (&Smalloc_info); #endif defsubr (&Ssuspicious_object); diff --git a/src/atimer.c b/src/atimer.c index d12eb4ad1ea..197b504bf51 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -305,20 +305,25 @@ set_alarm (void) #ifdef HAVE_ITIMERSPEC if (0 <= timerfd || alarm_timer_ok) { + bool exit = false; struct itimerspec ispec; ispec.it_value = atimers->expiration; ispec.it_interval.tv_sec = ispec.it_interval.tv_nsec = 0; # ifdef HAVE_TIMERFD - if (timerfd >= 0) { - if (timerfd_settime (timerfd, TFD_TIMER_ABSTIME, &ispec, 0) == 0) - { - add_timer_wait_descriptor (timerfd); - return; - } - } + if (timerfd >= 0) + { + if (timerfd_settime (timerfd, TFD_TIMER_ABSTIME, &ispec, 0) == 0) + { + add_timer_wait_descriptor (timerfd); + exit = true; + } + } # endif if (alarm_timer_ok && timer_settime (alarm_timer, TIMER_ABSTIME, &ispec, 0) == 0) + exit = true; + + if (exit) return; } #endif @@ -335,9 +340,8 @@ set_alarm (void) memset (&it, 0, sizeof it); it.it_value = make_timeval (interval); setitimer (ITIMER_REAL, &it, 0); -#else /* not HAVE_SETITIMER */ - alarm (max (interval.tv_sec, 1)); #endif /* not HAVE_SETITIMER */ + alarm (max (interval.tv_sec, 1)); } } @@ -589,15 +593,17 @@ init_atimer (void) timerfd = (egetenv ("EMACS_IGNORE_TIMERFD") || have_buggy_timerfd () ? -1 : timerfd_create (CLOCK_REALTIME, TFD_NONBLOCK | TFD_CLOEXEC)); # endif - if (timerfd < 0) - { - struct sigevent sigev; - sigev.sigev_notify = SIGEV_SIGNAL; - sigev.sigev_signo = SIGALRM; - sigev.sigev_value.sival_ptr = &alarm_timer; - alarm_timer_ok - = timer_create (CLOCK_REALTIME, &sigev, &alarm_timer) == 0; - } + /* We're starting the alarms even if we have timerfd, because + timerfd events do not fire while Emacs Lisp is busy and doesn't + call thread_select. This might or might not mean that the + timerfd code doesn't really give us anything and should be + removed, see discussion in bug#19776. */ + struct sigevent sigev; + sigev.sigev_notify = SIGEV_SIGNAL; + sigev.sigev_signo = SIGALRM; + sigev.sigev_value.sival_ptr = &alarm_timer; + alarm_timer_ok + = timer_create (CLOCK_REALTIME, &sigev, &alarm_timer) == 0; #endif free_atimers = stopped_atimers = atimers = NULL; diff --git a/src/bidi.c b/src/bidi.c index 1413ba6b888..890a60acc43 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -3564,11 +3564,19 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it) } /* Utility function for looking for strong directional characters - whose bidi type was overridden by a directional override. */ + whose bidi type was overridden by directional override or embedding + or isolate control characters. */ ptrdiff_t bidi_find_first_overridden (struct bidi_it *bidi_it) { ptrdiff_t found_pos = ZV; + /* Maximum bidi levels we allow for L2R and R2L characters. Note + that these are levels after resolving explicit embeddings, + overrides, and isolates, i.e. before resolving implicit levels. */ + int max_l2r = bidi_it->paragraph_dir == L2R ? 0 : 2; + int max_r2l = 1; + /* Same for WEAK and NEUTRAL_ON types. */ + int max_weak = bidi_it->paragraph_dir == L2R ? 1 : 2; do { @@ -3576,11 +3584,28 @@ bidi_find_first_overridden (struct bidi_it *bidi_it) because the directional overrides are applied by the former. */ bidi_type_t type = bidi_resolve_weak (bidi_it); + unsigned level = bidi_it->level_stack[bidi_it->stack_idx].level; + bidi_category_t category = bidi_get_category (bidi_it->orig_type); + /* Detect strong L or R types that have been overridden by + explicit overrides. */ if ((type == STRONG_R && bidi_it->orig_type == STRONG_L) || (type == STRONG_L && (bidi_it->orig_type == STRONG_R - || bidi_it->orig_type == STRONG_AL))) + || bidi_it->orig_type == STRONG_AL)) + /* Detect strong L or R types or WEAK_EN types that were + pushed into higher embedding levels (and will thus + reorder) by explicit embeddings and isolates. */ + || ((bidi_it->orig_type == STRONG_L + || bidi_it->orig_type == WEAK_EN) + && level > max_l2r) + || ((bidi_it->orig_type == STRONG_R + || bidi_it->orig_type == STRONG_AL) + && level > max_r2l) + /* Detect other weak or neutral types whose level was + tweaked by explicit embeddings and isolates. */ + || ((category == WEAK || bidi_it->orig_type == NEUTRAL_ON) + && level > max_weak)) found_pos = bidi_it->charpos; } while (found_pos == ZV && bidi_it->charpos < ZV diff --git a/src/buffer.c b/src/buffer.c index b177c5eaa7f..9d8892a797a 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1434,7 +1434,7 @@ and `buffer-file-truename' are non-nil. */) DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p, Srestore_buffer_modified_p, 1, 1, 0, doc: /* Like `set-buffer-modified-p', but doesn't redisplay buffer's mode line. -This function also locks and unlocks the file visited by the buffer, +This function also locks or unlocks the file visited by the buffer, if both `buffer-file-truename' and `buffer-file-name' are non-nil. It is not ensured that mode lines will be updated to show the modified @@ -1768,6 +1768,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) /* Run hooks with the buffer to be killed as the current buffer. */ { ptrdiff_t count = SPECPDL_INDEX (); + bool modified; record_unwind_protect_excursion (); set_buffer_internal (b); @@ -1782,9 +1783,12 @@ cleaning up all windows currently displaying the buffer to be killed. */) return unbind_to (count, Qnil); } + /* Is this a modified buffer that's visiting a file? */ + modified = !NILP (BVAR (b, filename)) + && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b); + /* Query if the buffer is still modified. */ - if (INTERACTIVE && !NILP (BVAR (b, filename)) - && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) + if (INTERACTIVE && modified) { AUTO_STRING (format, "Buffer %s modified; kill anyway? "); tem = do_yes_or_no_p (CALLN (Fformat, format, BVAR (b, name))); @@ -1792,6 +1796,23 @@ cleaning up all windows currently displaying the buffer to be killed. */) return unbind_to (count, Qnil); } + /* Delete the autosave file, if requested. */ + if (modified + && kill_buffer_delete_auto_save_files + && delete_auto_save_files + && !NILP (Frecent_auto_save_p ()) + && STRINGP (BVAR (b, auto_save_file_name)) + && !NILP (Ffile_exists_p (BVAR (b, auto_save_file_name))) + /* If `auto-save-visited-mode' is on, then we're auto-saving + to the visited file -- don't delete it.. */ + && NILP (Fstring_equal (BVAR (b, auto_save_file_name), + BVAR (b, filename)))) + { + tem = do_yes_or_no_p (build_string ("Delete auto-save file? ")); + if (!NILP (tem)) + call0 (intern ("delete-auto-save-file-if-necessary")); + } + /* If the hooks have killed the buffer, exit now. */ if (!BUFFER_LIVE_P (b)) return unbind_to (count, Qt); @@ -1888,24 +1909,6 @@ cleaning up all windows currently displaying the buffer to be killed. */) replace_buffer_in_windows_safely (buffer); Vinhibit_quit = tem; - /* Delete any auto-save file, if we saved it in this session. - But not if the buffer is modified. */ - if (STRINGP (BVAR (b, auto_save_file_name)) - && BUF_AUTOSAVE_MODIFF (b) != 0 - && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b) - && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) - && NILP (Fsymbol_value (intern ("auto-save-visited-file-name")))) - { - Lisp_Object delete; - delete = Fsymbol_value (intern ("delete-auto-save-files")); - if (! NILP (delete)) - internal_delete_file (BVAR (b, auto_save_file_name)); - } - - /* Deleting an auto-save file could have killed our buffer. */ - if (!BUFFER_LIVE_P (b)) - return Qt; - if (b->base_buffer) { INTERVAL i; @@ -2802,7 +2805,7 @@ current buffer is cleared. */) } DEFUN ("kill-all-local-variables", Fkill_all_local_variables, - Skill_all_local_variables, 0, 0, 0, + Skill_all_local_variables, 0, 1, 0, doc: /* Switch to Fundamental mode by killing current buffer's local variables. Most local variable bindings are eliminated so that the default values become effective once more. Also, the syntax table is set from @@ -2813,18 +2816,20 @@ This function also forces redisplay of the mode line. Every function to select a new major mode starts by calling this function. -As a special exception, local variables whose names have -a non-nil `permanent-local' property are not eliminated by this function. +As a special exception, local variables whose names have a non-nil +`permanent-local' property are not eliminated by this function. If +the optional KILL-PERMANENT argument is non-nil, clear out these local +variables, too. The first thing this function does is run the normal hook `change-major-mode-hook'. */) - (void) + (Lisp_Object kill_permanent) { run_hook (Qchange_major_mode_hook); /* Actually eliminate all local bindings of this buffer. */ - reset_buffer_local_variables (current_buffer, 0); + reset_buffer_local_variables (current_buffer, !NILP (kill_permanent)); /* Force mode-line redisplay. Useful here because all major mode commands call this function. */ @@ -2995,7 +3000,7 @@ overlays_in (EMACS_INT beg, EMACS_INT end, bool extend, ptrdiff_t next = ZV; ptrdiff_t prev = BEGV; bool inhibit_storing = 0; - bool end_is_Z = end == Z; + bool end_is_Z = end == ZV; for (struct Lisp_Overlay *tail = current_buffer->overlays_before; tail; tail = tail->next) @@ -3840,7 +3845,9 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos) or the found one ends before PREV, or the found one is the last one in the list, we don't have to fix anything. */ - if (!tail || end < prev || !tail->next) + if (!tail) + return; + if (end < prev || !tail->next) return; right_pair = parent; @@ -4268,9 +4275,10 @@ DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0, doc: /* Return a list of the overlays that overlap the region BEG ... END. Overlap means that at least one character is contained within the overlay and also contained within the specified region. + Empty overlays are included in the result if they are located at BEG, between BEG and END, or at END provided END denotes the position at the -end of the buffer. */) +end of the accessible part of the buffer. */) (Lisp_Object beg, Lisp_Object end) { ptrdiff_t len, noverlays; @@ -5801,7 +5809,10 @@ Note that this is overridden by the variable `truncate-partial-width-windows' if that variable is non-nil and this buffer is not full-frame width. -Minibuffers set this variable to nil. */); +Minibuffers set this variable to nil. + +Don't set this to a non-nil value when `visual-line-mode' is +turned on, as it could produce confusing results. */); DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil, doc: /* Non-nil means to use word-wrapping for continuation lines. @@ -6365,6 +6376,18 @@ nil NORECORD argument since it may lead to infinite recursion. */); Vbuffer_list_update_hook = Qnil; DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook"); + DEFVAR_BOOL ("kill-buffer-delete-auto-save-files", + kill_buffer_delete_auto_save_files, + doc: /* If non-nil, offer to delete any autosave file when killing a buffer. + +If `delete-auto-save-files' is nil, any autosave deletion is inhibited. */); + kill_buffer_delete_auto_save_files = 0; + + DEFVAR_BOOL ("delete-auto-save-files", delete_auto_save_files, + doc: /* Non-nil means delete auto-save file when a buffer is saved. +This is the default. If nil, auto-save file deletion is inhibited. */); + delete_auto_save_files = 1; + defsubr (&Sbuffer_live_p); defsubr (&Sbuffer_list); defsubr (&Sget_buffer); diff --git a/src/buffer.h b/src/buffer.h index 24e9c3fcbc8..8623bed08e6 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -60,6 +60,14 @@ enum { BEG = 1, BEG_BYTE = BEG }; /* Macros for the addresses of places in the buffer. */ +/* WARNING: Use the 'char *' pointers to buffer text with care in code + that could GC: GC can relocate buffer text, invalidating such + pointers. It is best to use character or byte position instead, + delaying the access through BYTE_POS_ADDR etc. pointers to the + latest possible moment. If you must use the 'char *' pointers + (e.g., for speed), be sure to adjust them after any call that could + potentially GC. */ + /* Address of beginning of buffer. */ #define BEG_ADDR (current_buffer->text->beg) @@ -1002,6 +1010,9 @@ SET_BUF_PT_BOTH (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t byte) or convert between a byte position and an address. These functions do not check that the position is in range. */ +/* See the important WARNING above about using the 'char *' pointers + returned by these functions. */ + /* Return the address of byte position N in current buffer. */ INLINE unsigned char * diff --git a/src/callint.c b/src/callint.c index 6f8a7f13f61..44dae361c1f 100644 --- a/src/callint.c +++ b/src/callint.c @@ -606,7 +606,7 @@ invoke it (via an `interactive' spec that contains, for instance, an break; case 'e': /* The invoking event. */ - if (next_event >= key_count) + if (!inhibit_mouse_event_check && next_event >= key_count) error ("%s must be bound to an event with parameters", (SYMBOLP (function) ? SSDATA (SYMBOL_NAME (function)) @@ -900,6 +900,14 @@ Its purpose is to give temporary modes such as Isearch mode a way to turn themselves off when a mouse command switches windows. */); Vmouse_leave_buffer_hook = Qnil; + DEFVAR_BOOL ("inhibit-mouse-event-check", inhibit_mouse_event_check, + doc: /* Whether the interactive spec "e" requires a mouse gesture event. +If non-nil, `(interactive "e")' doesn't signal an error when the command +was invoked by an input event that is not a mouse gesture: a click, a drag, +etc. To create the event data when the input was some other event, +use `event-start', `event-end', and `event-click-count'. */); + inhibit_mouse_event_check = false; + defsubr (&Sinteractive); defsubr (&Scall_interactively); defsubr (&Sfuncall_interactively); diff --git a/src/callproc.c b/src/callproc.c index 675b78daf3e..fa43f973844 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -232,6 +232,8 @@ directory where the process is run (see below). If you want to make the input come from an Emacs buffer, use `call-process-region' instead. Third argument DESTINATION specifies how to handle program's output. +(\"Output\" here means both standard output and standard error +output.) If DESTINATION is a buffer, or t that stands for the current buffer, it means insert output in that buffer before point. If DESTINATION is nil, it means discard output; 0 means discard diff --git a/src/casefiddle.c b/src/casefiddle.c index a7a25414909..81e9ed153fb 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -54,6 +54,9 @@ struct casing_context /* Whether the context is within a word. */ bool inword; + + /* What the last operation was. */ + bool downcase_last; }; /* Initialize CTX structure for casing characters. */ @@ -143,10 +146,14 @@ case_character_impl (struct casing_str_buf *buf, /* Handle simple, one-to-one case. */ if (flag == CASE_DOWN) - cased = downcase (ch); + { + cased = downcase (ch); + ctx->downcase_last = true; + } else { bool cased_is_set = false; + ctx->downcase_last = false; if (!NILP (ctx->titlecase_char_table)) { prop = CHAR_TABLE_REF (ctx->titlecase_char_table, ch); @@ -297,6 +304,16 @@ do_casify_multibyte_string (struct casing_context *ctx, Lisp_Object obj) return obj; } +static int +ascii_casify_character (bool downcase, int c) +{ + Lisp_Object cased = CHAR_TABLE_REF (downcase? + uniprop_table (Qlowercase) : + uniprop_table (Quppercase), + c); + return FIXNATP (cased) ? XFIXNAT (cased) : c; +} + static Lisp_Object do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj) { @@ -310,11 +327,12 @@ do_casify_unibyte_string (struct casing_context *ctx, Lisp_Object obj) cased = case_single_character (ctx, ch); if (ch == cased) continue; - cased = make_char_unibyte (cased); - /* If the char can't be converted to a valid byte, just don't - change it. */ - if (SINGLE_BYTE_CHAR_P (cased)) - SSET (obj, i, cased); + /* If down/upcasing changed an ASCII character into a non-ASCII + character (this can happen in some locales, like the Turkish + "I"), downcase using the ASCII char table. */ + if (ASCII_CHAR_P (ch) && !SINGLE_BYTE_CHAR_P (cased)) + cased = ascii_casify_character (ctx->downcase_last, ch); + SSET (obj, i, make_char_unibyte (cased)); } return obj; } @@ -339,10 +357,13 @@ casify_object (enum case_action flag, Lisp_Object obj) DEFUN ("upcase", Fupcase, Supcase, 1, 1, 0, doc: /* Convert argument to upper case and return that. -The argument may be a character or string. The result has the same type. +The argument may be a character or string. The result has the same +type. (See `downcase' for further details about the type.) + The argument object is not altered--the value is a copy. If argument is a character, characters which map to multiple code points when cased, e.g. fi, are returned unchanged. + See also `capitalize', `downcase' and `upcase-initials'. */) (Lisp_Object obj) { @@ -351,7 +372,15 @@ See also `capitalize', `downcase' and `upcase-initials'. */) DEFUN ("downcase", Fdowncase, Sdowncase, 1, 1, 0, doc: /* Convert argument to lower case and return that. -The argument may be a character or string. The result has the same type. +The argument may be a character or string. The result has the same type, +including the multibyteness of the string. + +This means that if this function is called with a unibyte string +argument, and downcasing it would turn it into a multibyte string +(according to the current locale), the downcasing is done using ASCII +\"C\" rules instead. To accurately downcase according to the current +locale, the string must be converted into multibyte first. + The argument object is not altered--the value is a copy. */) (Lisp_Object obj) { @@ -362,7 +391,10 @@ DEFUN ("capitalize", Fcapitalize, Scapitalize, 1, 1, 0, doc: /* Convert argument to capitalized form and return that. This means that each word's first character is converted to either title case or upper case, and the rest to lower case. -The argument may be a character or string. The result has the same type. + +The argument may be a character or string. The result has the same +type. (See `downcase' for further details about the type.) + The argument object is not altered--the value is a copy. If argument is a character, characters which map to multiple code points when cased, e.g. fi, are returned unchanged. */) @@ -377,7 +409,10 @@ DEFUN ("upcase-initials", Fupcase_initials, Supcase_initials, 1, 1, 0, doc: /* Convert the initial of each word in the argument to upper case. This means that each word's first character is converted to either title case or upper case, and the rest are left unchanged. -The argument may be a character or string. The result has the same type. + +The argument may be a character or string. The result has the same +type. (See `downcase' for further details about the type.) + The argument object is not altered--the value is a copy. If argument is a character, characters which map to multiple code points when cased, e.g. fi, are returned unchanged. */) @@ -651,6 +686,8 @@ syms_of_casefiddle (void) DEFSYM (Qbounds, "bounds"); DEFSYM (Qidentity, "identity"); DEFSYM (Qtitlecase, "titlecase"); + DEFSYM (Qlowercase, "lowercase"); + DEFSYM (Quppercase, "uppercase"); DEFSYM (Qspecial_uppercase, "special-uppercase"); DEFSYM (Qspecial_lowercase, "special-lowercase"); DEFSYM (Qspecial_titlecase, "special-titlecase"); diff --git a/src/character.h b/src/character.h index 1a745484daa..6ee6bcab205 100644 --- a/src/character.h +++ b/src/character.h @@ -82,6 +82,8 @@ enum LEFT_ANGLE_BRACKET = 0x3008, RIGHT_ANGLE_BRACKET = 0x3009, OBJECT_REPLACEMENT_CHARACTER = 0xFFFC, + TAG_SPACE = 0xE0020, + CANCEL_TAG = 0xE007F, }; extern int char_string (unsigned, unsigned char *); diff --git a/src/cmds.c b/src/cmds.c index c8a96d918cd..00fde0ef79b 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -455,7 +455,7 @@ internal_self_insert (int c, EMACS_INT n) ptrdiff_t to; if (INT_ADD_WRAPV (PT, chars_to_delete, &to)) to = PTRDIFF_MAX; - replace_range (PT, to, string, 1, 1, 1, 0); + replace_range (PT, to, string, 1, 1, 1, 0, false); Fforward_char (make_fixnum (n)); } else if (n > 1) diff --git a/src/coding.c b/src/coding.c index 87b55aecc05..7030a53869a 100644 --- a/src/coding.c +++ b/src/coding.c @@ -8250,6 +8250,39 @@ decode_coding_object (struct coding_system *coding, } +/* Encode the text in the range FROM/FROM_BYTE and TO/TO_BYTE in + SRC_OBJECT into DST_OBJECT by coding context CODING. + + SRC_OBJECT is a buffer, a string, or Qnil. + + If it is a buffer, the text is at point of the buffer. FROM and TO + are positions in the buffer. + + If it is a string, the text is at the beginning of the string. + FROM and TO are indices into the string. + + If it is nil, the text is at coding->source. FROM and TO are + indices into coding->source. + + DST_OBJECT is a buffer, Qt, or Qnil. + + If it is a buffer, the encoded text is inserted at point of the + buffer. If the buffer is the same as SRC_OBJECT, the source text + is replaced with the encoded text. + + If it is Qt, a string is made from the encoded text, and set in + CODING->dst_object. However, if CODING->raw_destination is non-zero, + the encoded text is instead returned in CODING->destination as a C string, + and the caller is responsible for freeing CODING->destination. This + feature is meant to be used when the caller doesn't need the result as + a Lisp string, and wants to avoid unnecessary consing of large strings. + + If it is Qnil, the encoded text is stored at CODING->destination. + The caller must allocate CODING->dst_bytes bytes at + CODING->destination by xmalloc. If the encoded text is longer than + CODING->dst_bytes, CODING->destination is reallocated by xrealloc + (and CODING->dst_bytes is enlarged accordingly). */ + void encode_coding_object (struct coding_system *coding, Lisp_Object src_object, @@ -8275,11 +8308,14 @@ encode_coding_object (struct coding_system *coding, attrs = CODING_ID_ATTRS (coding->id); - if (EQ (src_object, dst_object)) + bool same_buffer = false; + if (EQ (src_object, dst_object) && BUFFERP (src_object)) { struct Lisp_Marker *tail; - for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next) + same_buffer = true; + + for (tail = BUF_MARKERS (XBUFFER (src_object)); tail; tail = tail->next) { tail->need_adjustment = tail->charpos == (tail->insertion_type ? from : to); @@ -8298,7 +8334,7 @@ encode_coding_object (struct coding_system *coding, else insert_1_both ((char *) coding->source + from, chars, bytes, 0, 0, 0); - if (EQ (src_object, dst_object)) + if (same_buffer) { set_buffer_internal (XBUFFER (src_object)); saved_pt = PT, saved_pt_byte = PT_BYTE; @@ -8329,7 +8365,7 @@ encode_coding_object (struct coding_system *coding, { code_conversion_save (0, 0); set_buffer_internal (XBUFFER (src_object)); - if (EQ (src_object, dst_object)) + if (same_buffer) { saved_pt = PT, saved_pt_byte = PT_BYTE; coding->src_object = del_range_1 (from, to, 1, 1); @@ -10394,8 +10430,7 @@ encode_file_name (Lisp_Object fname) cause subtle bugs because the system would silently use a different filename than expected. Perform this check after encoding to not miss NUL bytes introduced through encoding. */ - CHECK_TYPE (memchr (SSDATA (encoded), '\0', SBYTES (encoded)) == NULL, - Qfilenamep, fname); + CHECK_STRING_NULL_BYTES (encoded); return encoded; } diff --git a/src/comp.c b/src/comp.c index c3803464827..5b947fc99b6 100644 --- a/src/comp.c +++ b/src/comp.c @@ -71,6 +71,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #undef gcc_jit_context_new_binary_op #undef gcc_jit_context_new_call #undef gcc_jit_context_new_call_through_ptr +#undef gcc_jit_context_new_cast #undef gcc_jit_context_new_comparison #undef gcc_jit_context_new_field #undef gcc_jit_context_new_function @@ -151,8 +152,10 @@ DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_context_new_global, DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_function_new_local, (gcc_jit_function *func, gcc_jit_location *loc, gcc_jit_type *type, const char *name)); +#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_global_set_initializer, (gcc_jit_lvalue *global, const void *blob, size_t num_bytes)); +#endif DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_lvalue_access_field, (gcc_jit_lvalue *struct_or_union, gcc_jit_location *loc, gcc_jit_field *field)); @@ -176,6 +179,9 @@ DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_call, DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_call_through_ptr, (gcc_jit_context *ctxt, gcc_jit_location *loc, gcc_jit_rvalue *fn_ptr, int numargs, gcc_jit_rvalue **args)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_cast, + (gcc_jit_context *ctxt, gcc_jit_location *loc, + gcc_jit_rvalue *rvalue, gcc_jit_type *type)); DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_comparison, (gcc_jit_context *ctxt, gcc_jit_location *loc, enum gcc_jit_comparison op, gcc_jit_rvalue *a, gcc_jit_rvalue *b)); @@ -255,9 +261,11 @@ DEF_DLL_FN (void, gcc_jit_context_set_str_option, DEF_DLL_FN (void, gcc_jit_struct_set_fields, (gcc_jit_struct *struct_type, gcc_jit_location *loc, int num_fields, gcc_jit_field **fields)); +#if defined (LIBGCCJIT_HAVE_gcc_jit_version) DEF_DLL_FN (int, gcc_jit_version_major, (void)); DEF_DLL_FN (int, gcc_jit_version_minor, (void)); DEF_DLL_FN (int, gcc_jit_version_patchlevel, (void)); +#endif static bool init_gccjit_functions (void) @@ -288,6 +296,7 @@ init_gccjit_functions (void) LOAD_DLL_FN (library, gcc_jit_context_new_binary_op); LOAD_DLL_FN (library, gcc_jit_context_new_call); LOAD_DLL_FN (library, gcc_jit_context_new_call_through_ptr); + LOAD_DLL_FN (library, gcc_jit_context_new_cast); LOAD_DLL_FN (library, gcc_jit_context_new_comparison); LOAD_DLL_FN (library, gcc_jit_context_new_field); LOAD_DLL_FN (library, gcc_jit_context_new_function); @@ -327,10 +336,14 @@ init_gccjit_functions (void) LOAD_DLL_FN (library, gcc_jit_type_get_pointer); LOAD_DLL_FN_OPT (library, gcc_jit_context_add_command_line_option); LOAD_DLL_FN_OPT (library, gcc_jit_context_add_driver_option); +#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) LOAD_DLL_FN_OPT (library, gcc_jit_global_set_initializer); +#endif +#if defined (LIBGCCJIT_HAVE_gcc_jit_version) LOAD_DLL_FN_OPT (library, gcc_jit_version_major); LOAD_DLL_FN_OPT (library, gcc_jit_version_minor); LOAD_DLL_FN_OPT (library, gcc_jit_version_patchlevel); +#endif return true; } @@ -358,6 +371,7 @@ init_gccjit_functions (void) #define gcc_jit_context_new_binary_op fn_gcc_jit_context_new_binary_op #define gcc_jit_context_new_call fn_gcc_jit_context_new_call #define gcc_jit_context_new_call_through_ptr fn_gcc_jit_context_new_call_through_ptr +#define gcc_jit_context_new_cast fn_gcc_jit_context_new_cast #define gcc_jit_context_new_comparison fn_gcc_jit_context_new_comparison #define gcc_jit_context_new_field fn_gcc_jit_context_new_field #define gcc_jit_context_new_function fn_gcc_jit_context_new_function @@ -382,7 +396,9 @@ init_gccjit_functions (void) #define gcc_jit_function_get_param fn_gcc_jit_function_get_param #define gcc_jit_function_new_block fn_gcc_jit_function_new_block #define gcc_jit_function_new_local fn_gcc_jit_function_new_local -#define gcc_jit_global_set_initializer fn_gcc_jit_global_set_initializer +#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) + #define gcc_jit_global_set_initializer fn_gcc_jit_global_set_initializer +#endif #define gcc_jit_lvalue_access_field fn_gcc_jit_lvalue_access_field #define gcc_jit_lvalue_as_rvalue fn_gcc_jit_lvalue_as_rvalue #define gcc_jit_lvalue_get_address fn_gcc_jit_lvalue_get_address @@ -396,9 +412,11 @@ init_gccjit_functions (void) #define gcc_jit_struct_set_fields fn_gcc_jit_struct_set_fields #define gcc_jit_type_get_const fn_gcc_jit_type_get_const #define gcc_jit_type_get_pointer fn_gcc_jit_type_get_pointer -#define gcc_jit_version_major fn_gcc_jit_version_major -#define gcc_jit_version_minor fn_gcc_jit_version_minor -#define gcc_jit_version_patchlevel fn_gcc_jit_version_patchlevel +#if defined (LIBGCCJIT_HAVE_gcc_jit_version) + #define gcc_jit_version_major fn_gcc_jit_version_major + #define gcc_jit_version_minor fn_gcc_jit_version_minor + #define gcc_jit_version_patchlevel fn_gcc_jit_version_patchlevel +#endif #endif @@ -499,13 +517,6 @@ static f_reloc_t freloc; #define NUM_CAST_TYPES 15 -enum cast_kind_of_type - { - kind_unsigned, - kind_signed, - kind_pointer - }; - typedef struct { EMACS_INT len; gcc_jit_rvalue *r_val; @@ -516,6 +527,7 @@ typedef struct { typedef struct { EMACS_INT speed; EMACS_INT debug; + Lisp_Object compiler_options; Lisp_Object driver_options; gcc_jit_context *ctxt; gcc_jit_type *void_type; @@ -571,14 +583,9 @@ typedef struct { be used for the scope. */ gcc_jit_type *cast_union_type; gcc_jit_function *cast_functions_from_to[NUM_CAST_TYPES][NUM_CAST_TYPES]; - /* We add one to make space for the last member which is the "biggest_type" - member. */ - gcc_jit_type *cast_types[NUM_CAST_TYPES + 1]; - size_t cast_type_sizes[NUM_CAST_TYPES + 1]; - enum cast_kind_of_type cast_type_kind[NUM_CAST_TYPES + 1]; - const char *cast_type_names[NUM_CAST_TYPES + 1]; - gcc_jit_field *cast_union_fields[NUM_CAST_TYPES + 1]; - size_t cast_union_field_biggest_type; + gcc_jit_function *cast_ptr_to_int; + gcc_jit_function *cast_int_to_ptr; + gcc_jit_type *cast_types[NUM_CAST_TYPES]; gcc_jit_function *func; /* Current function being compiled. */ bool func_has_non_local; /* From comp-func has-non-local slot. */ EMACS_INT func_speed; /* From comp-func speed slot. */ @@ -698,6 +705,12 @@ comp_hash_source_file (Lisp_Object filename) /* Can't use Finsert_file_contents + Fbuffer_hash as this is called by Fcomp_el_to_eln_filename too early during bootstrap. */ bool is_gz = suffix_p (filename, ".gz"); +#ifndef HAVE_ZLIB + if (is_gz) + xsignal2 (Qfile_notify_error, + build_string ("Cannot natively compile compressed *.el files without zlib support"), + filename); +#endif Lisp_Object encoded_filename = ENCODE_FILE (filename); FILE *f = emacs_fopen (SSDATA (encoded_filename), is_gz ? "rb" : "r"); @@ -706,9 +719,13 @@ comp_hash_source_file (Lisp_Object filename) Lisp_Object digest = make_uninit_string (MD5_DIGEST_SIZE * 2); +#ifdef HAVE_ZLIB int res = is_gz ? md5_gz_stream (f, SSDATA (digest)) : md5_stream (f, SSDATA (digest)); +#else + int res = md5_stream (f, SSDATA (digest)); +#endif fclose (f); if (res) @@ -1113,13 +1130,6 @@ emit_coerce (gcc_jit_type *new_type, gcc_jit_rvalue *obj) int old_index = type_to_cast_index (old_type); int new_index = type_to_cast_index (new_type); - if (comp.cast_type_sizes[old_index] < comp.cast_type_sizes[new_index] - && comp.cast_type_kind[new_index] == kind_signed) - xsignal3 (Qnative_ice, - build_string ("FIXME: sign extension not implemented"), - build_string (comp.cast_type_names[old_index]), - build_string (comp.cast_type_names[new_index])); - /* Lookup the appropriate cast function in the cast matrix. */ return gcc_jit_context_new_call (comp.ctxt, NULL, @@ -2493,8 +2503,7 @@ emit_static_object (const char *name, Lisp_Object obj) ptrdiff_t len = SBYTES (str); const char *p = SSDATA (str); -#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) \ - || defined (WINDOWSNT) +#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) if (gcc_jit_global_set_initializer) { ptrdiff_t str_size = len + 1; @@ -3111,30 +3120,17 @@ define_thread_state_struct (void) gcc_jit_type_get_pointer (gcc_jit_struct_as_type (comp.thread_state_s)); } -struct cast_type -{ - gcc_jit_type *type; - const char *name; - size_t bytes_size; - enum cast_kind_of_type kind; -}; - static gcc_jit_function * -define_cast_from_to (struct cast_type from, int from_index, struct cast_type to, - int to_index) +define_type_punning (const char *name, + gcc_jit_type *from, gcc_jit_field *from_field, + gcc_jit_type *to, gcc_jit_field *to_field) { - /* FIXME: sign extension not implemented. */ - if (comp.cast_type_sizes[from_index] < comp.cast_type_sizes[to_index] - && comp.cast_type_kind[to_index] == kind_signed) - return NULL; - - char *name = format_string ("cast_from_%s_to_%s", from.name, to.name); gcc_jit_param *param = gcc_jit_context_new_param (comp.ctxt, NULL, - from.type, "arg"); + from, "arg"); gcc_jit_function *result = gcc_jit_context_new_function (comp.ctxt, NULL, GCC_JIT_FUNCTION_INTERNAL, - to.type, + to, name, 1, ¶m, @@ -3148,26 +3144,63 @@ define_cast_from_to (struct cast_type from, int from_index, struct cast_type to, comp.cast_union_type, "union_cast"); - /* Zero the union first. */ gcc_jit_block_add_assignment (entry_block, NULL, gcc_jit_lvalue_access_field (tmp_union, NULL, - comp.cast_union_fields[NUM_CAST_TYPES]), - gcc_jit_context_new_rvalue_from_int ( - comp.ctxt, - comp.cast_types[NUM_CAST_TYPES], - 0)); - - gcc_jit_block_add_assignment (entry_block, NULL, - gcc_jit_lvalue_access_field (tmp_union, NULL, - comp.cast_union_fields[from_index]), + from_field), gcc_jit_param_as_rvalue (param)); gcc_jit_block_end_with_return (entry_block, NULL, gcc_jit_rvalue_access_field ( gcc_jit_lvalue_as_rvalue (tmp_union), - NULL, - comp.cast_union_fields[to_index])); + NULL, to_field)); + + return result; +} + +struct cast_type +{ + gcc_jit_type *type; + const char *name; + bool is_ptr; +}; + +static gcc_jit_function * +define_cast_from_to (struct cast_type from, struct cast_type to) +{ + char *name = format_string ("cast_from_%s_to_%s", from.name, to.name); + gcc_jit_param *param = gcc_jit_context_new_param (comp.ctxt, NULL, + from.type, "arg"); + gcc_jit_function *result + = gcc_jit_context_new_function (comp.ctxt, + NULL, + GCC_JIT_FUNCTION_INTERNAL, + to.type, name, + 1, ¶m, 0); + DECL_BLOCK (entry_block, result); + + gcc_jit_rvalue *tmp = gcc_jit_param_as_rvalue (param); + if (from.is_ptr != to.is_ptr) + { + if (from.is_ptr) + { + tmp = gcc_jit_context_new_cast (comp.ctxt, NULL, + tmp, comp.void_ptr_type); + tmp = gcc_jit_context_new_call (comp.ctxt, NULL, + comp.cast_ptr_to_int, 1, &tmp); + } + else + { + tmp = gcc_jit_context_new_cast (comp.ctxt, NULL, + tmp, comp.uintptr_type); + tmp = gcc_jit_context_new_call (comp.ctxt, NULL, + comp.cast_int_to_ptr, 1, &tmp); + } + } + + tmp = gcc_jit_context_new_cast (comp.ctxt, NULL, tmp, to.type); + + gcc_jit_block_end_with_return (entry_block, NULL, tmp); return result; } @@ -3176,69 +3209,58 @@ static void define_cast_functions (void) { struct cast_type cast_types[NUM_CAST_TYPES] - = { { comp.bool_type, "bool", sizeof (bool), kind_unsigned }, - { comp.char_ptr_type, "char_ptr", sizeof (char *), kind_pointer }, - { comp.int_type, "int", sizeof (int), kind_signed }, - { comp.lisp_cons_ptr_type, "cons_ptr", sizeof (struct Lisp_Cons *), - kind_pointer }, - { comp.lisp_obj_ptr_type, "lisp_obj_ptr", sizeof (Lisp_Object *), - kind_pointer }, - { comp.lisp_word_tag_type, "lisp_word_tag", sizeof (Lisp_Word_tag), - kind_unsigned }, - { comp.lisp_word_type, "lisp_word", sizeof (Lisp_Word), - LISP_WORDS_ARE_POINTERS ? kind_pointer : kind_signed }, - { comp.long_long_type, "long_long", sizeof (long long), kind_signed }, - { comp.long_type, "long", sizeof (long), kind_signed }, - { comp.ptrdiff_type, "ptrdiff", sizeof (ptrdiff_t), kind_signed }, - { comp.uintptr_type, "uintptr", sizeof (uintptr_t), kind_unsigned }, - { comp.unsigned_long_long_type, "unsigned_long_long", - sizeof (unsigned long long), kind_unsigned }, - { comp.unsigned_long_type, "unsigned_long", sizeof (unsigned long), - kind_unsigned }, - { comp.unsigned_type, "unsigned", sizeof (unsigned), kind_unsigned }, - { comp.void_ptr_type, "void_ptr", sizeof (void*), kind_pointer } }; - - /* Find the biggest size. It should be unsigned long long, but to be - sure we find it programmatically. */ - size_t biggest_size = 0; - for (int i = 0; i < NUM_CAST_TYPES; ++i) - biggest_size = max (biggest_size, cast_types[i].bytes_size); + = { { comp.bool_type, "bool", false }, + { comp.char_ptr_type, "char_ptr", true }, + { comp.int_type, "int", false }, + { comp.lisp_cons_ptr_type, "lisp_cons_ptr", true }, + { comp.lisp_obj_ptr_type, "lisp_obj_ptr", true }, + { comp.lisp_word_tag_type, "lisp_word_tag", false }, + { comp.lisp_word_type, "lisp_word", LISP_WORDS_ARE_POINTERS }, + { comp.long_long_type, "long_long", false }, + { comp.long_type, "long", false }, + { comp.ptrdiff_type, "ptrdiff", false }, + { comp.uintptr_type, "uintptr", false }, + { comp.unsigned_long_long_type, "unsigned_long_long", false }, + { comp.unsigned_long_type, "unsigned_long", false }, + { comp.unsigned_type, "unsigned", false }, + { comp.void_ptr_type, "void_ptr", true } }; + gcc_jit_field *cast_union_fields[2]; + + /* Define the union used for type punning. */ + cast_union_fields[0] = gcc_jit_context_new_field (comp.ctxt, + NULL, + comp.void_ptr_type, + "void_ptr"); + cast_union_fields[1] = gcc_jit_context_new_field (comp.ctxt, + NULL, + comp.uintptr_type, + "uintptr"); - /* Define the union used for casting. */ - for (int i = 0; i < NUM_CAST_TYPES; ++i) - { - comp.cast_types[i] = cast_types[i].type; - comp.cast_union_fields[i] = gcc_jit_context_new_field (comp.ctxt, - NULL, - cast_types[i].type, - cast_types[i].name); - comp.cast_type_names[i] = cast_types[i].name; - comp.cast_type_sizes[i] = cast_types[i].bytes_size; - comp.cast_type_kind[i] = cast_types[i].kind; - } + comp.cast_union_type + = gcc_jit_context_new_union_type (comp.ctxt, + NULL, + "cast_union", + 2, cast_union_fields); + + comp.cast_ptr_to_int = define_type_punning ("cast_pointer_to_uintptr_t", + comp.void_ptr_type, + cast_union_fields[0], + comp.uintptr_type, + cast_union_fields[1]); + comp.cast_int_to_ptr = define_type_punning ("cast_uintptr_t_to_pointer", + comp.uintptr_type, + cast_union_fields[1], + comp.void_ptr_type, + cast_union_fields[0]); - gcc_jit_type *biggest_type = gcc_jit_context_get_int_type (comp.ctxt, - biggest_size, - false); - comp.cast_types[NUM_CAST_TYPES] = biggest_type; - comp.cast_union_fields[NUM_CAST_TYPES] = - gcc_jit_context_new_field (comp.ctxt, NULL, biggest_type, "biggest_type"); - comp.cast_type_names[NUM_CAST_TYPES] = "biggest_type"; - comp.cast_type_sizes[NUM_CAST_TYPES] = biggest_size; - comp.cast_type_kind[NUM_CAST_TYPES] = kind_unsigned; - - comp.cast_union_type = - gcc_jit_context_new_union_type (comp.ctxt, - NULL, - "cast_union", - NUM_CAST_TYPES + 1, - comp.cast_union_fields); + for (int i = 0; i < NUM_CAST_TYPES; ++i) + comp.cast_types[i] = cast_types[i].type; /* Define the cast functions using a matrix. */ for (int i = 0; i < NUM_CAST_TYPES; ++i) for (int j = 0; j < NUM_CAST_TYPES; ++j) comp.cast_functions_from_to[i][j] = - define_cast_from_to (cast_types[i], i, cast_types[j], j); + define_cast_from_to (cast_types[i], cast_types[j]); } static void @@ -4029,7 +4051,13 @@ make_directory_wrapper_1 (Lisp_Object ignore) DEFUN ("comp-el-to-eln-rel-filename", Fcomp_el_to_eln_rel_filename, Scomp_el_to_eln_rel_filename, 1, 1, 0, - doc: /* Return the corresponding .eln relative filename. */) + doc: /* Return the relative name of the .eln file for FILENAME. +FILENAME must exist, and if it's a symlink, the target must exist. +If FILENAME is compressed, it must have the \".gz\" extension, +and Emacs must have been compiled with zlib; the file will be +uncompressed on the fly to hash its contents. +Value includes the original base name, followed by 2 hash values, +one for the file name and another for its contents, followed by .eln. */) (Lisp_Object filename) { CHECK_STRING (filename); @@ -4095,7 +4123,7 @@ DEFUN ("comp-el-to-eln-rel-filename", Fcomp_el_to_eln_rel_filename, FOR_EACH_TAIL (lds_re_tail) { Lisp_Object match_idx = - Fstring_match (XCAR (lds_re_tail), filename, Qnil); + Fstring_match (XCAR (lds_re_tail), filename, Qnil, Qnil); if (EQ (match_idx, make_fixnum (0))) { filename = @@ -4114,10 +4142,22 @@ DEFUN ("comp-el-to-eln-rel-filename", Fcomp_el_to_eln_rel_filename, DEFUN ("comp-el-to-eln-filename", Fcomp_el_to_eln_filename, Scomp_el_to_eln_filename, 1, 2, 0, - doc: /* Return the .eln filename for source FILENAME to used -for new compilations. -If BASE-DIR is non-nil use it as a base directory, look for a suitable -directory in `comp-eln-load-path' otherwise. */) + doc: /* Return the absolute .eln file name for source FILENAME. +The resulting .eln file name is intended to be used for natively +compiling FILENAME. FILENAME must exist and be readable, but other +than that, its leading directories are ignored when constructing +the name of the .eln file. +If BASE-DIR is non-nil, use it as the directory for the .eln file; +non-absolute BASE-DIR is interpreted as relative to `invocation-directory'. +If BASE-DIR is omitted or nil, look for the first writable directory +in `native-comp-eln-load-path', and use as BASE-DIR its subdirectory +whose name is given by `comp-native-version-dir'. +If FILENAME specifies a preloaded file, the directory for the .eln +file is the \"preloaded/\" subdirectory of the directory determined +as described above. FILENAME is considered to be a preloaded file if +the value of `comp-file-preloaded-p' is non-nil, or if FILENAME +appears in the value of the environment variable LISP_PRELOADED; +the latter is supposed to be used by the Emacs build procedure. */) (Lisp_Object filename, Lisp_Object base_dir) { Lisp_Object source_filename = filename; @@ -4374,8 +4414,7 @@ DEFUN ("comp-native-driver-options-effective-p", doc: /* Return t if `comp-native-driver-options' is effective. */) (void) { -#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \ - || defined (WINDOWSNT) +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) if (gcc_jit_context_add_driver_option) return Qt; #endif @@ -4383,13 +4422,28 @@ DEFUN ("comp-native-driver-options-effective-p", } #pragma GCC diagnostic pop +#pragma GCC diagnostic ignored "-Waddress" +DEFUN ("comp-native-compiler-options-effective-p", + Fcomp_native_compiler_options_effective_p, + Scomp_native_compiler_options_effective_p, + 0, 0, 0, + doc: /* Return t if `comp-native-compiler-options' is effective. */) + (void) +{ +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option) + if (gcc_jit_context_add_command_line_option) + return Qt; +#endif + return Qnil; +} +#pragma GCC diagnostic pop + static void add_driver_options (void) { Lisp_Object options = Fsymbol_value (Qnative_comp_driver_options); -#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \ - || defined (WINDOWSNT) +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) load_gccjit_if_necessary (true); if (!NILP (Fcomp_native_driver_options_effective_p ())) FOR_EACH_TAIL (options) @@ -4408,8 +4462,7 @@ add_driver_options (void) " and above.")); /* Captured `comp-native-driver-options' because file-local. */ -#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \ - || defined (WINDOWSNT) +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) options = comp.driver_options; if (!NILP (Fcomp_native_driver_options_effective_p ())) FOR_EACH_TAIL (options) @@ -4422,6 +4475,43 @@ add_driver_options (void) #endif } +static void +add_compiler_options (void) +{ + Lisp_Object options = Fsymbol_value (Qnative_comp_compiler_options); + +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option) + load_gccjit_if_necessary (true); + if (!NILP (Fcomp_native_compiler_options_effective_p ())) + FOR_EACH_TAIL (options) + gcc_jit_context_add_command_line_option (comp.ctxt, + /* FIXME: Need to encode + this, but how? either + ENCODE_FILE or + ENCODE_SYSTEM. */ + SSDATA (XCAR (options))); +#endif + if (CONSP (options)) + xsignal1 (Qnative_compiler_error, + build_string ("Customizing native compiler options" + " via `comp-native-compiler-options' is" + " only available on libgccjit version 9" + " and above.")); + + /* Captured `comp-native-compiler-options' because file-local. */ +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option) + options = comp.compiler_options; + if (!NILP (Fcomp_native_compiler_options_effective_p ())) + FOR_EACH_TAIL (options) + gcc_jit_context_add_command_line_option (comp.ctxt, + /* FIXME: Need to encode + this, but how? either + ENCODE_FILE or + ENCODE_SYSTEM. */ + SSDATA (XCAR (options))); +#endif +} + DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, Scomp__compile_ctxt_to_file, 1, 1, 0, @@ -4467,6 +4557,7 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, comp.debug = XFIXNUM (CALL1I (comp-ctxt-debug, Vcomp_ctxt)); eassert (comp.debug < INT_MAX); comp.driver_options = CALL1I (comp-ctxt-driver-options, Vcomp_ctxt); + comp.compiler_options = CALL1I (comp-ctxt-compiler-options, Vcomp_ctxt); if (comp.debug) gcc_jit_context_set_bool_option (comp.ctxt, @@ -4490,6 +4581,15 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL, comp.speed < 0 ? 0 : (comp.speed > 3 ? 3 : comp.speed)); + + /* On MacOS set a unique dylib ID. */ +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \ + && defined (DARWIN_OS) + gcc_jit_context_add_driver_option (comp.ctxt, "-install_name"); + gcc_jit_context_add_driver_option ( + comp.ctxt, SSDATA (Ffile_name_nondirectory (filename))); +#endif + comp.d_default_idx = CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-default, Vcomp_ctxt)); comp.d_impure_idx = @@ -4523,8 +4623,7 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, /* Work around bug#46495 (GCC PR99126). */ #if defined (WIDE_EMACS_INT) \ - && (defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option) \ - || defined (WINDOWSNT)) + && defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option) Lisp_Object version = Fcomp_libgccjit_version (); if (NILP (version) || XFIXNUM (XCAR (version)) < 11) @@ -4532,6 +4631,7 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, "-fdisable-tree-isolate-paths"); #endif + add_compiler_options (); add_driver_options (); if (comp.debug > 1) @@ -4575,7 +4675,7 @@ The return value has the form (MAJOR MINOR PATCHLEVEL) or nil if unknown (before GCC version 10). */) (void) { -#if defined (LIBGCCJIT_HAVE_gcc_jit_version) || defined (WINDOWSNT) +#if defined (LIBGCCJIT_HAVE_gcc_jit_version) load_gccjit_if_necessary (true); return gcc_jit_version_major @@ -4635,7 +4735,7 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code) } -/* `comp-eln-load-path' clean-up support code. */ +/* `native-comp-eln-load-path' clean-up support code. */ static Lisp_Object all_loaded_comp_units_h; @@ -4650,7 +4750,7 @@ return_nil (Lisp_Object arg) /* Windows does not let us delete a .eln file that is currently loaded by a process. The strategy is to rename .eln files into .old.eln instead of removing them when this is not possible and clean-up - `comp-eln-load-path' when exiting. + `native-comp-eln-load-path' when exiting. Any error is ignored because it may be due to the file being loaded in another Emacs instance. */ @@ -4778,7 +4878,7 @@ maybe_defer_native_compilation (Lisp_Object function_name, /**************************************/ /* Fixup the system eln-cache directory, which is the last entry in - `comp-eln-load-path'. Argument is a .eln file in that directory. */ + `native-comp-eln-load-path'. Argument is a .eln file in that directory. */ void fixup_eln_load_path (Lisp_Object eln_filename) { @@ -5160,7 +5260,8 @@ file_in_eln_sys_dir (Lisp_Object filename) eln_sys_dir = XCAR (tmp); return !NILP (Fstring_match (Fregexp_quote (Fexpand_file_name (eln_sys_dir, Qnil)), - Fexpand_file_name (filename, Qnil), Qnil)); + Fexpand_file_name (filename, Qnil), + Qnil, Qnil)); } /* Load related routines. */ @@ -5239,6 +5340,7 @@ compiled one. */); DEFSYM (Qnative_comp_speed, "native-comp-speed"); DEFSYM (Qnative_comp_debug, "native-comp-debug"); DEFSYM (Qnative_comp_driver_options, "native-comp-driver-options"); + DEFSYM (Qnative_comp_compiler_options, "native-comp-compiler-options"); DEFSYM (Qcomp_libgccjit_reproducer, "comp-libgccjit-reproducer"); /* Limple instruction set. */ @@ -5348,6 +5450,7 @@ compiled one. */); defsubr (&Scomp_el_to_eln_rel_filename); defsubr (&Scomp_el_to_eln_filename); defsubr (&Scomp_native_driver_options_effective_p); + defsubr (&Scomp_native_compiler_options_effective_p); defsubr (&Scomp__install_trampoline); defsubr (&Scomp__init_ctxt); defsubr (&Scomp__release_ctxt); diff --git a/src/composite.c b/src/composite.c index 129e9d6bb25..c170805d9dd 100644 --- a/src/composite.c +++ b/src/composite.c @@ -882,14 +882,15 @@ fill_gstring_body (Lisp_Object gstring) /* Try to compose the characters at CHARPOS according to composition rule RULE ([PATTERN PREV-CHARS FUNC]). LIMIT limits the characters to compose. STRING, if not nil, is a target string. WIN is a - window where the characters are being displayed. If characters are + window where the characters are being displayed. CH is the + character that triggered the composition check. If characters are successfully composed, return the composition as a glyph-string object. Otherwise return nil. */ static Lisp_Object autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t limit, struct window *win, struct face *face, - Lisp_Object string, Lisp_Object direction) + Lisp_Object string, Lisp_Object direction, int ch) { ptrdiff_t count = SPECPDL_INDEX (); Lisp_Object pos = make_fixnum (charpos); @@ -920,7 +921,7 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, struct frame *f = XFRAME (font_object); if (FRAME_WINDOW_P (f)) { - font_object = font_range (charpos, bytepos, &to, win, face, string); + font_object = font_range (charpos, bytepos, &to, win, face, string, ch); if (! FONT_OBJECT_P (font_object) || (! NILP (re) && to < limit @@ -953,6 +954,9 @@ char_composable_p (int c) Lisp_Object val; return (c >= ' ' && (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER + /* Per Unicode TR51, these tag characters can be part of + Emoji sequences. */ + || (TAG_SPACE <= c && c <= CANCEL_TAG) /* unicode-category-table may not be available during dumping. */ || (CHAR_TABLE_P (Vunicode_category_table) @@ -961,6 +965,23 @@ char_composable_p (int c) && (XFIXNUM (val) <= UNICODE_CATEGORY_Zs)))))); } +static inline bool +inhibit_auto_composition (void) +{ + if (NILP (Vauto_composition_mode)) + return true; + + if (STRINGP (Vauto_composition_mode)) + { + char *name = tty_type_name (Qnil); + + if (name && ! strcmp (SSDATA (Vauto_composition_mode), name)) + return true; + } + + return false; +} + /* Update cmp_it->stop_pos to the next position after CHARPOS (and BYTEPOS) where character composition may happen. If BYTEPOS is negative, compute it. ENDPOS is a limit of searching. If it is @@ -1015,7 +1036,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, cmp_it->ch = -1; } if (NILP (BVAR (current_buffer, enable_multibyte_characters)) - || NILP (Vauto_composition_mode)) + || inhibit_auto_composition ()) return; if (bytepos < 0) { @@ -1252,7 +1273,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos, if (XFIXNAT (AREF (elt, 1)) != cmp_it->lookback) goto no_composition; lgstring = autocmp_chars (elt, charpos, bytepos, endpos, - w, face, string, direction); + w, face, string, direction, cmp_it->ch); if (composition_gstring_p (lgstring)) break; lgstring = Qnil; @@ -1290,7 +1311,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos, else direction = QR2L; lgstring = autocmp_chars (elt, cpos, bpos, charpos + 1, w, face, - string, direction); + string, direction, cmp_it->ch); if (! composition_gstring_p (lgstring) || cpos + LGSTRING_CHAR_LEN (lgstring) - 1 != charpos) /* Composition failed or didn't cover the current @@ -1659,7 +1680,7 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, ptrdiff_t backlim, for (check = cur; check_pos < check.pos; ) BACKWARD_CHAR (check, stop); *gstring = autocmp_chars (elt, check.pos, check.pos_byte, - tail, w, NULL, string, Qnil); + tail, w, NULL, string, Qnil, c); need_adjustment = 1; if (NILP (*gstring)) { @@ -1741,7 +1762,7 @@ composition_adjust_point (ptrdiff_t last_pt, ptrdiff_t new_pt) } if (NILP (BVAR (current_buffer, enable_multibyte_characters)) - || NILP (Vauto_composition_mode)) + || inhibit_auto_composition ()) return new_pt; /* Next check the automatic composition. */ @@ -1941,7 +1962,7 @@ See `find-composition' for more details. */) if (!find_composition (from, to, &start, &end, &prop, string)) { if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) - && ! NILP (Vauto_composition_mode) + && ! inhibit_auto_composition () && find_automatic_composition (from, to, (ptrdiff_t) -1, &start, &end, &gstring, string)) return list3 (make_fixnum (start), make_fixnum (end), gstring); @@ -2040,7 +2061,10 @@ The default value is the function `compose-chars-after'. */); DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode, doc: /* Non-nil if Auto-Composition mode is enabled. -Use the command `auto-composition-mode' to change this variable. */); +Use the command `auto-composition-mode' to change this variable. + +If this variable is a string, `auto-composition-mode' will be disabled in +buffers displayed on a terminal whose type compares equal to this string. */); Vauto_composition_mode = Qt; DEFVAR_LISP ("auto-composition-function", Vauto_composition_function, @@ -2100,6 +2124,17 @@ GSTRING, or modify GSTRING itself and return it. See also the documentation of `auto-composition-mode'. */); Vcomposition_function_table = Fmake_char_table (Qnil, Qnil); + DEFVAR_LISP ("auto-composition-emoji-eligible-codepoints", Vauto_composition_emoji_eligible_codepoints, + doc: /* List of codepoints for which auto-composition will check for an emoji font. + +These are codepoints which have Emoji_Presentation = No, and thus by +default are not displayed as emoji. In certain circumstances, such as +when followed by U+FE0F (VS-16) the emoji font should be used for +them anyway. + +This list is auto-generated, you should not need to modify it. */); + Vauto_composition_emoji_eligible_codepoints = Qnil; + defsubr (&Scompose_region_internal); defsubr (&Scompose_string_internal); defsubr (&Sfind_composition_internal); diff --git a/src/composite.h b/src/composite.h index 67e87201bf2..945f2612915 100644 --- a/src/composite.h +++ b/src/composite.h @@ -254,6 +254,10 @@ composition_valid_p (ptrdiff_t start, ptrdiff_t end, Lisp_Object prop) #define LGSTRING_HEADER(lgs) AREF (lgs, 0) #define LGSTRING_SET_HEADER(lgs, header) ASET (lgs, 0, header) +/* LGSTRING_FONT retrieves the font used for LGSTRING, if we are going + to display it on a GUI frame. On text-mode frames, that slot + stores the coding-system that should be used to write output to the + frame's terminal. */ #define LGSTRING_FONT(lgs) AREF (LGSTRING_HEADER (lgs), 0) #define LGSTRING_CHAR(lgs, i) AREF (LGSTRING_HEADER (lgs), (i) + 1) #define LGSTRING_CHAR_LEN(lgs) (ASIZE (LGSTRING_HEADER (lgs)) - 1) diff --git a/src/conf_post.h b/src/conf_post.h index 8558dc466cc..2c6fbb0dba5 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -293,7 +293,6 @@ extern int emacs_setenv_TZ (char const *); ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check)) #define ARG_NONNULL ATTRIBUTE_NONNULL -#define ATTRIBUTE_UNUSED MAYBE_UNUSED /* Declare NAME to be a pointer to an object of type TYPE, initialized to the address ADDR, which may be of a different type. Accesses diff --git a/src/data.c b/src/data.c index ffca7e75355..0d3376f0903 100644 --- a/src/data.c +++ b/src/data.c @@ -681,7 +681,7 @@ global value outside of any lexical scope. */) /* It has been previously suggested to make this function an alias for symbol-function, but upon discussion at Bug#23957, there is a risk breaking backward compatibility, as some users of fboundp may - expect `t' in particular, rather than any true value. */ + expect t in particular, rather than any true value. */ DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, doc: /* Return t if SYMBOL's function definition is not void. */) (Lisp_Object symbol) @@ -1045,6 +1045,8 @@ The value, if non-nil, is a list of mode name symbols. */) if (COMPILEDP (fun)) { + if (PVSIZE (fun) <= COMPILED_INTERACTIVE) + return Qnil; Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE); if (VECTORP (form)) /* New form -- the second element is the command modes. */ diff --git a/src/dispextern.h b/src/dispextern.h index c8cefec37f4..ef4d7d915f6 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -544,8 +544,8 @@ struct glyph int img_id; #ifdef HAVE_XWIDGETS - /* Xwidget reference (type == XWIDGET_GLYPH). */ - struct xwidget *xwidget; + /* Xwidget ID. */ + uint32_t xwidget; #endif /* Sub-structure for type == STRETCH_GLYPH. */ @@ -1334,7 +1334,9 @@ struct glyph_string /* The area within row. */ enum glyph_row_area area; - /* Characters to be drawn, and number of characters. */ + /* Characters to be drawn, and number of characters. Note that + NCHARS can be zero if this is a composition glyph string, as + evidenced by FIRST_GLYPH->type. */ unsigned *char2b; int nchars; @@ -3171,7 +3173,7 @@ struct image_cache /* Size of bucket vector of image caches. Should be prime. */ -#define IMAGE_CACHE_BUCKETS_SIZE 1001 +#define IMAGE_CACHE_BUCKETS_SIZE 1009 #endif /* HAVE_WINDOW_SYSTEM */ @@ -3213,7 +3215,7 @@ enum tab_bar_item_idx /* Default values of the above variables. */ -#define DEFAULT_TAB_BAR_BUTTON_MARGIN 4 +#define DEFAULT_TAB_BAR_BUTTON_MARGIN 1 #define DEFAULT_TAB_BAR_BUTTON_RELIEF 1 /* The height in pixels of the default tab-bar images. */ @@ -3426,8 +3428,8 @@ extern void get_glyph_string_clip_rect (struct glyph_string *, NativeRectangle *nr); extern Lisp_Object find_hot_spot (Lisp_Object, int, int); -extern void handle_tab_bar_click (struct frame *, - int, int, bool, int); +extern Lisp_Object handle_tab_bar_click (struct frame *, + int, int, bool, int); extern void handle_tool_bar_click (struct frame *, int, int, bool, int); @@ -3731,10 +3733,8 @@ extern Lisp_Object gui_default_parameter (struct frame *, Lisp_Object, const char *, const char *, enum resource_types); -#ifndef HAVE_NS /* These both used on W32 and X only. */ extern bool gui_mouse_grabbed (Display_Info *); extern void gui_redo_mouse_highlight (Display_Info *); -#endif /* HAVE_NS */ #endif /* HAVE_WINDOW_SYSTEM */ diff --git a/src/dispnew.c b/src/dispnew.c index b79d0c41707..92d9eb1f700 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -475,7 +475,8 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y = row->glyphs[TEXT_AREA] + dim.width - left - right; /* Leave room for a border glyph. */ if (!FRAME_WINDOW_P (XFRAME (w->frame)) - && !WINDOW_RIGHTMOST_P (w)) + && !WINDOW_RIGHTMOST_P (w) + && right > 0) row->glyphs[RIGHT_MARGIN_AREA] -= 1; row->glyphs[LAST_AREA] = row->glyphs[LEFT_MARGIN_AREA] + dim.width; @@ -1148,7 +1149,8 @@ prepare_desired_row (struct window *w, struct glyph_row *row, bool mode_line_p) row->glyphs[RIGHT_MARGIN_AREA] = row->glyphs[LAST_AREA] - right; /* Leave room for a border glyph. */ if (!FRAME_WINDOW_P (XFRAME (w->frame)) - && !WINDOW_RIGHTMOST_P (w)) + && !WINDOW_RIGHTMOST_P (w) + && right > 0) row->glyphs[RIGHT_MARGIN_AREA] -= 1; } } @@ -3848,6 +3850,9 @@ gui_update_window_end (struct window *w, bool cursor_on_p, w->output_cursor.hpos, w->output_cursor.vpos, w->output_cursor.x, w->output_cursor.y); + if (cursor_in_mouse_face_p (w) && cursor_on_p) + mouse_face_overwritten_p = 1; + if (draw_window_fringes (w, true)) { if (WINDOW_RIGHT_DIVIDER_WIDTH (w)) @@ -4444,16 +4449,6 @@ scrolling_window (struct window *w, int tab_line_p) break; } -#ifdef HAVE_XWIDGETS - /* Currently this seems needed to detect xwidget movement reliably. - This is most probably because an xwidget glyph is represented in - struct glyph's 'union u' by a pointer to a struct, which takes 8 - bytes in 64-bit builds, and thus the comparison of u.val values - done by GLYPH_EQUAL_P doesn't work reliably, since it assumes the - size of the union is 4 bytes. FIXME. */ - return 0; -#endif - /* Can't scroll the display of w32 GUI frames when position of point is indicated by the system caret, because scrolling the display will then "copy" the pixels used by the caret. */ @@ -6717,7 +6712,7 @@ See `buffer-display-table' for more information. */); DEFVAR_LISP ("tab-bar-position", Vtab_bar_position, doc: /* Specify on which side from the tool bar the tab bar shall be. -Possible values are `t' (below the tool bar), `nil' (above the tool bar). +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); diff --git a/src/editfns.c b/src/editfns.c index 8ab17ebc9f9..c8219decb06 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2371,7 +2371,7 @@ Both characters must have the same length of multi-byte form. */) /* replace_range is less efficient, because it moves the gap, but it handles combining correctly. */ replace_range (pos, pos + 1, string, - false, false, true, false); + false, false, true, false, false); pos_byte_next = CHAR_TO_BYTE (pos); if (pos_byte_next > pos_byte) /* Before combining happened. We should not increment @@ -2578,7 +2578,7 @@ It returns the number of characters changed. */) but it should handle multibyte characters correctly. */ string = make_multibyte_string ((char *) str, 1, str_len); replace_range (pos, pos + 1, string, - true, false, true, false); + true, false, true, false, false); len = str_len; } else @@ -2613,7 +2613,8 @@ It returns the number of characters changed. */) = (VECTORP (val) ? Fconcat (1, &val) : Fmake_string (make_fixnum (1), val, Qnil)); - replace_range (pos, pos + len, string, true, false, true, false); + replace_range (pos, pos + len, string, true, false, true, false, + false); pos_byte += SBYTES (string); pos += SCHARS (string); characters_changed += SCHARS (string); diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index fe52587c1a5..a56e4dd12ae 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -169,6 +169,19 @@ struct emacs_env_28 @module_env_snippet_28@ }; +struct emacs_env_29 +{ +@module_env_snippet_25@ + +@module_env_snippet_26@ + +@module_env_snippet_27@ + +@module_env_snippet_28@ + +@module_env_snippet_29@ +}; + /* 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 7fd004973d9..925f167d5fa 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -133,6 +133,7 @@ extern char etext; #endif #include "pdumper.h" +#include "fingerprint.h" #include "epaths.h" static const char emacs_version[] = PACKAGE_VERSION; @@ -255,6 +256,7 @@ Initialization options:\n\ #ifdef HAVE_PDUMPER "\ --dump-file FILE read dumped state from FILE\n\ +--fingerprint output fingerprint and exit\n\ ", #endif #if SECCOMP_USABLE @@ -830,6 +832,8 @@ load_pdump (int argc, char **argv) const char *const suffix = ".pdmp"; int result; char *emacs_executable = argv[0]; + ptrdiff_t hexbuf_size; + char *hexbuf; const char *strip_suffix = #if defined DOS_NT || defined CYGWIN ".exe" @@ -924,12 +928,18 @@ load_pdump (int argc, char **argv) path_exec = ns_relocate (path_exec); #endif - /* Look for "emacs.pdmp" in PATH_EXEC. We hardcode "emacs" in - "emacs.pdmp" so that the Emacs binary still works if the user - copies and renames it. */ + /* Look for "emacs-FINGERPRINT.pdmp" in PATH_EXEC. We hardcode + "emacs" in "emacs-FINGERPRINT.pdmp" so that the Emacs binary + still works if the user copies and renames it. */ + hexbuf_size = 2 * sizeof fingerprint; + hexbuf = xmalloc (hexbuf_size + 1); + hexbuf_digest (hexbuf, (char *) fingerprint, sizeof fingerprint); + hexbuf[hexbuf_size] = '\0'; needed = (strlen (path_exec) + 1 + strlen (argv0_base) + + 1 + + strlen (hexbuf) + strlen (suffix) + 1); if (bufsize < needed) @@ -937,8 +947,8 @@ load_pdump (int argc, char **argv) xfree (dump_file); dump_file = xpalloc (NULL, &bufsize, needed - bufsize, -1, 1); } - sprintf (dump_file, "%s%c%s%s", - path_exec, DIRECTORY_SEP, argv0_base, suffix); + sprintf (dump_file, "%s%c%s-%s%s", + path_exec, DIRECTORY_SEP, argv0_base, hexbuf, suffix); #if !defined (NS_SELF_CONTAINED) /* Assume the Emacs binary lives in a sibling directory as set up by the default installation configuration. */ @@ -1387,6 +1397,24 @@ main (int argc, char **argv) exit (0); } +#ifdef HAVE_PDUMPER + if (argmatch (argv, argc, "-fingerprint", "--fingerprint", 4, + NULL, &skip_args)) + { + if (initialized) + { + dump_fingerprint (stdout, "", + (unsigned char *) fingerprint); + exit (0); + } + else + { + fputs ("Not initialized\n", stderr); + exit (1); + } + } +#endif + emacs_wd = emacs_get_current_dir_name (); #ifdef HAVE_PDUMPER if (dumped_with_pdumper_p ()) @@ -1847,7 +1875,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #ifdef HAVE_PGTK init_pgtkterm (); /* before init_atimer(). */ #endif - init_atimer (); running_asynch_code = 0; init_random (); @@ -2009,6 +2036,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (!will_dump_p ()) set_initial_environment (); + /* Has to run after the environment is set up. */ + init_atimer (); + #ifdef WINDOWSNT globals_of_w32 (); #ifdef HAVE_W32NOTIFY @@ -2320,6 +2350,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (dump_mode) Vdump_mode = build_string (dump_mode); +#ifdef HAVE_PDUMPER + /* Allow code to be run (mostly useful after redumping). */ + safe_run_hooks (Qafter_pdump_load_hook); +#endif + /* Enter editor command loop. This never returns. */ set_initial_minibuffer_mode (); Frecursive_edit (); @@ -2342,6 +2377,9 @@ struct standard_args static const struct standard_args standard_args[] = { { "-version", "--version", 150, 0 }, +#ifdef HAVE_PDUMPER + { "-fingerprint", "--fingerprint", 140, 0 }, +#endif { "-chdir", "--chdir", 130, 1 }, { "-t", "--terminal", 120, 1 }, { "-nw", "--no-window-system", 110, 0 }, diff --git a/src/eval.c b/src/eval.c index 48104bd0f45..94ad0607732 100644 --- a/src/eval.c +++ b/src/eval.c @@ -29,6 +29,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "dispextern.h" #include "buffer.h" #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 @@ -364,9 +365,6 @@ do_debug_on_call (Lisp_Object code, ptrdiff_t count) call_debugger (list1 (code)); } -/* NOTE!!! Every function that can call EVAL must protect its args - and temporaries from garbage collection while it needs them. - The definition of `For' shows what you have to do. */ DEFUN ("or", For, Sor, 0, UNEVALLED, 0, doc: /* Eval args until one of them yields non-nil, then return that value. @@ -1081,6 +1079,47 @@ usage: (while TEST BODY...) */) return Qnil; } +static void +with_delayed_message_display (struct atimer *timer) +{ + message3 (build_string (timer->client_data)); +} + +static void +with_delayed_message_cancel (void *timer) +{ + xfree (((struct atimer *) timer)->client_data); + cancel_atimer (timer); +} + +DEFUN ("funcall-with-delayed-message", + Ffuncall_with_delayed_message, Sfuncall_with_delayed_message, + 3, 3, 0, + doc: /* Like `funcall', but display MESSAGE if FUNCTION takes longer than TIMEOUT. +TIMEOUT is a number of seconds, and can be an integer or a floating +point number. + +If FUNCTION takes less time to execute than TIMEOUT seconds, MESSAGE +is not displayed. */) + (Lisp_Object timeout, Lisp_Object message, Lisp_Object function) +{ + ptrdiff_t count = SPECPDL_INDEX (); + + CHECK_NUMBER (timeout); + CHECK_STRING (message); + + /* Set up the atimer. */ + struct timespec interval = dtotimespec (XFLOATINT (timeout)); + struct atimer *timer = start_atimer (ATIMER_RELATIVE, interval, + with_delayed_message_display, + xstrdup (SSDATA (message))); + record_unwind_protect_ptr (with_delayed_message_cancel, timer); + + Lisp_Object result = CALLN (Ffuncall, function); + + return unbind_to (count, result); +} + DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0, doc: /* Return result of expanding macros at top level of FORM. If FORM is not a macro call, it is returned unchanged. @@ -1174,14 +1213,6 @@ usage: (catch TAG BODY...) */) FUNC should return a Lisp_Object. This is how catches are done from within C code. */ -/* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by - throwing t to tag `exit'. - 0 means there is no (throw 'exit t) in progress, or it wasn't from - a minibuffer which isn't the most nested; - N > 0 means the `throw' was done from the minibuffer at level N which - wasn't the most nested. */ -EMACS_INT minibuffer_quit_level = 0; - Lisp_Object internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) @@ -1189,9 +1220,6 @@ internal_catch (Lisp_Object tag, /* This structure is made part of the chain `catchlist'. */ struct handler *c = push_handler (tag, CATCHER); - if (EQ (tag, Qexit)) - minibuffer_quit_level = 0; - /* Call FUNC. */ if (! sys_setjmp (c->jmp)) { @@ -1205,17 +1233,6 @@ internal_catch (Lisp_Object tag, Lisp_Object val = handlerlist->val; clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; - if (EQ (tag, Qexit) && EQ (val, Qt) && minibuffer_quit_level > 0) - /* If we've thrown t to tag `exit' from within a minibuffer, we - exit all minibuffers more deeply nested than the current - one. */ - { - if (minibuf_level > minibuffer_quit_level - && !NILP (Fminibuffer_innermost_command_loop_p (Qnil))) - Fthrow (Qexit, Qt); - else - minibuffer_quit_level = 0; - } return val; } } @@ -3270,6 +3287,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, emacs_abort (); i = optional = rest = 0; + bool previous_rest = false; for (; CONSP (syms_left); syms_left = XCDR (syms_left)) { maybe_quit (); @@ -3280,13 +3298,14 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, if (EQ (next, Qand_rest)) { - if (rest) + if (rest || previous_rest) xsignal1 (Qinvalid_function, fun); rest = 1; + previous_rest = true; } else if (EQ (next, Qand_optional)) { - if (optional || rest) + if (optional || rest || previous_rest) xsignal1 (Qinvalid_function, fun); optional = 1; } @@ -3312,10 +3331,11 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, else /* Dynamically bind NEXT. */ specbind (next, arg); + previous_rest = false; } } - if (!NILP (syms_left)) + if (!NILP (syms_left) || previous_rest) xsignal1 (Qinvalid_function, fun); else if (i < nargs) xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs)); @@ -4333,13 +4353,19 @@ syms_of_eval (void) { DEFVAR_INT ("max-specpdl-size", max_specpdl_size, doc: /* Limit on number of Lisp variable bindings and `unwind-protect's. -If Lisp code tries to increase the total number past this amount, -an error is signaled. -You can safely use a value considerably larger than the default value, -if that proves inconveniently small. However, if you increase it too far, -Emacs could run out of memory trying to make the stack bigger. -Note that this limit may be silently increased by the debugger -if `debug-on-error' or `debug-on-quit' is set. */); + +If Lisp code tries to use more bindings than this amount, an error is +signaled. + +You can safely increase this variable substantially if the default +value proves inconveniently small. However, if you increase it too +much, Emacs could run out of memory trying to make the stack bigger. +Note that this limit may be silently increased by the debugger if +`debug-on-error' or `debug-on-quit' is set. + +\"spec\" is short for \"special variables\", i.e., dynamically bound +variables. \"PDL\" is short for \"push-down list\", which is an old +term for \"stack\". */); DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth, doc: /* Limit on depth in `eval', `apply' and `funcall' before error. @@ -4527,6 +4553,7 @@ alist of active lexical bindings. */); defsubr (&Slet); defsubr (&SletX); defsubr (&Swhile); + defsubr (&Sfuncall_with_delayed_message); defsubr (&Smacroexpand); defsubr (&Scatch); defsubr (&Sthrow); diff --git a/src/fileio.c b/src/fileio.c index 13c99bee109..3c13d3fe416 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -945,6 +945,7 @@ the root directory. */) USE_SAFE_ALLOCA; CHECK_STRING (name); + CHECK_STRING_NULL_BYTES (name); /* If the file name has special constructs in it, call the corresponding file name handler. */ @@ -993,7 +994,10 @@ the root directory. */) if (STRINGP (dir)) { if (file_name_absolute_no_tilde_p (dir)) - default_directory = dir; + { + CHECK_STRING_NULL_BYTES (dir); + default_directory = dir; + } else { Lisp_Object absdir @@ -1307,6 +1311,8 @@ the root directory. */) newdir = SSDATA (hdir); newdirlim = newdir + SBYTES (hdir); } + else if (!multibyte && STRING_MULTIBYTE (tem)) + multibyte = 1; #ifdef DOS_NT collapse_newdir = false; #endif diff --git a/src/fns.c b/src/fns.c index 932800a3a49..76c76c92ba9 100644 --- a/src/fns.c +++ b/src/fns.c @@ -322,7 +322,7 @@ Letter-case is significant, but text properties are ignored. */) USE_SAFE_ALLOCA; ptrdiff_t *column = SAFE_ALLOCA ((len1 + 1) * sizeof (ptrdiff_t)); - for (y = 1; y <= len1; y++) + for (y = 0; y <= len1; y++) column[y] = y; if (use_byte_compare) @@ -672,6 +672,9 @@ DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0, doc: /* Concatenate all the arguments and make the result a string. The result is a string whose elements are the elements of all the arguments. Each argument may be a string or a list or vector of characters (integers). + +Values of the `composition' property of the result are not guaranteed +to be `eq'. usage: (concat &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { @@ -1174,7 +1177,7 @@ string_make_multibyte (Lisp_Object string) /* Convert STRING (if unibyte) to a multibyte string without changing - the number of characters. Characters 0200 trough 0237 are + the number of characters. Characters 0200 through 0237 are converted to eight-bit characters. */ Lisp_Object @@ -1755,7 +1758,8 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0, doc: /* Return non-nil if KEY is equal to the car of an element of ALIST. The value is actually the first element of ALIST whose car equals KEY. -Equality is defined by TESTFN if non-nil or by `equal' if nil. */) +Equality is defined by the function TESTFN, defaulting to `equal'. +TESTFN is called with 2 arguments: a car of an alist element and KEY. */) (Lisp_Object key, Lisp_Object alist, Lisp_Object testfn) { if (eq_comparable_value (key) && NILP (testfn)) @@ -2851,12 +2855,16 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) return leni; } -DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0, +DEFUN ("mapconcat", Fmapconcat, Smapconcat, 2, 3, 0, doc: /* Apply FUNCTION to each element of SEQUENCE, and concat the results as strings. In between each pair of results, stick in SEPARATOR. Thus, " " as SEPARATOR results in spaces between the values returned by FUNCTION. + SEQUENCE may be a list, a vector, a bool-vector, or a string. -SEPARATOR must be a string, a vector, or a list of characters. + +Optional argument SEPARATOR must be a string, a vector, or a list of +characters; nil stands for the empty string. + FUNCTION must be a function of one argument, and must return a value that is a sequence of characters: either a string, or a vector or list of numbers that are valid character codepoints. */) @@ -2949,8 +2957,10 @@ do_yes_or_no_p (Lisp_Object prompt) DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, doc: /* Ask user a yes-or-no question. Return t if answer is yes, and nil if the answer is no. -PROMPT is the string to display to ask the question. It should end in -a space; `yes-or-no-p' adds \"(yes or no) \" to it. + +PROMPT is the string to display to ask the question; `yes-or-no-p' +adds \"(yes or no) \" to it. It does not need to end in space, but if +it does up to one space will be removed. The user must confirm the answer with RET, and can edit it until it has been confirmed. diff --git a/src/font.c b/src/font.c index cdf35b03702..205e9d214c0 100644 --- a/src/font.c +++ b/src/font.c @@ -57,24 +57,26 @@ struct table_entry int numeric; /* The first one is a valid name as a face attribute. The second one (if any) is a typical name in XLFD field. */ - const char *names[5]; + const char *names[6]; }; /* Table of weight numeric values and their names. This table must be - sorted by numeric values in ascending order. */ + sorted by numeric values in ascending order and the numeric values + must approximately match the weights in the font files. */ static const struct table_entry weight_table[] = { { 0, { "thin" }}, - { 20, { "ultra-light", "ultralight" }}, - { 40, { "extra-light", "extralight" }}, + { 40, { "ultra-light", "ultralight", "extra-light", "extralight" }}, { 50, { "light" }}, - { 75, { "semi-light", "semilight", "demilight", "book" }}, - { 100, { "normal", "medium", "regular", "unspecified" }}, - { 180, { "semi-bold", "semibold", "demibold", "demi" }}, + { 55, { "semi-light", "semilight", "demilight" }}, + { 80, { "regular", "normal", "unspecified", "book" }}, + { 100, { "medium" }}, + { 180, { "semi-bold", "semibold", "demibold", "demi-bold", "demi" }}, { 200, { "bold" }}, - { 205, { "extra-bold", "extrabold" }}, - { 210, { "ultra-bold", "ultrabold", "black" }} + { 205, { "extra-bold", "extrabold", "ultra-bold", "ultrabold" }}, + { 210, { "black", "heavy" }}, + { 250, { "ultra-heavy", "ultraheavy" }} }; /* Table of slant numeric values and their names. This table must be @@ -1029,8 +1031,8 @@ font_expand_wildcards (Lisp_Object *field, int n) X font backend driver, it is a font-entity. In that case, NAME is a fully specified XLFD. */ -int -font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) +static int +font_parse_xlfd_1 (char *name, ptrdiff_t len, Lisp_Object font, int segments) { int i, j, n; char *f[XLFD_LAST_INDEX + 1]; @@ -1040,17 +1042,27 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) if (len > 255 || !len) /* Maximum XLFD name length is 255. */ return -1; + /* Accept "*-.." as a fully specified XLFD. */ if (name[0] == '*' && (len == 1 || name[1] == '-')) i = 1, f[XLFD_FOUNDRY_INDEX] = name; else i = 0; + + /* Split into segments. */ for (p = name + i; *p; p++) if (*p == '-') { - f[i++] = p + 1; - if (i == XLFD_LAST_INDEX) - break; + /* If we have too many segments, then gather them up into the + FAMILY part of the name. This allows using fonts with + dashes in the FAMILY bit. */ + if (segments > XLFD_LAST_INDEX && i == XLFD_WEIGHT_INDEX) + segments--; + else { + f[i++] = p + 1; + if (i == XLFD_LAST_INDEX) + break; + } } f[i] = name + len; @@ -1215,6 +1227,28 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) return 0; } +int +font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) +{ + int found = font_parse_xlfd_1 (name, len, font, -1); + if (found > -1) + return found; + + int segments = 0; + /* Count how many segments we have. */ + for (char *p = name; *p; p++) + if (*p == '-') + segments++; + + /* If we have a surplus of segments, then we try to parse again, in + case there's a font with dashes in the family name. */ + if (segments > XLFD_LAST_INDEX) + return font_parse_xlfd_1 (name, len, font, segments); + else + return -1; +} + + /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES length), and return the name length. If FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */ @@ -1452,11 +1486,20 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font) #define PROP_MATCH(STR) (word_len == strlen (STR) \ && memcmp (p, STR, strlen (STR)) == 0) - if (PROP_MATCH ("light") + if (PROP_MATCH ("thin") + || PROP_MATCH ("ultra-light") + || PROP_MATCH ("light") + || PROP_MATCH ("semi-light") + || PROP_MATCH ("book") || PROP_MATCH ("medium") + || PROP_MATCH ("normal") + || PROP_MATCH ("semibold") || PROP_MATCH ("demibold") || PROP_MATCH ("bold") - || PROP_MATCH ("black")) + || PROP_MATCH ("ultra-bold") + || PROP_MATCH ("black") + || PROP_MATCH ("heavy") + || PROP_MATCH ("ultra-heavy")) FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, val); else if (PROP_MATCH ("roman") || PROP_MATCH ("italic") @@ -3828,12 +3871,32 @@ font_at (int c, ptrdiff_t pos, struct face *face, struct window *w, #ifdef HAVE_WINDOW_SYSTEM +/* Check if CH is a codepoint for which we should attempt to use the + emoji font, even if the codepoint itself has Emoji_Presentation = + No. Vauto_composition_emoji_eligible_codepoints is filled in for + us by admin/unidata/emoji-zwj.awk. */ +static bool +codepoint_is_emoji_eligible (int ch) +{ + if (EQ (CHAR_TABLE_REF (Vchar_script_table, ch), Qemoji)) + return true; + + if (! NILP (Fmemq (make_fixnum (ch), + Vauto_composition_emoji_eligible_codepoints))) + return true; + + return false; +} + /* Check how many characters after character/byte position POS/POS_BYTE (at most to *LIMIT) can be displayed by the same font in the window W. FACE, if non-NULL, is the face selected for the character at POS. If STRING is not nil, it is the string to check instead of the current buffer. In that case, FACE must be not NULL. + CH is the character that actually caused the composition + process to start, it may be different from the character at POS. + The return value is the font-object for the character at POS. *LIMIT is set to the position where that font can't be used. @@ -3841,15 +3904,16 @@ font_at (int c, ptrdiff_t pos, struct face *face, struct window *w, Lisp_Object font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit, - struct window *w, struct face *face, Lisp_Object string) + struct window *w, struct face *face, Lisp_Object string, + int ch) { ptrdiff_t ignore; int c; Lisp_Object font_object = Qnil; + struct frame *f = XFRAME (w->frame); if (!face) { - struct frame *f = XFRAME (w->frame); int face_id; if (NILP (string)) @@ -3868,6 +3932,23 @@ font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit, face = FACE_FROM_ID (f, face_id); } + /* If the composition was triggered by an emoji, use a character + from 'script-representative-chars', rather than the first + character in the string, to determine the font to use. */ + if (codepoint_is_emoji_eligible (ch)) + { + Lisp_Object val = assq_no_quit (Qemoji, Vscript_representative_chars); + if (CONSP (val)) + { + val = XCDR (val); + if (CONSP (val)) + val = XCAR (val); + else if (VECTORP (val)) + val = AREF (val, 0); + font_object = font_for_char (face, XFIXNAT (val), pos, string); + } + } + while (pos < *limit) { c = (NILP (string) @@ -4896,6 +4977,33 @@ If the font is not OpenType font, CAPABILITY is nil. */) : Qnil)); } +DEFUN ("font-has-char-p", Ffont_has_char_p, Sfont_has_char_p, 2, 3, 0, + doc: + /* Return non-nil if FONT on FRAME has a glyph for character CH. +FONT can be either a font-entity or a font-object. If it is +a font-entity and the result is nil, it means the font needs to be +opened (with `open-font') to check. +FRAME defaults to the selected frame if it is nil or omitted. */) + (Lisp_Object font, Lisp_Object ch, Lisp_Object frame) +{ + struct frame *f; + CHECK_FONT (font); + CHECK_CHARACTER (ch); + + if (NILP (frame)) + f = XFRAME (selected_frame); + else + { + CHECK_FRAME (frame); + f = XFRAME (frame); + } + + if (font_has_char (f, font, XFIXNAT (ch)) <= 0) + return Qnil; + else + return Qt; +} + DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0, doc: /* Return a vector of FONT-OBJECT's glyphs for the specified characters. @@ -4914,8 +5022,13 @@ where CODE is the glyph-code of C in FONT-OBJECT. WIDTH thru DESCENT are the metrics (in pixels) of the glyph. ADJUSTMENT is always nil. -If FONT-OBJECT doesn't have a glyph for a character, -the corresponding element is nil. */) + +If FONT-OBJECT doesn't have a glyph for a character, the corresponding +element is nil. + +Also see `font-has-char-p', which is more efficient than this function +if you just want to check whether FONT-OBJECT has a glyph for a +character. */) (Lisp_Object font_object, Lisp_Object from, Lisp_Object to, Lisp_Object object) { @@ -5391,6 +5504,7 @@ syms_of_font (void) DEFSYM (Qiso8859_1, "iso8859-1"); DEFSYM (Qiso10646_1, "iso10646-1"); DEFSYM (Qunicode_bmp, "unicode-bmp"); + DEFSYM (Qemoji, "emoji"); /* Symbols representing keys of font extra info. */ DEFSYM (QCotf, ":otf"); @@ -5466,6 +5580,7 @@ syms_of_font (void) defsubr (&Sclose_font); defsubr (&Squery_font); defsubr (&Sfont_get_glyphs); + defsubr (&Sfont_has_char_p); defsubr (&Sfont_match_p); defsubr (&Sfont_at); #if 0 diff --git a/src/font.h b/src/font.h index 750754433c8..6ee7bcafffa 100644 --- a/src/font.h +++ b/src/font.h @@ -885,7 +885,7 @@ valid_font_driver (struct font_driver const *d) extern Lisp_Object font_update_drivers (struct frame *f, Lisp_Object list); extern Lisp_Object font_range (ptrdiff_t, ptrdiff_t, ptrdiff_t *, struct window *, struct face *, - Lisp_Object); + Lisp_Object, int); extern void font_fill_lglyph_metrics (Lisp_Object, struct font *, unsigned int); extern Lisp_Object font_put_extra (Lisp_Object font, Lisp_Object prop, diff --git a/src/fontset.c b/src/fontset.c index 332be6c39d1..7d4bd65f70c 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1361,7 +1361,11 @@ check_fontset_name (Lisp_Object name, Lisp_Object *frame) if (EQ (name, Qt)) return Vdefault_fontset; if (NILP (name)) - id = FRAME_FONTSET (f); + { + if (!FRAME_WINDOW_P (f)) + error ("Can't use fontsets in non-GUI frames"); + id = FRAME_FONTSET (f); + } else { CHECK_STRING (name); diff --git a/src/frame.c b/src/frame.c index 94e0073e22a..bb5d46f4eeb 100644 --- a/src/frame.c +++ b/src/frame.c @@ -732,7 +732,7 @@ adjust_frame_size (struct frame *f, int new_text_width, int new_text_height, && (f->new_width >= 0 || f->new_height >= 0)) /* For implied resizes with inhibit 2 (external menu and tool bar) pick up any new sizes the display engine has not - processed yet. Otherwsie, we would request the old sizes + processed yet. Otherwise, we would request the old sizes which will make this request appear as a request to set new sizes and have the WM react accordingly which is not TRT. @@ -1409,11 +1409,6 @@ affects all frames on the same terminal device. */) (t->display_info.tty->name ? build_string (t->display_info.tty->name) : Qnil)); - /* 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); - Fmodify_frame_parameters (frame, parms); /* Make the frame face hash be frame-specific, so that each frame could change its face definitions independently. */ @@ -1426,6 +1421,12 @@ affects all frames on the same terminal device. */) for (idx = 0; idx < table->count; ++idx) set_hash_value_slot (table, idx, Fcopy_sequence (HASH_VALUE (table, idx))); + /* 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); + Fmodify_frame_parameters (frame, parms); + f->can_set_window_size = true; f->after_make_frame = true; @@ -1840,15 +1841,20 @@ prev_frame (Lisp_Object frame, Lisp_Object minibuf) DEFUN ("next-frame", Fnext_frame, Snext_frame, 0, 2, 0, doc: /* Return the next frame in the frame list after FRAME. -It considers only frames on the same terminal as FRAME. -By default, skip minibuffer-only frames. -If omitted, FRAME defaults to the selected frame. -If optional argument MINIFRAME is nil, exclude minibuffer-only frames. -If MINIFRAME is a window, include only its own frame -and any frame now using that window as the minibuffer. -If MINIFRAME is `visible', include all visible frames. -If MINIFRAME is 0, include all visible and iconified frames. -Otherwise, include all frames. */) +Only frames on the same terminal as FRAME are included in the list +of candidate frames. If omitted, FRAME defaults to the selected frame. + +If MINIFRAME is nil (the default), include all frames except +minibuffer-only frames. + +If MINIFRAME is a window, include only its own frame and any frame now +using that window as the minibuffer. + +If MINIFRAME is `visible', include only visible frames. + +If MINIFRAME is 0, include only visible and iconified frames. + +If MINIFRAME is any other value, include all frames. */) (Lisp_Object frame, Lisp_Object miniframe) { if (NILP (frame)) @@ -5033,8 +5039,6 @@ gui_set_no_special_glyphs (struct frame *f, Lisp_Object new_value, Lisp_Object o } -#ifndef HAVE_NS - /* Non-zero if mouse is grabbed on DPYINFO and we know the frame where it is. */ @@ -5059,8 +5063,6 @@ gui_redo_mouse_highlight (Display_Info *dpyinfo) dpyinfo->last_mouse_motion_y); } -#endif /* HAVE_NS */ - /* Subroutines of creating an X frame. */ /* Make sure that Vx_resource_name is set to a reasonable value. @@ -6251,7 +6253,10 @@ when the mouse is over clickable text. */); DEFVAR_LISP ("make-pointer-invisible", Vmake_pointer_invisible, doc: /* If non-nil, make mouse pointer invisible while typing. -The pointer becomes visible again when the mouse is moved. */); +The pointer becomes visible again when the mouse is moved. + +When using this, you might also want to disable highlighting of +clickable text. See `mouse-highlight'. */); Vmake_pointer_invisible = Qt; DEFVAR_LISP ("move-frame-functions", Vmove_frame_functions, diff --git a/src/frame.h b/src/frame.h index 9856890c315..39607766049 100644 --- a/src/frame.h +++ b/src/frame.h @@ -449,8 +449,8 @@ struct frame /* Non-zero if this frame's faces need to be recomputed. */ bool_bf face_change : 1; - /* Non-zero if this frame's image cache cannot be freed because the - frame is in the process of being redisplayed. */ + /* Non-zero if this frame's image cache and face cache cannot be + freed because the frame is in the process of being redisplayed. */ bool_bf inhibit_clear_image_cache : 1; /* True when new_width or new_height were set by change_frame_size, diff --git a/src/fringe.c b/src/fringe.c index e67ea9d88fd..f22d0956982 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -971,6 +971,14 @@ update_window_fringes (struct window *w, bool keep_current_p) if (w->pseudo_window_p) return 0; + ptrdiff_t count = SPECPDL_INDEX (); + + /* This function could be called for redisplaying non-selected + windows, in which case point has been temporarily moved to that + window's window-point. So we cannot afford quitting out of here, + as point is restored after this function returns. */ + specbind (Qinhibit_quit, Qt); + if (!MINI_WINDOW_P (w) && (ind = BVAR (XBUFFER (w->contents), indicate_buffer_boundaries), !NILP (ind))) { @@ -1333,6 +1341,8 @@ update_window_fringes (struct window *w, bool keep_current_p) row->fringe_bitmap_periodic_p = periodic_p; } + unbind_to (count, Qnil); + return redraw_p && !keep_current_p; } diff --git a/src/gtkutil.c b/src/gtkutil.c index 40d1d17a60a..7f8a33c01d7 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -2617,20 +2617,34 @@ xg_get_file_name (struct frame *f, #ifdef HAVE_GTK3 -#define XG_WEIGHT_TO_SYMBOL(w) \ - (w <= PANGO_WEIGHT_THIN ? Qextra_light \ - : w <= PANGO_WEIGHT_ULTRALIGHT ? Qlight \ - : w <= PANGO_WEIGHT_LIGHT ? Qsemi_light \ - : w < PANGO_WEIGHT_MEDIUM ? Qnormal \ - : w <= PANGO_WEIGHT_SEMIBOLD ? Qsemi_bold \ - : w <= PANGO_WEIGHT_BOLD ? Qbold \ - : w <= PANGO_WEIGHT_HEAVY ? Qextra_bold \ - : Qultra_bold) - -#define XG_STYLE_TO_SYMBOL(s) \ - (s == PANGO_STYLE_OBLIQUE ? Qoblique \ - : s == PANGO_STYLE_ITALIC ? Qitalic \ - : Qnormal) +static +Lisp_Object xg_weight_to_symbol (PangoWeight w) +{ + return + (w <= PANGO_WEIGHT_THIN ? Qthin /* 100 */ + : w <= PANGO_WEIGHT_ULTRALIGHT ? Qultra_light /* 200 */ + : w <= PANGO_WEIGHT_LIGHT ? Qlight /* 300 */ +#if PANGO_VERSION_CHECK(1, 36, 7) + : w <= PANGO_WEIGHT_SEMILIGHT ? Qsemi_light /* 350 */ +#endif + : w <= PANGO_WEIGHT_BOOK ? Qbook /* 380 */ + : w <= PANGO_WEIGHT_NORMAL ? Qnormal /* 400 */ + : w <= PANGO_WEIGHT_MEDIUM ? Qmedium /* 500 */ + : w <= PANGO_WEIGHT_SEMIBOLD ? Qsemi_bold /* 600 */ + : w <= PANGO_WEIGHT_BOLD ? Qbold /* 700 */ + : w <= PANGO_WEIGHT_ULTRABOLD ? Qultra_bold /* 800 */ + : w <= PANGO_WEIGHT_HEAVY ? Qblack /* 900 */ + : Qultra_heavy); /* 1000 */ +} + +static +Lisp_Object xg_style_to_symbol (PangoStyle s) +{ + return + (s == PANGO_STYLE_OBLIQUE ? Qoblique + : s == PANGO_STYLE_ITALIC ? Qitalic + : Qnormal); +} #endif /* HAVE_GTK3 */ @@ -2726,8 +2740,8 @@ xg_get_font (struct frame *f, const char *default_name) font = CALLN (Ffont_spec, QCfamily, build_string (family), QCsize, make_float (pango_units_to_double (size)), - QCweight, XG_WEIGHT_TO_SYMBOL (weight), - QCslant, XG_STYLE_TO_SYMBOL (style)); + QCweight, xg_weight_to_symbol (weight), + QCslant, xg_style_to_symbol (style)); char *font_desc_str = pango_font_description_to_string (desc); dupstring (&x_last_font_name, font_desc_str); @@ -3328,8 +3342,9 @@ xg_item_label_same_p (GtkMenuItem *witem, const char *label) char *utf8_label = get_utf8_string (label); const char *old_label = witem ? xg_get_menu_item_label (witem) : 0; - bool is_same = (!old_label == !utf8_label - && (!old_label || strcmp (utf8_label, old_label) == 0)); + bool is_same = (old_label + ? utf8_label && strcmp (utf8_label, old_label) == 0 + : !utf8_label); if (utf8_label) g_free (utf8_label); diff --git a/src/image.c b/src/image.c index 7a6f406e76f..f911da51eaa 100644 --- a/src/image.c +++ b/src/image.c @@ -3670,10 +3670,8 @@ convert_mono_to_color_image (struct frame *f, struct image *img, release_frame_dc (f, hdc); old_prev = SelectObject (old_img_dc, img->pixmap); new_prev = SelectObject (new_img_dc, new_pixmap); - /* Windows convention for mono bitmaps is black = background, - white = foreground. */ - SetTextColor (new_img_dc, background); - SetBkColor (new_img_dc, foreground); + SetTextColor (new_img_dc, foreground); + SetBkColor (new_img_dc, background); BitBlt (new_img_dc, 0, 0, img->width, img->height, old_img_dc, 0, 0, SRCCOPY); @@ -4246,9 +4244,9 @@ struct xpm_cached_color }; /* The hash table used for the color cache, and its bucket vector - size. */ + size (which should be prime). */ -#define XPM_COLOR_CACHE_BUCKETS 1001 +#define XPM_COLOR_CACHE_BUCKETS 1009 static struct xpm_cached_color **xpm_color_cache; /* Initialize the color cache. */ @@ -6551,9 +6549,8 @@ image_can_use_native_api (Lisp_Object type) } /* - * These functions are actually defined in the OS-native implementation - * file. Currently, for Windows GDI+ interface, w32image.c, but other - * operating systems can follow suit. + * These functions are actually defined in the OS-native implementation file. + * Currently, for Windows GDI+ interface, w32image.c, and nsimage.m for macOS. */ /* Indices of image specification fields in native format, below. */ @@ -8363,24 +8360,30 @@ gif_image_p (Lisp_Object object) # undef DrawText # endif -/* Giflib before 5.0 didn't define these macros (used only if HAVE_NTGUI). */ -# ifndef GIFLIB_MINOR -# define GIFLIB_MINOR 0 -# endif -# ifndef GIFLIB_RELEASE -# define GIFLIB_RELEASE 0 -# endif - # else /* HAVE_NTGUI */ # include <gif_lib.h> # endif /* HAVE_NTGUI */ -/* Giflib before 5.0 didn't define these macros. */ +/* Giflib before 4.1.6 didn't define these macros. */ # ifndef GIFLIB_MAJOR # define GIFLIB_MAJOR 4 # endif +# ifndef GIFLIB_MINOR +# define GIFLIB_MINOR 0 +# endif +# ifndef GIFLIB_RELEASE +# define GIFLIB_RELEASE 0 +# endif +/* Giflib before 5.0 didn't define these macros. */ +# if GIFLIB_MAJOR < 5 +# define DISPOSAL_UNSPECIFIED 0 /* No disposal specified. */ +# define DISPOSE_DO_NOT 1 /* Leave image in place. */ +# define DISPOSE_BACKGROUND 2 /* Set area too background color. */ +# define DISPOSE_PREVIOUS 3 /* Restore to previous content. */ +# define NO_TRANSPARENT_COLOR -1 +# endif /* GifErrorString is declared to return char const * when GIFLIB_MAJOR and GIFLIB_MINOR indicate 5.1 or later. Do not bother using it in @@ -8403,6 +8406,8 @@ DEF_DLL_FN (GifFileType *, DGifOpenFileName, (const char *)); # else DEF_DLL_FN (GifFileType *, DGifOpen, (void *, InputFunc, int *)); DEF_DLL_FN (GifFileType *, DGifOpenFileName, (const char *, int *)); +DEF_DLL_FN (int, DGifSavedExtensionToGCB, + (GifFileType *, int, GraphicsControlBlock *)); # endif # if HAVE_GIFERRORSTRING DEF_DLL_FN (char const *, GifErrorString, (int)); @@ -8420,6 +8425,9 @@ init_gif_functions (void) LOAD_DLL_FN (library, DGifSlurp); LOAD_DLL_FN (library, DGifOpen); LOAD_DLL_FN (library, DGifOpenFileName); +# if GIFLIB_MAJOR >= 5 + LOAD_DLL_FN (library, DGifSavedExtensionToGCB); +# endif # if HAVE_GIFERRORSTRING LOAD_DLL_FN (library, GifErrorString); # endif @@ -8430,12 +8438,18 @@ init_gif_functions (void) # undef DGifOpen # undef DGifOpenFileName # undef DGifSlurp +# if GIFLIB_MAJOR >= 5 +# undef DGifSavedExtensionToGCB +# endif # undef GifErrorString # define DGifCloseFile fn_DGifCloseFile # define DGifOpen fn_DGifOpen # define DGifOpenFileName fn_DGifOpenFileName # define DGifSlurp fn_DGifSlurp +# if GIFLIB_MAJOR >= 5 +# define DGifSavedExtensionToGCB fn_DGifSavedExtensionToGCB +# endif # define GifErrorString fn_GifErrorString # endif /* WINDOWSNT */ @@ -8513,7 +8527,7 @@ gif_load (struct frame *f, struct image *img) if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file); - return 0; + return false; } Lisp_Object encoded_file = ENCODE_FILE (file); @@ -8536,8 +8550,7 @@ gif_load (struct frame *f, struct image *img) else #endif image_error ("Cannot open `%s'", file); - - return 0; + return false; } } else @@ -8545,7 +8558,7 @@ gif_load (struct frame *f, struct image *img) if (!STRINGP (specified_data)) { image_error ("Invalid image data `%s'", specified_data); - return 0; + return false; } /* Read from memory! */ @@ -8569,7 +8582,7 @@ gif_load (struct frame *f, struct image *img) else #endif image_error ("Cannot open memory source `%s'", img->spec); - return 0; + return false; } } @@ -8577,8 +8590,7 @@ gif_load (struct frame *f, struct image *img) if (!check_image_size (f, gif->SWidth, gif->SHeight)) { image_size_error (); - gif_close (gif, NULL); - return 0; + goto gif_error; } /* Read entire contents. */ @@ -8589,8 +8601,7 @@ gif_load (struct frame *f, struct image *img) image_error ("Error reading `%s'", img->spec); else image_error ("Error reading GIF data"); - gif_close (gif, NULL); - return 0; + goto gif_error; } /* Which sub-image are we to display? */ @@ -8601,8 +8612,7 @@ gif_load (struct frame *f, struct image *img) { image_error ("Invalid image number `%s' in image `%s'", image_number, img->spec); - gif_close (gif, NULL); - return 0; + goto gif_error; } } @@ -8619,8 +8629,7 @@ gif_load (struct frame *f, struct image *img) if (!check_image_size (f, width, height)) { image_size_error (); - gif_close (gif, NULL); - return 0; + goto gif_error; } /* Check that the selected subimages fit. It's not clear whether @@ -8637,18 +8646,14 @@ gif_load (struct frame *f, struct image *img) && 0 <= subimg_left && subimg_left <= width - subimg_width)) { image_error ("Subimage does not fit in image"); - gif_close (gif, NULL); - return 0; + goto gif_error; } } /* Create the X image and pixmap. */ Emacs_Pix_Container ximg; if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) - { - gif_close (gif, NULL); - return 0; - } + goto gif_error; /* Clear the part of the screen image not covered by the image. Full animated GIF support requires more here (see the gif89 spec, @@ -8707,13 +8712,17 @@ gif_load (struct frame *f, struct image *img) char *, which invites problems with bytes >= 0x80. */ struct SavedImage *subimage = gif->SavedImages + j; unsigned char *raster = (unsigned char *) subimage->RasterBits; - int transparency_color_index = -1; - int disposal = 0; int subimg_width = subimage->ImageDesc.Width; int subimg_height = subimage->ImageDesc.Height; int subimg_top = subimage->ImageDesc.Top; int subimg_left = subimage->ImageDesc.Left; + /* From gif89a spec: 1 = "keep in place", 2 = "restore + to background". Treat any other value like 2. */ + int disposal = DISPOSAL_UNSPECIFIED; + int transparency_color_index = NO_TRANSPARENT_COLOR; + +#if GIFLIB_MAJOR < 5 /* Find the Graphic Control Extension block for this sub-image. Extract the disposal method and transparency color. */ for (i = 0; i < subimage->ExtensionBlockCount; i++) @@ -8724,24 +8733,29 @@ gif_load (struct frame *f, struct image *img) && extblock->ByteCount == 4 && extblock->Bytes[0] & 1) { - /* From gif89a spec: 1 = "keep in place", 2 = "restore - to background". Treat any other value like 2. */ disposal = (extblock->Bytes[0] >> 2) & 7; transparency_color_index = (unsigned char) extblock->Bytes[3]; break; } } +#else + GraphicsControlBlock gcb; + DGifSavedExtensionToGCB (gif, j, &gcb); + disposal = gcb.DisposalMode; + transparency_color_index = gcb.TransparentColor; +#endif /* We can't "keep in place" the first subimage. */ if (j == 0) - disposal = 2; + disposal = DISPOSE_BACKGROUND; - /* For disposal == 0, the spec says "No disposal specified. The - decoder is not required to take any action." In practice, it - seems we need to treat this like "keep in place", see e.g. + /* For disposal == 0 (DISPOSAL_UNSPECIFIED), the spec says + "No disposal specified. The decoder is not required to take + any action." In practice, it seems we need to treat this + like "keep in place" (DISPOSE_DO_NOT), see e.g. https://upload.wikimedia.org/wikipedia/commons/3/37/Clock.gif */ - if (disposal == 0) - disposal = 1; + if (disposal == DISPOSAL_UNSPECIFIED) + disposal = DISPOSE_DO_NOT; gif_color_map = subimage->ImageDesc.ColorMap; if (!gif_color_map) @@ -8780,7 +8794,7 @@ gif_load (struct frame *f, struct image *img) for (x = 0; x < subimg_width; x++) { int c = raster[y * subimg_width + x]; - if (transparency_color_index != c || disposal != 1) + if (transparency_color_index != c || disposal != DISPOSE_DO_NOT) { PUT_PIXEL (ximg, x + subimg_left, row + subimg_top, pixel_colors[c]); @@ -8794,7 +8808,7 @@ gif_load (struct frame *f, struct image *img) for (x = 0; x < subimg_width; ++x) { int c = raster[y * subimg_width + x]; - if (transparency_color_index != c || disposal != 1) + if (transparency_color_index != c || disposal != DISPOSE_DO_NOT) { PUT_PIXEL (ximg, x + subimg_left, y + subimg_top, pixel_colors[c]); @@ -8864,14 +8878,296 @@ gif_load (struct frame *f, struct image *img) /* Put ximg into the image. */ image_put_x_image (f, img, ximg, 0); - return 1; + return true; + + gif_error: + gif_close (gif, NULL); + return false; } #endif /* HAVE_GIF */ +#ifdef HAVE_WEBP + + +/*********************************************************************** + WebP + ***********************************************************************/ + +#include "webp/decode.h" + +/* Indices of image specification fields in webp_format, below. */ + +enum webp_keyword_index +{ + WEBP_TYPE, + WEBP_DATA, + WEBP_FILE, + WEBP_ASCENT, + WEBP_MARGIN, + WEBP_RELIEF, + WEBP_ALGORITHM, + WEBP_HEURISTIC_MASK, + WEBP_MASK, + WEBP_BACKGROUND, + WEBP_LAST +}; + +/* Vector of image_keyword structures describing the format + of valid user-defined image specifications. */ + +static const struct image_keyword webp_format[WEBP_LAST] = +{ + {":type", IMAGE_SYMBOL_VALUE, 1}, + {":data", IMAGE_STRING_VALUE, 0}, + {":file", IMAGE_STRING_VALUE, 0}, + {":ascent", IMAGE_ASCENT_VALUE, 0}, + {":margin", IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR, 0}, + {":relief", IMAGE_INTEGER_VALUE, 0}, + {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":background", IMAGE_STRING_OR_NIL_VALUE, 0} +}; + +/* Return true if OBJECT is a valid WebP image specification. */ + +static bool +webp_image_p (Lisp_Object object) +{ + struct image_keyword fmt[WEBP_LAST]; + memcpy (fmt, webp_format, sizeof fmt); + + if (!parse_image_spec (object, fmt, WEBP_LAST, Qwebp)) + return false; + + /* Must specify either the :data or :file keyword. */ + return fmt[WEBP_FILE].count + fmt[WEBP_DATA].count == 1; +} + +#ifdef WINDOWSNT + +/* WebP library details. */ + +DEF_DLL_FN (int, WebPGetInfo, (const uint8_t *, size_t, int *, int *)); +/* WebPGetFeatures is a static inline function defined in WebP's + decode.h. Since we cannot use that with dynamically-loaded libwebp + DLL, we instead load the internal function it calls and redirect to + that through a macro. */ +DEF_DLL_FN (VP8StatusCode, WebPGetFeaturesInternal, + (const uint8_t *, size_t, WebPBitstreamFeatures *, int)); +DEF_DLL_FN (uint8_t *, WebPDecodeRGBA, (const uint8_t *, size_t, int *, int *)); +DEF_DLL_FN (uint8_t *, WebPDecodeRGB, (const uint8_t *, size_t, int *, int *)); +DEF_DLL_FN (void, WebPFree, (void *)); + +static bool +init_webp_functions (void) +{ + HMODULE library; + + if (!(library = w32_delayed_load (Qwebp))) + return false; + + LOAD_DLL_FN (library, WebPGetInfo); + LOAD_DLL_FN (library, WebPGetFeaturesInternal); + LOAD_DLL_FN (library, WebPDecodeRGBA); + LOAD_DLL_FN (library, WebPDecodeRGB); + LOAD_DLL_FN (library, WebPFree); + return true; +} + +#undef WebPGetInfo +#undef WebPGetFeatures +#undef WebPDecodeRGBA +#undef WebPDecodeRGB +#undef WebPFree + +#define WebPGetInfo fn_WebPGetInfo +#define WebPGetFeatures(d,s,f) \ + fn_WebPGetFeaturesInternal(d,s,f,WEBP_DECODER_ABI_VERSION) +#define WebPDecodeRGBA fn_WebPDecodeRGBA +#define WebPDecodeRGB fn_WebPDecodeRGB +#define WebPFree fn_WebPFree + +#endif /* WINDOWSNT */ + +/* Load WebP image IMG for use on frame F. Value is true if + successful. */ + +static bool +webp_load (struct frame *f, struct image *img) +{ + ptrdiff_t size = 0; + uint8_t *contents; + Lisp_Object file; + + /* Open the WebP file. */ + Lisp_Object specified_file = image_spec_value (img->spec, QCfile, NULL); + Lisp_Object specified_data = image_spec_value (img->spec, QCdata, NULL); + + if (NILP (specified_data)) + { + int fd; + file = image_find_image_fd (specified_file, &fd); + if (!STRINGP (file)) + { + image_error ("Cannot find image file `%s'", specified_file); + return false; + } + + contents = (uint8_t *) slurp_file (fd, &size); + if (contents == NULL) + { + image_error ("Error loading WebP image `%s'", file); + return false; + } + } + else + { + if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data); + return false; + } + contents = SDATA (specified_data); + size = SBYTES (specified_data); + } + + /* Validate the WebP image header. */ + if (!WebPGetInfo (contents, size, NULL, NULL)) + { + if (NILP (specified_data)) + image_error ("Not a WebP file: `%s'", file); + else + image_error ("Invalid header in WebP image data"); + goto webp_error1; + } + + /* Get WebP features. */ + WebPBitstreamFeatures features; + VP8StatusCode result = WebPGetFeatures (contents, size, &features); + switch (result) + { + case VP8_STATUS_OK: + break; + case VP8_STATUS_NOT_ENOUGH_DATA: + case VP8_STATUS_OUT_OF_MEMORY: + case VP8_STATUS_INVALID_PARAM: + case VP8_STATUS_BITSTREAM_ERROR: + case VP8_STATUS_UNSUPPORTED_FEATURE: + case VP8_STATUS_SUSPENDED: + case VP8_STATUS_USER_ABORT: + default: + /* Error out in all other cases. */ + if (NILP (specified_data)) + image_error ("Error when interpreting WebP image data: `%s'", file); + else + image_error ("Error when interpreting WebP image data"); + goto webp_error1; + } + + /* Decode WebP data. */ + uint8_t *decoded; + int width, height; + if (features.has_alpha) + /* Linear [r0, g0, b0, a0, r1, g1, b1, a1, ...] order. */ + decoded = WebPDecodeRGBA (contents, size, &width, &height); + else + /* Linear [r0, g0, b0, r1, g1, b1, ...] order. */ + decoded = WebPDecodeRGB (contents, size, &width, &height); + + if (!(width <= INT_MAX && height <= INT_MAX + && check_image_size (f, width, height))) + { + image_size_error (); + goto webp_error2; + } + + /* Create the x image and pixmap. */ + Emacs_Pix_Container ximg, mask_img; + if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, false)) + goto webp_error2; + + /* Create an image and pixmap serving as mask if the WebP image + contains an alpha channel. */ + if (features.has_alpha + && !image_create_x_image_and_pixmap (f, img, width, height, 1, &mask_img, true)) + { + image_destroy_x_image (ximg); + image_clear_image_1 (f, img, CLEAR_IMAGE_PIXMAP); + goto webp_error2; + } + + /* Fill the X image and mask from WebP data. */ + init_color_table (); + + uint8_t *p = decoded; + for (int y = 0; y < height; ++y) + { + for (int x = 0; x < width; ++x) + { + int r = *p++ << 8; + int g = *p++ << 8; + int b = *p++ << 8; + PUT_PIXEL (ximg, x, y, lookup_rgb_color (f, r, g, b)); + + /* An alpha channel associates variable transparency with an + image. WebP allows up to 256 levels of partial transparency. + We handle this like with PNG (which see), using the frame's + background color to combine the image with. */ + if (features.has_alpha) + { + if (mask_img) + PUT_PIXEL (mask_img, x, y, *p > 0 ? PIX_MASK_DRAW : PIX_MASK_RETAIN); + ++p; + } + } + } + +#ifdef COLOR_TABLE_SUPPORT + /* Remember colors allocated for this image. */ + img->colors = colors_in_color_table (&img->ncolors); + free_color_table (); +#endif /* COLOR_TABLE_SUPPORT */ + + /* Put ximg into the image. */ + image_put_x_image (f, img, ximg, 0); + + /* Same for the mask. */ + if (mask_img) + { + /* Fill in the background_transparent field while we have the + mask handy. Casting avoids a GCC warning. */ + image_background_transparent (img, f, (Emacs_Pix_Context)mask_img); + + image_put_x_image (f, img, mask_img, 1); + } + + img->width = width; + img->height = height; + + /* Clean up. */ + WebPFree (decoded); + if (NILP (specified_data)) + xfree (contents); + return true; + + webp_error2: + WebPFree (decoded); + + webp_error1: + if (NILP (specified_data)) + xfree (contents); + return false; +} + +#endif /* HAVE_WEBP */ + + #ifdef HAVE_IMAGEMAGICK + /*********************************************************************** ImageMagick ***********************************************************************/ @@ -9816,14 +10112,15 @@ DEF_DLL_FN (void, rsvg_handle_get_intrinsic_dimensions, DEF_DLL_FN (gboolean, rsvg_handle_get_geometry_for_layer, (RsvgHandle *, const char *, const RsvgRectangle *, RsvgRectangle *, RsvgRectangle *, GError **)); +# else +DEF_DLL_FN (void, rsvg_handle_get_dimensions, + (RsvgHandle *, RsvgDimensionData *)); # endif # if LIBRSVG_CHECK_VERSION (2, 48, 0) DEF_DLL_FN (gboolean, rsvg_handle_set_stylesheet, (RsvgHandle *, const guint8 *, gsize, GError **)); # endif -DEF_DLL_FN (void, rsvg_handle_get_dimensions, - (RsvgHandle *, RsvgDimensionData *)); DEF_DLL_FN (GdkPixbuf *, rsvg_handle_get_pixbuf, (RsvgHandle *)); DEF_DLL_FN (int, gdk_pixbuf_get_width, (const GdkPixbuf *)); DEF_DLL_FN (int, gdk_pixbuf_get_height, (const GdkPixbuf *)); @@ -9874,11 +10171,12 @@ init_svg_functions (void) #if LIBRSVG_CHECK_VERSION (2, 46, 0) LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_dimensions); LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer); +#else + LOAD_DLL_FN (library, rsvg_handle_get_dimensions); #endif #if LIBRSVG_CHECK_VERSION (2, 48, 0) LOAD_DLL_FN (library, rsvg_handle_set_stylesheet); #endif - LOAD_DLL_FN (library, rsvg_handle_get_dimensions); LOAD_DLL_FN (library, rsvg_handle_get_pixbuf); LOAD_DLL_FN (gdklib, gdk_pixbuf_get_width); @@ -9916,8 +10214,9 @@ init_svg_functions (void) # if LIBRSVG_CHECK_VERSION (2, 46, 0) # undef rsvg_handle_get_intrinsic_dimensions # undef rsvg_handle_get_geometry_for_layer +# else +# undef rsvg_handle_get_dimensions # endif -# undef rsvg_handle_get_dimensions # if LIBRSVG_CHECK_VERSION (2, 48, 0) # undef rsvg_handle_set_stylesheet # endif @@ -9952,8 +10251,9 @@ init_svg_functions (void) fn_rsvg_handle_get_intrinsic_dimensions # define rsvg_handle_get_geometry_for_layer \ fn_rsvg_handle_get_geometry_for_layer +# else +# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions # endif -# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions # if LIBRSVG_CHECK_VERSION (2, 48, 0) # define rsvg_handle_set_stylesheet fn_rsvg_handle_set_stylesheet # endif @@ -10136,10 +10436,16 @@ svg_load_image (struct frame *f, struct image *img, char *contents, if (!STRINGP (lcss)) { /* Generate the CSS for the SVG image. */ - const char *css_spec = "svg{font-family:\"%s\";font-size:%4dpx}"; - int css_len = strlen (css_spec) + strlen (img->face_font_family); + /* FIXME: The below calculations leave enough space for a font + size up to 9999, if it overflows we just throw an error but + should probably increase the buffer size. */ + const char *css_spec = "svg{font-family:\"%s\";font-size:%dpx}"; + int css_len = strlen (css_spec) + strlen (img->face_font_family) + 1; css = xmalloc (css_len); - snprintf (css, css_len, css_spec, img->face_font_family, img->face_font_size); + if (css_len <= snprintf (css, css_len, css_spec, + img->face_font_family, img->face_font_size)) + goto rsvg_error; + rsvg_handle_set_stylesheet (rsvg_handle, (guint8 *)css, strlen (css), NULL); } else @@ -10179,7 +10485,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, #if LIBRSVG_CHECK_VERSION (2, 46, 0) RsvgRectangle zero_rect, viewbox, out_logical_rect; - /* Try the instrinsic dimensions first. */ + /* Try the intrinsic dimensions first. */ gboolean has_width, has_height, has_viewbox; RsvgLength iwidth, iheight; double dpi = FRAME_DISPLAY_INFO (f)->resx; @@ -10214,7 +10520,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, } else { - /* We haven't found a useable set of sizes, so try working out + /* We haven't found a usable set of sizes, so try working out the visible area. */ rsvg_handle_get_geometry_for_layer (rsvg_handle, NULL, &zero_rect, &viewbox, @@ -10222,21 +10528,13 @@ svg_load_image (struct frame *f, struct image *img, char *contents, viewbox_width = viewbox.x + viewbox.width; viewbox_height = viewbox.y + viewbox.height; } - - if (viewbox_width == 0 || viewbox_height == 0) +#else + /* In librsvg before 2.46.0, guess the viewbox from the image dimensions. */ + RsvgDimensionData dimension_data; + rsvg_handle_get_dimensions (rsvg_handle, &dimension_data); + viewbox_width = dimension_data.width; + viewbox_height = dimension_data.height; #endif - { - /* The functions used above to get the geometry of the visible - area of the SVG are only available in librsvg 2.46 and above, - so in certain circumstances this code path can result in some - parts of the SVG being cropped. */ - RsvgDimensionData dimension_data; - - rsvg_handle_get_dimensions (rsvg_handle, &dimension_data); - - viewbox_width = dimension_data.width; - viewbox_height = dimension_data.height; - } compute_image_size (viewbox_width, viewbox_height, img, &width, &height); @@ -10297,12 +10595,11 @@ svg_load_image (struct frame *f, struct image *img, char *contents, wrapped_contents = xmalloc (buffer_size); - if (!wrapped_contents - || buffer_size <= snprintf (wrapped_contents, buffer_size, wrapper, - foreground & 0xFFFFFF, width, height, - viewbox_width, viewbox_height, - background & 0xFFFFFF, - SSDATA (encoded_contents))) + if (buffer_size <= snprintf (wrapped_contents, buffer_size, wrapper, + foreground & 0xFFFFFF, width, height, + viewbox_width, viewbox_height, + background & 0xFFFFFF, + SSDATA (encoded_contents))) goto rsvg_error; wrapped_size = strlen (wrapped_contents); @@ -10862,6 +11159,10 @@ static struct image_type const image_types[] = { SYMBOL_INDEX (Qxpm), xpm_image_p, xpm_load, image_clear_image, IMAGE_TYPE_INIT (init_xpm_functions) }, #endif +#if defined HAVE_WEBP + { SYMBOL_INDEX (Qwebp), webp_image_p, webp_load, image_clear_image, + IMAGE_TYPE_INIT (init_webp_functions) }, +#endif { SYMBOL_INDEX (Qxbm), xbm_image_p, xbm_load, image_clear_image }, { SYMBOL_INDEX (Qpbm), pbm_image_p, pbm_load, image_clear_image }, }; @@ -11027,6 +11328,11 @@ non-numeric, there is no explicit limit on the size of images. */); add_image_type (Qpng); #endif +#if defined (HAVE_WEBP) + DEFSYM (Qwebp, "webp"); + add_image_type (Qwebp); +#endif + #if defined (HAVE_IMAGEMAGICK) DEFSYM (Qimagemagick, "imagemagick"); add_image_type (Qimagemagick); diff --git a/src/insdel.c b/src/insdel.c index e66120eb08a..40674e15e45 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1392,7 +1392,7 @@ adjust_after_insert (ptrdiff_t from, ptrdiff_t from_byte, void replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new, bool prepare, bool inherit, bool markers, - bool adjust_match_data) + bool adjust_match_data, bool inhibit_mod_hooks) { ptrdiff_t inschars = SCHARS (new); ptrdiff_t insbytes = SBYTES (new); @@ -1552,8 +1552,11 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new, if (adjust_match_data) update_search_regs (from, to, from + SCHARS (new)); - signal_after_change (from, nchars_del, GPT - from); - update_compositions (from, GPT, CHECK_BORDER); + if (!inhibit_mod_hooks) + { + signal_after_change (from, nchars_del, GPT - from); + update_compositions (from, GPT, CHECK_BORDER); + } } /* Replace the text from character positions FROM to TO with diff --git a/src/intervals.c b/src/intervals.c index f88a41f2549..11d5b6bbb6f 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -166,10 +166,11 @@ merge_properties (register INTERVAL source, register INTERVAL target) } } -/* Return true if the two intervals have the same properties. */ +/* Return true if the two intervals have the same properties. + If use_equal is true, use Fequal for comparisons instead of EQ. */ -bool -intervals_equal (INTERVAL i0, INTERVAL i1) +static bool +intervals_equal_1 (INTERVAL i0, INTERVAL i1, bool use_equal) { Lisp_Object i0_cdr, i0_sym; Lisp_Object i1_cdr, i1_val; @@ -204,7 +205,8 @@ intervals_equal (INTERVAL i0, INTERVAL i1) /* i0 and i1 both have sym, but it has different values in each. */ if (!CONSP (i1_val) || (i1_val = XCDR (i1_val), !CONSP (i1_val)) - || !EQ (XCAR (i1_val), XCAR (i0_cdr))) + || use_equal ? NILP (Fequal (XCAR (i1_val), XCAR (i0_cdr))) + : !EQ (XCAR (i1_val), XCAR (i0_cdr))) return false; i0_cdr = XCDR (i0_cdr); @@ -218,6 +220,14 @@ intervals_equal (INTERVAL i0, INTERVAL i1) /* Lengths of the two plists were equal. */ return (NILP (i0_cdr) && NILP (i1_cdr)); } + +/* Return true if the two intervals have the same properties. */ + +bool +intervals_equal (INTERVAL i0, INTERVAL i1) +{ + return intervals_equal_1 (i0, i1, false); +} /* Traverse an interval tree TREE, performing FUNCTION on each node. @@ -2291,7 +2301,7 @@ compare_string_intervals (Lisp_Object s1, Lisp_Object s2) /* If we ever find a mismatch between the strings, they differ. */ - if (! intervals_equal (i1, i2)) + if (! intervals_equal_1 (i1, i2, true)) return 0; /* Advance POS till the end of the shorter interval, diff --git a/src/keyboard.c b/src/keyboard.c index 5b828ca60ff..79c353702c7 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -375,6 +375,7 @@ static void timer_resume_idle (void); static void deliver_user_signal (int); static char *find_user_signal_name (int); static void store_user_signal_events (void); +static bool is_ignored_event (union buffered_input_event *); /* Advance or retreat a buffered input event pointer. */ @@ -753,10 +754,21 @@ DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "", doc: /* Invoke the editor command loop recursively. To get out of the recursive edit, a command can throw to `exit' -- for instance (throw \\='exit nil). -If you throw a value other than t, `recursive-edit' returns normally -to the function that called it. Throwing a t value causes -`recursive-edit' to quit, so that control returns to the command loop -one level up. + +The following values (last argument to `throw') can be used when +throwing to \\='exit: + +- t causes `recursive-edit' to quit, so that control returns to the + command loop one level up. + +- A string causes `recursive-edit' to signal an error, printing that + string as the error message. + +- A function causes `recursive-edit' to call that function with no + arguments, and then return normally. + +- Any other value causes `recursive-edit' to return normally to the + function that called it. This function is called by the editor initialization to begin editing. */) (void) @@ -924,6 +936,7 @@ static Lisp_Object cmd_error (Lisp_Object data) { Lisp_Object old_level, old_length; + ptrdiff_t count = SPECPDL_INDEX (); Lisp_Object conditions; char macroerror[sizeof "After..kbd macro iterations: " + INT_STRLEN_BOUND (EMACS_INT)]; @@ -950,9 +963,13 @@ cmd_error (Lisp_Object data) Vexecuting_kbd_macro = Qnil; executing_kbd_macro = Qnil; } + else if (!NILP (KVAR (current_kboard, defining_kbd_macro))) + /* An `M-x' command that signals a `minibuffer-quit' condition + that's part of a kbd macro. */ + finalize_kbd_macro_chars (); - Vstandard_output = Qt; - Vstandard_input = Qt; + specbind (Qstandard_output, Qt); + specbind (Qstandard_input, Qt); kset_prefix_arg (current_kboard, Qnil); kset_last_prefix_arg (current_kboard, Qnil); cancel_echoing (); @@ -969,6 +986,7 @@ cmd_error (Lisp_Object data) Vquit_flag = Qnil; Vinhibit_quit = Qnil; + unbind_to (count, Qnil); return make_fixnum (0); } @@ -1007,25 +1025,28 @@ Default value of `command-error-function'. */) (Lisp_Object data, Lisp_Object context, Lisp_Object signal) { struct frame *sf = SELECTED_FRAME (); - Lisp_Object conditions; + Lisp_Object conditions = Fget (XCAR (data), Qerror_conditions); + int is_minibuffer_quit = !NILP (Fmemq (Qminibuffer_quit, conditions)); CHECK_STRING (context); /* If the window system or terminal frame hasn't been initialized - yet, or we're not interactive, write the message to stderr and exit. */ - if (!sf->glyphs_initialized_p - /* The initial frame is a special non-displaying frame. It - will be current in daemon mode when there are no frames - to display, and in non-daemon mode before the real frame - has finished initializing. If an error is thrown in the - latter case while creating the frame, then the frame - will never be displayed, so the safest thing to do is - write to stderr and quit. In daemon mode, there are - many other potential errors that do not prevent frames - from being created, so continuing as normal is better in - that case. */ - || (!IS_DAEMON && FRAME_INITIAL_P (sf)) - || noninteractive) + yet, or we're not interactive, write the message to stderr and exit. + Don't do this for the minibuffer-quit condition. */ + if (!is_minibuffer_quit + && (!sf->glyphs_initialized_p + /* The initial frame is a special non-displaying frame. It + will be current in daemon mode when there are no frames + to display, and in non-daemon mode before the real frame + has finished initializing. If an error is thrown in the + latter case while creating the frame, then the frame + will never be displayed, so the safest thing to do is + write to stderr and quit. In daemon mode, there are + many other potential errors that do not prevent frames + from being created, so continuing as normal is better in + that case. */ + || (!IS_DAEMON && FRAME_INITIAL_P (sf)) + || noninteractive)) { print_error_message (data, Qexternal_debugging_output, SSDATA (context), signal); @@ -1034,12 +1055,10 @@ Default value of `command-error-function'. */) } else { - conditions = Fget (XCAR (data), Qerror_conditions); - clear_message (1, 0); message_log_maybe_newline (); - if (!NILP (Fmemq (Qminibuffer_quit, conditions))) + if (is_minibuffer_quit) { Fding (Qt); } @@ -2925,20 +2944,8 @@ read_char (int commandflag, Lisp_Object map, last_input_event = c; call4 (Qcommand_execute, tem, Qnil, Fvector (1, &last_input_event), Qt); - if (CONSP (c) - && (EQ (XCAR (c), Qselect_window) - || EQ (XCAR (c), Qfocus_out) -#ifdef HAVE_DBUS - || EQ (XCAR (c), Qdbus_event) -#endif -#ifdef USE_FILE_NOTIFY - || EQ (XCAR (c), Qfile_notify) -#endif -#ifdef THREADS_ENABLED - || EQ (XCAR (c), Qthread_event) -#endif - || EQ (XCAR (c), Qconfig_changed_event)) - && !end_time) + if (CONSP (c) && !NILP (Fmemq (XCAR (c), Vwhile_no_input_ignore_events)) + && !end_time) /* We stopped being idle for this event; undo that. This prevents automatic window selection (under mouse-autoselect-window) from acting as a real input event, for @@ -3440,10 +3447,17 @@ readable_events (int flags) if (flags & READABLE_EVENTS_DO_TIMERS_NOW) timer_check (); - /* If the buffer contains only FOCUS_IN/OUT_EVENT events, and - READABLE_EVENTS_FILTER_EVENTS is set, report it as empty. */ + /* READABLE_EVENTS_FILTER_EVENTS is meant to be used only by + input-pending-p and similar callers, which aren't interested in + some input events. If this flag is set, and + input-pending-p-filter-events is non-nil, ignore events in + while-no-input-ignore-events. If the flag is set and + input-pending-p-filter-events is nil, ignore only + FOCUS_IN/OUT_EVENT events. */ if (kbd_fetch_ptr != kbd_store_ptr) { + /* See https://lists.gnu.org/r/emacs-devel/2005-05/msg00297.html + for why we treat toolkit scroll-bar events specially here. */ if (flags & (READABLE_EVENTS_FILTER_EVENTS #ifdef USE_TOOLKIT_SCROLL_BARS | READABLE_EVENTS_IGNORE_SQUEEZABLES @@ -3458,8 +3472,11 @@ readable_events (int flags) #ifdef USE_TOOLKIT_SCROLL_BARS (flags & READABLE_EVENTS_FILTER_EVENTS) && #endif - (event->kind == FOCUS_IN_EVENT - || event->kind == FOCUS_OUT_EVENT)) + ((!input_pending_p_filter_events + && (event->kind == FOCUS_IN_EVENT + || event->kind == FOCUS_OUT_EVENT)) + || (input_pending_p_filter_events + && is_ignored_event (event)))) #ifdef USE_TOOLKIT_SCROLL_BARS && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES) && (event->kind == SCROLL_BAR_CLICK_EVENT @@ -3641,29 +3658,10 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, #endif /* subprocesses */ } - Lisp_Object ignore_event; - - switch (event->kind) - { - case FOCUS_IN_EVENT: ignore_event = Qfocus_in; break; - case FOCUS_OUT_EVENT: ignore_event = Qfocus_out; break; - case HELP_EVENT: ignore_event = Qhelp_echo; break; - case ICONIFY_EVENT: ignore_event = Qiconify_frame; break; - case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break; - case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break; -#ifdef USE_FILE_NOTIFY - case FILE_NOTIFY_EVENT: ignore_event = Qfile_notify; break; -#endif -#ifdef HAVE_DBUS - case DBUS_EVENT: ignore_event = Qdbus_event; break; -#endif - default: ignore_event = Qnil; break; - } - /* If we're inside while-no-input, and this event qualifies as input, set quit-flag to cause an interrupt. */ if (!NILP (Vthrow_on_input) - && NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events))) + && !is_ignored_event (event)) Vquit_flag = Vthrow_on_input; } @@ -3998,6 +3996,7 @@ kbd_buffer_get_event (KBOARD **kbp, #endif #ifdef HAVE_XWIDGETS case XWIDGET_EVENT: + case XWIDGET_DISPLAY_EVENT: #endif case SAVE_SESSION_EVENT: case NO_EVENT: @@ -4235,7 +4234,7 @@ decode_timer (Lisp_Object timer, struct timespec *result) { Lisp_Object *vec; - if (! (VECTORP (timer) && ASIZE (timer) == 9)) + if (! (VECTORP (timer) && ASIZE (timer) == 10)) return false; vec = XVECTOR (timer)->contents; if (! NILP (vec[0])) @@ -4902,7 +4901,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. */ -static const char *const lispy_function_keys[] = +const char *const lispy_function_keys[] = { /* X Keysym value */ @@ -5088,13 +5087,56 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, enum window_part part; Lisp_Object posn = Qnil; Lisp_Object extra_info = Qnil; + int mx = XFIXNUM (x), my = XFIXNUM (y); /* Coordinate pixel positions to return. */ int xret = 0, yret = 0; /* The window or frame under frame pixel coordinates (x,y) */ Lisp_Object window_or_frame = f - ? window_from_coordinates (f, XFIXNUM (x), XFIXNUM (y), &part, 0, 0) + ? window_from_coordinates (f, mx, my, &part, true, true) : Qnil; + /* Report mouse events on the tab bar and (on GUI frames) on the + tool bar. */ +#ifdef HAVE_WINDOW_SYSTEM + if ((WINDOWP (f->tab_bar_window) + && EQ (window_or_frame, f->tab_bar_window)) +#ifndef HAVE_EXT_TOOL_BAR + || (WINDOWP (f->tool_bar_window) + && EQ (window_or_frame, f->tool_bar_window)) +#endif + ) + { + /* FIXME: While track_mouse is non-nil, we do not report this + event as something that happened on the tool or tab bar since + that would break mouse dragging operations that originate from + an ordinary window beneath and expect the window to auto-scroll + as soon as the mouse cursor appears above or beneath it + (Bug#50993). Since this "fix" might break track_mouse based + operations originating from the tool or tab bar itself, such + operations should set track_mouse to some special value that + would be recognized by the following check. + + This issue should be properly handled by 'mouse-drag-track' and + friends, so the below is only a temporary workaround. */ + if (NILP (track_mouse)) + posn = EQ (window_or_frame, f->tab_bar_window) ? Qtab_bar : Qtool_bar; + /* Kludge alert: for mouse events on the tab bar and tool bar, + keyboard.c wants the frame, not the special-purpose window + we use to display those, and it wants frame-relative + coordinates. FIXME! */ + window_or_frame = Qnil; + } +#endif + if (f + && !FRAME_WINDOW_P (f) + && FRAME_TAB_BAR_LINES (f) > 0 + && my >= FRAME_MENU_BAR_LINES (f) + && my < FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f)) + { + posn = Qtab_bar; + window_or_frame = Qnil; /* see above */ + } + if (WINDOWP (window_or_frame)) { /* It's a click in window WINDOW at frame coordinates (X,Y) */ @@ -5107,15 +5149,15 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, Lisp_Object object = Qnil; /* Pixel coordinates relative to the window corner. */ - int wx = XFIXNUM (x) - WINDOW_LEFT_EDGE_X (w); - int wy = XFIXNUM (y) - WINDOW_TOP_EDGE_Y (w); + int wx = mx - WINDOW_LEFT_EDGE_X (w); + int wy = my - WINDOW_TOP_EDGE_Y (w); /* For text area clicks, return X, Y relative to the corner of this text area. Note that dX, dY etc are set below, by buffer_posn_from_coords. */ if (part == ON_TEXT) { - xret = XFIXNUM (x) - window_box_left (w, TEXT_AREA); + xret = mx - window_box_left (w, TEXT_AREA); yret = wy - WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w); } /* For mode line and header line clicks, return X, Y relative to @@ -5239,7 +5281,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, : (part == ON_RIGHT_FRINGE || part == ON_RIGHT_MARGIN || (part == ON_VERTICAL_SCROLL_BAR && WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w))) - ? (XFIXNUM (x) - window_box_left (w, TEXT_AREA)) + ? (mx - window_box_left (w, TEXT_AREA)) : 0; int y2 = wy; @@ -5291,17 +5333,17 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, make_fixnum (row)), extra_info))); } - else if (f) { /* Return mouse pixel coordinates here. */ XSETFRAME (window_or_frame, f); - xret = XFIXNUM (x); - yret = XFIXNUM (y); + xret = mx; + yret = my; #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f) && FRAME_LIVE_P (f) + && NILP (posn) && FRAME_INTERNAL_BORDER_WIDTH (f) > 0 && !NILP (get_frame_param (f, Qdrag_internal_border))) { @@ -5650,6 +5692,11 @@ make_lispy_event (struct input_event *event) position = make_lispy_position (f, event->x, event->y, event->timestamp); + + /* For tab-bar clicks, add the propertized string with + button information as OBJECT member of POSITION. */ + if (CONSP (event->arg) && EQ (XCAR (event->arg), Qtab_bar)) + position = nconc2 (position, Fcons (XCDR (event->arg), Qnil)); } #ifndef USE_TOOLKIT_SCROLL_BARS else @@ -6079,23 +6126,20 @@ make_lispy_event (struct input_event *event) #ifdef HAVE_DBUS case DBUS_EVENT: - { - return Fcons (Qdbus_event, event->arg); - } + return Fcons (Qdbus_event, event->arg); #endif /* HAVE_DBUS */ #ifdef THREADS_ENABLED case THREAD_EVENT: - { - return Fcons (Qthread_event, event->arg); - } + return Fcons (Qthread_event, event->arg); #endif /* THREADS_ENABLED */ #ifdef HAVE_XWIDGETS case XWIDGET_EVENT: - { - return Fcons (Qxwidget_event, event->arg); - } + return Fcons (Qxwidget_event, event->arg); + + case XWIDGET_DISPLAY_EVENT: + return list2 (Qxwidget_display_event, event->arg); #endif #ifdef USE_FILE_NOTIFY @@ -7796,7 +7840,9 @@ parse_menu_item (Lisp_Object item, int inmenubar) else if (EQ (tem, QCkeys)) { tem = XCAR (item); - if (CONSP (tem) || STRINGP (tem)) + if (FUNCTIONP (tem)) + ASET (item_properties, ITEM_PROPERTY_KEYEQ, call0 (tem)); + else if (CONSP (tem) || STRINGP (tem)) ASET (item_properties, ITEM_PROPERTY_KEYEQ, tem); } else if (EQ (tem, QCbutton) && CONSP (XCAR (item))) @@ -9193,8 +9239,7 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt, /* If the function returned something invalid, barf--don't ignore it. */ if (! (NILP (next) || VECTORP (next) || STRINGP (next))) - error ("Function %s returns invalid key sequence", - SSDATA (SYMBOL_NAME (tem))); + signal_error ("Function returns invalid key sequence", tem); } return next; } @@ -10125,7 +10170,8 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, use the corresponding lower-case letter instead. */ if (NILP (current_binding) && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t - && FIXNUMP (key)) + && FIXNUMP (key) + && translate_upper_case_key_bindings) { Lisp_Object new_key; EMACS_INT k = XFIXNUM (key); @@ -10177,12 +10223,14 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, int modifiers = CONSP (breakdown) ? (XFIXNUM (XCAR (XCDR (breakdown)))) : 0; - if (modifiers & shift_modifier - /* Treat uppercase keys as shifted. */ - || (FIXNUMP (key) - && (KEY_TO_CHAR (key) - < XCHAR_TABLE (BVAR (current_buffer, downcase_table))->header.size) - && uppercasep (KEY_TO_CHAR (key)))) + if (translate_upper_case_key_bindings + && (modifiers & shift_modifier + /* Treat uppercase keys as shifted. */ + || (FIXNUMP (key) + && (KEY_TO_CHAR (key) + < XCHAR_TABLE (BVAR (current_buffer, + downcase_table))->header.size) + && uppercasep (KEY_TO_CHAR (key))))) { Lisp_Object new_key = (modifiers & shift_modifier @@ -11289,6 +11337,8 @@ The elements of this list correspond to the arguments of DEFUN ("posn-at-x-y", Fposn_at_x_y, Sposn_at_x_y, 2, 4, 0, doc: /* Return position information for pixel coordinates X and Y. By default, X and Y are relative to text area of the selected window. +Note that the text area includes the header-line and the tab-line of +the window, if any of them are present. Optional third arg FRAME-OR-WINDOW non-nil specifies frame or window. If optional fourth arg WHOLE is non-nil, X is relative to the left edge of the window. @@ -11556,6 +11606,52 @@ static const struct event_head head_table[] = { {SYMBOL_INDEX (Qselect_window), SYMBOL_INDEX (Qswitch_frame)} }; +static Lisp_Object +init_while_no_input_ignore_events (void) +{ + Lisp_Object events = listn (9, Qselect_window, Qhelp_echo, Qmove_frame, + Qiconify_frame, Qmake_frame_visible, + Qfocus_in, Qfocus_out, Qconfig_changed_event, + Qselection_request); + +#ifdef HAVE_DBUS + events = Fcons (Qdbus_event, events); +#endif +#ifdef USE_FILE_NOTIFY + events = Fcons (Qfile_notify, events); +#endif +#ifdef THREADS_ENABLED + events = Fcons (Qthread_event, events); +#endif + + return events; +} + +static bool +is_ignored_event (union buffered_input_event *event) +{ + Lisp_Object ignore_event; + + switch (event->kind) + { + case FOCUS_IN_EVENT: ignore_event = Qfocus_in; break; + case FOCUS_OUT_EVENT: ignore_event = Qfocus_out; break; + case HELP_EVENT: ignore_event = Qhelp_echo; break; + case ICONIFY_EVENT: ignore_event = Qiconify_frame; break; + case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break; + case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break; +#ifdef USE_FILE_NOTIFY + case FILE_NOTIFY_EVENT: ignore_event = Qfile_notify; break; +#endif +#ifdef HAVE_DBUS + case DBUS_EVENT: ignore_event = Qdbus_event; break; +#endif + default: ignore_event = Qnil; break; + } + + return !NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events)); +} + static void syms_of_keyboard_for_pdumper (void); void @@ -11642,6 +11738,7 @@ syms_of_keyboard (void) #ifdef HAVE_XWIDGETS DEFSYM (Qxwidget_event, "xwidget-event"); + DEFSYM (Qxwidget_display_event, "xwidget-display-event"); #endif #ifdef USE_FILE_NOTIFY @@ -12450,7 +12547,29 @@ If nil, Emacs crashes immediately in response to fatal signals. */); DEFVAR_LISP ("while-no-input-ignore-events", Vwhile_no_input_ignore_events, - doc: /* Ignored events from while-no-input. */); + doc: /* Ignored events from `while-no-input'. +Events in this list do not count as pending input while running +`while-no-input' and do not cause any idle timers to get reset when they +occur. */); + Vwhile_no_input_ignore_events = init_while_no_input_ignore_events (); + + DEFVAR_BOOL ("translate-upper-case-key-bindings", + translate_upper_case_key_bindings, + doc: /* If non-nil, interpret upper case keys as lower case (when applicable). +Emacs allows binding both upper and lower case key sequences to +commands. However, if there is a lower case key sequence bound to a +command, and the user enters an upper case key sequence that is not +bound to a command, Emacs will use the lower case binding. Setting +this variable to nil inhibits this behaviour. */); + translate_upper_case_key_bindings = true; + + DEFVAR_BOOL ("input-pending-p-filter-events", + input_pending_p_filter_events, + doc: /* If non-nil, `input-pending-p' ignores some input events. +If this variable is non-nil (the default), `input-pending-p' and +other similar functions ignore input events in `while-no-input-ignore-events'. +This flag may eventually be removed once this behavior is deemed safe. */); + input_pending_p_filter_events = true; pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper); } diff --git a/src/keyboard.h b/src/keyboard.h index 8bdffaa2bff..21c51ec3862 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -491,7 +491,7 @@ extern void process_pending_signals (void); extern struct timespec timer_check (void); extern void mark_kboards (void); -#ifdef HAVE_NTGUI +#if defined HAVE_NTGUI || defined HAVE_X_WINDOWS extern const char *const lispy_function_keys[]; #endif diff --git a/src/keymap.c b/src/keymap.c index fb8eceaec18..29d2ca7ab7e 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -65,6 +65,9 @@ static Lisp_Object exclude_keys; /* Pre-allocated 2-element vector for Fcommand_remapping to use. */ static Lisp_Object command_remapping_vector; +/* Char table for the backwards-compatibility part in Flookup_key. */ +static Lisp_Object unicode_case_table; + /* Hash table used to cache a reverse-map to speed up calls to where-is. */ static Lisp_Object where_is_cache; /* Which keymaps are reverse-stored in the cache. */ @@ -629,6 +632,9 @@ the definition it is bound to. The event may be a character range. If KEYMAP has a parent, the parent's bindings are included as well. This works recursively: if the parent has itself a parent, then the grandparent's bindings are also included and so on. + +For more information, see Info node `(elisp) Keymaps'. + usage: (map-keymap FUNCTION KEYMAP) */) (Lisp_Object function, Lisp_Object keymap, Lisp_Object sort_first) { @@ -1024,6 +1030,28 @@ is not copied. */) /* Simple Keymap mutators and accessors. */ +static Lisp_Object +possibly_translate_key_sequence (Lisp_Object key, ptrdiff_t *length) +{ + if (VECTORP (key) && ASIZE (key) == 1 && STRINGP (AREF (key, 0))) + { + /* KEY is on the ["C-c"] format, so translate to internal + format. */ + if (NILP (Ffboundp (Qkbd_valid_p))) + xsignal2 (Qerror, + build_string ("`kbd-valid-p' is not defined, so this syntax can't be used: %s"), + key); + if (NILP (call1 (Qkbd_valid_p, AREF (key, 0)))) + xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); + key = call1 (Qkbd, AREF (key, 0)); + *length = CHECK_VECTOR_OR_STRING (key); + if (*length == 0) + xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key); + } + + return key; +} + /* GC is possible in this function if it autoloads a keymap. */ DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0, @@ -1047,7 +1075,9 @@ DEF is anything that can be a key's definition: function definition, which should at that time be one of the above, or another symbol whose function definition is used, etc.), a cons (STRING . DEFN), meaning that DEFN is the definition - (DEFN should be a valid definition in its own right), + (DEFN should be a valid definition in its own right) and + STRING is the menu item name (which is used only if the containing + keymap has been created with a menu name, see `make-keymap'), or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP, or an extended menu item definition. (See info node `(elisp)Extended Menu Items'.) @@ -1082,6 +1112,8 @@ binding KEY to DEF is added at the front of KEYMAP. */) def = tmp; } + key = possibly_translate_key_sequence (key, &length); + ptrdiff_t idx = 0; while (1) { @@ -1180,27 +1212,8 @@ remapping in all currently active keymaps. */) return FIXNUMP (command) ? Qnil : command; } -/* Value is number if KEY is too long; nil if valid but has no definition. */ -/* GC is possible in this function. */ - -DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, - doc: /* Look up key sequence KEY in KEYMAP. Return the definition. -A value of nil means undefined. See doc of `define-key' -for kinds of definitions. - -A number as value means KEY is "too long"; -that is, characters or symbols in it except for the last one -fail to be a valid sequence of prefix characters in KEYMAP. -The number is how many characters at the front of KEY -it takes to reach a non-prefix key. -KEYMAP can also be a list of keymaps. - -Normally, `lookup-key' ignores bindings for t, which act as default -bindings, used when nothing else in the keymap applies; this makes it -usable as a general function for probing keymaps. However, if the -third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will -recognize the default bindings, just as `read-key-sequence' does. */) - (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) +static Lisp_Object +lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) { bool t_ok = !NILP (accept_default); @@ -1211,6 +1224,8 @@ recognize the default bindings, just as `read-key-sequence' does. */) if (length == 0) return keymap; + key = possibly_translate_key_sequence (key, &length); + ptrdiff_t idx = 0; while (1) { @@ -1240,6 +1255,156 @@ recognize the default bindings, just as `read-key-sequence' does. */) } } +/* Value is number if KEY is too long; nil if valid but has no definition. */ +/* GC is possible in this function. */ + +DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, + doc: /* Look up key sequence KEY in KEYMAP. Return the definition. +A value of nil means undefined. See doc of `define-key' +for kinds of definitions. + +A number as value means KEY is "too long"; +that is, characters or symbols in it except for the last one +fail to be a valid sequence of prefix characters in KEYMAP. +The number is how many characters at the front of KEY +it takes to reach a non-prefix key. +KEYMAP can also be a list of keymaps. + +Normally, `lookup-key' ignores bindings for t, which act as default +bindings, used when nothing else in the keymap applies; this makes it +usable as a general function for probing keymaps. However, if the +third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will +recognize the default bindings, just as `read-key-sequence' does. */) + (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) +{ + Lisp_Object found = lookup_key_1 (keymap, key, accept_default); + if (!NILP (found) && !NUMBERP (found)) + return found; + + /* Menu definitions might use mixed case symbols (notably in old + versions of `easy-menu-define'), or use " " instead of "-". + The rest of this function is about accepting these variations for + backwards-compatibility. (Bug#50752) */ + + /* Just skip everything below unless this is a menu item. */ + if (!VECTORP (key) || !(ASIZE (key) > 0) + || !EQ (AREF (key, 0), Qmenu_bar)) + return found; + + /* Initialize the unicode case table, if it wasn't already. */ + if (NILP (unicode_case_table)) + { + unicode_case_table = uniprop_table (intern ("lowercase")); + /* uni-lowercase.el might be unavailable during bootstrap. */ + if (NILP (unicode_case_table)) + return found; + staticpro (&unicode_case_table); + } + + ptrdiff_t key_len = ASIZE (key); + Lisp_Object new_key = make_vector (key_len, Qnil); + + /* Try both the Unicode case table, and the buffer local one. + Otherwise, we will fail for e.g. the "Turkish" language + environment where 'I' does not downcase to 'i'. */ + Lisp_Object tables[2] = {unicode_case_table, Fcurrent_case_table ()}; + for (int tbl_num = 0; tbl_num < 2; tbl_num++) + { + /* First, let's try converting all symbols like "Foo-Bar-Baz" to + "foo-bar-baz". */ + for (int i = 0; i < key_len; i++) + { + Lisp_Object item = AREF (key, i); + if (!SYMBOLP (item)) + ASET (new_key, i, item); + else + { + Lisp_Object key_item = Fsymbol_name (item); + Lisp_Object new_item; + if (!STRING_MULTIBYTE (key_item)) + new_item = Fdowncase (key_item); + else + { + USE_SAFE_ALLOCA; + ptrdiff_t size = SCHARS (key_item), n; + if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n)) + n = PTRDIFF_MAX; + unsigned char *dst = SAFE_ALLOCA (n); + unsigned char *p = dst; + ptrdiff_t j_char = 0, j_byte = 0; + + while (j_char < size) + { + int ch = fetch_string_char_advance (key_item, + &j_char, &j_byte); + Lisp_Object ch_conv = CHAR_TABLE_REF (tables[tbl_num], + ch); + if (!NILP (ch_conv)) + CHAR_STRING (XFIXNUM (ch_conv), p); + else + CHAR_STRING (ch, p); + p = dst + j_byte; + } + new_item = make_multibyte_string ((char *) dst, + SCHARS (key_item), + SBYTES (key_item)); + SAFE_FREE (); + } + ASET (new_key, i, Fintern (new_item, Qnil)); + } + } + + /* Check for match. */ + found = lookup_key_1 (keymap, new_key, accept_default); + if (!NILP (found) && !NUMBERP (found)) + break; + + /* If we still don't have a match, let's convert any spaces in + our lowercased string into dashes, e.g. "foo bar baz" to + "foo-bar-baz". */ + for (int i = 0; i < key_len; i++) + { + if (!SYMBOLP (AREF (new_key, i))) + continue; + + Lisp_Object lc_key = Fsymbol_name (AREF (new_key, i)); + + /* If there are no spaces in this symbol, just skip it. */ + if (!strstr (SSDATA (lc_key), " ")) + continue; + + USE_SAFE_ALLOCA; + ptrdiff_t size = SCHARS (lc_key), n; + if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n)) + n = PTRDIFF_MAX; + unsigned char *dst = SAFE_ALLOCA (n); + + /* We can walk the string data byte by byte, because UTF-8 + encoding ensures that no other byte of any multibyte + sequence will ever include a 7-bit byte equal to an ASCII + single-byte character. */ + memcpy (dst, SSDATA (lc_key), SBYTES (lc_key)); + for (int i = 0; i < SBYTES (lc_key); ++i) + { + if (dst[i] == ' ') + dst[i] = '-'; + } + Lisp_Object new_it = + make_multibyte_string ((char *) dst, + SCHARS (lc_key), SBYTES (lc_key)); + ASET (new_key, i, Fintern (new_it, Qnil)); + SAFE_FREE (); + } + + /* Check for match. */ + found = lookup_key_1 (keymap, new_key, accept_default); + if (!NILP (found) && !NUMBERP (found)) + break; + } + + return found; +} + /* Make KEYMAP define event C as a keymap (i.e., as a prefix). Assume that currently it does not define C at all. Return the keymap. */ @@ -2768,7 +2933,10 @@ You type Translation\n\ { if (EQ (start1, BVAR (XBUFFER (buffer), keymap))) { - Lisp_Object msg = build_unibyte_string ("\f\nMajor Mode Bindings"); + Lisp_Object msg = + CALLN (Fformat, + build_unibyte_string ("\f\n`%s' Major Mode Bindings"), + XBUFFER (buffer)->major_mode_); CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, @@ -2935,7 +3103,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, Lisp_Object suppress = Qnil; bool first = true; /* Range of elements to be handled. */ - int from, to, stop; + int to, stop; if (!keymap_p) { @@ -2955,17 +3123,19 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, if (partial) suppress = intern ("suppress-keymap"); - from = 0; + /* STOP is a boundary between normal characters (-#x3FFF7F) and + 8-bit characters (#x3FFF80-), used below when VECTOR is a + char-table. */ if (CHAR_TABLE_P (vector)) stop = MAX_5_BYTE_CHAR + 1, to = MAX_CHAR + 1; else stop = to = ASIZE (vector); - for (int i = from; ; i++) + for (int i = 0; ; i++) { bool this_shadowed = false; Lisp_Object shadowed_by = Qnil; - int range_beg, range_end; + int range_beg; Lisp_Object val, tem2; maybe_quit (); @@ -2981,6 +3151,10 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, if (CHAR_TABLE_P (vector)) { + /* Find the value in VECTOR for the first character in the + range [RANGE_BEG..STOP), and update the range to include + only the characters whose value is the same as that of + the first in the range. */ range_beg = i; i = stop - 1; val = char_table_ref_and_range (vector, range_beg, &range_beg, &i); @@ -3039,33 +3213,26 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, insert1 (describe_key_maybe_fontify (kludge, prefix, keymap_p)); /* Find all consecutive characters or rows that have the same - definition. But, if VECTOR is a char-table, we had better - put a boundary between normal characters (-#x3FFF7F) and - 8-bit characters (#x3FFF80-). */ - if (CHAR_TABLE_P (vector)) + definition. */ + if (!CHAR_TABLE_P (vector)) { while (i + 1 < stop - && (range_beg = i + 1, range_end = stop - 1, - val = char_table_ref_and_range (vector, range_beg, - &range_beg, &range_end), - tem2 = get_keyelt (val, 0), - !NILP (tem2)) + && (tem2 = get_keyelt (AREF (vector, i + 1), 0), + !NILP (tem2)) && !NILP (Fequal (tem2, definition))) - i = range_end; + i++; } - else - while (i + 1 < stop - && (tem2 = get_keyelt (AREF (vector, i + 1), 0), - !NILP (tem2)) - && !NILP (Fequal (tem2, definition))) - i++; /* Make sure found consecutive keys are either not shadowed or, if they are, that they are shadowed by the same command. */ - if (CHAR_TABLE_P (vector) && i != starting_i) + if (!NILP (Vdescribe_bindings_check_shadowing_in_ranges) + && CHAR_TABLE_P (vector) && i != starting_i + && (!EQ (Vdescribe_bindings_check_shadowing_in_ranges, + Qignore_self_insert) + || !EQ (definition, Qself_insert_command))) { Lisp_Object key = make_nil_vector (1); - for (int j = starting_i + 1; j <= i; j++) + for (int j = range_beg + 1; j <= i; j++) { ASET (key, 0, make_fixnum (j)); Lisp_Object tem = shadow_lookup (shadow, key, Qt, 0); @@ -3181,6 +3348,24 @@ be preferred. */); Vwhere_is_preferred_modifier = Qnil; where_is_preferred_modifier = 0; + DEFVAR_LISP ("describe-bindings-check-shadowing-in-ranges", + Vdescribe_bindings_check_shadowing_in_ranges, + doc: /* If non-nil, consider command shadowing when describing ranges of keys. +If the value is t, describing bindings of consecutive keys will not +report them as a single range if they are shadowed by different +minor-mode commands. +If the value is `ignore-self-insert', assume that consecutive keys +bound to `self-insert-command' are not all shadowed; this speeds up +commands such as \\[describe-bindings] and \\[describe-mode], but could miss some shadowing. +Any other non-nil value is treated is t. + +Beware: setting this non-nil could potentially slow down commands +that describe key bindings. That is why the default is nil. */); + Vdescribe_bindings_check_shadowing_in_ranges = Qnil; + + DEFSYM (Qself_insert_command, "self-insert-command"); + DEFSYM (Qignore_self_insert, "ignore-self-insert"); + DEFSYM (Qmenu_bar, "menu-bar"); DEFSYM (Qmode_line, "mode-line"); @@ -3244,4 +3429,7 @@ be preferred. */); defsubr (&Stext_char_description); defsubr (&Swhere_is_internal); defsubr (&Sdescribe_buffer_bindings); + + DEFSYM (Qkbd, "kbd"); + DEFSYM (Qkbd_valid_p, "kbd-valid-p"); } diff --git a/src/lisp.h b/src/lisp.h index 15a42a44562..31656bb3b1c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1555,6 +1555,14 @@ STRING_MULTIBYTE (Lisp_Object str) /* Convenience functions for dealing with Lisp strings. */ +/* WARNING: Use the 'char *' pointers to string data with care in code + that could GC: GC can relocate string data, invalidating such + pointers. It is best to use string character or byte index + instead, delaying the access through SDATA/SSDATA pointers to the + latest possible moment. If you must use the 'char *' pointers + (e.g., for speed), be sure to adjust them after any call that could + potentially GC. */ + INLINE unsigned char * SDATA (Lisp_Object string) { @@ -1615,6 +1623,13 @@ STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) XSTRING (string)->u.s.size = newsize; } +INLINE void +CHECK_STRING_NULL_BYTES (Lisp_Object string) +{ + CHECK_TYPE (memchr (SSDATA (string), '\0', SBYTES (string)) == NULL, + Qfilenamep, string); +} + /* A regular vector is just a header plus an array of Lisp_Objects. */ struct Lisp_Vector @@ -2812,9 +2827,8 @@ enum Lisp_Compiled }; /* Flag bits in a character. These also get used in termhooks.h. - Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE - (MUlti-Lingual Emacs) might need 22 bits for the character value - itself, so we probably shouldn't use any bits lower than 0x0400000. */ + Emacs needs 22 bits for the character value itself, see MAX_CHAR, + so we shouldn't use any bits lower than 0x0400000. */ enum char_bits { CHAR_ALT = 0x0400000, @@ -3717,7 +3731,8 @@ extern void adjust_markers_for_delete (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); extern void adjust_markers_bytepos (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, int); -extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool, bool, bool); +extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool, + bool, bool, bool); extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, const char *, ptrdiff_t, ptrdiff_t, bool); extern void syms_of_insdel (void); @@ -3932,7 +3947,8 @@ build_string (const char *str) extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); -extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); +extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; /* Make an uninitialized vector for SIZE objects. NOTE: you must be sure that GC cannot happen until the vector is completely @@ -3945,7 +3961,8 @@ extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); allocate_vector has a similar problem. */ -extern struct Lisp_Vector *allocate_vector (ptrdiff_t); +extern struct Lisp_Vector *allocate_vector (ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; INLINE Lisp_Object make_uninit_vector (ptrdiff_t size) @@ -3977,7 +3994,8 @@ make_nil_vector (ptrdiff_t size) } extern struct Lisp_Vector *allocate_pseudovector (int, int, int, - enum pvec_type); + enum pvec_type) + ATTRIBUTE_RETURNS_NONNULL; /* Allocate uninitialized pseudovector with no Lisp_Object slots. */ @@ -4009,7 +4027,7 @@ extern void free_cons (struct Lisp_Cons *); extern void init_alloc_once (void); extern void init_alloc (void); extern void syms_of_alloc (void); -extern struct buffer * allocate_buffer (void); +extern struct buffer *allocate_buffer (void) ATTRIBUTE_RETURNS_NONNULL; extern int valid_lisp_object_p (Lisp_Object); /* Defined in gmalloc.c. */ @@ -4112,7 +4130,6 @@ intern_c_string (const char *str) } /* Defined in eval.c. */ -extern EMACS_INT minibuffer_quit_level; extern Lisp_Object Vautoload_queue; extern Lisp_Object Vrun_hooks; extern Lisp_Object Vsignaling_function; @@ -4168,7 +4185,8 @@ extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object)); -extern struct handler *push_handler (Lisp_Object, enum handlertype); +extern struct handler *push_handler (Lisp_Object, enum handlertype) + ATTRIBUTE_RETURNS_NONNULL; extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); @@ -4309,9 +4327,10 @@ extern void syms_of_marker (void); /* Defined in fileio.c. */ -extern char *splice_dir_file (char *, char const *, char const *); +extern char *splice_dir_file (char *, char const *, char const *) + ATTRIBUTE_RETURNS_NONNULL; extern bool file_name_absolute_p (const char *); -extern char const *get_homedir (void); +extern char const *get_homedir (void) ATTRIBUTE_RETURNS_NONNULL; extern Lisp_Object expand_and_dir_to_file (Lisp_Object); extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, @@ -4465,7 +4484,7 @@ 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); +extern char *emacs_strerror (int) ATTRIBUTE_RETURNS_NONNULL; extern void shut_down_emacs (int, Lisp_Object); /* True means don't do interactive redisplay and don't change tty modes. */ @@ -4531,7 +4550,7 @@ extern void setup_process_coding_systems (Lisp_Object); extern int emacs_spawn (pid_t *, int, int, int, char **, char **, const char *, const char *, const sigset_t *); -extern char **make_environment_block (Lisp_Object); +extern char **make_environment_block (Lisp_Object) ATTRIBUTE_RETURNS_NONNULL; extern void init_callproc_1 (void); extern void init_callproc (void); extern void set_initial_environment (void); @@ -4651,6 +4670,7 @@ extern AVOID fatal (const char *msgid, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); /* Defined in terminal.c. */ extern void syms_of_terminal (void); +extern char * tty_type_name (Lisp_Object); /* Defined in font.c. */ extern void syms_of_font (void); @@ -4799,17 +4819,24 @@ extern char my_edata[]; extern char my_endbss[]; extern char *my_endbss_static; -extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); -extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); -extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); +extern void *xmalloc (size_t) + ATTRIBUTE_MALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xzalloc (size_t) + ATTRIBUTE_MALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xrealloc (void *, size_t) + ATTRIBUTE_ALLOC_SIZE ((2)) ATTRIBUTE_RETURNS_NONNULL; extern void xfree (void *); -extern void *xnmalloc (ptrdiff_t, ptrdiff_t) ATTRIBUTE_MALLOC_SIZE ((1,2)); +extern void *xnmalloc (ptrdiff_t, ptrdiff_t) + ATTRIBUTE_MALLOC_SIZE ((1,2)) ATTRIBUTE_RETURNS_NONNULL; extern void *xnrealloc (void *, ptrdiff_t, ptrdiff_t) - ATTRIBUTE_ALLOC_SIZE ((2,3)); -extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t); - -extern char *xstrdup (const char *) ATTRIBUTE_MALLOC; -extern char *xlispstrdup (Lisp_Object) ATTRIBUTE_MALLOC; + ATTRIBUTE_ALLOC_SIZE ((2,3)) ATTRIBUTE_RETURNS_NONNULL; +extern void *xpalloc (void *, ptrdiff_t *, ptrdiff_t, ptrdiff_t, ptrdiff_t) + ATTRIBUTE_RETURNS_NONNULL; + +extern char *xstrdup (char const *) + ATTRIBUTE_MALLOC ATTRIBUTE_RETURNS_NONNULL; +extern char *xlispstrdup (Lisp_Object) + ATTRIBUTE_MALLOC ATTRIBUTE_RETURNS_NONNULL; extern void dupstring (char **, char const *); /* Make DEST a copy of STRING's data. Return a pointer to DEST's terminating @@ -4859,7 +4886,8 @@ extern void init_system_name (void); enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 }; -extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); +extern void *record_xmalloc (size_t) + ATTRIBUTE_ALLOC_SIZE ((1)) ATTRIBUTE_RETURNS_NONNULL; #define USE_SAFE_ALLOCA \ ptrdiff_t sa_avail = MAX_ALLOCA; \ diff --git a/src/lread.c b/src/lread.c index a6c2db5d994..b3f9e6ff527 100644 --- a/src/lread.c +++ b/src/lread.c @@ -165,6 +165,12 @@ static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool, Lisp_Object, Lisp_Object); static void build_load_history (Lisp_Object, bool); + +static Lisp_Object oblookup_considering_shorthand (Lisp_Object, const char *, + ptrdiff_t, ptrdiff_t, + char **, ptrdiff_t *, + ptrdiff_t *); + /* Functions that read one byte from the current source READCHARFUN or unreads one byte. If the integer argument C is -1, it returns @@ -192,7 +198,7 @@ static int readbyte_from_string (int, Lisp_Object); Qlambda, or a cons, we use this to keep an unread character because a file stream can't handle multibyte-char unreading. The value -1 means that there's no unread character. */ -static int unread_char; +static int unread_char = -1; static int readchar (Lisp_Object readcharfun, bool *multibyte) @@ -1507,6 +1513,7 @@ Return t if the file exists and loads successfully. */) input.stream = stream; input.lookahead = 0; infile = &input; + unread_char = -1; } if (! NILP (Vpurify_flag)) @@ -2955,7 +2962,6 @@ read_integer (Lisp_Object readcharfun, int radix, return unbind_to (count, string_to_number (read_buffer, radix, NULL)); } - /* If the next token is ')' or ']' or '.', we store that character in *PCH and the return value is not interesting. Else, we store zero in *PCH and we read and return one lisp object. @@ -2967,6 +2973,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) { int c; bool uninterned_symbol = false; + bool skip_shorthand = false; bool multibyte; char stackbuf[stackbufsize]; current_thread->stack_top = stackbuf; @@ -3362,6 +3369,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == ':') { uninterned_symbol = true; + read_hash_prefixed_symbol: c = READCHAR; if (!(c > 040 && c != NO_BREAK_SPACE @@ -3375,6 +3383,12 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } goto read_symbol; } + /* #_foo is really the symbol foo, regardless of shorthands */ + if (c == '_') + { + skip_shorthand = true; + goto read_hash_prefixed_symbol; + } /* ## is the empty symbol. */ if (c == '#') return Fintern (empty_unibyte_string, Qnil); @@ -3755,7 +3769,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) ptrdiff_t nbytes = p - read_buffer; UNREAD (c); - if (!quoted && !uninterned_symbol) + if (!quoted && !uninterned_symbol && !skip_shorthand) { ptrdiff_t len; Lisp_Object result = string_to_number (read_buffer, 10, &len); @@ -3785,11 +3799,36 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) Like intern_1 but supports multibyte names. */ Lisp_Object obarray = check_obarray (Vobarray); - Lisp_Object tem = oblookup (obarray, read_buffer, - nchars, nbytes); + + char* longhand = NULL; + ptrdiff_t longhand_chars = 0; + ptrdiff_t longhand_bytes = 0; + + Lisp_Object tem; + if (skip_shorthand + /* The following ASCII characters are used in the + only "core" Emacs Lisp symbols that are comprised + entirely of characters that have the 'symbol + constituent' syntax. We exempt them from + transforming according to shorthands. */ + || strspn (read_buffer, "^*+-/<=>_|") >= nbytes) + tem = oblookup (obarray, read_buffer, nchars, nbytes); + else + tem = oblookup_considering_shorthand (obarray, read_buffer, + nchars, nbytes, &longhand, + &longhand_chars, + &longhand_bytes); if (SYMBOLP (tem)) result = tem; + else if (longhand) + { + Lisp_Object name + = make_specified_string (longhand, longhand_chars, + longhand_bytes, multibyte); + xfree (longhand); + result = intern_driver (name, obarray, tem); + } else { Lisp_Object name @@ -4338,6 +4377,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) Lisp_Object intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index) { + SET_SYMBOL_VAL (XSYMBOL (Qobarray_cache), Qnil); return intern_sym (Fmake_symbol (string), obarray, index); } @@ -4406,10 +4446,28 @@ it defaults to the value of `obarray'. */) obarray = check_obarray (NILP (obarray) ? Vobarray : obarray); CHECK_STRING (string); - tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); + + char* longhand = NULL; + ptrdiff_t longhand_chars = 0; + ptrdiff_t longhand_bytes = 0; + tem = oblookup_considering_shorthand (obarray, SSDATA (string), + SCHARS (string), SBYTES (string), + &longhand, &longhand_chars, + &longhand_bytes); + if (!SYMBOLP (tem)) - tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string), - obarray, tem); + { + if (longhand) + { + tem = intern_driver (make_specified_string (longhand, longhand_chars, + longhand_bytes, true), + obarray, tem); + xfree (longhand); + } + else + tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string), + obarray, tem); + } return tem; } @@ -4428,17 +4486,29 @@ it defaults to the value of `obarray'. */) if (!SYMBOLP (name)) { + char *longhand = NULL; + ptrdiff_t longhand_chars = 0; + ptrdiff_t longhand_bytes = 0; + CHECK_STRING (name); string = name; + tem = oblookup_considering_shorthand (obarray, SSDATA (string), + SCHARS (string), SBYTES (string), + &longhand, &longhand_chars, + &longhand_bytes); + if (longhand) + xfree (longhand); + return FIXNUMP (tem) ? Qnil : tem; } else - string = SYMBOL_NAME (name); - - tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); - if (FIXNUMP (tem) || (SYMBOLP (name) && !EQ (name, tem))) - return Qnil; - else - return tem; + { + /* If already a symbol, we don't do shorthand-longhand translation, + as promised in the docstring. */ + string = SYMBOL_NAME (name); + tem + = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); + return EQ (name, tem) ? name : Qnil; + } } DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0, @@ -4450,7 +4520,8 @@ OBARRAY, if nil, defaults to the value of the variable `obarray'. usage: (unintern NAME OBARRAY) */) (Lisp_Object name, Lisp_Object obarray) { - register Lisp_Object string, tem; + register Lisp_Object tem; + Lisp_Object string; size_t hash; if (NILP (obarray)) obarray = Vobarray; @@ -4464,9 +4535,16 @@ usage: (unintern NAME OBARRAY) */) string = name; } - tem = oblookup (obarray, SSDATA (string), - SCHARS (string), - SBYTES (string)); + char *longhand = NULL; + ptrdiff_t longhand_chars = 0; + ptrdiff_t longhand_bytes = 0; + tem = oblookup_considering_shorthand (obarray, SSDATA (string), + SCHARS (string), SBYTES (string), + &longhand, &longhand_chars, + &longhand_bytes); + if (longhand) + xfree(longhand); + if (FIXNUMP (tem)) return Qnil; /* If arg was a symbol, don't delete anything but that symbol itself. */ @@ -4553,6 +4631,70 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff XSETINT (tem, hash); return tem; } + +/* Like 'oblookup', but considers 'Vread_symbol_shorthands', + potentially recognizing that IN is shorthand for some other + longhand name, which is then then placed in OUT. In that case, + memory is malloc'ed for OUT (which the caller must free) while + SIZE_OUT and SIZE_BYTE_OUT respectively hold the character and byte + sizes of the transformed symbol name. If IN is not recognized + shorthand for any other symbol, OUT is set to point to NULL and + 'oblookup' is called. */ + +Lisp_Object +oblookup_considering_shorthand (Lisp_Object obarray, const char *in, + ptrdiff_t size, ptrdiff_t size_byte, char **out, + ptrdiff_t *size_out, ptrdiff_t *size_byte_out) +{ + Lisp_Object tail = Vread_symbol_shorthands; + + /* First, assume no transformation will take place. */ + *out = NULL; + /* Then, iterate each pair in Vread_symbol_shorthands. */ + FOR_EACH_TAIL_SAFE (tail) + { + Lisp_Object pair = XCAR (tail); + /* Be lenient to 'read-symbol-shorthands': if some element isn't a + cons, or some member of that cons isn't a string, just skip + to the next element. */ + if (!CONSP (pair)) + continue; + Lisp_Object sh_prefix = XCAR (pair); + Lisp_Object lh_prefix = XCDR (pair); + if (!STRINGP (sh_prefix) || !STRINGP (lh_prefix)) + continue; + ptrdiff_t sh_prefix_size = SBYTES (sh_prefix); + + /* Compare the prefix of the transformation pair to the symbol + name. If a match occurs, do the renaming and exit the loop. + In other words, only one such transformation may take place. + Calculate the amount of memory to allocate for the longhand + version of the symbol name with xrealloc. This isn't + strictly needed, but it could later be used as a way for + multiple transformations on a single symbol name. */ + if (sh_prefix_size <= size_byte + && memcmp (SSDATA (sh_prefix), in, sh_prefix_size) == 0) + { + ptrdiff_t lh_prefix_size = SBYTES (lh_prefix); + ptrdiff_t suffix_size = size_byte - sh_prefix_size; + *out = xrealloc (*out, lh_prefix_size + suffix_size); + memcpy (*out, SSDATA(lh_prefix), lh_prefix_size); + memcpy (*out + lh_prefix_size, in + sh_prefix_size, suffix_size); + *size_out = SCHARS (lh_prefix) - SCHARS (sh_prefix) + size; + *size_byte_out = lh_prefix_size + suffix_size; + break; + } + } + /* Now, as promised, call oblookup with the "final" symbol name to + lookup. That function remains oblivious to whether a + transformation happened here or not, but the caller of this + function can tell by inspecting the OUT parameter. */ + if (*out) + return oblookup (obarray, *out, *size_out, *size_byte_out); + else + return oblookup (obarray, in, size, size_byte); +} + void map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) @@ -5309,4 +5451,11 @@ that are loaded before your customizations are read! */); DEFSYM (Qrehash_threshold, "rehash-threshold"); DEFSYM (Qchar_from_name, "char-from-name"); + + DEFVAR_LISP ("read-symbol-shorthands", Vread_symbol_shorthands, + doc: /* Alist of known symbol-name shorthands. +This variable's value can only be set via file-local variables. +See Info node `(elisp)Shorthands' for more details. */); + Vread_symbol_shorthands = Qnil; + DEFSYM (Qobarray_cache, "obarray-cache"); } diff --git a/src/macfont.m b/src/macfont.m index d86f09f4850..1426cae6dc4 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -613,6 +613,21 @@ get_cgcolor(unsigned long idx, struct frame *f) return cgColor; } +static CGColorRef +get_cgcolor_from_nscolor (NSColor *nsColor, struct frame *f) +{ + [nsColor set]; + CGColorSpaceRef colorSpace = [[nsColor colorSpace] CGColorSpace]; + NSInteger noc = [nsColor numberOfComponents]; + CGFloat *components = xmalloc (sizeof(CGFloat)*(1+noc)); + CGColorRef cgColor; + + [nsColor getComponents: components]; + cgColor = CGColorCreate (colorSpace, components); + xfree (components); + return cgColor; +} + #define CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND(context, face, f) \ do { \ CGColorRef refcol_ = get_cgcolor (NS_FACE_FOREGROUND (face), f); \ @@ -2415,8 +2430,12 @@ macfont_list (struct frame *f, Lisp_Object spec) continue; /* Don't use a color bitmap font unless its family is - explicitly specified. */ - if ((sym_traits & kCTFontTraitColorGlyphs) && NILP (family)) + explicitly specified or we're looking for a font for + emoji. */ + if ((sym_traits & kCTFontTraitColorGlyphs) + && NILP (family) + && !EQ (CDR_SAFE (assq_no_quit (QCscript, AREF (spec, FONT_EXTRA_INDEX))), + Qemoji)) continue; if (j > 0 @@ -2907,14 +2926,14 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y, if (!CGRectIsNull (background_rect)) { - if (s->hl == DRAW_MOUSE_FACE) + if (s->hl == DRAW_CURSOR) { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + CGColorRef *colorref = get_cgcolor_from_nscolor (FRAME_CURSOR_COLOR (f), f); + CGContextSetFillColorWithColor (context, colorref); + CGColorRelease (colorref); } - CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND (context, face, f); + else + CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND (context, face, f); CGContextFillRects (context, &background_rect, 1); } @@ -2923,7 +2942,14 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y, CGAffineTransform atfm; CGContextScaleCTM (context, 1, -1); - CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND (context, face, s->f); + if (s->hl == DRAW_CURSOR) + { + CGColorRef *colorref = get_cgcolor_from_nscolor (FRAME_BACKGROUND_COLOR (f), f); + CGContextSetFillColorWithColor (context, colorref); + CGColorRelease (colorref); + } + else + CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND (context, face, s->f); if (macfont_info->synthetic_italic_p) atfm = synthetic_italic_atfm; else diff --git a/src/menu.c b/src/menu.c index a2738ebd8a2..780b71eba6b 100644 --- a/src/menu.c +++ b/src/menu.c @@ -1127,9 +1127,12 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) /* Decode the first argument: find the window and the coordinates. */ if (EQ (position, Qt) - || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar) - || EQ (XCAR (position), Qtab_bar) - || EQ (XCAR (position), Qtool_bar)))) + || (CONSP (position) + && (EQ (XCAR (position), Qmenu_bar) + || EQ (XCAR (position), Qtab_bar) + || (CONSP (XCDR (position)) + && EQ (XCAR (XCDR (position)), Qtab_bar)) + || EQ (XCAR (position), Qtool_bar)))) { get_current_pos_p = 1; } @@ -1284,12 +1287,16 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) /* Search for a string appearing directly as an element of the keymap. That string is the title of the menu. */ prompt = Fkeymap_prompt (keymap); - if (!NILP (prompt)) - title = prompt; -#ifdef HAVE_NS /* Is that needed and NS-specific? --Stef */ + +#if defined (USE_GTK) || defined (HAVE_NS) + if (STRINGP (prompt) + && SCHARS (prompt) > 0 + && !NILP (Fget_text_property (make_fixnum (0), Qhide, prompt))) + title = Qnil; else - title = build_string ("Select"); #endif + if (!NILP (prompt)) + title = prompt; /* Make that be the pane title of the first pane. */ if (!NILP (prompt) && menu_items_n_panes >= 0) @@ -1575,6 +1582,8 @@ syms_of_menu (void) menu_items = Qnil; staticpro (&menu_items); + DEFSYM (Qhide, "hide"); + defsubr (&Sx_popup_menu); defsubr (&Sx_popup_dialog); defsubr (&Smenu_bar_menu_at_x_y); diff --git a/src/minibuf.c b/src/minibuf.c index 0f4349e70b8..6c0cd358c50 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -491,8 +491,13 @@ confirm the aborting of the current minibuffer and all contained ones. */) array[1] = make_fixnum (minibuf_level - minibuf_depth + 1); if (!NILP (Fyes_or_no_p (Fformat (2, array)))) { - minibuffer_quit_level = minibuf_depth; - Fthrow (Qexit, Qt); + /* Due to the above check, the current minibuffer is in the + most nested command loop, which means that we don't have + to abort any extra non-minibuffer recursive edits. Thus, + the number of recursive edits we have to abort equals the + number of minibuffers we have to abort. */ + CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit"), + array[1]); } } else @@ -689,12 +694,15 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, call1 (Qpush_window_buffer_onto_prev, minibuf_window); record_unwind_protect_void (minibuffer_unwind); - record_unwind_protect (restore_window_configuration, - list3 (Fcurrent_window_configuration (Qnil), Qt, Qt)); + if (read_minibuffer_restore_windows) + record_unwind_protect (restore_window_configuration, + list3 (Fcurrent_window_configuration (Qnil), + Qt, Qt)); /* If the minibuffer window is on a different frame, save that frame's configuration too. */ - if (!EQ (mini_frame, selected_frame)) + if (read_minibuffer_restore_windows && + !EQ (mini_frame, selected_frame)) record_unwind_protect (restore_window_configuration, list3 (Fcurrent_window_configuration (mini_frame), Qnil, Qt)); @@ -997,7 +1005,7 @@ set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth) if (!NILP (Ffboundp (Qminibuffer_inactive_mode))) call0 (Qminibuffer_inactive_mode); else - Fkill_all_local_variables (); + Fkill_all_local_variables (Qnil); } buf = unbind_to (count, buf); } @@ -1284,8 +1292,8 @@ Fifth arg HIST, if non-nil, specifies a history list and optionally HISTPOS is the initial position for use by the minibuffer history commands. For consistency, you should also specify that element of the history as the value of INITIAL-CONTENTS. Positions are counted - starting from 1 at the beginning of the list. If HIST is the symbol - `t', history is not recorded. + starting from 1 at the beginning of the list. If HIST is t, history + is not recorded. If `history-add-new-input' is non-nil (the default), the result will be added to the history list using `add-to-history'. @@ -1537,6 +1545,27 @@ minibuf_conform_representation (Lisp_Object string, Lisp_Object basis) return Fstring_make_multibyte (string); } +static bool +match_regexps (Lisp_Object string, Lisp_Object regexps, + bool ignore_case) +{ + ptrdiff_t val; + for (; CONSP (regexps); regexps = XCDR (regexps)) + { + CHECK_STRING (XCAR (regexps)); + + val = fast_string_match_internal + (XCAR (regexps), string, + (ignore_case ? BVAR (current_buffer, case_canon_table) : Qnil)); + + if (val == -2) + error ("Stack overflow in regexp matcher"); + if (val < 0) + return false; + } + return true; +} + DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0, doc: /* Return common substring of all completions of STRING in COLLECTION. Test each possible completion specified by COLLECTION @@ -1570,6 +1599,7 @@ Additionally to this predicate, `completion-regexp-list' is used to further constrain the set of candidates. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { + Lisp_Object bestmatch, tail, elt, eltstring; /* Size in bytes of BESTMATCH. */ ptrdiff_t bestmatchsize = 0; @@ -1583,7 +1613,6 @@ is used to further constrain the set of candidates. */) ? list_table : function_table)); ptrdiff_t idx = 0, obsize = 0; int matchcount = 0; - ptrdiff_t bindcount = -1; Lisp_Object bucket, zero, end, tem; CHECK_STRING (string); @@ -1662,27 +1691,10 @@ is used to further constrain the set of candidates. */) completion_ignore_case ? Qt : Qnil), EQ (Qt, tem))) { - /* Yes. */ - Lisp_Object regexps; - /* Ignore this element if it fails to match all the regexps. */ - { - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - if (bindcount < 0) - { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } - tem = Fstring_match (XCAR (regexps), eltstring, zero); - if (NILP (tem)) - break; - } - if (CONSP (regexps)) - continue; - } + if (!match_regexps (eltstring, Vcompletion_regexp_list, + completion_ignore_case)) + continue; /* Ignore this element if there is a predicate and the predicate doesn't like it. */ @@ -1693,11 +1705,6 @@ is used to further constrain the set of candidates. */) tem = Fcommandp (elt, Qnil); else { - if (bindcount >= 0) - { - unbind_to (bindcount, Qnil); - bindcount = -1; - } tem = (type == hash_table ? call2 (predicate, elt, HASH_VALUE (XHASH_TABLE (collection), @@ -1779,9 +1786,6 @@ is used to further constrain the set of candidates. */) } } - if (bindcount >= 0) - unbind_to (bindcount, Qnil); - if (NILP (bestmatch)) return Qnil; /* No completions found. */ /* If we are ignoring case, and there is no exact match, @@ -1841,7 +1845,6 @@ with a space are ignored unless STRING itself starts with a space. */) : VECTORP (collection) ? 2 : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)); ptrdiff_t idx = 0, obsize = 0; - ptrdiff_t bindcount = -1; Lisp_Object bucket, tem, zero; CHECK_STRING (string); @@ -1926,27 +1929,10 @@ with a space are ignored unless STRING itself starts with a space. */) completion_ignore_case ? Qt : Qnil), EQ (Qt, tem))) { - /* Yes. */ - Lisp_Object regexps; - /* Ignore this element if it fails to match all the regexps. */ - { - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - if (bindcount < 0) - { - bindcount = SPECPDL_INDEX (); - specbind (Qcase_fold_search, - completion_ignore_case ? Qt : Qnil); - } - tem = Fstring_match (XCAR (regexps), eltstring, zero); - if (NILP (tem)) - break; - } - if (CONSP (regexps)) - continue; - } + if (!match_regexps (eltstring, Vcompletion_regexp_list, + completion_ignore_case)) + continue; /* Ignore this element if there is a predicate and the predicate doesn't like it. */ @@ -1957,11 +1943,6 @@ with a space are ignored unless STRING itself starts with a space. */) tem = Fcommandp (elt, Qnil); else { - if (bindcount >= 0) - { - unbind_to (bindcount, Qnil); - bindcount = -1; - } tem = type == 3 ? call2 (predicate, elt, HASH_VALUE (XHASH_TABLE (collection), idx - 1)) @@ -1974,9 +1955,6 @@ with a space are ignored unless STRING itself starts with a space. */) } } - if (bindcount >= 0) - unbind_to (bindcount, Qnil); - return Fnreverse (allmatches); } @@ -2029,8 +2007,7 @@ HIST, if non-nil, specifies a history list and optionally the initial (This is the only case in which you should use INITIAL-INPUT instead of DEF.) Positions are counted starting from 1 at the beginning of the list. The variable `history-length' controls the maximum length - of a history list. If HIST is the symbol `t', history is not - recorded. + of a history list. If HIST is t, history is not recorded. DEF, if non-nil, is the default value or the list of default values. @@ -2052,12 +2029,16 @@ See also `completing-read-function'. */) /* Test whether TXT is an exact completion. */ DEFUN ("test-completion", Ftest_completion, Stest_completion, 2, 3, 0, doc: /* Return non-nil if STRING is a valid completion. +For instance, if COLLECTION is a list of strings, STRING is a +valid completion if it appears in the list and PREDICATE is satisfied. + Takes the same arguments as `all-completions' and `try-completion'. + If COLLECTION is a function, it is called with three arguments: the values STRING, PREDICATE and `lambda'. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { - Lisp_Object regexps, tail, tem = Qnil; + Lisp_Object tail, tem = Qnil; ptrdiff_t i = 0; CHECK_STRING (string); @@ -2143,20 +2124,9 @@ the values STRING, PREDICATE and `lambda'. */) return call3 (collection, string, predicate, Qlambda); /* Reject this element if it fails to match all the regexps. */ - if (CONSP (Vcompletion_regexp_list)) - { - ptrdiff_t count = SPECPDL_INDEX (); - specbind (Qcase_fold_search, completion_ignore_case ? Qt : Qnil); - for (regexps = Vcompletion_regexp_list; CONSP (regexps); - regexps = XCDR (regexps)) - { - /* We can test against STRING, because if we got here, then - the element is equivalent to it. */ - if (NILP (Fstring_match (XCAR (regexps), string, Qnil))) - return unbind_to (count, Qnil); - } - unbind_to (count, Qnil); - } + if (!match_regexps (string, Vcompletion_regexp_list, + completion_ignore_case)) + return Qnil; /* Finally, check the predicate. */ if (!NILP (predicate)) @@ -2474,7 +2444,7 @@ is added with (set minibuffer-history-variable (cons STRING (symbol-value minibuffer-history-variable))) - If the variable is the symbol `t', no history is recorded. */); + If the variable is t, no history is recorded. */); XSETFASTINT (Vminibuffer_history_variable, 0); DEFVAR_LISP ("minibuffer-history-position", Vminibuffer_history_position, @@ -2527,6 +2497,19 @@ for instance when running a headless Emacs server. Functions like instead. */); inhibit_interaction = 0; + DEFVAR_BOOL ("read-minibuffer-restore-windows", read_minibuffer_restore_windows, + doc: /* Non-nil means restore window configurations on exit from minibuffer. +If this is non-nil (the default), reading input with the minibuffer will +restore, on exit, the window configurations of the frame where the +minibuffer was entered from and, if it is different, the frame that owns +the associated minibuffer window. + +If this is nil, window configurations are not restored upon exiting +the minibuffer. However, if `minibuffer-restore-windows' is present +in `minibuffer-exit-hook', exiting the minibuffer will remove the window +showing the *Completions* buffer, if any. */); + read_minibuffer_restore_windows = true; + defsubr (&Sactive_minibuffer_window); defsubr (&Sset_minibuffer_window); defsubr (&Sread_from_minibuffer); diff --git a/src/module-env-28.h b/src/module-env-28.h index f8820b0606b..bea80a5553a 100644 --- a/src/module-env-28.h +++ b/src/module-env-28.h @@ -1,7 +1,3 @@ - /* Add module environment functions newly added in Emacs 28 here. - Before Emacs 28 is released, remove this comment and start - module-env-29.h on the master branch. */ - void (*(*EMACS_ATTRIBUTE_NONNULL (1) get_function_finalizer) (emacs_env *env, emacs_value arg)) (void *) EMACS_NOEXCEPT; diff --git a/src/module-env-29.h b/src/module-env-29.h new file mode 100644 index 00000000000..6ca03773181 --- /dev/null +++ b/src/module-env-29.h @@ -0,0 +1,3 @@ + /* Add module environment functions newly added in Emacs 29 here. + Before Emacs 29 is released, remove this comment and start + module-env-30.h on the master branch. */ diff --git a/src/msdos.c b/src/msdos.c index 5da01c9e7ca..bf058c8aff9 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1794,7 +1794,7 @@ internal_terminal_init (void) } Vinitial_window_system = Qpc; - Vwindow_system_version = make_fixnum (28); /* RE Emacs version */ + Vwindow_system_version = make_fixnum (29); /* RE Emacs version */ tty->terminal->type = output_msdos_raw; /* If Emacs was dumped on DOS/V machine, forget the stale VRAM diff --git a/src/nsfns.m b/src/nsfns.m index 454a6fdab62..f4d81722460 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -609,13 +609,72 @@ ns_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) } } +void +ns_change_tab_bar_height (struct frame *f, int height) +{ + int unit = FRAME_LINE_HEIGHT (f); + int old_height = FRAME_TAB_BAR_HEIGHT (f); + int lines = (height + unit - 1) / unit; + Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); + + /* Make sure we redisplay all windows in this frame. */ + fset_redisplay (f); + + /* Recalculate tab bar and frame text sizes. */ + FRAME_TAB_BAR_HEIGHT (f) = height; + FRAME_TAB_BAR_LINES (f) = lines; + store_frame_param (f, Qtab_bar_lines, make_fixnum (lines)); + + if (FRAME_NS_WINDOW (f) && FRAME_TAB_BAR_HEIGHT (f) == 0) + { + clear_frame (f); + clear_current_matrices (f); + } + + if ((height < old_height) && WINDOWP (f->tab_bar_window)) + clear_glyph_matrix (XWINDOW (f->tab_bar_window)->current_matrix); + + if (!f->tab_bar_resized) + { + /* As long as tab_bar_resized is false, effectively try to change + F's native height. */ + if (NILP (fullscreen) || EQ (fullscreen, Qfullwidth)) + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 1, false, Qtab_bar_lines); + else + adjust_frame_size (f, -1, -1, 4, false, Qtab_bar_lines); + + f->tab_bar_resized = f->tab_bar_redisplayed; + } + else + /* Any other change may leave the native size of F alone. */ + adjust_frame_size (f, -1, -1, 3, false, Qtab_bar_lines); + + /* adjust_frame_size might not have done anything, garbage frame + here. */ + adjust_frame_glyphs (f); + SET_FRAME_GARBAGED (f); +} /* tabbar support */ static void ns_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { - /* Currently unimplemented. */ - NSTRACE ("ns_set_tab_bar_lines"); + int olines = FRAME_TAB_BAR_LINES (f); + int nlines; + + /* Treat tab bars like menu bars. */ + if (FRAME_MINIBUF_ONLY_P (f)) + return; + + /* Use VALUE only if an int >= 0. */ + if (RANGED_FIXNUMP (0, value, INT_MAX)) + nlines = XFIXNAT (value); + else + nlines = 0; + + if (nlines != olines && (olines == 0 || nlines == 0)) + ns_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); } @@ -947,11 +1006,7 @@ frame_parm_handler ns_frame_parm_handlers[] = 0, /* x_set_sticky */ 0, /* x_set_tool_bar_position */ 0, /* x_set_inhibit_double_buffering */ -#ifdef NS_IMPL_COCOA ns_set_undecorated, -#else - 0, /* ns_set_undecorated */ -#endif ns_set_parent_frame, 0, /* x_set_skip_taskbar */ ns_set_no_focus_on_map, @@ -1181,6 +1236,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, "fontBackend", "FontBackend", RES_TYPE_STRING); { +#ifdef NS_IMPL_COCOA /* use for default font name */ id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */ gui_default_parameter (f, parms, Qfontsize, @@ -1195,6 +1251,11 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, build_string (fontname), "font", "Font", RES_TYPE_STRING); xfree (fontname); +#else + gui_default_parameter (f, parms, Qfont, + build_string ("fixed"), + "font", "Font", RES_TYPE_STRING); +#endif } unblock_input (); @@ -1347,6 +1408,11 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, f->output_data.ns->in_animation = NO; +#ifdef NS_IMPL_COCOA + /* If the app has previously been disabled, start it up again. */ + [NSApp setActivationPolicy:NSApplicationActivationPolicyRegular]; +#endif + [[EmacsView alloc] initFrameFromEmacs: f]; ns_icon (f, parms); @@ -1965,12 +2031,14 @@ is layered in front of the windows of other applications. */) [NSApp unhide: NSApp]; [NSApp activateIgnoringOtherApps: YES]; } +#if GNUSTEP_GUI_MAJOR_VERSION > 0 || GNUSTEP_GUI_MINOR_VERSION >= 27 else if (EQ (on, intern ("activate-front"))) { [NSApp unhide: NSApp]; [[NSRunningApplication currentApplication] activateWithOptions: NSApplicationActivateIgnoringOtherApps]; } +#endif else if (NILP (on)) [NSApp unhide: NSApp]; else diff --git a/src/nsfont.m b/src/nsfont.m index 5a9cdfebc01..b3224629f05 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -1,4 +1,4 @@ -/* Font back-end driver for the NeXT/Open/GNUstep and macOS window system. +/* Font back-end driver for the GNUstep window system. See font.h Copyright (C) 2006-2021 Free Software Foundation, Inc. @@ -38,47 +38,269 @@ Author: Adrian Robert (arobert@cogsci.ucsd.edu) #include "termchar.h" #include "pdumper.h" -/* TODO: Drop once we can assume gnustep-gui 0.17.1. */ +#import <Foundation/NSException.h> #import <AppKit/NSFontDescriptor.h> +#import <AppKit/NSLayoutManager.h> +#import <GNUstepGUI/GSLayoutManager.h> +#import <GNUstepGUI/GSFontInfo.h> #define NSFONT_TRACE 0 -#define LCD_SMOOTHING_MARGIN 2 -/* Font glyph and metrics caching functions, implemented at end. */ -static void ns_uni_to_glyphs (struct nsfont_info *font_info, - unsigned char block); -static void ns_glyph_metrics (struct nsfont_info *font_info, - unsigned char block); +/* Structure used by GS `shape' functions for storing layout + information for each glyph. Borrowed from macfont.h. */ +struct ns_glyph_layout +{ + /* Range of indices of the characters composed into the group of + glyphs that share the cursor position with this glyph. The + members `location' and `length' are in UTF-16 indices. */ + NSRange comp_range; -#define INVALID_GLYPH 0xFFFF + /* UTF-16 index in the source string for the first character + associated with this glyph. */ + NSUInteger string_index; -/* ========================================================================== + /* Horizontal and vertical adjustments of glyph position. The + coordinate space is that of Core Text. So, the `baseline_delta' + value is negative if the glyph should be placed below the + baseline. */ + CGFloat advance_delta, baseline_delta; - Utilities + /* Typographical width of the glyph. */ + CGFloat advance; - ========================================================================== */ + /* Glyph ID of the glyph. */ + NSGlyph glyph_id; +}; + + +enum lgstring_direction + { + DIR_R2L = -1, DIR_UNKNOWN = 0, DIR_L2R = 1 + }; + +enum gs_font_slant + { + GS_FONT_SLANT_ITALIC, + GS_FONT_SLANT_REVERSE_ITALIC, + GS_FONT_SLANT_NORMAL + }; + +enum gs_font_weight + { + GS_FONT_WEIGHT_LIGHT, + GS_FONT_WEIGHT_BOLD, + GS_FONT_WEIGHT_NORMAL + }; + +enum gs_font_width + { + GS_FONT_WIDTH_CONDENSED, + GS_FONT_WIDTH_EXPANDED, + GS_FONT_WIDTH_NORMAL + }; + +enum gs_specified + { + GS_SPECIFIED_SLANT = 1, + GS_SPECIFIED_WEIGHT = 1 << 1, + GS_SPECIFIED_WIDTH = 1 << 2, + GS_SPECIFIED_FAMILY = 1 << 3, + GS_SPECIFIED_SPACING = 1 << 4 + }; +struct gs_font_data +{ + int specified; + enum gs_font_slant slant; + enum gs_font_weight weight; + enum gs_font_width width; + bool monospace_p; + char *family_name; +}; -/* Replace spaces w/another character so emacs core font parsing routines - aren't thrown off. */ static void -ns_escape_name (char *name) +ns_done_font_data (struct gs_font_data *data) { - for (; *name; name++) - if (*name == ' ') - *name = '_'; + if (data->specified & GS_SPECIFIED_FAMILY) + xfree (data->family_name); } - -/* Reconstruct spaces in a font family name passed through emacs. */ static void -ns_unescape_name (char *name) +ns_get_font_data (NSFontDescriptor *desc, struct gs_font_data *dat) { - for (; *name; name++) - if (*name == '_') - *name = ' '; + NSNumber *tem; + NSFontSymbolicTraits traits = [desc symbolicTraits]; + NSDictionary *dict = [desc objectForKey: NSFontTraitsAttribute]; + NSString *family = [desc objectForKey: NSFontFamilyAttribute]; + + dat->specified = 0; + + if (family != nil) + { + dat->specified |= GS_SPECIFIED_FAMILY; + dat->family_name = xstrdup ([family cStringUsingEncoding: NSUTF8StringEncoding]); + } + + tem = [desc objectForKey: NSFontFixedAdvanceAttribute]; + + if ((tem != nil && [tem boolValue] != NO) + || (traits & NSFontMonoSpaceTrait)) + { + dat->specified |= GS_SPECIFIED_SPACING; + dat->monospace_p = true; + } + else if (tem != nil && [tem boolValue] == NO) + { + dat->specified |= GS_SPECIFIED_SPACING; + dat->monospace_p = false; + } + + if (traits & NSFontBoldTrait) + { + dat->specified |= GS_SPECIFIED_WEIGHT; + dat->weight = GS_FONT_WEIGHT_BOLD; + } + + if (traits & NSFontItalicTrait) + { + dat->specified |= GS_SPECIFIED_SLANT; + dat->slant = GS_FONT_SLANT_ITALIC; + } + + if (traits & NSFontCondensedTrait) + { + dat->specified |= GS_SPECIFIED_WIDTH; + dat->width = GS_FONT_WIDTH_CONDENSED; + } + else if (traits & NSFontExpandedTrait) + { + dat->specified |= GS_SPECIFIED_WIDTH; + dat->width = GS_FONT_WIDTH_EXPANDED; + } + + if (dict != nil) + { + tem = [dict objectForKey: NSFontSlantTrait]; + + if (tem != nil) + { + dat->specified |= GS_SPECIFIED_SLANT; + + dat->slant = [tem floatValue] > 0 + ? GS_FONT_SLANT_ITALIC + : ([tem floatValue] < 0 + ? GS_FONT_SLANT_REVERSE_ITALIC + : GS_FONT_SLANT_NORMAL); + } + + tem = [dict objectForKey: NSFontWeightTrait]; + + if (tem != nil) + { + dat->specified |= GS_SPECIFIED_WEIGHT; + + dat->weight = [tem floatValue] > 0 + ? GS_FONT_WEIGHT_BOLD + : ([tem floatValue] < -0.4f + ? GS_FONT_WEIGHT_LIGHT + : GS_FONT_WEIGHT_NORMAL); + } + + tem = [dict objectForKey: NSFontWidthTrait]; + + if (tem != nil) + { + dat->specified |= GS_SPECIFIED_WIDTH; + + dat->width = [tem floatValue] > 0 + ? GS_FONT_WIDTH_EXPANDED + : ([tem floatValue] < 0 + ? GS_FONT_WIDTH_NORMAL + : GS_FONT_WIDTH_CONDENSED); + } + } +} + +static bool +ns_font_descs_match_p (NSFontDescriptor *desc, NSFontDescriptor *target) +{ + struct gs_font_data dat; + struct gs_font_data t; + + ns_get_font_data (desc, &dat); + ns_get_font_data (target, &t); + + if (!(t.specified & GS_SPECIFIED_WIDTH)) + t.width = GS_FONT_WIDTH_NORMAL; + if (!(t.specified & GS_SPECIFIED_WEIGHT)) + t.weight = GS_FONT_WEIGHT_NORMAL; + if (!(t.specified & GS_SPECIFIED_SPACING)) + t.monospace_p = false; + if (!(t.specified & GS_SPECIFIED_SLANT)) + t.slant = GS_FONT_SLANT_NORMAL; + + if (!(t.specified & GS_SPECIFIED_FAMILY)) + emacs_abort (); + + bool match_p = true; + + if (dat.specified & GS_SPECIFIED_WIDTH + && dat.width != t.width) + { + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_WEIGHT + && dat.weight != t.weight) + { + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_SPACING + && dat.monospace_p != t.monospace_p) + { + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_SLANT + && dat.monospace_p != t.monospace_p) + { + if (NSFONT_TRACE) + printf ("Matching monospace for %s: %d %d\n", + t.family_name, dat.monospace_p, + t.monospace_p); + match_p = false; + goto gout; + } + + if (dat.specified & GS_SPECIFIED_FAMILY + && strcmp (dat.family_name, t.family_name)) + match_p = false; + + gout: + ns_done_font_data (&dat); + ns_done_font_data (&t); + + return match_p; } +/* Font glyph and metrics caching functions, implemented at end. */ +static void ns_uni_to_glyphs (struct nsfont_info *font_info, + unsigned char block); +static void ns_glyph_metrics (struct nsfont_info *font_info, + unsigned int block); + +#define INVALID_GLYPH 0xFFFF + +/* ========================================================================== + + Utilities + + ========================================================================== */ + /* Extract family name from a font spec. */ static NSString * @@ -91,66 +313,116 @@ ns_get_family (Lisp_Object font_spec) { char *tmp = xlispstrdup (SYMBOL_NAME (tem)); NSString *family; - ns_unescape_name (tmp); family = [NSString stringWithUTF8String: tmp]; xfree (tmp); return family; } } - -/* Return 0 if attr not set, else value (which might also be 0). - On Leopard 0 gets returned even on descriptors where the attribute - was never set, so there's no way to distinguish between unspecified - and set to not have. Callers should assume 0 means unspecified. */ -static float -ns_attribute_fvalue (NSFontDescriptor *fdesc, NSString *trait) -{ - NSDictionary *tdict = [fdesc objectForKey: NSFontTraitsAttribute]; - NSNumber *val = [tdict objectForKey: trait]; - return val == nil ? 0.0F : [val floatValue]; -} - - /* Converts FONT_WEIGHT, FONT_SLANT, FONT_WIDTH, plus family and script/lang to NSFont descriptor. Information under extra only needed for matching. */ -#define STYLE_REF 100 static NSFontDescriptor * ns_spec_to_descriptor (Lisp_Object font_spec) { NSFontDescriptor *fdesc; NSMutableDictionary *fdAttrs = [NSMutableDictionary new]; - NSMutableDictionary *tdict = [NSMutableDictionary new]; NSString *family = ns_get_family (font_spec); - float n; - - /* Add each attr in font_spec to fdAttrs. */ - n = min (FONT_WEIGHT_NUMERIC (font_spec), 200); - if (n != -1 && n != STYLE_REF) - [tdict setObject: [NSNumber numberWithFloat: (n - 100.0F) / 100.0F] - forKey: NSFontWeightTrait]; - n = min (FONT_SLANT_NUMERIC (font_spec), 200); - if (n != -1 && n != STYLE_REF) - [tdict setObject: [NSNumber numberWithFloat: (n - 100.0F) / 100.0F] - forKey: NSFontSlantTrait]; - n = min (FONT_WIDTH_NUMERIC (font_spec), 200); - if (n > -1 && (n > STYLE_REF + 10 || n < STYLE_REF - 10)) - [tdict setObject: [NSNumber numberWithFloat: (n - 100.0F) / 100.0F] - forKey: NSFontWidthTrait]; - if ([tdict count] > 0) - [fdAttrs setObject: tdict forKey: NSFontTraitsAttribute]; + NSMutableDictionary *tdict = [NSMutableDictionary new]; - fdesc = [[[NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs] - retain] autorelease]; + Lisp_Object tem; + + tem = FONT_SLANT_SYMBOLIC (font_spec); + if (!NILP (tem)) + { + if (EQ (tem, Qitalic) || EQ (tem, Qoblique)) + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontSlantTrait]; + else if (EQ (tem, intern ("reverse-italic")) || + EQ (tem, intern ("reverse-oblique"))) + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontSlantTrait]; + else + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontSlantTrait]; + } + + tem = FONT_WIDTH_SYMBOLIC (font_spec); + if (!NILP (tem)) + { + if (EQ (tem, Qcondensed)) + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontWidthTrait]; + else if (EQ (tem, Qexpanded)) + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontWidthTrait]; + else + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontWidthTrait]; + } + + tem = FONT_WEIGHT_SYMBOLIC (font_spec); + + if (!NILP (tem)) + { + if (EQ (tem, Qbold)) + { + [tdict setObject: [NSNumber numberWithFloat: 1.0] + forKey: NSFontWeightTrait]; + } + else if (EQ (tem, Qlight)) + { + [tdict setObject: [NSNumber numberWithFloat: -1.0] + forKey: NSFontWeightTrait]; + } + else + { + [tdict setObject: [NSNumber numberWithFloat: 0.0] + forKey: NSFontWeightTrait]; + } + } + + tem = AREF (font_spec, FONT_SPACING_INDEX); if (family != nil) { - NSFontDescriptor *fdesc2 = [fdesc fontDescriptorWithFamily: family]; - fdesc = [[fdesc2 retain] autorelease]; + [fdAttrs setObject: family + forKey: NSFontFamilyAttribute]; } - [fdAttrs release]; + if (FIXNUMP (tem)) + { + if (XFIXNUM (tem) != FONT_SPACING_PROPORTIONAL) + { + [fdAttrs setObject: [NSNumber numberWithBool:YES] + forKey: NSFontFixedAdvanceAttribute]; + } + else + { + [fdAttrs setObject: [NSNumber numberWithBool:NO] + forKey: NSFontFixedAdvanceAttribute]; + } + } + + /* Handle special families such as ``fixed'' or ``Sans Serif''. */ + + if ([family isEqualToString: @"fixed"]) + { + [fdAttrs setObject: [[NSFont userFixedPitchFontOfSize: 0] familyName] + forKey: NSFontFamilyAttribute]; + } + else if ([family isEqualToString: @"Sans Serif"]) + { + [fdAttrs setObject: [[NSFont userFontOfSize: 0] familyName] + forKey: NSFontFamilyAttribute]; + } + + [fdAttrs setObject: tdict forKey: NSFontTraitsAttribute]; + + fdesc = [[[NSFontDescriptor fontDescriptorWithFontAttributes: fdAttrs] + retain] autorelease]; + [tdict release]; + [fdAttrs release]; return fdesc; } @@ -161,61 +433,64 @@ ns_descriptor_to_entity (NSFontDescriptor *desc, Lisp_Object extra, const char *style) { - Lisp_Object font_entity = font_make_entity (); - /* NSString *psName = [desc postscriptName]; */ - NSString *family = [desc objectForKey: NSFontFamilyAttribute]; - unsigned int traits = [desc symbolicTraits]; - char *escapedFamily; - - /* Shouldn't happen, but on Tiger fallback desc gets name but no family. */ - if (family == nil) - family = [desc objectForKey: NSFontNameAttribute]; - if (family == nil) - family = [[NSFont userFixedPitchFontOfSize: 0] familyName]; - - escapedFamily = xstrdup ([family UTF8String]); - ns_escape_name (escapedFamily); - - ASET (font_entity, FONT_TYPE_INDEX, Qns); - ASET (font_entity, FONT_FOUNDRY_INDEX, Qapple); - ASET (font_entity, FONT_FAMILY_INDEX, intern (escapedFamily)); - ASET (font_entity, FONT_ADSTYLE_INDEX, style ? intern (style) : Qnil); - ASET (font_entity, FONT_REGISTRY_INDEX, Qiso10646_1); - - FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, - traits & NSFontBoldTrait ? Qbold : Qmedium); -/* FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, - make_fixnum (100 + 100 - * ns_attribute_fvalue (desc, NSFontWeightTrait)));*/ - FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, - traits & NSFontItalicTrait ? Qitalic : Qnormal); -/* FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, - make_fixnum (100 + 100 - * ns_attribute_fvalue (desc, NSFontSlantTrait)));*/ - FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, - traits & NSFontCondensedTrait ? Qcondensed : - traits & NSFontExpandedTrait ? Qexpanded : Qnormal); -/* FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, - make_fixnum (100 + 100 - * ns_attribute_fvalue (desc, NSFontWidthTrait)));*/ - - ASET (font_entity, FONT_SIZE_INDEX, make_fixnum (0)); - ASET (font_entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); - ASET (font_entity, FONT_SPACING_INDEX, - make_fixnum([desc symbolicTraits] & NSFontMonoSpaceTrait - ? FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL)); - - ASET (font_entity, FONT_EXTRA_INDEX, extra); - ASET (font_entity, FONT_OBJLIST_INDEX, Qnil); + Lisp_Object font_entity = font_make_entity (); + struct gs_font_data data; + ns_get_font_data (desc, &data); + + ASET (font_entity, FONT_TYPE_INDEX, Qns); + ASET (font_entity, FONT_FOUNDRY_INDEX, Qns); + if (data.specified & GS_SPECIFIED_FAMILY) + ASET (font_entity, FONT_FAMILY_INDEX, intern (data.family_name)); + ASET (font_entity, FONT_ADSTYLE_INDEX, style ? intern (style) : Qnil); + ASET (font_entity, FONT_REGISTRY_INDEX, Qiso10646_1); + + if (data.specified & GS_SPECIFIED_WEIGHT) + { + FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, + data.weight == GS_FONT_WEIGHT_BOLD + ? Qbold : (data.weight == GS_FONT_WEIGHT_LIGHT + ? Qlight : Qnormal)); + } + else + FONT_SET_STYLE (font_entity, FONT_WEIGHT_INDEX, Qnormal); - if (NSFONT_TRACE) - { - fputs ("created font_entity:\n ", stderr); - debug_print (font_entity); - } + if (data.specified & GS_SPECIFIED_SLANT) + { + FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, + data.slant == GS_FONT_SLANT_ITALIC + ? Qitalic : (data.slant == GS_FONT_SLANT_REVERSE_ITALIC + ? intern ("reverse-italic") : Qnormal)); + } + else + FONT_SET_STYLE (font_entity, FONT_SLANT_INDEX, Qnormal); + + if (data.specified & GS_SPECIFIED_WIDTH) + { + FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, + data.width == GS_FONT_WIDTH_CONDENSED + ? Qcondensed : (data.width == GS_FONT_WIDTH_EXPANDED + ? intern ("expanded") : Qnormal)); + } + else + FONT_SET_STYLE (font_entity, FONT_WIDTH_INDEX, Qnormal); - xfree (escapedFamily); - return font_entity; + ASET (font_entity, FONT_SIZE_INDEX, make_fixnum (0)); + ASET (font_entity, FONT_AVGWIDTH_INDEX, make_fixnum (0)); + ASET (font_entity, FONT_SPACING_INDEX, + make_fixnum ((data.specified & GS_SPECIFIED_WIDTH && data.monospace_p) + ? FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL)); + + ASET (font_entity, FONT_EXTRA_INDEX, extra); + ASET (font_entity, FONT_OBJLIST_INDEX, Qnil); + + if (NSFONT_TRACE) + { + fputs ("created font_entity:\n ", stderr); + debug_print (font_entity); + } + + ns_done_font_data (&data); + return font_entity; } @@ -223,8 +498,7 @@ ns_descriptor_to_entity (NSFontDescriptor *desc, static Lisp_Object ns_fallback_entity (void) { - return ns_descriptor_to_entity ([[NSFont userFixedPitchFontOfSize: 0] - fontDescriptor], Qnil, NULL); + return ns_descriptor_to_entity ([[NSFont userFixedPitchFontOfSize: 1] fontDescriptor], Qnil, NULL); } @@ -510,21 +784,20 @@ static NSSet return families; } +/* GNUstep font matching is very mediocre (it can't even compare + symbolic styles correctly), which is why our own font matching + mechanism must be implemented. */ -/* Implementation for list() and match(). List() can return nil, match() -must return something. Strategy is to drop family name from attribute -matching set for match. */ +/* Implementation for list and match. */ static Lisp_Object ns_findfonts (Lisp_Object font_spec, BOOL isMatch) { Lisp_Object tem, list = Qnil; - NSFontDescriptor *fdesc, *desc; - NSMutableSet *fkeys; - NSArray *matchingDescs; - NSEnumerator *dEnum; - NSString *family; + NSFontDescriptor *fdesc; + NSArray *all_descs; + GSFontEnumerator *enumerator = [GSFontEnumerator sharedEnumerator]; + NSSet *cFamilies; - BOOL foundItal = NO; block_input (); if (NSFONT_TRACE) @@ -537,43 +810,22 @@ ns_findfonts (Lisp_Object font_spec, BOOL isMatch) cFamilies = ns_get_covering_families (ns_get_req_script (font_spec), 0.90); fdesc = ns_spec_to_descriptor (font_spec); - fkeys = [NSMutableSet setWithArray: [[fdesc fontAttributes] allKeys]]; - if (isMatch) - [fkeys removeObject: NSFontFamilyAttribute]; - - matchingDescs = [fdesc matchingFontDescriptorsWithMandatoryKeys: fkeys]; + all_descs = [enumerator availableFontDescriptors]; - if (NSFONT_TRACE) - NSLog(@"Got desc %@ and found %lu matching fonts from it: ", fdesc, - (unsigned long)[matchingDescs count]); - - for (dEnum = [matchingDescs objectEnumerator]; (desc = [dEnum nextObject]);) + for (NSFontDescriptor *desc in all_descs) { if (![cFamilies containsObject: [desc objectForKey: NSFontFamilyAttribute]]) continue; + if (!ns_font_descs_match_p (fdesc, desc)) + continue; + tem = ns_descriptor_to_entity (desc, - AREF (font_spec, FONT_EXTRA_INDEX), + AREF (font_spec, FONT_EXTRA_INDEX), NULL); if (isMatch) return tem; list = Fcons (tem, list); - if (fabs (ns_attribute_fvalue (desc, NSFontSlantTrait)) > 0.05) - foundItal = YES; - } - - /* Add synthItal member if needed. */ - family = [fdesc objectForKey: NSFontFamilyAttribute]; - if (family != nil && !foundItal && !NILP (list)) - { - NSFontDescriptor *s1 = [NSFontDescriptor new]; - NSFontDescriptor *sDesc - = [[s1 fontDescriptorWithSymbolicTraits: NSFontItalicTrait] - fontDescriptorWithFamily: family]; - list = Fcons (ns_descriptor_to_entity (sDesc, - AREF (font_spec, FONT_EXTRA_INDEX), - "synthItal"), list); - [s1 release]; } unblock_input (); @@ -652,7 +904,6 @@ nsfont_list_family (struct frame *f) objectEnumerator]; while ((family = [families nextObject])) list = Fcons (intern ([family UTF8String]), list); - /* FIXME: escape the name? */ if (NSFONT_TRACE) fprintf (stderr, "nsfont: list families returning %"pD"d entries\n", @@ -668,18 +919,15 @@ nsfont_list_family (struct frame *f) static Lisp_Object nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) { - BOOL synthItal; - unsigned int traits = 0; struct nsfont_info *font_info; struct font *font; NSFontDescriptor *fontDesc = ns_spec_to_descriptor (font_entity); NSFontManager *fontMgr = [NSFontManager sharedFontManager]; NSString *family; NSFont *nsfont, *sfont; - Lisp_Object tem; NSRect brect; Lisp_Object font_object; - int fixLeopardBug; + Lisp_Object tem; block_input (); @@ -692,42 +940,20 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) if (pixel_size <= 0) { /* try to get it out of frame params */ - Lisp_Object tem = get_frame_param (f, Qfontsize); - pixel_size = NILP (tem) ? 0 : XFIXNAT (tem); + tem = get_frame_param (f, Qfontsize); + pixel_size = NILP (tem) ? 0 : XFIXNAT (tem); } tem = AREF (font_entity, FONT_ADSTYLE_INDEX); - synthItal = !NILP (tem) && !strncmp ("synthItal", SSDATA (SYMBOL_NAME (tem)), - 9); family = ns_get_family (font_entity); if (family == nil) family = [[NSFont userFixedPitchFontOfSize: 0] familyName]; - /* Should be > 0.23 as some font descriptors (e.g. Terminus) set to that - when setting family in ns_spec_to_descriptor(). */ - if (ns_attribute_fvalue (fontDesc, NSFontWeightTrait) > 0.50F) - traits |= NSBoldFontMask; - if (ns_attribute_fvalue (fontDesc, NSFontSlantTrait) > 0.05F) - traits |= NSItalicFontMask; - - /* see https://web.archive.org/web/20100201175731/http://cocoadev.com/forums/comments.php?DiscussionID=74 */ - fixLeopardBug = traits & NSBoldFontMask ? 10 : 5; - nsfont = [fontMgr fontWithFamily: family - traits: traits weight: fixLeopardBug - size: pixel_size]; - /* if didn't find, try synthetic italic */ - if (nsfont == nil && synthItal) - { - nsfont = [fontMgr fontWithFamily: family - traits: traits & ~NSItalicFontMask - weight: fixLeopardBug size: pixel_size]; - } + + nsfont = [NSFont fontWithDescriptor: fontDesc + size: pixel_size]; if (nsfont == nil) - { - message_with_string ("*** Warning: font in family `%s' not found", - build_string ([family UTF8String]), 1); - nsfont = [NSFont userFixedPitchFontOfSize: pixel_size]; - } + nsfont = [NSFont userFixedPitchFontOfSize: pixel_size]; if (NSFONT_TRACE) NSLog (@"%@\n", nsfont); @@ -740,7 +966,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) if (!font) { unblock_input (); - return Qnil; /* FIXME: other terms do, but returning Qnil causes segfault. */ + return Qnil; } font_info->glyphs = xzalloc (0x100 * sizeof *font_info->glyphs); @@ -781,7 +1007,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) font_info->name = xstrdup (fontName); font_info->bold = [fontMgr traitsOfFont: nsfont] & NSBoldFontMask; font_info->ital = - synthItal || ([fontMgr traitsOfFont: nsfont] & NSItalicFontMask); + ([fontMgr traitsOfFont: nsfont] & NSItalicFontMask); /* Metrics etc.; some fonts return an unusually large max advance, so we only use it for fonts that have wide characters. */ @@ -808,8 +1034,6 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size) lrint (brect.size.width - (CGFloat) font_info->width); /* set up metrics portion of font struct */ - font->ascent = lrint([sfont ascender]); - font->descent = -lrint(floor(adjusted_descender)); font->space_width = lrint (ns_char_width (sfont, ' ')); font->max_width = lrint (font_info->max_bounds.width); font->min_width = font->space_width; /* Approximate. */ @@ -871,7 +1095,7 @@ nsfont_encode_char (struct font *font, int c) { struct nsfont_info *font_info = (struct nsfont_info *)font; unsigned char high = (c & 0xff00) >> 8, low = c & 0x00ff; - unsigned short g; + unsigned int g; if (c > 0xFFFF) return FONT_INVALID_CODE; @@ -934,51 +1158,23 @@ nsfont_text_extents (struct font *font, const unsigned int *code, static int nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, bool with_background) -/* NOTE: focus and clip must be set. */ { - static unsigned char cbuf[1024]; - unsigned char *c = cbuf; -#if GNUSTEP_GUI_MAJOR_VERSION > 0 || GNUSTEP_GUI_MINOR_VERSION > 22 - static CGFloat advances[1024]; - CGFloat *adv = advances; -#else - static float advances[1024]; - float *adv = advances; -#endif + NSGlyph *c = alloca ((to - from) * sizeof *c); + struct face *face; NSRect r; struct nsfont_info *font; - NSColor *col, *bgCol; - unsigned *t = s->char2b; - int i, len, flags; + NSColor *col; + int len = to - from; char isComposite = s->first_glyph->type == COMPOSITE_GLYPH; block_input (); - font = (struct nsfont_info *)s->face->font; + font = (struct nsfont_info *) s->font; if (font == NULL) font = (struct nsfont_info *)FRAME_FONT (s->f); - /* Select face based on input flags. */ - flags = s->hl == DRAW_CURSOR ? NS_DUMPGLYPH_CURSOR : - (s->hl == DRAW_MOUSE_FACE ? NS_DUMPGLYPH_MOUSEFACE : - (s->for_overlaps ? NS_DUMPGLYPH_FOREGROUND : - NS_DUMPGLYPH_NORMAL)); - - switch (flags) - { - case NS_DUMPGLYPH_CURSOR: - face = s->face; - break; - case NS_DUMPGLYPH_MOUSEFACE: - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - break; - default: - face = s->face; - } + face = s->face; r.origin.x = s->x; if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) @@ -987,91 +1183,24 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, r.origin.y = s->y; r.size.height = FONT_HEIGHT (font); - /* Convert UTF-16 (?) to UTF-8 and determine advances. Note if we just ask - NS to render the string, it will come out differently from the individual - character widths added up because of layout processing. */ - { - int cwidth, twidth = 0; - int hi, lo; - /* FIXME: composition: no vertical displacement is considered. */ - t += from; /* advance into composition */ - for (i = from; i < to; i++, t++) - { - hi = (*t & 0xFF00) >> 8; - lo = *t & 0x00FF; - if (isComposite) - { - if (!s->first_glyph->u.cmp.automatic) - cwidth = s->cmp->offsets[i * 2] /* (H offset) */ - twidth; - else - { - Lisp_Object gstring = composition_gstring_from_id (s->cmp_id); - Lisp_Object glyph = LGSTRING_GLYPH (gstring, i); - if (NILP (LGLYPH_ADJUSTMENT (glyph))) - cwidth = LGLYPH_WIDTH (glyph); - else - { - cwidth = LGLYPH_WADJUST (glyph); - *(adv-1) += LGLYPH_XOFF (glyph); - } - } - } - else - { - if (!font->metrics[hi]) /* FIXME: why/how can we need this now? */ - ns_glyph_metrics (font, hi); - cwidth = font->metrics[hi][lo].width; - } - twidth += cwidth; - *adv++ = cwidth; - c += CHAR_STRING (*t, c); /* This converts the char to UTF-8. */ - } - len = adv - advances; - r.size.width = twidth; - *c = 0; - } + for (int i = from; i < to; ++i) + c[i] = s->char2b[i]; /* Fill background if requested. */ if (with_background && !isComposite) { - NSRect br = r; - int fibw = FRAME_INTERNAL_BORDER_WIDTH (s->f); - int mbox_line_width = max (s->face->box_vertical_line_width, 0); - - if (s->row->full_width_p) - { - if (br.origin.x <= fibw + 1 + mbox_line_width) - { - br.size.width += br.origin.x - mbox_line_width; - br.origin.x = mbox_line_width; - } - if (FRAME_PIXEL_WIDTH (s->f) - (br.origin.x + br.size.width) - <= fibw+1) - br.size.width += fibw; - } - if (s->face->box == FACE_NO_BOX) - { - /* Expand unboxed top row over internal border. */ - if (br.origin.y <= fibw + 1 + mbox_line_width) - { - br.size.height += br.origin.y; - br.origin.y = 0; - } - } - else - { - int correction = abs (s->face->box_horizontal_line_width)+1; - br.origin.y += correction; - br.size.height -= 2*correction; - correction = abs (s->face->box_vertical_line_width)+1; - br.origin.x += correction; - br.size.width -= 2*correction; - } + NSRect br = NSMakeRect (x, y - FONT_BASE (s->font), + s->width, FONT_HEIGHT (s->font)); if (!s->face->stipple) - [(NS_FACE_BACKGROUND (face) != 0 - ? ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) - : FRAME_BACKGROUND_COLOR (s->f)) set]; + { + if (s->hl != DRAW_CURSOR) + [(NS_FACE_BACKGROUND (face) != 0 + ? ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) + : FRAME_BACKGROUND_COLOR (s->f)) set]; + else + [FRAME_CURSOR_COLOR (s->f) set]; + } else { struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); @@ -1080,43 +1209,32 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, NSRectFill (br); } - /* set up for character rendering */ r.origin.y = y; - col = (NS_FACE_FOREGROUND (face) != 0 - ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f) - : FRAME_FOREGROUND_COLOR (s->f)); - - bgCol = (flags != NS_DUMPGLYPH_FOREGROUND ? nil - : (NS_FACE_BACKGROUND (face) != 0 - ? ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) - : FRAME_BACKGROUND_COLOR (s->f))); + if (s->hl == DRAW_CURSOR) + col = FRAME_BACKGROUND_COLOR (s->f); + else + col = (NS_FACE_FOREGROUND (face) != 0 + ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f) + : FRAME_FOREGROUND_COLOR (s->f)); /* render under GNUstep using DPS */ { - NSGraphicsContext *context = GSCurrentContext (); - + NSGraphicsContext *context = [NSGraphicsContext currentContext]; DPSgsave (context); - [font->nsfont set]; - - /* do erase if "foreground" mode */ - if (bgCol != nil) + if (s->clip_head) { - [bgCol set]; - DPSmoveto (context, r.origin.x, r.origin.y); -/*[context GSSetTextDrawingMode: GSTextFillStroke]; /// not implemented yet */ - DPSxshow (context, (const char *) cbuf, advances, len); - DPSstroke (context); - [col set]; -/*[context GSSetTextDrawingMode: GSTextFill]; /// not implemented yet */ + DPSrectclip (context, s->clip_head->x, 0, + FRAME_PIXEL_WIDTH (s->f), + FRAME_PIXEL_HEIGHT (s->f)); } + [font->nsfont set]; [col set]; - /* draw with DPSxshow () */ DPSmoveto (context, r.origin.x, r.origin.y); - DPSxshow (context, (const char *) cbuf, advances, len); + GSShowGlyphs (context, c, len); DPSstroke (context); DPSgrestore (context); @@ -1126,6 +1244,360 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, return to-from; } +static NSUInteger +ns_font_shape (NSFont *font, NSString *string, + struct ns_glyph_layout *glyph_layouts, NSUInteger glyph_len, + enum lgstring_direction dir) +{ + NSUInteger i; + NSUInteger result = 0; + NSTextStorage *textStorage; + NSLayoutManager *layoutManager; + NSTextContainer *textContainer; + NSUInteger stringLength; + NSPoint spaceLocation; + /* numberOfGlyphs can't actually be 0, but this pacifies GCC */ + NSUInteger used, numberOfGlyphs = 0; + + textStorage = [[NSTextStorage alloc] initWithString:string]; + layoutManager = [[NSLayoutManager alloc] init]; + textContainer = [[NSTextContainer alloc] init]; + + /* Append a trailing space to measure baseline position. */ + [textStorage appendAttributedString:([[[NSAttributedString alloc] + initWithString:@" "] autorelease])]; + [textStorage setFont:font]; + [textContainer setLineFragmentPadding:0]; + + [layoutManager addTextContainer:textContainer]; + [textContainer release]; + [textStorage addLayoutManager:layoutManager]; + [layoutManager release]; + + if (!(textStorage && layoutManager && textContainer)) + emacs_abort (); + + stringLength = [string length]; + + /* Force layout. */ + (void) [layoutManager glyphRangeForTextContainer:textContainer]; + + spaceLocation = [layoutManager locationForGlyphAtIndex:stringLength]; + + /* Remove the appended trailing space because otherwise it may + generate a wrong result for a right-to-left text. */ + [textStorage beginEditing]; + [textStorage deleteCharactersInRange:(NSMakeRange (stringLength, 1))]; + [textStorage endEditing]; + (void) [layoutManager glyphRangeForTextContainer:textContainer]; + + i = 0; + while (i < stringLength) + { + NSRange range; + NSFont *fontInTextStorage = + [textStorage attribute: NSFontAttributeName + atIndex:i + longestEffectiveRange: &range + inRange: NSMakeRange (0, stringLength)]; + + if (!(fontInTextStorage == font + || [[fontInTextStorage fontName] isEqualToString:[font fontName]])) + break; + i = NSMaxRange (range); + } + if (i < stringLength) + /* Make the test `used <= glyph_len' below fail if textStorage + contained some fonts other than the specified one. */ + used = glyph_len + 1; + else + { + NSRange range = NSMakeRange (0, stringLength); + + range = [layoutManager glyphRangeForCharacterRange:range + actualCharacterRange:NULL]; + numberOfGlyphs = NSMaxRange (range); + used = numberOfGlyphs; + for (i = 0; i < numberOfGlyphs; i++) + if ([layoutManager notShownAttributeForGlyphAtIndex:i]) + used--; + } + + if (0 < used && used <= glyph_len) + { + NSUInteger glyphIndex, prevGlyphIndex; + NSUInteger *permutation; + NSRange compRange, range; + CGFloat totalAdvance; + + glyphIndex = 0; + while ([layoutManager notShownAttributeForGlyphAtIndex:glyphIndex]) + glyphIndex++; + + permutation = NULL; +#define RIGHT_TO_LEFT_P permutation + + /* Fill the `comp_range' member of struct mac_glyph_layout, and + setup a permutation for right-to-left text. */ + compRange = NSMakeRange (0, 0); + for (range = NSMakeRange (0, 0); NSMaxRange (range) < used; + range.length++) + { + struct ns_glyph_layout *gl = glyph_layouts + NSMaxRange (range); + NSUInteger characterIndex = + [layoutManager characterIndexForGlyphAtIndex:glyphIndex]; + + gl->string_index = characterIndex; + + if (characterIndex >= NSMaxRange (compRange)) + { + compRange.location = NSMaxRange (compRange); + do + { + NSRange characterRange = + [string + rangeOfComposedCharacterSequenceAtIndex:characterIndex]; + + compRange.length = + NSMaxRange (characterRange) - compRange.location; + [layoutManager glyphRangeForCharacterRange:compRange + actualCharacterRange:&characterRange]; + characterIndex = NSMaxRange (characterRange) - 1; + } + while (characterIndex >= NSMaxRange (compRange)); + + if (RIGHT_TO_LEFT_P) + for (i = 0; i < range.length; i++) + permutation[range.location + i] = NSMaxRange (range) - i - 1; + + range = NSMakeRange (NSMaxRange (range), 0); + } + + gl->comp_range.location = compRange.location; + gl->comp_range.length = compRange.length; + + while (++glyphIndex < numberOfGlyphs) + if (![layoutManager notShownAttributeForGlyphAtIndex:glyphIndex]) + break; + } + if (RIGHT_TO_LEFT_P) + for (i = 0; i < range.length; i++) + permutation[range.location + i] = NSMaxRange (range) - i - 1; + + /* Then fill the remaining members. */ + glyphIndex = prevGlyphIndex = 0; + while ([layoutManager notShownAttributeForGlyphAtIndex:glyphIndex]) + glyphIndex++; + + if (!RIGHT_TO_LEFT_P) + totalAdvance = 0; + else + { + NSUInteger nrects; + NSRect *glyphRects = + [layoutManager + rectArrayForGlyphRange:(NSMakeRange (0, numberOfGlyphs)) + withinSelectedGlyphRange:(NSMakeRange (NSNotFound, 0)) + inTextContainer:textContainer rectCount:&nrects]; + + totalAdvance = NSMaxX (glyphRects[0]); + } + + for (i = 0; i < used; i++) + { + struct ns_glyph_layout *gl; + NSPoint location; + NSUInteger nextGlyphIndex; + NSRange glyphRange; + NSRect *glyphRects; + NSUInteger nrects; + + if (!RIGHT_TO_LEFT_P) + gl = glyph_layouts + i; + else + { + NSUInteger dest = permutation[i]; + + gl = glyph_layouts + dest; + if (i < dest) + { + NSUInteger tmp = gl->string_index; + + gl->string_index = glyph_layouts[i].string_index; + glyph_layouts[i].string_index = tmp; + } + } + gl->glyph_id = [layoutManager glyphAtIndex: glyphIndex]; + + location = [layoutManager locationForGlyphAtIndex:glyphIndex]; + gl->baseline_delta = spaceLocation.y - location.y; + + for (nextGlyphIndex = glyphIndex + 1; nextGlyphIndex < numberOfGlyphs; + nextGlyphIndex++) + if (![layoutManager + notShownAttributeForGlyphAtIndex:nextGlyphIndex]) + break; + + if (!RIGHT_TO_LEFT_P) + { + CGFloat maxX; + + if (prevGlyphIndex == 0) + glyphRange = NSMakeRange (0, nextGlyphIndex); + else + glyphRange = NSMakeRange (glyphIndex, + nextGlyphIndex - glyphIndex); + glyphRects = + [layoutManager + rectArrayForGlyphRange:glyphRange + withinSelectedGlyphRange:(NSMakeRange (NSNotFound, 0)) + inTextContainer:textContainer rectCount:&nrects]; + maxX = max (NSMaxX (glyphRects[0]), totalAdvance); + gl->advance_delta = location.x - totalAdvance; + gl->advance = maxX - totalAdvance; + totalAdvance = maxX; + } + else + { + CGFloat minX; + + if (nextGlyphIndex == numberOfGlyphs) + glyphRange = NSMakeRange (prevGlyphIndex, + numberOfGlyphs - prevGlyphIndex); + else + glyphRange = NSMakeRange (prevGlyphIndex, + glyphIndex + 1 - prevGlyphIndex); + glyphRects = + [layoutManager + rectArrayForGlyphRange:glyphRange + withinSelectedGlyphRange:(NSMakeRange (NSNotFound, 0)) + inTextContainer:textContainer rectCount:&nrects]; + minX = min (NSMinX (glyphRects[0]), totalAdvance); + gl->advance = totalAdvance - minX; + totalAdvance = minX; + gl->advance_delta = location.x - totalAdvance; + } + + prevGlyphIndex = glyphIndex + 1; + glyphIndex = nextGlyphIndex; + } + + if (RIGHT_TO_LEFT_P) + xfree (permutation); + +#undef RIGHT_TO_LEFT_P + + result = used; + } + [textStorage release]; + + return result; +} + +static Lisp_Object +nsfont_shape (Lisp_Object lgstring, Lisp_Object direction) +{ + struct font *font = CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring)); + struct nsfont_info *font_info = (struct nsfont_info *) font; + struct ns_glyph_layout *glyph_layouts; + NSFont *nsfont = font_info->nsfont; + ptrdiff_t glyph_len, len, i; + Lisp_Object tem; + unichar *mb_buf; + NSUInteger used; + + glyph_len = LGSTRING_GLYPH_LEN (lgstring); + for (i = 0; i < glyph_len; ++i) + { + tem = LGSTRING_GLYPH (lgstring, i); + + if (NILP (tem)) + break; + } + + len = i; + + if (INT_MAX / 2 < len) + memory_full (SIZE_MAX); + + block_input (); + + mb_buf = alloca (len * sizeof *mb_buf); + + for (i = 0; i < len; ++i) + { + uint32_t c = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, i)); + mb_buf[i] = (unichar) c; + } + + NSString *string = [NSString stringWithCharacters: mb_buf + length: len]; + unblock_input (); + + if (!string) + return Qnil; + + block_input (); + + enum lgstring_direction dir = DIR_UNKNOWN; + + if (EQ (direction, QL2R)) + dir = DIR_L2R; + else if (EQ (direction, QR2L)) + dir = DIR_R2L; + glyph_layouts = alloca (sizeof (struct ns_glyph_layout) * glyph_len); + used = ns_font_shape (nsfont, string, glyph_layouts, glyph_len, dir); + + for (i = 0; i < used; i++) + { + Lisp_Object lglyph = LGSTRING_GLYPH (lgstring, i); + struct ns_glyph_layout *gl = glyph_layouts + i; + EMACS_INT from, to; + struct font_metrics metrics; + + if (NILP (lglyph)) + { + lglyph = LGLYPH_NEW (); + LGSTRING_SET_GLYPH (lgstring, i, lglyph); + } + + from = gl->comp_range.location; + LGLYPH_SET_FROM (lglyph, from); + + to = gl->comp_range.location + gl->comp_range.length; + LGLYPH_SET_TO (lglyph, to - 1); + + /* LGLYPH_CHAR is used in `describe-char' for checking whether + the composition is trivial. */ + { + UTF32Char c; + + if (mb_buf[gl->string_index] >= 0xD800 + && mb_buf[gl->string_index] < 0xDC00) + c = (((mb_buf[gl->string_index] - 0xD800) << 10) + + (mb_buf[gl->string_index + 1] - 0xDC00) + 0x10000); + else + c = mb_buf[gl->string_index]; + + LGLYPH_SET_CHAR (lglyph, c); + } + + { + unsigned long cc = gl->glyph_id; + LGLYPH_SET_CODE (lglyph, cc); + } + + nsfont_text_extents (font, &gl->glyph_id, 1, &metrics); + LGLYPH_SET_WIDTH (lglyph, metrics.width); + LGLYPH_SET_LBEARING (lglyph, metrics.lbearing); + LGLYPH_SET_RBEARING (lglyph, metrics.rbearing); + LGLYPH_SET_ASCENT (lglyph, metrics.ascent); + LGLYPH_SET_DESCENT (lglyph, metrics.descent); + } + unblock_input (); + + return make_fixnum (used); +} /* ========================================================================== @@ -1134,6 +1606,50 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, ========================================================================== */ +static NSGlyph +ns_uni_to_glyphs_1 (struct nsfont_info *info, unsigned int c) +{ + unichar characters[] = { c }; + NSString *string = + [NSString stringWithCharacters: characters + length: 1]; + NSDictionary *attributes = + [NSDictionary dictionaryWithObjectsAndKeys: + info->nsfont, NSFontAttributeName, nil]; + NSTextStorage *storage = [[NSTextStorage alloc] initWithString: string + attributes: attributes]; + NSTextContainer *text_container = [[NSTextContainer alloc] init]; + NSLayoutManager *manager = [[NSLayoutManager alloc] init]; + + [manager addTextContainer: text_container]; + [text_container release]; /* Retained by manager */ + [storage addLayoutManager: manager]; + [manager release]; /* Retained by storage */ + + NSFont *font_in_storage = [storage attribute: NSFontAttributeName + atIndex:0 + effectiveRange: NULL]; + NSGlyph glyph = FONT_INVALID_CODE; + + if ((font_in_storage == info->nsfont + || [[font_in_storage fontName] isEqualToString: [info->nsfont fontName]])) + { + @try + { + glyph = [manager glyphAtIndex: 0]; + } + @catch (NSException *e) + { + /* GNUstep bug? */ + glyph = 'X'; + } + } + + [storage release]; + + return glyph; +} + /* Find and cache corresponding glyph codes for unicode values in given hi-byte block of 256. */ static void @@ -1141,7 +1657,7 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) { unichar *unichars = xmalloc (0x101 * sizeof (unichar)); unsigned int i, g, idx; - unsigned short *glyphs; + unsigned int *glyphs; if (NSFONT_TRACE) fprintf (stderr, "%p\tFinding glyphs for glyphs in block %d\n", @@ -1149,7 +1665,7 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) block_input (); - font_info->glyphs[block] = xmalloc (0x100 * sizeof (unsigned short)); + font_info->glyphs[block] = xmalloc (0x100 * sizeof (unsigned int)); if (!unichars || !(font_info->glyphs[block])) emacs_abort (); @@ -1166,7 +1682,8 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) for (i = 0; i < 0x100; i++, glyphs++) { g = unichars[i]; - *glyphs = g; + NSGlyph glyph = ns_uni_to_glyphs_1 (font_info, g); + *glyphs = glyph; } } @@ -1175,18 +1692,19 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) } -/* Determine and cache metrics for corresponding glyph codes in given - hi-byte block of 256. */ +/* Determine and cache metrics for glyphs in given hi-byte block of + 256. */ static void -ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block) +ns_glyph_metrics (struct nsfont_info *font_info, unsigned int block) { - unsigned int i, g; + unsigned int i; + NSGlyph g; unsigned int numGlyphs = [font_info->nsfont numberOfGlyphs]; NSFont *sfont; struct font_metrics *metrics; if (NSFONT_TRACE) - fprintf (stderr, "%p\tComputing metrics for glyphs in block %d\n", + fprintf (stderr, "%p\tComputing metrics for glyphs in block %u\n", font_info, block); /* not implemented yet (as of startup 0.18), so punt */ @@ -1209,19 +1727,14 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block) w = max ([sfont advancementForGlyph: g].width, 2.0); metrics->width = lrint (w); - lb = r.origin.x; - rb = r.size.width - w; - // Add to bearing for LCD smoothing. We don't know if it is there. - if (lb < 0) - metrics->lbearing = round (lb - LCD_SMOOTHING_MARGIN); - if (font_info->ital) - rb += (CGFloat) (0.22F * font_info->height); - metrics->rbearing = lrint (w + rb + LCD_SMOOTHING_MARGIN); - - metrics->descent = r.origin.y < 0 ? -r.origin.y : 0; - /* lrint (hshrink * [sfont ascender] + expand * hd/2); */ - metrics->ascent = r.size.height - metrics->descent; - /* -lrint (hshrink* [sfont descender] - expand * hd/2); */ + lb = NSMinX (r); + rb = NSMaxX (r); + + metrics->rbearing = lrint (rb); + metrics->lbearing = lrint (lb); + + metrics->descent = NSMinY (r); + metrics->ascent = NSMaxY (r); } unblock_input (); } @@ -1257,6 +1770,7 @@ struct font_driver const nsfont_driver = .has_char = nsfont_has_char, .encode_char = nsfont_encode_char, .text_extents = nsfont_text_extents, + .shape = nsfont_shape, .draw = nsfont_draw, }; @@ -1265,7 +1779,6 @@ syms_of_nsfont (void) { DEFSYM (Qcondensed, "condensed"); DEFSYM (Qexpanded, "expanded"); - DEFSYM (Qapple, "apple"); DEFSYM (Qmedium, "medium"); DEFVAR_LISP ("ns-reg-to-script", Vns_reg_to_script, doc: /* Internal use: maps font registry to Unicode script. */); diff --git a/src/nsimage.m b/src/nsimage.m index 3c16cd371e6..dd2bb3b0d7b 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -265,16 +265,12 @@ ns_image_size_in_bytes (void *img) image = [[EmacsImage alloc] initByReferencingFile:filename]; image->bmRep = nil; -#ifdef NS_IMPL_COCOA - imgRep = [NSBitmapImageRep imageRepWithData:[image TIFFRepresentation]]; -#else - imgRep = [image bestRepresentationForDevice: nil]; -#endif - if (imgRep == nil) + if (![image isValid]) { [image release]; return nil; } + imgRep = [[image representations] firstObject]; [image setSize: NSMakeSize([imgRep pixelsWide], [imgRep pixelsHigh])]; [image setName:filename]; @@ -381,51 +377,10 @@ ns_image_size_in_bytes (void *img) } } - xbm_fg = fg; [self addRepresentation: bmRep]; return self; } -/* Set color for a bitmap image. */ -- (instancetype)setXBMColor: (NSColor *)color -{ - NSSize s = [self size]; - unsigned char *planes[5]; - EmacsCGFloat r, g, b, a; - NSColor *rgbColor; - - if (bmRep == nil || color == nil) - return self; - - if ([color colorSpace] != [NSColorSpace genericRGBColorSpace]) - rgbColor = [color colorUsingColorSpace:[NSColorSpace genericRGBColorSpace]]; - else - rgbColor = color; - - [rgbColor getRed: &r green: &g blue: &b alpha: &a]; - - [bmRep getBitmapDataPlanes: planes]; - - { - int i, len = s.width*s.height; - int rr = r * 0xff, gg = g * 0xff, bb = b * 0xff; - unsigned char fgr = (xbm_fg >> 16) & 0xff; - unsigned char fgg = (xbm_fg >> 8) & 0xff; - unsigned char fgb = xbm_fg & 0xff; - - for (i = 0; i < len; ++i) - if (planes[0][i] == fgr && planes[1][i] == fgg && planes[2][i] == fgb) - { - planes[0][i] = rr; - planes[1][i] = gg; - planes[2][i] = bb; - } - xbm_fg = ((rr << 16) & 0xff0000) + ((gg << 8) & 0xff00) + (bb & 0xff); - } - - return self; -} - - (instancetype)initForXPMWithDepth: (int)depth width: (int)width height: (int)height { diff --git a/src/nsmenu.m b/src/nsmenu.m index 1b03fe91a8b..29201e69079 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -101,6 +101,15 @@ popup_activated (void) static void ns_update_menubar (struct frame *f, bool deep_p) { +#ifdef NS_IMPL_GNUSTEP + static int inside = 0; + + if (inside) + return; + + inside++; +#endif + BOOL needsSet = NO; id menu = [NSApp mainMenu]; bool owfi; @@ -120,7 +129,12 @@ ns_update_menubar (struct frame *f, bool deep_p) NSTRACE ("ns_update_menubar"); if (f != SELECTED_FRAME () || FRAME_EXTERNAL_MENU_BAR (f) == 0) + { +#ifdef NS_IMPL_GNUSTEP + inside--; +#endif return; + } XSETFRAME (Vmenu_updating_frame, f); /*fprintf (stderr, "ns_update_menubar: frame: %p\tdeep: %d\tsub: %p\n", f, deep_p, submenu); */ @@ -144,10 +158,6 @@ ns_update_menubar (struct frame *f, bool deep_p) t = -(1000*tb.time+tb.millitm); #endif -#ifdef NS_IMPL_GNUSTEP - deep_p = 1; /* See comment in menuNeedsUpdate. */ -#endif - if (deep_p) { /* Make a widget-value tree representing the entire menu trees. */ @@ -275,6 +285,9 @@ ns_update_menubar (struct frame *f, bool deep_p) free_menubar_widget_value_tree (first_wv); discard_menu_items (); unbind_to (specpdl_count, Qnil); +#ifdef NS_IMPL_GNUSTEP + inside--; +#endif return; } @@ -408,6 +421,10 @@ ns_update_menubar (struct frame *f, bool deep_p) if (needsSet) [NSApp setMainMenu: menu]; +#ifdef NS_IMPL_GNUSTEP + inside--; +#endif + unblock_input (); } @@ -452,17 +469,34 @@ set_frame_menubar (struct frame *f, bool deep_p) call to ns_update_menubar. */ - (void)menuNeedsUpdate: (NSMenu *)menu { +#ifdef NS_IMPL_GNUSTEP + static int inside = 0; +#endif + if (!FRAME_LIVE_P (SELECTED_FRAME ())) return; -#ifdef NS_IMPL_COCOA -/* TODO: GNUstep calls this method when the menu is still being built - which results in a recursive stack overflow. One possible solution - is to use menuWillOpen instead, but the Apple docs explicitly warn - against changing the contents of the menu in it. I don't know what - the right thing to do for GNUstep is. */ +#ifdef NS_IMPL_GNUSTEP + /* GNUstep calls this method when the menu is still being built + which results in a recursive stack overflow, which this variable + prevents. */ + + if (!inside) + ++inside; + else + return; +#endif + if (needsUpdate) - ns_update_menubar (SELECTED_FRAME (), true); + { +#ifdef NS_IMPL_GNUSTEP + needsUpdate = NO; +#endif + ns_update_menubar (SELECTED_FRAME (), true); + } + +#ifdef NS_IMPL_GNUSTEP + --inside; #endif } @@ -789,6 +823,9 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags, p.x = x; p.y = y; + /* Don't GC due to a mysterious bug. */ + inhibit_garbage_collection (); + /* now parse stage 2 as in ns_update_menubar */ wv = make_widget_value ("contextmenu", NULL, true, Qnil); wv->button_type = BUTTON_TYPE_NONE; @@ -959,16 +996,18 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags, } pmenu = [[EmacsMenu alloc] initWithTitle: - [NSString stringWithLispString: title]]; + NILP (title) ? @"" : [NSString stringWithLispString: title]]; + /* On GNUstep, this call makes menu_items nil for whatever reason + when displaying a context menu from `context-menu-mode'. */ + Lisp_Object items = menu_items; [pmenu fillWithWidgetValue: first_wv->contents]; + menu_items = items; free_menubar_widget_value_tree (first_wv); - unbind_to (specpdl_count, Qnil); - popup_activated_flag = 1; tem = [pmenu runMenuAt: p forFrame: f keymaps: keymaps]; popup_activated_flag = 0; [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; - + unbind_to (specpdl_count, Qnil); unblock_input (); return tem; } @@ -991,36 +1030,43 @@ free_frame_tool_bar (struct frame *f) NSTRACE ("free_frame_tool_bar"); block_input (); - view->wait_for_tool_bar = NO; /* Note: This triggers an animation, which calls windowDidResize repeatedly. */ f->output_data.ns->in_animation = 1; - [[view toolbar] setVisible: NO]; + [[[view window] toolbar] setVisible:NO]; f->output_data.ns->in_animation = 0; + [[view window] setToolbar:nil]; + unblock_input (); } void -update_frame_tool_bar (struct frame *f) +update_frame_tool_bar_1 (struct frame *f, EmacsToolbar *toolbar) /* -------------------------------------------------------------------------- Update toolbar contents. -------------------------------------------------------------------------- */ { int i, k = 0; - EmacsView *view = FRAME_NS_VIEW (f); - EmacsToolbar *toolbar = [view toolbar]; NSTRACE ("update_frame_tool_bar"); - if (view == nil || toolbar == nil) return; block_input (); #ifdef NS_IMPL_COCOA [toolbar clearActive]; #else [toolbar clearAll]; + /* It takes at least 3 such adjustments to fix an issue where the + tool bar is 2x too tall when a frame's tool bar is first shown. + This is ugly, but I have no other solution for this problem. */ + if (FRAME_OUTPUT_DATA (f)->tool_bar_adjusted < 3) + { + [toolbar setVisible: NO]; + FRAME_OUTPUT_DATA (f)->tool_bar_adjusted++; + [toolbar setVisible: YES]; + } #endif /* Update EmacsToolbar as in GtkUtils, build items list. */ @@ -1034,6 +1080,8 @@ update_frame_tool_bar (struct frame *f) ptrdiff_t img_id; struct image *img; Lisp_Object image; + Lisp_Object labelObj; + const char *labelText; Lisp_Object helpObj; const char *helpText; @@ -1060,6 +1108,8 @@ update_frame_tool_bar (struct frame *f) { idx = -1; } + labelObj = TOOLPROP (TOOL_BAR_ITEM_LABEL); + labelText = NILP (labelObj) ? "" : SSDATA (labelObj); helpObj = TOOLPROP (TOOL_BAR_ITEM_HELP); if (NILP (helpObj)) helpObj = TOOLPROP (TOOL_BAR_ITEM_CAPTION); @@ -1085,18 +1135,12 @@ update_frame_tool_bar (struct frame *f) [toolbar addDisplayItemWithImage: img->pixmap idx: k++ tag: i + labelText: labelText helpText: helpText enabled: enabled_p]; #undef TOOLPROP } - if (![toolbar isVisible]) - { - f->output_data.ns->in_animation = 1; - [toolbar setVisible: YES]; - f->output_data.ns->in_animation = 0; - } - #ifdef NS_IMPL_COCOA if ([toolbar changed]) { @@ -1121,13 +1165,25 @@ update_frame_tool_bar (struct frame *f) } #endif - if (view->wait_for_tool_bar && FRAME_TOOLBAR_HEIGHT (f) > 0) + [toolbar setVisible:YES]; + unblock_input (); +} + +void +update_frame_tool_bar (struct frame *f) +{ + EmacsWindow *window = (EmacsWindow *)[FRAME_NS_VIEW (f) window]; + EmacsToolbar *toolbar = (EmacsToolbar *)[window toolbar]; + + if (!toolbar) { - view->wait_for_tool_bar = NO; - [view setNeedsDisplay: YES]; + [window createToolbar:f]; + return; } - unblock_input (); + if (window == nil || toolbar == nil) return; + + update_frame_tool_bar_1 (f, toolbar); } @@ -1196,6 +1252,7 @@ update_frame_tool_bar (struct frame *f) - (void) addDisplayItemWithImage: (EmacsImage *)img idx: (int)idx tag: (int)tag + labelText: (const char *)label helpText: (const char *)help enabled: (BOOL)enabled { @@ -1213,6 +1270,7 @@ update_frame_tool_bar (struct frame *f) item = [[[NSToolbarItem alloc] initWithItemIdentifier: identifier] autorelease]; [item setImage: img]; + [item setLabel: [NSString stringWithUTF8String: label]]; [item setToolTip: [NSString stringWithUTF8String: help]]; [item setTarget: emacsView]; [item setAction: @selector (toolbarClicked:)]; diff --git a/src/nsterm.h b/src/nsterm.h index b29e76cc63f..8175f996644 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1,3 +1,4 @@ +/* -*- objc -*- */ /* Definitions and headers for communication with NeXT/Open/GNUstep API. Copyright (C) 1989, 1993, 2005, 2008-2021 Free Software Foundation, Inc. @@ -348,16 +349,6 @@ typedef id instancetype; #endif -/* macOS 10.14 and above cannot draw directly "to the glass" and - therefore we draw to an offscreen buffer and swap it in when the - toolkit wants to draw the frame. GNUstep and macOS 10.7 and below - do not support this method, so we revert to drawing directly to the - glass. */ -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101400 -#define NS_DRAW_TO_BUFFER 1 -#endif - - /* ========================================================================== NSColor, EmacsColor category. @@ -416,6 +407,26 @@ typedef id instancetype; @end #endif +/* EmacsWindow */ +@interface EmacsWindow : NSWindow +{ + NSPoint grabOffset; +} + +#ifdef NS_IMPL_GNUSTEP +- (NSInteger) orderedIndex; +#endif + +- (instancetype)initWithEmacsFrame:(struct frame *)f; +- (instancetype)initWithEmacsFrame:(struct frame *)f fullscreen:(BOOL)fullscreen screen:(NSScreen *)screen; +- (void)createToolbar:(struct frame *)f; +- (void)setParentChildRelationships; +- (NSInteger)borderWidth; +- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above; +- (void)setAppearance; +@end + + /* ========================================================================== The main Emacs view @@ -423,7 +434,7 @@ typedef id instancetype; ========================================================================== */ @class EmacsToolbar; -@class EmacsSurface; +@class EmacsLayer; #ifdef NS_IMPL_COCOA @interface EmacsView : NSView <NSTextInput, NSWindowDelegate> @@ -439,19 +450,13 @@ typedef id instancetype; NSString *workingText; BOOL processingCompose; int fs_state, fs_before_fs, next_maximized; - int bwidth; int maximized_width, maximized_height; - NSWindow *nonfs_window; + EmacsWindow *nonfs_window; BOOL fs_is_native; -#ifdef NS_DRAW_TO_BUFFER - EmacsSurface *surface; -#endif @public struct frame *emacsframe; int scrollbarsNeedingUpdate; - EmacsToolbar *toolbar; NSRect ns_userRect; - BOOL wait_for_tool_bar; } /* AppKit-side interface */ @@ -465,9 +470,7 @@ typedef id instancetype; /* Emacs-side interface */ - (instancetype) initFrameFromEmacs: (struct frame *) f; -- (void) createToolbar: (struct frame *)f; - (void) setWindowClosing: (BOOL)closing; -- (EmacsToolbar *) toolbar; - (void) deleteWorkingText; - (void) handleFS; - (void) setFSValue: (int)value; @@ -483,11 +486,11 @@ typedef id instancetype; #endif - (int)fullscreenState; -#ifdef NS_DRAW_TO_BUFFER -- (void)focusOnDrawingBuffer; -- (void)unfocusDrawingBuffer; +#ifdef NS_IMPL_COCOA +- (void)lockFocus; +- (void)unlockFocus; #endif -- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect; +- (void)copyRect:(NSRect)srcRect to:(NSPoint)dest; /* Non-notification versions of NSView methods. Used for direct calls. */ - (void)windowWillEnterFullScreen; @@ -498,27 +501,6 @@ typedef id instancetype; @end -/* Small utility used for processing resize events under Cocoa. */ -@interface EmacsWindow : NSWindow -{ - NSPoint grabOffset; -} - -#ifdef NS_IMPL_GNUSTEP -- (NSInteger) orderedIndex; -#endif - -- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above; -- (void)setAppearance; -@end - - -/* Fullscreen version of the above. */ -@interface EmacsFSWindow : EmacsWindow -{ -} -@end - /* ========================================================================== The main menu implementation @@ -568,6 +550,7 @@ typedef id instancetype; - (void) addDisplayItemWithImage: (EmacsImage *)img idx: (int)idx tag: (int)tag + labelText: (const char *)label helpText: (const char *)help enabled: (BOOL)enabled; @@ -647,7 +630,6 @@ typedef id instancetype; NSBitmapImageRep *bmRep; /* used for accessing pixel data */ unsigned char *pixmapData[5]; /* shortcut to access pixel data */ NSColor *stippleMask; - unsigned long xbm_fg; @public NSAffineTransform *transform; BOOL smoothing; @@ -657,7 +639,6 @@ typedef id instancetype; - (instancetype)initFromXBM: (unsigned char *)bits width: (int)w height: (int)h fg: (unsigned long)fg bg: (unsigned long)bg reverseBytes: (BOOL)reverse; -- (instancetype)setXBMColor: (NSColor *)color; - (instancetype)initForXPMWithDepth: (int)depth width: (int)width height: (int)height; - (void)setPixmapData; - (unsigned long)getPixelAtX: (int)x Y: (int)y; @@ -716,23 +697,17 @@ typedef id instancetype; + (CGFloat)scrollerWidth; @end -#ifdef NS_DRAW_TO_BUFFER -@interface EmacsSurface : NSObject +#ifdef NS_IMPL_COCOA +@interface EmacsLayer : CALayer { NSMutableArray *cache; - NSSize size; CGColorSpaceRef colorSpace; IOSurfaceRef currentSurface; - IOSurfaceRef lastSurface; CGContextRef context; - CGFloat scale; } -- (id) initWithSize: (NSSize)s ColorSpace: (CGColorSpaceRef)cs Scale: (CGFloat)scale; -- (void) dealloc; -- (NSSize) getSize; +- (id) initWithColorSpace: (CGColorSpaceRef)cs; +- (void) setColorSpace: (CGColorSpaceRef)cs; - (CGContextRef) getContext; -- (void) releaseContext; -- (IOSurfaceRef) getSurface; @end #endif @@ -845,7 +820,7 @@ struct nsfont_info XCharStruct max_bounds; /* We compute glyph codes and metrics on-demand in blocks of 256 indexed by hibyte, lobyte. */ - unsigned short **glyphs; /* map Unicode index to glyph */ + unsigned int **glyphs; /* map Unicode index to glyph */ struct font_metrics **metrics; }; #endif @@ -1003,6 +978,12 @@ struct ns_output /* Non-zero if we are doing an animation, e.g. toggling the tool bar. */ int in_animation; + +#ifdef NS_IMPL_GNUSTEP + /* Zero if this is the first time a toolbar has been updated on this + frame. */ + int tool_bar_adjusted; +#endif }; /* This dummy declaration needed to support TTYs. */ @@ -1161,6 +1142,7 @@ extern void ns_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval); extern void ns_set_scroll_bar_default_width (struct frame *f); extern void ns_set_scroll_bar_default_height (struct frame *f); +extern void ns_change_tab_bar_height (struct frame *f, int height); extern const char *ns_get_string_resource (void *_rdb, const char *name, const char *class); @@ -1175,6 +1157,10 @@ extern void ns_init_locale (void); /* in nsmenu */ extern void update_frame_tool_bar (struct frame *f); +#ifdef __OBJC__ +extern void update_frame_tool_bar_1 (struct frame *f, EmacsToolbar *toolbar); +#endif + extern void free_frame_tool_bar (struct frame *f); extern Lisp_Object find_and_return_menu_selection (struct frame *f, bool keymaps, diff --git a/src/nsterm.m b/src/nsterm.m index b9e2c9b6916..1f17a30272c 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -65,14 +65,12 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) #ifdef NS_IMPL_GNUSTEP #include "process.h" +#import <GNUstepGUI/GSDisplayServer.h> #endif #ifdef NS_IMPL_COCOA #include "macfont.h" #include <Carbon/Carbon.h> -#endif - -#ifdef NS_DRAW_TO_BUFFER #include <IOSurface/IOSurface.h> #endif @@ -272,9 +270,6 @@ long context_menu_value = 0; /* display update */ static struct frame *ns_updating_frame; -#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 -static NSView *focus_view = NULL; -#endif static int ns_window_num = 0; static BOOL gsaved = NO; #ifdef NS_IMPL_COCOA @@ -1027,38 +1022,8 @@ ns_update_begin (struct frame *f) ns_update_auto_hide_menu_bar (); -#ifdef NS_IMPL_COCOA - if ([view isFullscreen] && [view fsIsNative]) - { - // Fix reappearing tool bar in fullscreen for Mac OS X 10.7 - BOOL tbar_visible = FRAME_EXTERNAL_TOOL_BAR (f) ? YES : NO; - NSToolbar *toolbar = [FRAME_NS_VIEW (f) toolbar]; - if (! tbar_visible != ! [toolbar isVisible]) - [toolbar setVisible: tbar_visible]; - } -#endif - ns_updating_frame = f; -#ifdef NS_DRAW_TO_BUFFER -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - if ([FRAME_NS_VIEW (f) wantsUpdateLayer]) - { -#endif - [view focusOnDrawingBuffer]; -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - } - else - { -#endif -#endif /* NS_DRAW_TO_BUFFER */ - -#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - [view lockFocus]; -#endif -#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - } -#endif - + [view lockFocus]; } @@ -1069,39 +1034,21 @@ ns_update_end (struct frame *f) external (RIF) call; for whole frame, called after gui_update_window_end -------------------------------------------------------------------------- */ { -#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 EmacsView *view = FRAME_NS_VIEW (f); -#endif NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end"); /* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */ MOUSE_HL_INFO (f)->mouse_face_defer = 0; -#ifdef NS_DRAW_TO_BUFFER -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - if ([FRAME_NS_VIEW (f) wantsUpdateLayer]) - { -#endif - [FRAME_NS_VIEW (f) unfocusDrawingBuffer]; -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - } - else - { -#endif -#endif /* NS_DRAW_TO_BUFFER */ - -#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - block_input (); - - [view unlockFocus]; - [[view window] flushWindow]; + block_input (); - unblock_input (); -#endif -#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - } + [view unlockFocus]; +#if defined (NS_IMPL_GNUSTEP) + [[view window] flushWindow]; #endif + + unblock_input (); ns_updating_frame = NULL; } @@ -1116,8 +1063,6 @@ ns_focus (struct frame *f, NSRect *r, int n) the entire window. -------------------------------------------------------------------------- */ { - EmacsView *view = FRAME_NS_VIEW (f); - NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus"); if (r != NULL) { @@ -1126,47 +1071,23 @@ ns_focus (struct frame *f, NSRect *r, int n) if (f != ns_updating_frame) { -#ifdef NS_DRAW_TO_BUFFER -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - if ([FRAME_NS_VIEW (f) wantsUpdateLayer]) - { -#endif - [view focusOnDrawingBuffer]; -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - } - else - { -#endif -#endif /* NS_DRAW_TO_BUFFER */ - -#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - if (view != focus_view) - { - if (focus_view != NULL) - { - [focus_view unlockFocus]; - [[focus_view window] flushWindow]; - } - - if (view) - [view lockFocus]; - focus_view = view; - } -#endif -#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - } -#endif + EmacsView *view = FRAME_NS_VIEW (f); + [view lockFocus]; } - /* clipping */ if (r) { - [[NSGraphicsContext currentContext] saveGraphicsState]; + NSGraphicsContext *ctx = [NSGraphicsContext currentContext]; + [ctx saveGraphicsState]; +#ifdef NS_IMPL_COCOA if (n == 2) NSRectClipList (r, 2); else NSRectClip (*r); +#else + GSRectClipList (ctx, r, n); +#endif gsaved = YES; } } @@ -1186,35 +1107,14 @@ ns_unfocus (struct frame *f) gsaved = NO; } -#ifdef NS_DRAW_TO_BUFFER - #if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - if ([FRAME_NS_VIEW (f) wantsUpdateLayer]) - { -#endif - if (! ns_updating_frame) - [FRAME_NS_VIEW (f) unfocusDrawingBuffer]; - [FRAME_NS_VIEW (f) setNeedsDisplay:YES]; -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - } - else + if (f != ns_updating_frame) { + EmacsView *view = FRAME_NS_VIEW (f); + [view unlockFocus]; +#if defined (NS_IMPL_GNUSTEP) + [[view window] flushWindow]; #endif -#endif /* NS_DRAW_TO_BUFFER */ - -#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - if (f != ns_updating_frame) - { - if (focus_view != NULL) - { - [focus_view unlockFocus]; - [[focus_view window] flushWindow]; - focus_view = NULL; - } - } -#endif -#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 } -#endif } @@ -1381,7 +1281,7 @@ ns_ring_bell (struct frame *f) } } -#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 +#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 static void hide_bell (void) /* -------------------------------------------------------------------------- @@ -1548,7 +1448,7 @@ ns_make_frame_visible (struct frame *f) if (!FRAME_VISIBLE_P (f)) { EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); - NSWindow *window = [view window]; + EmacsWindow *window = (EmacsWindow *)[view window]; SET_FRAME_VISIBLE (f, 1); ns_raise_frame (f, ! FRAME_NO_FOCUS_ON_MAP (f)); @@ -1571,11 +1471,8 @@ ns_make_frame_visible (struct frame *f) relationship, so reinstate it. */ if ([window parentWindow] == nil && FRAME_PARENT_FRAME (f) != NULL) { - NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window]; - block_input (); - [parent addChildWindow: window - ordered: NSWindowAbove]; + [window setParentChildRelationships]; unblock_input (); /* If the parent frame moved while the child frame was @@ -1732,52 +1629,35 @@ ns_set_offset (struct frame *f, int xoff, int yoff, int change_grav) block_input (); - if (FRAME_PARENT_FRAME (f)) - { - /* Convert the parent frame's view rectangle into screen - coords. */ - EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)); - NSRect parentRect = [parentView convertRect:[parentView frame] - toView:nil]; - parentRect = [[parentView window] convertRectToScreen:parentRect]; + /* If there is no parent frame then just convert to screen + coordinates, UNLESS we have negative values, in which case I + think it's best to position from the bottom and right of the + current screen rather than the main screen or whole display. */ - if (f->size_hint_flags & XNegative) - topLeft.x = NSMaxX (parentRect) - NSWidth (windowFrame) + xoff; - else - topLeft.x = NSMinX (parentRect) + xoff; + NSRect parentRect = ns_parent_window_rect (f); - if (f->size_hint_flags & YNegative) - topLeft.y = NSMinY (parentRect) + NSHeight (windowFrame) - yoff; - else - topLeft.y = NSMaxY (parentRect) - yoff; - } + if (f->size_hint_flags & XNegative) + topLeft.x = NSMaxX (parentRect) - NSWidth (windowFrame) + xoff; + else if (FRAME_PARENT_FRAME (f)) + topLeft.x = NSMinX (parentRect) + xoff; else - { - /* If there is no parent frame then just convert to screen - coordinates, UNLESS we have negative values, in which case I - think it's best to position from the bottom and right of the - current screen rather than the main screen or whole - display. */ - NSRect screenFrame = [[[view window] screen] frame]; + topLeft.x = xoff; - if (f->size_hint_flags & XNegative) - topLeft.x = NSMaxX (screenFrame) - NSWidth (windowFrame) + xoff; - else - topLeft.x = xoff; - - if (f->size_hint_flags & YNegative) - topLeft.y = NSMinY (screenFrame) + NSHeight (windowFrame) - yoff; - else - topLeft.y = NSMaxY ([[[NSScreen screens] objectAtIndex:0] frame]) - yoff; + if (f->size_hint_flags & YNegative) + topLeft.y = NSMinY (parentRect) + NSHeight (windowFrame) - yoff; + else if (FRAME_PARENT_FRAME (f)) + topLeft.y = NSMaxY (parentRect) - yoff; + else + topLeft.y = NSMaxY ([[[NSScreen screens] objectAtIndex:0] frame]) - yoff; #ifdef NS_IMPL_GNUSTEP - /* Don't overlap the menu. + /* Don't overlap the menu. - FIXME: Surely there's a better way than just hardcoding 100 - in here? */ - topLeft.x = 100; + FIXME: Surely there's a better way than just hardcoding 100 in + here? */ + if (topLeft.x < 100) + topLeft.x = 100; #endif - } NSTRACE_POINT ("setFrameTopLeftPoint", topLeft); [[view window] setFrameTopLeftPoint:topLeft]; @@ -1800,45 +1680,38 @@ ns_set_window_size (struct frame *f, { EmacsView *view = FRAME_NS_VIEW (f); NSWindow *window = [view window]; - NSRect wr = [window frame]; - int orig_height = wr.size.height; + NSRect frameRect; NSTRACE ("ns_set_window_size"); if (view == nil) return; - NSTRACE_RECT ("current", wr); + NSTRACE_RECT ("current", [window frame]); NSTRACE_MSG ("Width:%d Height:%d", width, height); NSTRACE_MSG ("Font %d x %d", FRAME_COLUMN_WIDTH (f), FRAME_LINE_HEIGHT (f)); block_input (); - wr.size.width = width + f->border_width; - wr.size.height = height; - if (! [view isFullscreen]) - wr.size.height += FRAME_NS_TITLEBAR_HEIGHT (f) - + FRAME_TOOLBAR_HEIGHT (f); + frameRect = [window frameRectForContentRect:NSMakeRect (0, 0, width, height)]; + + /* Set the origin so the top left of the frame doesn't move. */ + frameRect.origin = [window frame].origin; + frameRect.origin.y += NSHeight ([view frame]) - height; - /* Do not try to constrain to this screen. We may have multiple - screens, and want Emacs to span those. Constraining to screen - prevents that, and that is not nice to the user. */ - if (f->output_data.ns->zooming) - f->output_data.ns->zooming = 0; - else - wr.origin.y += orig_height - wr.size.height; + if (f->output_data.ns->zooming) + f->output_data.ns->zooming = 0; - /* Usually it seems safe to delay changing the frame size, but when a - series of actions are taken with no redisplay between them then we - can end up using old values so don't delay here. */ - change_frame_size (f, width, height, false, NO, false); + /* Usually it seems safe to delay changing the frame size, but when a + series of actions are taken with no redisplay between them then we + can end up using old values so don't delay here. */ + change_frame_size (f, width, height, false, NO, false); - [window setFrame:wr display:NO]; + [window setFrame:frameRect display:NO]; unblock_input (); } -#ifdef NS_IMPL_COCOA void ns_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) /* -------------------------------------------------------------------------- @@ -1848,45 +1721,34 @@ ns_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu dragged, resized, iconified, maximized or deleted with the mouse. If nil, draw the frame with all the elements listed above unless these have been suspended via window manager settings. - - GNUStep cannot change an existing window's style. -------------------------------------------------------------------------- */ { - EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); - NSWindow *window = [view window]; - NSTRACE ("ns_set_undecorated"); if (!EQ (new_value, old_value)) { + EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); + NSWindow *oldWindow = [view window]; + NSWindow *newWindow; + block_input (); - if (NILP (new_value)) - { - FRAME_UNDECORATED (f) = false; - [window setStyleMask: ((window.styleMask | FRAME_DECORATED_FLAGS) - ^ FRAME_UNDECORATED_FLAGS)]; + FRAME_UNDECORATED (f) = !NILP (new_value); - [view createToolbar: f]; - } - else - { - [window setToolbar: nil]; - /* Do I need to release the toolbar here? */ + newWindow = [[EmacsWindow alloc] initWithEmacsFrame:f]; - FRAME_UNDECORATED (f) = true; - [window setStyleMask: ((window.styleMask | FRAME_UNDECORATED_FLAGS) - ^ FRAME_DECORATED_FLAGS)]; - } + if ([oldWindow isKeyWindow]) + [newWindow makeKeyAndOrderFront:NSApp]; - /* At this point it seems we don't have an active NSResponder, - so some key presses (TAB) are swallowed by the system. */ - [window makeFirstResponder: view]; + [newWindow setIsVisible:[oldWindow isVisible]]; + if ([oldWindow isMiniaturized]) + [newWindow miniaturize:NSApp]; + + [oldWindow close]; unblock_input (); } } -#endif /* NS_IMPL_COCOA */ void ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) @@ -1913,7 +1775,6 @@ ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_val -------------------------------------------------------------------------- */ { struct frame *p = NULL; - NSWindow *parent, *child; NSTRACE ("ns_set_parent_frame"); @@ -1926,72 +1787,11 @@ ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_val error ("Invalid specification of `parent-frame'"); } - if (p != FRAME_PARENT_FRAME (f)) - { - block_input (); - child = [FRAME_NS_VIEW (f) window]; - -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 - EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); -#endif - - if ([child parentWindow] != nil) - { -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 - parent = [child parentWindow]; -#endif - - [[child parentWindow] removeChildWindow:child]; -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 - if ([child respondsToSelector:@selector(setAccessibilitySubrole:)]) -#endif - [child setAccessibilitySubrole:NSAccessibilityStandardWindowSubrole]; -#endif -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 - if (NILP (new_value)) - { - NSTRACE ("child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary"); - [child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary]; - // if current parent in fullscreen and no new parent make child fullscreen - while (parent) { - if (([parent styleMask] & NSWindowStyleMaskFullScreen) != 0) - { - [view toggleFullScreen:child]; - break; - } - // check all parents - parent = [parent parentWindow]; - } - } -#endif - } + fset_parent_frame (f, new_value); - if (!NILP (new_value)) - { -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 - // child frame must not be in fullscreen - if ([view fsIsNative] && [view isFullscreen]) - [view toggleFullScreen:child]; - NSTRACE ("child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary"); - [child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary]; -#endif - parent = [FRAME_NS_VIEW (p) window]; - - [parent addChildWindow: child - ordered: NSWindowAbove]; -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 - if ([child respondsToSelector:@selector(setAccessibilitySubrole:)]) -#endif - [child setAccessibilitySubrole:NSAccessibilityFloatingWindowSubrole]; -#endif - } - - unblock_input (); - - fset_parent_frame (f, new_value); - } + block_input (); + [(EmacsWindow *)[FRAME_NS_VIEW (f) window] setParentChildRelationships]; + unblock_input (); } void @@ -2433,12 +2233,10 @@ ns_set_frame_alpha (struct frame *f) else if (0.0 <= alpha && alpha < alpha_min && alpha_min <= 1.0) alpha = alpha_min; -#ifdef NS_IMPL_COCOA { EmacsView *view = FRAME_NS_VIEW (f); - [[view window] setAlphaValue: alpha]; + [[view window] setAlphaValue: alpha]; } -#endif } @@ -2457,13 +2255,19 @@ frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) { NSTRACE ("frame_set_mouse_pixel_position"); - /* FIXME: what about GNUstep? */ #ifdef NS_IMPL_COCOA CGPoint mouse_pos = CGPointMake(f->left_pos + pix_x, f->top_pos + pix_y + FRAME_NS_TITLEBAR_HEIGHT(f) + FRAME_TOOLBAR_HEIGHT(f)); CGWarpMouseCursorPosition (mouse_pos); +#else + GSDisplayServer *server = GSServerForWindow ([FRAME_NS_VIEW (f) window]); + [server setMouseLocation: NSMakePoint (f->left_pos + pix_x, + f->top_pos + pix_y + + FRAME_NS_TITLEBAR_HEIGHT(f) + + FRAME_TOOLBAR_HEIGHT(f)) + onScreen: [[[FRAME_NS_VIEW (f) window] screen] screenNumber]]; #endif } @@ -2641,9 +2445,6 @@ ns_define_frame_cursor (struct frame *f, Emacs_Cursor cursor) EmacsView *view = FRAME_NS_VIEW (f); FRAME_POINTER_TYPE (f) = cursor; [[view window] invalidateCursorRectsForView: view]; - /* Redisplay assumes this function also draws the changed frame - cursor, but this function doesn't, so do it explicitly. */ - gui_update_cursor (f, 1); } } @@ -2779,8 +2580,7 @@ ns_get_shifted_character (NSEvent *event) ========================================================================== */ -#if 0 -/* FIXME: Remove this function. */ +#ifdef NS_IMPL_GNUSTEP static void ns_redraw_scroll_bars (struct frame *f) { @@ -2825,10 +2625,9 @@ ns_clear_frame (struct frame *f) NSRectFill (r); ns_unfocus (f); - /* as of 2006/11 or so this is now needed */ - /* FIXME: I don't see any reason for this and removing it makes no - difference here. Do we need it for GNUstep? */ - //ns_redraw_scroll_bars (f); +#ifdef NS_IMPL_GNUSTEP + ns_redraw_scroll_bars (f); +#endif unblock_input (); } @@ -2909,10 +2708,10 @@ ns_scroll_run (struct window *w, struct run *run) { NSRect srcRect = NSMakeRect (x, from_y, width, height); - NSRect dstRect = NSMakeRect (x, to_y, width, height); + NSPoint dest = NSMakePoint (x, to_y); EmacsView *view = FRAME_NS_VIEW (f); - [view copyRect:srcRect to:dstRect]; + [view copyRect:srcRect to:dest]; #ifdef NS_IMPL_COCOA [view setNeedsDisplayInRect:srcRect]; #endif @@ -2929,11 +2728,10 @@ ns_clear_under_internal_border (struct frame *f) if (FRAME_LIVE_P (f) && FRAME_INTERNAL_BORDER_WIDTH (f) > 0) { - int border_width = FRAME_INTERNAL_BORDER_WIDTH (f); - NSView *view = FRAME_NS_VIEW (f); - NSRect edge_rect, frame_rect = [view bounds]; - NSRectEdge edge[] = {NSMinXEdge, NSMinYEdge, NSMaxXEdge, NSMaxYEdge}; - + int border = FRAME_INTERNAL_BORDER_WIDTH (f); + int width = FRAME_PIXEL_WIDTH (f); + int height = FRAME_PIXEL_HEIGHT (f); + int margin = FRAME_TOP_MARGIN_HEIGHT (f); int face_id = (FRAME_PARENT_FRAME (f) ? (!NILP (Vface_remapping_alist) @@ -2955,12 +2753,12 @@ ns_clear_under_internal_border (struct frame *f) ns_focus (f, NULL, 1); [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; - for (int i = 0; i < 4 ; i++) - { - NSDivideRect (frame_rect, &edge_rect, &frame_rect, border_width, edge[i]); - NSRectFill (edge_rect); - } + NSRectFill (NSMakeRect (0, margin, width, border)); + NSRectFill (NSMakeRect (0, 0, border, height)); + NSRectFill (NSMakeRect (0, margin, width, border)); + NSRectFill (NSMakeRect (width - border, 0, border, height)); + NSRectFill (NSMakeRect (0, height - border, width, border)); ns_unfocus (f); } } @@ -3034,11 +2832,11 @@ ns_shift_glyphs_for_insert (struct frame *f, -------------------------------------------------------------------------- */ { NSRect srcRect = NSMakeRect (x, y, width, height); - NSRect dstRect = NSMakeRect (x+shift_by, y, width, height); + NSPoint dest = NSMakePoint (x+shift_by, y); NSTRACE ("ns_shift_glyphs_for_insert"); - [FRAME_NS_VIEW (f) copyRect:srcRect to:dstRect]; + [FRAME_NS_VIEW (f) copyRect:srcRect to:dest]; } @@ -3056,31 +2854,31 @@ ns_compute_glyph_string_overhangs (struct glyph_string *s) External (RIF); compute left/right overhang of whole string and set in s -------------------------------------------------------------------------- */ { - struct font *font = s->font; - - if (s->char2b) + if (s->cmp == NULL + && (s->first_glyph->type == CHAR_GLYPH + || s->first_glyph->type == COMPOSITE_GLYPH)) { struct font_metrics metrics; - unsigned int codes[2]; - codes[0] = *(s->char2b); - codes[1] = *(s->char2b + s->nchars - 1); - font->driver->text_extents (font, codes, 2, &metrics); - s->left_overhang = -metrics.lbearing; - s->right_overhang - = metrics.rbearing > metrics.width - ? metrics.rbearing - metrics.width : 0; + if (s->first_glyph->type == CHAR_GLYPH) + { + struct font *font = s->font; + font->driver->text_extents (font, s->char2b, s->nchars, &metrics); + } + else + { + Lisp_Object gstring = composition_gstring_from_id (s->cmp_id); + + composition_gstring_width (gstring, s->cmp_from, s->cmp_to, &metrics); + } + s->right_overhang = (metrics.rbearing > metrics.width + ? metrics.rbearing - metrics.width : 0); + s->left_overhang = metrics.lbearing < 0 ? - metrics.lbearing : 0; } - else + else if (s->cmp) { - s->left_overhang = 0; -#ifdef NS_IMPL_GNUSTEP - if (EQ (font->driver->type, Qns)) - s->right_overhang = ((struct nsfont_info *)font)->ital ? - FONT_HEIGHT (font) * 0.2 : 0; - else -#endif - s->right_overhang = 0; + s->right_overhang = s->cmp->rbearing - s->cmp->pixel_width; + s->left_overhang = - s->cmp->lbearing; } } @@ -3092,8 +2890,40 @@ ns_compute_glyph_string_overhangs (struct glyph_string *s) ========================================================================== */ +static NSMutableDictionary *fringe_bmp; + +static void +ns_define_fringe_bitmap (int which, unsigned short *bits, int h, int w) +{ + NSBezierPath *p = [NSBezierPath bezierPath]; + + if (!fringe_bmp) + fringe_bmp = [[NSMutableDictionary alloc] initWithCapacity:25]; + + [p moveToPoint:NSMakePoint (0, 0)]; + + for (int y = 0 ; y < h ; y++) + for (int x = 0 ; x < w ; x++) + { + /* XBM rows are always round numbers of bytes, with any unused + bits ignored. */ + int byte = y * (w/8 + (w%8 ? 1 : 0)) + x/8; + bool bit = bits[byte] & (0x80 >> x%8); + if (bit) + [p appendBezierPathWithRect:NSMakeRect (x, y, 1, 1)]; + } + + [fringe_bmp setObject:p forKey:[NSNumber numberWithInt:which]]; +} + + +static void +ns_destroy_fringe_bitmap (int which) +{ + [fringe_bmp removeObjectForKey:[NSNumber numberWithInt:which]]; +} + -extern int max_used_fringe_bitmap; static void ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fringe_bitmap_params *p) @@ -3119,41 +2949,18 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct frame *f = XFRAME (WINDOW_FRAME (w)); struct face *face = p->face; - static EmacsImage **bimgs = NULL; - static int nBimgs = 0; NSRect clearRect = NSZeroRect; - NSRect imageRect = NSZeroRect; NSRect rowRect = ns_row_rect (w, row, ANY_AREA); NSTRACE_WHEN (NSTRACE_GROUP_FRINGE, "ns_draw_fringe_bitmap"); 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); - /* grow bimgs if needed */ - if (nBimgs < max_used_fringe_bitmap) - { - bimgs = xrealloc (bimgs, max_used_fringe_bitmap * sizeof *bimgs); - memset (bimgs + nBimgs, 0, - (max_used_fringe_bitmap - nBimgs) * sizeof *bimgs); - nBimgs = max_used_fringe_bitmap; - } - - /* Work out the rectangle we will composite into. */ - if (p->which) - imageRect = NSMakeRect (p->x, p->y, p->wd, p->h); + /* Work out the rectangle we will need to clear. */ + clearRect = NSMakeRect (p->x, p->y, p->wd, p->h); - /* Work out the rectangle we will need to clear. Because we're - compositing rather than blitting, we need to clear the area under - the image regardless of anything else. */ if (p->bx >= 0 && !p->overlay_p) - { - clearRect = NSMakeRect (p->bx, p->by, p->nx, p->ny); - clearRect = NSUnionRect (clearRect, imageRect); - } - else - { - clearRect = imageRect; - } + clearRect = NSUnionRect (clearRect, NSMakeRect (p->bx, p->by, p->nx, p->ny)); /* Handle partially visible rows. */ clearRect = NSIntersectionRect (clearRect, rowRect); @@ -3169,53 +2976,29 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row, NSRectFill (clearRect); } - if (p->which) + NSBezierPath *bmp = [fringe_bmp objectForKey:[NSNumber numberWithInt:p->which]]; + if (bmp) { - EmacsImage *img = bimgs[p->which - 1]; + NSAffineTransform *transform = [NSAffineTransform transform]; + NSColor *bm_color; - if (!img) - { - // Note: For "periodic" images, allocate one EmacsImage for - // the base image, and use it for all dh:s. - unsigned short *bits = p->bits; - int full_height = p->h + p->dh; - int i; - unsigned char *cbits = xmalloc (full_height); - - for (i = 0; i < full_height; i++) - cbits[i] = bits[i]; - img = [[EmacsImage alloc] initFromXBM: cbits width: 8 - height: full_height - fg: 0 bg: 0 - reverseBytes: NO]; - bimgs[p->which - 1] = img; - xfree (cbits); - } - - - { - NSColor *bm_color; - if (!p->cursor_p) - bm_color = ns_lookup_indexed_color(face->foreground, f); - else if (p->overlay_p) - bm_color = ns_lookup_indexed_color(face->background, f); - else - bm_color = f->output_data.ns->cursor_color; - [img setXBMColor: bm_color]; - } + /* Because the image is defined at (0, 0) we need to take a copy + and then transform that copy to the new origin. */ + bmp = [bmp copy]; + [transform translateXBy:p->x yBy:p->y - p->dh]; + [bmp transformUsingAffineTransform:transform]; - // Note: For periodic images, the full image height is "h + hd". - // By using the height h, a suitable part of the image is used. - NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h); + if (!p->cursor_p) + bm_color = ns_lookup_indexed_color(face->foreground, f); + else if (p->overlay_p) + bm_color = ns_lookup_indexed_color(face->background, f); + else + bm_color = f->output_data.ns->cursor_color; - NSTRACE_RECT ("fromRect", fromRect); + [bm_color set]; + [bmp fill]; - [img drawInRect: imageRect - fromRect: fromRect - operation: NSCompositingOperationSourceOver - fraction: 1.0 - respectFlipped: YES - hints: nil]; + [bmp release]; } ns_unfocus (f); } @@ -3235,14 +3018,13 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, struct frame *f = WINDOW_XFRAME (w); struct glyph *phys_cursor_glyph; struct glyph *cursor_glyph; - struct face *face; - NSColor *hollow_color = FRAME_BACKGROUND_COLOR (f); /* If cursor is out of bounds, don't draw garbage. This can happen in mini-buffer windows when switching between echo area glyphs and mini-buffer. */ - NSTRACE ("ns_draw_window_cursor"); + NSTRACE ("ns_draw_window_cursor (on = %d, cursor_type = %d)", + on_p, cursor_type); if (!on_p) return; @@ -3258,6 +3040,8 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, if ((phys_cursor_glyph = get_phys_cursor_glyph (w)) == NULL) { + NSTRACE_MSG ("No phys cursor glyph was found!"); + if (glyph_row->exact_window_width_line_p && w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA]) { @@ -3267,10 +3051,6 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, return; } - /* We draw the cursor (with NSRectFill), then draw the glyph on top - (other terminals do it the other way round). We must set - w->phys_cursor_width to the cursor width. For bar cursors, that - is CURSOR_WIDTH; for box cursors, it is the glyph width. */ get_phys_cursor_geometry (w, glyph_row, phys_cursor_glyph, &fx, &fy, &h); /* The above get_phys_cursor_geometry call set w->phys_cursor_width @@ -3302,17 +3082,17 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, /* Prevent the cursor from being drawn outside the text area. */ r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA)); - ns_focus (f, &r, 1); + ns_focus (f, NULL, 0); - face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); - if (face && NS_FACE_BACKGROUND (face) - == ns_index_color (FRAME_CURSOR_COLOR (f), f)) - { - [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; - hollow_color = FRAME_CURSOR_COLOR (f); - } - else - [FRAME_CURSOR_COLOR (f) set]; + NSGraphicsContext *ctx = [NSGraphicsContext currentContext]; + [ctx saveGraphicsState]; +#ifdef NS_IMPL_GNUSTEP + GSRectClipList (ctx, &r, 1); +#else + NSRectClip (r); +#endif + + [FRAME_CURSOR_COLOR (f) set]; switch (cursor_type) { @@ -3320,13 +3100,11 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, case NO_CURSOR: break; case FILLED_BOX_CURSOR: - NSRectFill (r); + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); break; case HOLLOW_BOX_CURSOR: - NSRectFill (r); - [hollow_color set]; - NSRectFill (NSInsetRect (r, 1, 1)); - [FRAME_CURSOR_COLOR (f) set]; + draw_phys_cursor_glyph (w, glyph_row, DRAW_NORMAL_TEXT); + [NSBezierPath strokeRect: r]; break; case HBAR_CURSOR: NSRectFill (r); @@ -3342,12 +3120,9 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, NSRectFill (s); break; } - ns_unfocus (f); - /* Draw the character under the cursor. Other terms only draw - the character on top of box cursors, so do the same here. */ - if (cursor_type == FILLED_BOX_CURSOR || cursor_type == HOLLOW_BOX_CURSOR) - draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + [ctx restoreGraphicsState]; + ns_unfocus (f); } @@ -3527,16 +3302,18 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, if (s->for_overlaps) return; + if (s->hl == DRAW_CURSOR) + [FRAME_BACKGROUND_COLOR (s->f) set]; + else if (face->underline_defaulted_p) + [defaultCol set]; + else + [ns_lookup_indexed_color (face->underline_color, s->f) set]; + /* Do underline. */ if (face->underline) { if (s->face->underline == FACE_UNDER_WAVE) { - if (face->underline_defaulted_p) - [defaultCol set]; - else - [ns_lookup_indexed_color (face->underline_color, s->f) set]; - ns_draw_underwave (s, width, x); } else if (s->face->underline == FACE_UNDER_LINE) @@ -3607,11 +3384,6 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, s->underline_position = position; r = NSMakeRect (x, s->ybase + position, width, thickness); - - if (face->underline_defaulted_p) - [defaultCol set]; - else - [ns_lookup_indexed_color (face->underline_color, s->f) set]; NSRectFill (r); } } @@ -3621,11 +3393,6 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, { NSRect r; r = NSMakeRect (x, s->y, width, 1); - - if (face->overline_color_defaulted_p) - [defaultCol set]; - else - [ns_lookup_indexed_color (face->overline_color, s->f) set]; NSRectFill (r); } @@ -3648,10 +3415,6 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, dy = lrint ((glyph_height - h) / 2); r = NSMakeRect (x, glyph_y + dy, width, 1); - if (face->strike_through_color_defaulted_p) - [defaultCol set]; - else - [ns_lookup_indexed_color (face->strike_through_color, s->f) set]; NSRectFill (r); } } @@ -3690,7 +3453,7 @@ ns_draw_box (NSRect r, CGFloat hthickness, CGFloat vthickness, static void -ns_draw_relief (NSRect r, int hthickness, int vthickness, char raised_p, +ns_draw_relief (NSRect outer, int hthickness, int vthickness, char raised_p, char top_p, char bottom_p, char left_p, char right_p, struct glyph_string *s) /* -------------------------------------------------------------------------- @@ -3701,7 +3464,7 @@ ns_draw_relief (NSRect r, int hthickness, int vthickness, char raised_p, { static NSColor *baseCol = nil, *lightCol = nil, *darkCol = nil; NSColor *newBaseCol = nil; - NSRect sr = r; + NSRect inner; NSTRACE ("ns_draw_relief"); @@ -3735,33 +3498,55 @@ ns_draw_relief (NSRect r, int hthickness, int vthickness, char raised_p, darkCol = [[baseCol shadowWithLevel: 0.3] retain]; } - [(raised_p ? lightCol : darkCol) set]; - - /* TODO: mitering. Using NSBezierPath doesn't work because of color switch. */ + /* Calculate the inner rectangle. */ + inner = NSMakeRect (NSMinX (outer) + (left_p ? hthickness : 0), + NSMinY (outer) + (top_p ? vthickness : 0), + NSWidth (outer) - (left_p ? hthickness : 0) + - (right_p ? hthickness : 0), + NSHeight (outer) - (top_p ? vthickness : 0) + - (bottom_p ? vthickness : 0)); - /* top */ - sr.size.height = hthickness; - if (top_p) NSRectFill (sr); + [(raised_p ? lightCol : darkCol) set]; - /* left */ - sr.size.height = r.size.height; - sr.size.width = vthickness; - if (left_p) NSRectFill (sr); + if (top_p || left_p) + { + NSBezierPath *p = [NSBezierPath bezierPath]; + [p moveToPoint:NSMakePoint (NSMinX (outer), NSMinY (outer))]; + if (top_p) + { + [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))]; + [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))]; + } + [p lineToPoint:NSMakePoint (NSMinX (inner), NSMinY (inner))]; + if (left_p) + { + [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))]; + [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))]; + } + [p closePath]; + [p fill]; + } [(raised_p ? darkCol : lightCol) set]; - /* bottom */ - sr.size.width = r.size.width; - sr.size.height = hthickness; - sr.origin.y += r.size.height - hthickness; - if (bottom_p) NSRectFill (sr); - - /* right */ - sr.size.height = r.size.height; - sr.origin.y = r.origin.y; - sr.size.width = vthickness; - sr.origin.x += r.size.width - vthickness; - if (right_p) NSRectFill (sr); + if (bottom_p || right_p) + { + NSBezierPath *p = [NSBezierPath bezierPath]; + [p moveToPoint:NSMakePoint (NSMaxX (outer), NSMaxY (outer))]; + if (right_p) + { + [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))]; + [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))]; + } + [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMaxY (inner))]; + if (bottom_p) + { + [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))]; + [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))]; + } + [p closePath]; + [p fill]; + } } @@ -3777,17 +3562,7 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s) struct glyph *last_glyph; NSRect r; int hthickness, vthickness; - struct face *face; - - if (s->hl == DRAW_MOUSE_FACE) - { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = s->face; + struct face *face = s->face; vthickness = face->box_vertical_line_width; hthickness = face->box_horizontal_line_width; @@ -3861,34 +3636,26 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p) || FONT_TOO_HIGH (s->font) || s->font_not_found_p || s->extends_to_end_of_line_p || force_p) { - struct face *face; - if (s->hl == DRAW_MOUSE_FACE) - { - face - = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = FACE_FROM_ID (s->f, s->first_glyph->face_id); + struct face *face = s->face; if (!face->stipple) - [(NS_FACE_BACKGROUND (face) != 0 - ? ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) - : FRAME_BACKGROUND_COLOR (s->f)) set]; + { + if (s->hl != DRAW_CURSOR) + [(NS_FACE_BACKGROUND (face) != 0 + ? ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) + : FRAME_BACKGROUND_COLOR (s->f)) set]; + else + [FRAME_CURSOR_COLOR (s->f) set]; + } else { struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); [[dpyinfo->bitmaps[face->stipple-1].img stippleMask] set]; } - if (s->hl != DRAW_CURSOR) - { - NSRect r = NSMakeRect (s->x, s->y + box_line_width, - s->background_width, - s->height-2*box_line_width); - NSRectFill (r); - } + NSRect r = NSMakeRect (s->x, s->y + box_line_width, + s->background_width, + s->height-2*box_line_width); + NSRectFill (r); s->background_filled_p = 1; } @@ -3909,7 +3676,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) int th; char raised_p; NSRect br; - struct face *face; + struct face *face = s->face; NSColor *tdCol; NSTRACE ("ns_dumpglyphs_image"); @@ -3930,15 +3697,6 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) /* Draw BG: if we need larger area than image itself cleared, do that, otherwise, since we composite the image under NS (instead of mucking with its background color), we must clear just the image area. */ - if (s->hl == DRAW_MOUSE_FACE) - { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = FACE_FROM_ID (s->f, s->first_glyph->face_id); [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f) set]; @@ -4009,16 +3767,8 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) if (s->hl == DRAW_CURSOR) { - [FRAME_CURSOR_COLOR (s->f) set]; - if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) + [FRAME_CURSOR_COLOR (s->f) set]; tdCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); - else - /* Currently on NS img->mask is always 0. Since - get_window_cursor_type specifies a hollow box cursor when on - a non-masked image we never reach this clause. But we put it - in, in anticipation of better support for image masks on - NS. */ - tdCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); } else { @@ -4070,66 +3820,35 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) static void ns_dumpglyphs_stretch (struct glyph_string *s) { - NSRect r[2]; NSRect glyphRect; - int n; - struct face *face; + struct face *face = s->face; NSColor *fgCol, *bgCol; if (!s->background_filled_p) { - n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - if (s->hl == DRAW_MOUSE_FACE) - { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = FACE_FROM_ID (s->f, s->first_glyph->face_id); + face = s->face; bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); + if (s->hl == DRAW_CURSOR) + { + fgCol = bgCol; + bgCol = FRAME_CURSOR_COLOR (s->f); + } + glyphRect = NSMakeRect (s->x, s->y, s->background_width, s->height); [bgCol set]; - /* NOTE: under NS this is NOT used to draw cursors, but we must avoid - overwriting cursor (usually when cursor on a tab) */ - if (s->hl == DRAW_CURSOR) - { - CGFloat x, width; - - /* FIXME: This looks like it will only work for left to - right languages. */ - x = NSMinX (glyphRect); - width = s->w->phys_cursor_width; - glyphRect.size.width -= width; - glyphRect.origin.x += width; - - NSRectFill (glyphRect); - - /* Draw overlining, etc. on the cursor. */ - if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) - ns_draw_text_decoration (s, face, bgCol, width, x); - else - ns_draw_text_decoration (s, face, fgCol, width, x); - } - else - { - NSRectFill (glyphRect); - } + NSRectFill (glyphRect); /* Draw overlining, etc. on the stretch glyph (or the part of the stretch glyph after the cursor). */ ns_draw_text_decoration (s, face, fgCol, NSWidth (glyphRect), NSMinX (glyphRect)); - ns_unfocus (s->f); s->background_filled_p = 1; } } @@ -4138,7 +3857,7 @@ ns_dumpglyphs_stretch (struct glyph_string *s) static void ns_draw_glyph_string_foreground (struct glyph_string *s) { - int x, flags; + int x; struct font *font = s->font; /* If first glyph of S has a left box line, start drawing the text @@ -4149,15 +3868,9 @@ ns_draw_glyph_string_foreground (struct glyph_string *s) else x = s->x; - flags = s->hl == DRAW_CURSOR ? NS_DUMPGLYPH_CURSOR : - (s->hl == DRAW_MOUSE_FACE ? NS_DUMPGLYPH_MOUSEFACE : - (s->for_overlaps ? NS_DUMPGLYPH_FOREGROUND : - NS_DUMPGLYPH_NORMAL)); - font->driver->draw (s, s->cmp_from, s->nchars, x, s->ybase, - (flags == NS_DUMPGLYPH_NORMAL && !s->background_filled_p) - || flags == NS_DUMPGLYPH_MOUSEFACE); + !s->for_overlaps && !s->background_filled_p); } @@ -4264,9 +3977,9 @@ ns_draw_glyph_string (struct glyph_string *s) struct font *font = s->face->font; if (! font) font = FRAME_FONT (s->f); - NSTRACE_WHEN (NSTRACE_GROUP_GLYPHS, "ns_draw_glyph_string"); + NSTRACE ("ns_draw_glyph_string (hl = %u)", s->hl); - if (s->next && s->right_overhang && !s->for_overlaps/*&&s->hl!=DRAW_CURSOR*/) + if (s->next && s->right_overhang && !s->for_overlaps) { int width; struct glyph_string *next; @@ -4276,17 +3989,17 @@ ns_draw_glyph_string (struct glyph_string *s) width += next->width, next = next->next) if (next->first_glyph->type != IMAGE_GLYPH) { + n = ns_get_glyph_string_clip_rect (s->next, r); + ns_focus (s->f, r, n); if (next->first_glyph->type != STRETCH_GLYPH) { - n = ns_get_glyph_string_clip_rect (s->next, r); - ns_focus (s->f, r, n); ns_maybe_dumpglyphs_background (s->next, 1); - ns_unfocus (s->f); } else { ns_dumpglyphs_stretch (s->next); } + ns_unfocus (s->f); next->num_clips = 0; } } @@ -4303,14 +4016,21 @@ ns_draw_glyph_string (struct glyph_string *s) box_drawn_p = 1; } + n = ns_get_glyph_string_clip_rect (s, r); + + if (!s->clip_head /* draw_glyphs didn't specify a clip mask. */ + && !s->clip_tail + && ((s->prev && s->prev->hl != s->hl && s->left_overhang) + || (s->next && s->next->hl != s->hl && s->right_overhang))) + r[0] = NSIntersectionRect (r[0], NSMakeRect (s->x, s->y, s->width, s->height)); + + ns_focus (s->f, r, n); + switch (s->first_glyph->type) { case IMAGE_GLYPH: - n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); ns_dumpglyphs_image (s, r[0]); - ns_unfocus (s->f); break; case XWIDGET_GLYPH: @@ -4323,57 +4043,36 @@ ns_draw_glyph_string (struct glyph_string *s) case CHAR_GLYPH: case COMPOSITE_GLYPH: - n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - - if (s->for_overlaps || (s->cmp_from > 0 - && ! s->first_glyph->u.cmp.automatic)) - s->background_filled_p = 1; - else - ns_maybe_dumpglyphs_background - (s, s->first_glyph->type == COMPOSITE_GLYPH); - - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; - } - { - BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; + BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; + if (s->for_overlaps || (isComposite + && (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic))) + s->background_filled_p = 1; + else + ns_maybe_dumpglyphs_background + (s, s->first_glyph->type == COMPOSITE_GLYPH); - if (isComposite) - ns_draw_composite_glyph_string_foreground (s); - else - ns_draw_glyph_string_foreground (s); - } + if (isComposite) + ns_draw_composite_glyph_string_foreground (s); + else + ns_draw_glyph_string_foreground (s); - { - NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 - ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), - s->f) - : FRAME_FOREGROUND_COLOR (s->f)); - [col set]; - - /* Draw underline, overline, strike-through. */ - ns_draw_text_decoration (s, s->face, col, s->width, s->x); + { + NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 + ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), + s->f) + : FRAME_FOREGROUND_COLOR (s->f)); + [col set]; + + /* Draw underline, overline, strike-through. */ + ns_draw_text_decoration (s, s->face, col, s->width, s->x); + } } - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; - } - - ns_unfocus (s->f); break; case GLYPHLESS_GLYPH: - n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - if (s->for_overlaps || (s->cmp_from > 0 && ! s->first_glyph->u.cmp.automatic)) s->background_filled_p = 1; @@ -4383,7 +4082,6 @@ ns_draw_glyph_string (struct glyph_string *s) /* ... */ /* Not yet implemented. */ /* ... */ - ns_unfocus (s->f); break; default: @@ -4392,13 +4090,92 @@ ns_draw_glyph_string (struct glyph_string *s) /* Draw box if not done already. */ if (!s->for_overlaps && !box_drawn_p && s->face->box != FACE_NO_BOX) + ns_dumpglyphs_box_or_relief (s); + + ns_unfocus (s->f); + + /* Draw surrounding overhangs. */ + if (s->prev) { - n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - ns_dumpglyphs_box_or_relief (s); + ns_focus (s->f, NULL, 0); + struct glyph_string *prev; + + for (prev = s->prev; prev; prev = prev->prev) + if (prev->hl != s->hl + && prev->x + prev->width + prev->right_overhang > s->x) + { + /* As prev was drawn while clipped to its own area, we + must draw the right_overhang part using s->hl now. */ + enum draw_glyphs_face save = prev->hl; + struct face *save_face = prev->face; + + prev->face = s->face; + NSRect r = NSMakeRect (s->x, s->y, s->width, s->height); + [[NSGraphicsContext currentContext] saveGraphicsState]; + NSRectClip (r); +#ifdef NS_IMPL_GNUSTEP + DPSgsave ([NSGraphicsContext currentContext]); + DPSrectclip ([NSGraphicsContext currentContext], s->x, s->y, + s->width, s->height); +#endif + prev->num_clips = 1; + prev->hl = s->hl; + if (prev->first_glyph->type == CHAR_GLYPH) + ns_draw_glyph_string_foreground (prev); + else + ns_draw_composite_glyph_string_foreground (prev); +#ifdef NS_IMPL_GNUSTEP + DPSgrestore ([NSGraphicsContext currentContext]); +#endif + [[NSGraphicsContext currentContext] restoreGraphicsState]; + prev->hl = save; + prev->face = save_face; + prev->num_clips = 0; + } ns_unfocus (s->f); } + if (s->next) + { + ns_focus (s->f, NULL, 0); + struct glyph_string *next; + + for (next = s->next; next; next = next->next) + if (next->hl != s->hl + && next->x - next->left_overhang < s->x + s->width) + { + /* As next will be drawn while clipped to its own area, + we must draw the left_overhang part using s->hl now. */ + enum draw_glyphs_face save = next->hl; + struct face *save_face = next->face; + + next->hl = s->hl; + next->face = s->face; + NSRect r = NSMakeRect (s->x, s->y, s->width, s->height); + [[NSGraphicsContext currentContext] saveGraphicsState]; + NSRectClip (r); +#ifdef NS_IMPL_GNUSTEP + DPSgsave ([NSGraphicsContext currentContext]); + DPSrectclip ([NSGraphicsContext currentContext], s->x, s->y, + s->width, s->height); +#endif + next->num_clips = 1; + if (next->first_glyph->type == CHAR_GLYPH) + ns_draw_glyph_string_foreground (next); + else + ns_draw_composite_glyph_string_foreground (next); +#ifdef NS_IMPL_GNUSTEP + DPSgrestore ([NSGraphicsContext currentContext]); +#endif + [[NSGraphicsContext currentContext] restoreGraphicsState]; + next->hl = save; + next->num_clips = 0; + next->face = save_face; + next->clip_head = next; + next->background_filled_p = 0; + } + ns_unfocus (s->f); + } s->num_clips = 0; } @@ -5148,6 +4925,17 @@ ns_default_font_parameter (struct frame *f, Lisp_Object parms) { } +#ifdef NS_IMPL_GNUSTEP +static void +ns_update_window_end (struct window *w, bool cursor_on_p, + bool mouse_face_overwritten_p) +{ + NSTRACE ("ns_update_window_end (cursor_on_p = %d)", cursor_on_p); + + ns_redraw_scroll_bars (WINDOW_XFRAME (w)); +} +#endif + /* This and next define (many of the) public functions in this file. */ /* gui_* are generic versions in xdisp.c that we, and other terms, get away with using despite presence in the "system dependent" redisplay @@ -5164,14 +4952,18 @@ static struct redisplay_interface ns_redisplay_interface = ns_scroll_run, ns_after_update_window_line, NULL, /* update_window_begin */ +#ifndef NS_IMPL_GNUSTEP NULL, /* update_window_end */ +#else + ns_update_window_end, +#endif 0, /* flush_display */ gui_clear_window_mouse_face, gui_get_glyph_overhangs, gui_fix_overlapping_area, ns_draw_fringe_bitmap, - 0, /* define_fringe_bitmap */ /* FIXME: simplify ns_draw_fringe_bitmap */ - 0, /* destroy_fringe_bitmap */ + ns_define_fringe_bitmap, + ns_destroy_fringe_bitmap, ns_compute_glyph_string_overhangs, ns_draw_glyph_string, ns_define_frame_cursor, @@ -5209,6 +5001,12 @@ ns_delete_terminal (struct terminal *terminal) block_input (); +#ifdef NS_IMPL_COCOA + /* Rather than try to clean up the NS environment we can just + disable the app and leave it waiting for any new frames. */ + [NSApp setActivationPolicy:NSApplicationActivationPolicyProhibited]; +#endif + image_destroy_all_bitmaps (dpyinfo); ns_delete_display (dpyinfo); unblock_input (); @@ -5266,6 +5064,7 @@ ns_create_terminal (struct ns_display_info *dpyinfo) terminal->free_pixmap = ns_free_pixmap; terminal->delete_frame_hook = ns_destroy_window; terminal->delete_terminal_hook = ns_delete_terminal; + terminal->change_tab_bar_height_hook = ns_change_tab_bar_height; /* Other hooks are NULL by default. */ return terminal; @@ -5357,6 +5156,8 @@ ns_term_init (Lisp_Object display_name) terminal->name = xlispstrdup (display_name); + gui_init_fringe (terminal->rif); + unblock_input (); if (!inhibit_x_resources) @@ -6198,11 +5999,6 @@ not_in_argv (NSString *arg) name:NSViewFrameDidChangeNotification object:nil]; -#ifdef NS_DRAW_TO_BUFFER - [surface release]; -#endif - - [toolbar release]; if (fs_state == FULLSCREEN_BOTH) [nonfs_window release]; [super dealloc]; @@ -6387,9 +6183,11 @@ not_in_argv (NSString *arg) Lisp_Object kind = fnKeysym ? QCfunction : QCordinary; emacs_event->modifiers = EV_MODIFIERS2 (flags, kind); +#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); +#endif /* If it was a function key or had control-like modifiers, pass it directly to Emacs. */ @@ -6878,10 +6676,35 @@ not_in_argv (NSString *arg) } else { - emacs_event->kind = MOUSE_CLICK_EVENT; + Lisp_Object tab_bar_arg = Qnil; + bool tab_bar_p = false; + + if (WINDOWP (emacsframe->tab_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (emacsframe->tab_bar_window))) + { + Lisp_Object window; + int x = lrint (p.x); + int y = lrint (p.y); + + window = window_from_coordinates (emacsframe, x, y, 0, true, true); + tab_bar_p = EQ (window, emacsframe->tab_bar_window); + + if (tab_bar_p) + tab_bar_arg = handle_tab_bar_click (emacsframe, x, y, EV_UDMODIFIERS (theEvent) & down_modifier, + EV_MODIFIERS (theEvent) | EV_UDMODIFIERS (theEvent)); + } + + if (!(tab_bar_p && NILP (tab_bar_arg))) + emacs_event->kind = MOUSE_CLICK_EVENT; + emacs_event->arg = tab_bar_arg; emacs_event->code = EV_BUTTON (theEvent); emacs_event->modifiers = EV_MODIFIERS (theEvent) | EV_UDMODIFIERS (theEvent); + + if (emacs_event->modifiers & down_modifier) + FRAME_DISPLAY_INFO (emacsframe)->grabbed |= 1 << EV_BUTTON (theEvent); + else + FRAME_DISPLAY_INFO (emacsframe)->grabbed &= ~(1 << EV_BUTTON (theEvent)); } XSETINT (emacs_event->x, lrint (p.x)); @@ -7148,43 +6971,6 @@ not_in_argv (NSString *arg) } -- (void)windowDidResize: (NSNotification *)notification -{ - NSTRACE ("[EmacsView windowDidResize:]"); - if (!FRAME_LIVE_P (emacsframe)) - { - NSTRACE_MSG ("Ignored (frame dead)"); - return; - } - if (emacsframe->output_data.ns->in_animation) - { - NSTRACE_MSG ("Ignored (in animation)"); - return; - } - - if (! [self fsIsNative]) - { - NSWindow *theWindow = [notification object]; - /* We can get notification on the non-FS window when in - fullscreen mode. */ - if ([self window] != theWindow) return; - } - - NSTRACE_RECT ("frame", [[notification object] frame]); - -#ifdef NS_IMPL_GNUSTEP - NSWindow *theWindow = [notification object]; - - /* In GNUstep, at least currently, it's possible to get a didResize - without getting a willResize, therefore we need to act as if we got - the willResize now. */ - NSSize sz = [theWindow frame].size; - sz = [self windowWillResize: theWindow toSize: sz]; -#endif /* NS_IMPL_GNUSTEP */ - - ns_send_appdefined (-1); -} - #ifdef NS_IMPL_COCOA - (void)viewDidEndLiveResize { @@ -7202,56 +6988,34 @@ not_in_argv (NSString *arg) #endif /* NS_IMPL_COCOA */ -- (void)viewDidResize:(NSNotification *)notification +- (void)resizeWithOldSuperviewSize: (NSSize)oldSize { - NSRect frame = [self frame]; - int neww, newh, oldw, oldh; - - if (! FRAME_LIVE_P (emacsframe)) - return; - - NSTRACE ("[EmacsView viewDidResize]"); + NSRect frame; + int width, height; -#ifdef NS_DRAW_TO_BUFFER - /* If the buffer size doesn't match the view's backing size, destroy - the buffer and let it be recreated at the correct size later. */ - if ([self wantsUpdateLayer] && surface) - { - NSRect surfaceRect = {{0, 0}, [surface getSize]}; - NSRect frameRect = [[self window] convertRectToBacking:frame]; + NSTRACE ("[EmacsView resizeWithOldSuperviewSize:]"); - if (!NSEqualRects (frameRect, surfaceRect)) - { - [surface release]; - surface = nil; + [super resizeWithOldSuperviewSize:oldSize]; - [self setNeedsDisplay:YES]; - } - } -#endif + if (! FRAME_LIVE_P (emacsframe)) + return; - neww = (int)NSWidth (frame); - newh = (int)NSHeight (frame); - oldw = FRAME_PIXEL_WIDTH (emacsframe); - oldh = FRAME_PIXEL_HEIGHT (emacsframe); + frame = [[self superview] bounds]; + width = (int)NSWidth (frame); + height = (int)NSHeight (frame); - /* Don't want to do anything when the view size hasn't changed. */ - if (emacsframe->new_size_p - ? (newh == emacsframe->new_height - && neww == emacsframe->new_width) - : (oldh == newh && oldw == neww)) - { - NSTRACE_MSG ("No change"); - return; - } - - NSTRACE_SIZE ("New size", NSMakeSize (neww, newh)); - NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh)); + NSTRACE_SIZE ("New size", NSMakeSize (width, height)); - change_frame_size (emacsframe, neww, newh, false, YES, false); + /* Reset the frame size to match the bounds of the superview (the + NSWindow's contentView). We need to do this as sometimes the + view's frame isn't resized correctly, or can end up with the + wrong origin. */ + [self setFrame:frame]; + change_frame_size (emacsframe, width, height, false, YES, false); SET_FRAME_GARBAGED (emacsframe); cancel_mouse_face (emacsframe); + ns_send_appdefined (-1); } @@ -7309,6 +7073,7 @@ not_in_argv (NSString *arg) XSETFRAME (frame, emacsframe); help_echo_string = Qnil; gen_help_event (Qnil, frame, Qnil, Qnil, 0); + any_help_event_p = NO; } if (emacs_event && is_focus_frame) @@ -7346,42 +7111,8 @@ not_in_argv (NSString *arg) } -- (void)createToolbar: (struct frame *)f -{ - EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); - NSWindow *window = [view window]; - - toolbar = [[EmacsToolbar alloc] initForView: self withIdentifier: - [NSString stringWithFormat: @"Emacs Frame %d", - ns_window_num]]; - [toolbar setVisible: NO]; - [window setToolbar: toolbar]; - - /* Don't set frame garbaged until tool bar is up to date? - This avoids an extra clear and redraw (flicker) at frame creation. */ - if (FRAME_EXTERNAL_TOOL_BAR (f)) wait_for_tool_bar = YES; - else wait_for_tool_bar = NO; - - -#ifdef NS_IMPL_COCOA - { - NSButton *toggleButton; - toggleButton = [window standardWindowButton: NSWindowToolbarButton]; - [toggleButton setTarget: self]; - [toggleButton setAction: @selector (toggleToolbar: )]; - } -#endif -} - - - (instancetype) initFrameFromEmacs: (struct frame *)f { - NSRect r, wr; - Lisp_Object tem; - EmacsWindow *win; - NSColor *col; - NSString *name; - NSTRACE ("[EmacsView initFrameFromEmacs:]"); NSTRACE_MSG ("cols:%d lines:%d", f->text_cols, f->text_lines); @@ -7403,21 +7134,11 @@ not_in_argv (NSString *arg) nonfs_window = nil; ns_userRect = NSMakeRect (0, 0, 0, 0); - r = NSMakeRect (0, 0, FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols), - FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines)); - [self initWithFrame: r]; + [self initWithFrame: + NSMakeRect (0, 0, FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols), + FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines))]; [self setAutoresizingMask: NSViewWidthSizable | NSViewHeightSizable]; -#ifdef NS_DRAW_TO_BUFFER - /* These settings mean AppKit will retain the contents of the frame - on resize. Unfortunately it also means the frame will not be - automatically marked for display, but we can do that ourselves in - viewDidResize. */ - [self setLayerContentsRedrawPolicy: - NSViewLayerContentsRedrawOnSetNeedsDisplay]; - [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft]; -#endif - FRAME_NS_VIEW (f) = self; emacsframe = f; #ifdef NS_IMPL_COCOA @@ -7425,100 +7146,22 @@ not_in_argv (NSString *arg) maximizing_resize = NO; #endif - win = [[EmacsWindow alloc] - initWithContentRect: r - styleMask: (FRAME_UNDECORATED (f) - ? FRAME_UNDECORATED_FLAGS - : FRAME_DECORATED_FLAGS) - backing: NSBackingStoreBuffered - defer: YES]; + [[EmacsWindow alloc] initWithEmacsFrame:f]; -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 -#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) -#endif - if (FRAME_PARENT_FRAME (f)) - [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary]; - else - [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary]; -#endif - - wr = [win frame]; - bwidth = f->border_width = wr.size.width - r.size.width; - - [win setAcceptsMouseMovedEvents: YES]; - [win setDelegate: self]; -#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090 -#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090 - if ([win respondsToSelector: @selector(useOptimizedDrawing:)]) -#endif - [win useOptimizedDrawing: YES]; +#ifdef NS_IMPL_COCOA + /* These settings mean AppKit will retain the contents of the frame + on resize. Unfortunately it also means the frame will not be + automatically marked for display, but we can do that ourselves in + resizeWithOldSuperviewSize. */ + [self setWantsLayer:YES]; + [self setLayerContentsRedrawPolicy: + NSViewLayerContentsRedrawOnSetNeedsDisplay]; + [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft]; #endif - [[win contentView] addSubview: self]; - if (ns_drag_types) [self registerForDraggedTypes: ns_drag_types]; - tem = f->name; - name = NILP (tem) ? @"Emacs" : [NSString stringWithLispString:tem]; - [win setTitle: name]; - - /* toolbar support */ - if (! FRAME_UNDECORATED (f)) - [self createToolbar: f]; - - - [win setAppearance]; - -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 - if ([win respondsToSelector: @selector(titlebarAppearsTransparent)]) - win.titlebarAppearsTransparent = FRAME_NS_TRANSPARENT_TITLEBAR (f); -#endif - - tem = f->icon_name; - if (!NILP (tem)) - [win setMiniwindowTitle: - [NSString stringWithLispString:tem]]; - - if (FRAME_PARENT_FRAME (f) != NULL) - { - NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window]; - [parent addChildWindow: win - ordered: NSWindowAbove]; - } - - if (FRAME_Z_GROUP (f) != z_group_none) - win.level = NSNormalWindowLevel - + (FRAME_Z_GROUP_BELOW (f) ? -1 : 1); - - { - NSScreen *screen = [win screen]; - - if (screen != 0) - { - NSPoint pt = NSMakePoint - (IN_BOUND (-SCREENMAX, f->left_pos - + NS_PARENT_WINDOW_LEFT_POS (f), SCREENMAX), - IN_BOUND (-SCREENMAX, - NS_PARENT_WINDOW_TOP_POS (f) - f->top_pos, - SCREENMAX)); - - [win setFrameTopLeftPoint: pt]; - - NSTRACE_RECT ("new frame", [win frame]); - } - } - - [win makeFirstResponder: self]; - - col = ns_lookup_indexed_color (NS_FACE_BACKGROUND - (FACE_FROM_ID (emacsframe, DEFAULT_FACE_ID)), - emacsframe); - [win setBackgroundColor: col]; - if ([col alphaComponent] != (EmacsCGFloat) 1.0) - [win setOpaque: NO]; - #if !defined (NS_IMPL_COCOA) \ || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090 #if MAC_OS_X_VERSION_MAX_ALLOWED > 1090 @@ -7529,21 +7172,6 @@ not_in_argv (NSString *arg) [NSApp registerServicesMenuSendTypes: ns_send_types returnTypes: [NSArray array]]; - /* Set up view resize notifications. */ - [self setPostsFrameChangedNotifications:YES]; - [[NSNotificationCenter defaultCenter] - addObserver:self - selector:@selector (viewDidResize:) - name:NSViewFrameDidChangeNotification object:nil]; - - /* macOS Sierra automatically enables tabbed windows. We can't - allow this to be enabled until it's available on a Free system. - Currently it only happens by accident and is buggy anyway. */ -#ifdef NS_IMPL_COCOA - if ([win respondsToSelector: @selector(setTabbingMode:)]) - [win setTabbingMode: NSWindowTabbingModeDisallowed]; -#endif - ns_window_num++; return self; } @@ -7795,7 +7423,6 @@ not_in_argv (NSString *arg) } else { - BOOL tbar_visible = FRAME_EXTERNAL_TOOL_BAR (emacsframe) ? YES : NO; #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 \ && MAC_OS_X_VERSION_MIN_REQUIRED <= 1070 unsigned val = (unsigned)[NSApp presentationOptions]; @@ -7813,7 +7440,6 @@ not_in_argv (NSString *arg) [NSApp setPresentationOptions: options]; } #endif - [toolbar setVisible:tbar_visible]; } } @@ -7854,14 +7480,6 @@ not_in_argv (NSString *arg) #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 [self updateCollectionBehavior]; #endif - if (FRAME_EXTERNAL_TOOL_BAR (emacsframe)) - { - [toolbar setVisible:YES]; - update_frame_tool_bar (emacsframe); - [[self window] display]; - } - else - [toolbar setVisible:NO]; if (next_maximized != -1) [[self window] performZoom:self]; @@ -7906,7 +7524,7 @@ not_in_argv (NSString *arg) NSWindowCollectionBehavior b = [win collectionBehavior]; if (ns_use_native_fullscreen) { - if ([win parentWindow]) + if (FRAME_PARENT_FRAME (emacsframe)) { b &= ~NSWindowCollectionBehaviorFullScreenPrimary; b |= NSWindowCollectionBehaviorFullScreenAuxiliary; @@ -7933,7 +7551,7 @@ not_in_argv (NSString *arg) - (void)toggleFullScreen: (id)sender { - NSWindow *w, *fw; + EmacsWindow *w, *fw; BOOL onFirstScreen; struct frame *f; NSRect r, wr; @@ -7952,7 +7570,7 @@ not_in_argv (NSString *arg) return; } - w = [self window]; + w = (EmacsWindow *)[self window]; onFirstScreen = [[w screen] isEqual:[[NSScreen screens] objectAtIndex:0]]; f = emacsframe; wr = [w frame]; @@ -7987,27 +7605,9 @@ not_in_argv (NSString *arg) #endif } - fw = [[EmacsFSWindow alloc] - initWithContentRect:[w contentRectForFrameRect:wr] - styleMask:NSWindowStyleMaskBorderless - backing:NSBackingStoreBuffered - defer:YES - screen:screen]; - - [fw setContentView:[w contentView]]; - [fw setTitle:[w title]]; - [fw setDelegate:self]; - [fw setAcceptsMouseMovedEvents: YES]; -#if !defined (NS_IMPL_COCOA) \ - || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090 -#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090 - if ([fw respondsToSelector: @selector(useOptimizedDrawing:)]) -#endif - [fw useOptimizedDrawing: YES]; -#endif - [fw setBackgroundColor: col]; - if ([col alphaComponent] != (EmacsCGFloat) 1.0) - [fw setOpaque: NO]; + fw = [[EmacsWindow alloc] initWithEmacsFrame:emacsframe + fullscreen:YES + screen:screen]; f->border_width = 0; @@ -8015,7 +7615,6 @@ not_in_argv (NSString *arg) [self windowWillEnterFullScreen]; [fw makeKeyAndOrderFront:NSApp]; - [fw makeFirstResponder:self]; [w orderOut:self]; r = [fw frameRectForContentRect:[screen frame]]; [fw setFrame: r display:YES animate:ns_use_fullscreen_animation]; @@ -8042,7 +7641,7 @@ not_in_argv (NSString *arg) if ([col alphaComponent] != (EmacsCGFloat) 1.0) [w setOpaque: NO]; - f->border_width = bwidth; + f->border_width = [w borderWidth]; // To do: consider using [NSNotificationCenter postNotificationName:] to // send notifications. @@ -8179,12 +7778,6 @@ not_in_argv (NSString *arg) } -- (EmacsToolbar *)toolbar -{ - return toolbar; -} - - /* This gets called on toolbar button click. */ - (instancetype)toolbarClicked: (id)item { @@ -8221,44 +7814,54 @@ not_in_argv (NSString *arg) } -#ifdef NS_DRAW_TO_BUFFER -- (void)focusOnDrawingBuffer +#ifdef NS_IMPL_COCOA +- (CALayer *)makeBackingLayer; { - CGFloat scale = [[self window] backingScaleFactor]; - - NSTRACE ("[EmacsView focusOnDrawingBuffer]"); + EmacsLayer *l = [[EmacsLayer alloc] + initWithColorSpace:[[[self window] colorSpace] CGColorSpace]]; + [l setDelegate:(id)self]; + [l setContentsScale:[[self window] backingScaleFactor]]; - if (! surface) - { - NSRect frame = [self frame]; - NSSize s = NSMakeSize (NSWidth (frame) * scale, NSHeight (frame) * scale); + return l; +} - surface = [[EmacsSurface alloc] initWithSize:s - ColorSpace:[[[self window] colorSpace] - CGColorSpace] - Scale:scale]; - /* Since we're using NSViewLayerContentsRedrawOnSetNeedsDisplay - the layer's scale factor is not set automatically, so do it - now. */ - [[self layer] setContentsScale:scale]; - } +- (void)lockFocus +{ + NSTRACE ("[EmacsView lockFocus]"); - CGContextRef context = [surface getContext]; + if ([self wantsLayer]) + { + CGContextRef context = [(EmacsLayer*)[self layer] getContext]; - [NSGraphicsContext - setCurrentContext:[NSGraphicsContext - graphicsContextWithCGContext:context - flipped:YES]]; + [NSGraphicsContext + setCurrentContext:[NSGraphicsContext + graphicsContextWithCGContext:context + flipped:YES]]; + } +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + else + [super lockFocus]; +#endif } -- (void)unfocusDrawingBuffer +- (void)unlockFocus { - NSTRACE ("[EmacsView unfocusDrawingBuffer]"); + NSTRACE ("[EmacsView unlockFocus]"); - [NSGraphicsContext setCurrentContext:nil]; - [self setNeedsDisplay:YES]; + if ([self wantsLayer]) + { + [NSGraphicsContext setCurrentContext:nil]; + [self setNeedsDisplay:YES]; + } +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 + else + { + [super unlockFocus]; + [super flushWindow]; + } +#endif } @@ -8267,33 +7870,54 @@ not_in_argv (NSString *arg) { NSTRACE ("EmacsView windowDidChangeBackingProperties:]"); - if ([self wantsUpdateLayer]) + if ([self wantsLayer]) { NSRect frame = [self frame]; + EmacsLayer *layer = (EmacsLayer *)[self layer]; - [surface release]; - surface = nil; + [layer setContentsScale:[[notification object] backingScaleFactor]]; + [layer setColorSpace:[[[notification object] colorSpace] CGColorSpace]]; ns_clear_frame (emacsframe); expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame)); } } -#endif /* NS_DRAW_TO_BUFFER */ +#endif /* NS_IMPL_COCOA */ -- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect +- (void)copyRect:(NSRect)srcRect to:(NSPoint)dest { NSTRACE ("[EmacsView copyRect:To:]"); NSTRACE_RECT ("Source", srcRect); - NSTRACE_RECT ("Destination", dstRect); + NSTRACE_POINT ("Destination", dest); -#ifdef NS_DRAW_TO_BUFFER -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - if ([self wantsUpdateLayer]) + NSRect dstRect = NSMakeRect (dest.x, dest.y, NSWidth (srcRect), + NSHeight (srcRect)); + NSRect frame = [self frame]; + + /* TODO: This check is an attempt to debug a rare graphical glitch + on macOS and should be removed before the Emacs 28 release. */ + if (!NSContainsRect (frame, srcRect) + || !NSContainsRect (frame, dstRect)) + { + NSLog (@"[EmacsView copyRect:to:] Attempting to copy to or " + "from an area outside the graphics buffer."); + NSLog (@" Frame: (%f, %f) %f×%f", + NSMinX (frame), NSMinY (frame), + NSWidth (frame), NSHeight (frame)); + NSLog (@" Source: (%f, %f) %f×%f", + NSMinX (srcRect), NSMinY (srcRect), + NSWidth (srcRect), NSHeight (srcRect)); + NSLog (@" Destination: (%f, %f) %f×%f", + NSMinX (dstRect), NSMinY (dstRect), + NSWidth (dstRect), NSHeight (dstRect)); + } + +#ifdef NS_IMPL_COCOA + if ([self wantsLayer]) { -#endif double scale = [[self window] backingScaleFactor]; - CGContextRef context = [[NSGraphicsContext currentContext] CGContext]; + CGContextRef context = [(EmacsLayer *)[self layer] getContext]; int bpp = CGBitmapContextGetBitsPerPixel (context) / 8; void *pixels = CGBitmapContextGetData (context); int rowSize = CGBitmapContextGetBytesPerRow (context); @@ -8302,8 +7926,8 @@ not_in_argv (NSString *arg) + (int) (NSMinY (srcRect) * scale * rowSize + NSMinX (srcRect) * scale * bpp); void *dstPixels = (char *) pixels - + (int) (NSMinY (dstRect) * scale * rowSize - + NSMinX (dstRect) * scale * bpp); + + (int) (dest.y * scale * rowSize + + dest.x * scale * bpp); if (NSIntersectsRect (srcRect, dstRect) && NSMinY (srcRect) < NSMinY (dstRect)) @@ -8317,14 +7941,14 @@ not_in_argv (NSString *arg) (char *) srcPixels + y * rowSize, srcRowSize); -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 } +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 else { #endif -#endif /* NS_DRAW_TO_BUFFER */ +#endif /* NS_IMPL_COCOA */ -#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 +#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 hide_bell(); // Ensure the bell image isn't scrolled. ns_focus (emacsframe, &dstRect, 1); @@ -8333,22 +7957,26 @@ not_in_argv (NSString *arg) dstRect.origin.y - srcRect.origin.y)]; ns_unfocus (emacsframe); #endif -#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 } #endif } -#ifdef NS_DRAW_TO_BUFFER +#ifdef NS_IMPL_COCOA /* If the frame has been garbaged but the toolkit wants to draw, for example when resizing the frame, we end up with a blank screen. Sometimes this results in an unpleasant flicker, so try to - redisplay before drawing. */ -- (void)viewWillDraw + redisplay before drawing. + + This used to be done in viewWillDraw, but with the custom layer + that method is not called. We cannot call redisplay directly from + [NSView layout], because it may trigger another round of layout by + changing the frame size and recursive layout calls are banned. It + appears to be safe to call redisplay here. */ +- (void)layoutSublayersOfLayer:(CALayer *)layer { - if (FRAME_GARBAGED_P (emacsframe) - && !redisplaying_p - && [self wantsUpdateLayer]) + if (!redisplaying_p && FRAME_GARBAGED_P (emacsframe)) { /* If there is IO going on when redisplay is run here Emacs crashes. I think it's because this code will always be run @@ -8365,45 +7993,8 @@ not_in_argv (NSString *arg) waiting_for_input = owfi; } } - - -- (BOOL)wantsUpdateLayer -{ -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - if (NSAppKitVersionNumber < 1671) - return NO; -#endif - - /* Running on macOS 10.14 or above. */ - return YES; -} - - -- (void)updateLayer -{ - NSTRACE ("[EmacsView updateLayer]"); - - /* We run redisplay on frames that are garbaged, but marked for - display, before updateLayer is called so if the frame is still - garbaged that means the last redisplay must have refused to - update the frame. */ - if (FRAME_GARBAGED_P (emacsframe)) - return; - - /* This can fail to update the screen if the same surface is - provided twice in a row, even if its contents have changed. - There's a private method, -[CALayer setContentsChanged], that we - could use to force it, but we shouldn't often get the same - surface twice in a row. */ - [surface releaseContext]; - [[self layer] setContents:(id)[surface getSurface]]; - [surface performSelectorOnMainThread:@selector (getContext) - withObject:nil - waitUntilDone:NO]; -} #endif - - (void)drawRect: (NSRect)rect { NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]", @@ -8647,6 +8238,244 @@ not_in_argv (NSString *arg) @implementation EmacsWindow + +- (instancetype) initWithEmacsFrame:(struct frame *)f +{ + return [self initWithEmacsFrame:f fullscreen:NO screen:nil]; +} + + +- (instancetype) initWithEmacsFrame:(struct frame *)f + fullscreen:(BOOL)fullscreen + screen:(NSScreen *)screen +{ + NSWindowStyleMask styleMask; + + NSTRACE ("[EmacsWindow initWithEmacsFrame:fullscreen:screen:]"); + + if (fullscreen) + styleMask = NSWindowStyleMaskBorderless; + else if (FRAME_UNDECORATED (f)) + styleMask = FRAME_UNDECORATED_FLAGS; + else + styleMask = FRAME_DECORATED_FLAGS; + + + self = [super initWithContentRect: + NSMakeRect (0, 0, + FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols), + FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines)) + styleMask:styleMask + backing:NSBackingStoreBuffered + defer:YES + screen:screen]; + if (self) + { + NSString *name; + NSColor *col; + NSScreen *screen = [self screen]; + EmacsView *view = FRAME_NS_VIEW (f); + + [self setDelegate:view]; + [[self contentView] addSubview:view]; + [self makeFirstResponder:view]; + +#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090 +#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090 + if ([self respondsToSelector: @selector(useOptimizedDrawing:)]) +#endif + [self useOptimizedDrawing:YES]; +#endif + + [self setAcceptsMouseMovedEvents:YES]; + + name = NILP (f->name) ? @"Emacs" : [NSString stringWithLispString:f->name]; + [self setTitle:name]; + + if (!NILP (f->icon_name)) + [self setMiniwindowTitle: + [NSString stringWithLispString:f->icon_name]]; + + [self setAppearance]; + +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 + if ([self respondsToSelector:@selector(titlebarAppearsTransparent)]) + [self setTitlebarAppearsTransparent:FRAME_NS_TRANSPARENT_TITLEBAR (f)]; +#endif + + [self setParentChildRelationships]; + + if (FRAME_Z_GROUP (f) != z_group_none) + [self setLevel:NSNormalWindowLevel + (FRAME_Z_GROUP_BELOW (f) ? -1 : 1)]; + + if (screen != 0) + { + NSPoint pt = NSMakePoint + (IN_BOUND (-SCREENMAX, f->left_pos + + NS_PARENT_WINDOW_LEFT_POS (f), SCREENMAX), + IN_BOUND (-SCREENMAX, + NS_PARENT_WINDOW_TOP_POS (f) - f->top_pos, + SCREENMAX)); + + [self setFrameTopLeftPoint:pt]; + + NSTRACE_RECT ("new frame", [self frame]); + } + + f->border_width = [self borderWidth]; + + col = ns_lookup_indexed_color (NS_FACE_BACKGROUND + (FACE_FROM_ID (f, DEFAULT_FACE_ID)), + f); + [self setBackgroundColor:col]; + if ([col alphaComponent] != (EmacsCGFloat) 1.0) + [self setOpaque:NO]; + + /* toolbar support */ + [self createToolbar:f]; + + /* macOS Sierra automatically enables tabbed windows. We can't + allow this to be enabled until it's available on a Free system. + Currently it only happens by accident and is buggy anyway. */ +#ifdef NS_IMPL_COCOA + if ([self respondsToSelector:@selector(setTabbingMode:)]) + [self setTabbingMode:NSWindowTabbingModeDisallowed]; +#endif + } + + return self; +} + + +- (void)createToolbar: (struct frame *)f +{ + if (FRAME_UNDECORATED (f) || !FRAME_EXTERNAL_TOOL_BAR (f)) + return; + + EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); + + EmacsToolbar *toolbar = [[EmacsToolbar alloc] + initForView:view + withIdentifier:[NSString stringWithLispString:f->name]]; + + [self setToolbar:toolbar]; + update_frame_tool_bar_1 (f, toolbar); + +#ifdef NS_IMPL_COCOA + { + NSButton *toggleButton; + toggleButton = [self standardWindowButton:NSWindowToolbarButton]; + [toggleButton setTarget:view]; + [toggleButton setAction:@selector (toggleToolbar:)]; + } +#endif +} + +- (void)dealloc +{ + NSTRACE ("[EmacsWindow dealloc]"); + + /* We need to release the toolbar ourselves. */ + [[self toolbar] release]; + [super dealloc]; +} + +- (NSInteger) borderWidth +{ + return NSWidth ([self frame]) - NSWidth ([[self contentView] frame]); +} + + +- (void)setParentChildRelationships + /* After certain operations, for example making a frame visible or + resetting the NSWindow through modifying the undecorated status, + the parent/child relationship may be broken. We can also use + this method to set them, as long as the frame struct already has + the correct relationship set. */ +{ + NSTRACE ("[EmacsWindow setParentChildRelationships]"); + + Lisp_Object frame, tail; + EmacsView *ourView = (EmacsView *)[self delegate]; + struct frame *ourFrame = ourView->emacsframe; + struct frame *parentFrame = FRAME_PARENT_FRAME (ourFrame); + EmacsWindow *oldParentWindow = (EmacsWindow *)[self parentWindow]; + + +#ifdef NS_IMPL_COCOA + /* We have to set the accessibility subroles and/or the collection + behaviors early otherwise child windows may not go fullscreen as + expected later. */ + +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 + if ([child respondsToSelector:@selector(setAccessibilitySubrole:)]) +#endif + /* Set the accessibility subroles. */ + if (parentFrame) + [self setAccessibilitySubrole:NSAccessibilityFloatingWindowSubrole]; + else + [self setAccessibilitySubrole:NSAccessibilityStandardWindowSubrole]; + +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 + [ourView updateCollectionBehavior]; +#endif +#endif + + + /* Check if we have an incorrectly set parent. */ + if ((! parentFrame && oldParentWindow) + || (parentFrame && oldParentWindow + && ((EmacsView *)[oldParentWindow delegate])->emacsframe != parentFrame)) + { + [[self parentWindow] removeChildWindow:self]; + +#ifdef NS_IMPL_COCOA +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([ourView respondsToSelector:@selector (toggleFullScreen)] +#endif + /* If we are the descendent of a fullscreen window and we + have no new parent, go fullscreen. */ + { + NSWindow *parent = (NSWindow *)oldParentWindow; + while (parent) + { + if (([parent styleMask] & NSWindowStyleMaskFullScreen) != 0) + { + [ourView toggleFullScreen:self]; + break; + } + parent = [parent parentWindow]; + } + } +#endif + } + + if (parentFrame) + { + NSWindow *parentWindow = [FRAME_NS_VIEW (parentFrame) window]; + +#ifdef NS_IMPL_COCOA +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([ourView respondsToSelector:@selector (toggleFullScreen)] +#endif + /* Child frames must not be fullscreen. */ + if ([ourView fsIsNative] && [ourView isFullscreen]) + [ourView toggleFullScreen:self]; +#endif + + [parentWindow addChildWindow:self + ordered:NSWindowAbove]; + } + + /* Check our child windows are configured correctly. */ + FOR_EACH_FRAME (tail, frame) + { + if (FRAME_PARENT_FRAME (XFRAME (frame)) == ourFrame) + [(EmacsWindow *)[FRAME_NS_VIEW (XFRAME (frame)) window] setParentChildRelationships]; + } +} + + /* It seems the only way to reorder child frames is by removing them from the parent and then reattaching them in the correct order. */ @@ -9056,22 +8885,15 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) { return !FRAME_NO_ACCEPT_FOCUS (((EmacsView *)[self delegate])->emacsframe); } -@end /* EmacsWindow */ - - -@implementation EmacsFSWindow - -- (BOOL)canBecomeKeyWindow -{ - return YES; -} - (BOOL)canBecomeMainWindow + /* Required for fullscreen and undecorated windows. */ { return YES; } -@end +@end /* EmacsWindow */ + /* ========================================================================== @@ -9570,7 +9392,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) @end /* EmacsScroller */ -#ifdef NS_DRAW_TO_BUFFER +#ifdef NS_IMPL_COCOA /* ========================================================================== @@ -9578,7 +9400,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) ========================================================================== */ -@implementation EmacsSurface +@implementation EmacsLayer /* An IOSurface is a pixel buffer that is efficiently copied to VRAM @@ -9591,80 +9413,109 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) ability to draw to the screen at any time, we need to keep a cache of multiple surfaces that we can use at will. - The EmacsSurface class maintains this cache of surfaces, and + The EmacsLayer class maintains this cache of surfaces, and handles the conversion to a CGGraphicsContext that AppKit can use to draw on. The cache is simple: if a free surface is found it is removed from - the cache and set as the "current" surface. Once Emacs is done - with drawing to the current surface, the previous surface that was - drawn to is added to the cache for reuse, and the current one is - set as the last surface. If no free surfaces are found in the - cache then a new one is created. - - When AppKit wants to update the screen, we provide it with the last - surface, as that has the most recent data. - - FIXME: It is possible for the cache to grow if Emacs draws faster - than the surfaces can be drawn to the screen, so there should - probably be some sort of pruning job that removes excess - surfaces. */ + the cache and set as the "current" surface. Emacs draws to the + surface and when the layer wants to update the screen we set it's + contents to the surface and then add it back on to the end of the + cache. If no free surfaces are found in the cache then a new one + is created. */ #define CACHE_MAX_SIZE 2 -- (id) initWithSize: (NSSize)s - ColorSpace: (CGColorSpaceRef)cs - Scale: (CGFloat)scl +- (id) initWithColorSpace: (CGColorSpaceRef)cs { - NSTRACE ("[EmacsSurface initWithSize:ColorSpace:]"); - - [super init]; + NSTRACE ("[EmacsLayer initWithColorSpace:]"); - cache = [[NSMutableArray arrayWithCapacity:CACHE_MAX_SIZE] retain]; - size = s; - colorSpace = cs; - scale = scl; + self = [super init]; + if (self) + { + cache = [[NSMutableArray arrayWithCapacity:CACHE_MAX_SIZE] retain]; + [self setColorSpace:cs]; + } + else + { + return nil; + } return self; } -- (void) dealloc +- (void) setColorSpace: (CGColorSpaceRef)cs { - if (context) - CGContextRelease (context); - - if (currentSurface) - CFRelease (currentSurface); + /* We don't need to clear the cache because the new colorspace will + be used next time we create a new context. */ + if (cs) + colorSpace = cs; + else + colorSpace = CGColorSpaceCreateWithName(kCGColorSpaceGenericRGB); +} - for (id object in cache) - CFRelease ((IOSurfaceRef)object); +- (void) dealloc +{ + [self releaseSurfaces]; [cache release]; [super dealloc]; } -/* Return the size values our cached data is using. */ -- (NSSize) getSize +- (void) releaseSurfaces { - return size; + [self setContents:nil]; + [self releaseContext]; + + if (currentSurface) + { + CFRelease (currentSurface); + currentSurface = nil; + } + + if (cache) + { + for (id object in cache) + CFRelease ((IOSurfaceRef)object); + + [cache removeAllObjects]; + } } -/* Return a CGContextRef that can be used for drawing to the screen. - This must ALWAYS be paired with a call to releaseContext, and the - calls cannot be nested. */ +/* Check whether the current bounds match the IOSurfaces we are using. + If they do return YES, otherwise NO. */ +- (BOOL) checkDimensions +{ + int width = NSWidth ([self bounds]) * [self contentsScale]; + int height = NSHeight ([self bounds]) * [self contentsScale]; + IOSurfaceRef s = currentSurface ? currentSurface + : (IOSurfaceRef)[cache firstObject]; + + return !s || (IOSurfaceGetWidth (s) == width + && IOSurfaceGetHeight (s) == height); +} + + +/* Return a CGContextRef that can be used for drawing to the screen. */ - (CGContextRef) getContext { - NSTRACE ("[EmacsSurface getContext]"); + CGFloat scale = [self contentsScale]; + + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer getContext]"); + NSTRACE_MSG ("IOSurface count: %lu", [cache count] + (currentSurface ? 1 : 0)); + + if (![self checkDimensions]) + [self releaseSurfaces]; if (!context) { IOSurfaceRef surface = NULL; - - NSTRACE_MSG ("IOSurface count: %lu", [cache count] + (lastSurface ? 1 : 0)); + int width = NSWidth ([self bounds]) * scale; + int height = NSHeight ([self bounds]) * scale; for (id object in cache) { @@ -9687,16 +9538,22 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) else if (!surface) { int bytesPerRow = IOSurfaceAlignProperty (kIOSurfaceBytesPerRow, - size.width * 4); + width * 4); surface = IOSurfaceCreate - ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber numberWithInt:size.width], - (id)kIOSurfaceHeight:[NSNumber numberWithInt:size.height], + ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber numberWithInt:width], + (id)kIOSurfaceHeight:[NSNumber numberWithInt:height], (id)kIOSurfaceBytesPerRow:[NSNumber numberWithInt:bytesPerRow], (id)kIOSurfaceBytesPerElement:[NSNumber numberWithInt:4], (id)kIOSurfacePixelFormat:[NSNumber numberWithUnsignedInt:'BGRA']}); } + if (!surface) + { + NSLog (@"Failed to create IOSurface for frame %@", [self delegate]); + return nil; + } + IOReturn lockStatus = IOSurfaceLock (surface, 0, nil); if (lockStatus != kIOReturnSuccess) NSLog (@"Failed to lock surface: %x", lockStatus); @@ -9714,7 +9571,16 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) (kCGImageAlphaPremultipliedFirst | kCGBitmapByteOrder32Host)); - CGContextTranslateCTM(context, 0, size.height); + if (!context) + { + NSLog (@"Failed to create context for frame %@", [self delegate]); + IOSurfaceUnlock (currentSurface, 0, nil); + CFRelease (currentSurface); + currentSurface = nil; + return nil; + } + + CGContextTranslateCTM(context, 0, IOSurfaceGetHeight (currentSurface)); CGContextScaleCTM(context, scale, -scale); } @@ -9726,7 +9592,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) IOSurface, so it will be sent to VRAM. */ - (void) releaseContext { - NSTRACE ("[EmacsSurface releaseContextAndGetSurface]"); + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer releaseContext]"); if (!context) return; @@ -9737,19 +9603,34 @@ 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); - - /* Put currentSurface back on the end of the cache. */ - [cache addObject:(id)currentSurface]; - lastSurface = currentSurface; - currentSurface = NULL; } -/* Get the IOSurface that we want to draw to the screen. */ -- (IOSurfaceRef) getSurface +- (void) display { - /* lastSurface always contains the most up-to-date and complete data. */ - return lastSurface; + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer display]"); + + if (context) + { + [self releaseContext]; + +#if CACHE_MAX_SIZE == 1 + /* This forces the layer to see the surface as updated. */ + [self setContents:nil]; +#endif + + [self setContents:(id)currentSurface]; + + /* Put currentSurface back on the end of the cache. */ + [cache addObject:(id)currentSurface]; + currentSurface = NULL; + + /* Schedule a run of getContext so that if Emacs is idle it will + perform the buffer copy, etc. */ + [self performSelectorOnMainThread:@selector (getContext) + withObject:nil + waitUntilDone:NO]; + } } @@ -9759,19 +9640,20 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) - (void) copyContentsTo: (IOSurfaceRef) destination { IOReturn lockStatus; + IOSurfaceRef source = (IOSurfaceRef)[self contents]; void *sourceData, *destinationData; int numBytes = IOSurfaceGetAllocSize (destination); - NSTRACE ("[EmacsSurface copyContentsTo:]"); + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer copyContentsTo:]"); - if (!lastSurface || lastSurface == destination) + if (!source || source == destination) return; - lockStatus = IOSurfaceLock (lastSurface, kIOSurfaceLockReadOnly, nil); + lockStatus = IOSurfaceLock (source, kIOSurfaceLockReadOnly, nil); if (lockStatus != kIOReturnSuccess) NSLog (@"Failed to lock source surface: %x", lockStatus); - sourceData = IOSurfaceGetBaseAddress (lastSurface); + sourceData = IOSurfaceGetBaseAddress (source); destinationData = IOSurfaceGetBaseAddress (destination); /* Since every IOSurface should have the exact same settings, a @@ -9779,17 +9661,17 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) the other. */ memcpy (destinationData, sourceData, numBytes); - lockStatus = IOSurfaceUnlock (lastSurface, kIOSurfaceLockReadOnly, nil); + lockStatus = IOSurfaceUnlock (source, kIOSurfaceLockReadOnly, nil); if (lockStatus != kIOReturnSuccess) NSLog (@"Failed to unlock source surface: %x", lockStatus); } #undef CACHE_MAX_SIZE -@end /* EmacsSurface */ +@end /* EmacsLayer */ -#endif +#endif /* NS_IMPL_COCOA */ #ifdef NS_IMPL_GNUSTEP diff --git a/src/pdumper.c b/src/pdumper.c index 7730ea3d061..9eff5c48d09 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -312,14 +312,15 @@ dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset) error ("dump relocation out of range"); } -static void -dump_fingerprint (char const *label, +void +dump_fingerprint (FILE *output, char const *label, unsigned char const xfingerprint[sizeof fingerprint]) { enum { hexbuf_size = 2 * sizeof fingerprint }; char hexbuf[hexbuf_size]; hexbuf_digest (hexbuf, xfingerprint, sizeof fingerprint); - fprintf (stderr, "%s: %.*s\n", label, hexbuf_size, hexbuf); + fprintf (output, "%s%s%.*s\n", label, *label ? ": " : "", + hexbuf_size, hexbuf); } /* To be used if some order in the relocation process has to be enforced. */ @@ -799,7 +800,7 @@ dump_tailq_length (const struct dump_tailq *tailq) return tailq->length; } -static void ATTRIBUTE_UNUSED +static void dump_tailq_prepend (struct dump_tailq *tailq, Lisp_Object value) { Lisp_Object link = Fcons (value, tailq->head); @@ -809,24 +810,6 @@ dump_tailq_prepend (struct dump_tailq *tailq, Lisp_Object value) tailq->length += 1; } -static void ATTRIBUTE_UNUSED -dump_tailq_append (struct dump_tailq *tailq, Lisp_Object value) -{ - Lisp_Object link = Fcons (value, Qnil); - if (NILP (tailq->head)) - { - eassert (NILP (tailq->tail)); - tailq->head = tailq->tail = link; - } - else - { - eassert (!NILP (tailq->tail)); - XSETCDR (tailq->tail, link); - tailq->tail = link; - } - tailq->length += 1; -} - static bool dump_tailq_empty_p (struct dump_tailq *tailq) { @@ -4145,7 +4128,7 @@ types. */) ctx->header.fingerprint[i] = fingerprint[i]; const dump_off header_start = ctx->offset; - dump_fingerprint ("Dumping fingerprint", ctx->header.fingerprint); + dump_fingerprint (stderr, "Dumping fingerprint", ctx->header.fingerprint); dump_write (ctx, &ctx->header, sizeof (ctx->header)); const dump_off header_end = ctx->offset; @@ -4537,15 +4520,28 @@ dump_map_file_w32 (void *base, int fd, off_t offset, size_t size, uint32_t offset_low = (uint32_t) (full_offset & 0xffffffff); int error; + DWORD protect; DWORD map_access; file = (HANDLE) _get_osfhandle (fd); if (file == INVALID_HANDLE_VALUE) goto out; + switch (protection) + { + case DUMP_MEMORY_ACCESS_READWRITE: + protect = PAGE_WRITECOPY; /* for Windows 9X */ + break; + default: + case DUMP_MEMORY_ACCESS_NONE: + case DUMP_MEMORY_ACCESS_READ: + protect = PAGE_READONLY; + break; + } + section = CreateFileMapping (file, /*lpAttributes=*/NULL, - PAGE_READONLY, + protect, /*dwMaximumSizeHigh=*/0, /*dwMaximumSizeLow=*/0, /*lpName=*/NULL); @@ -5300,6 +5296,9 @@ dump_do_dump_relocation (const uintptr_t dump_base, error ("Trying to load incoherent dumped eln file %s", SSDATA (comp_u->file)); + if (!CONSP (comp_u->file)) + error ("Incoherent compilation unit for dump was dumped"); + /* emacs_execdir is always unibyte, but the file names in comp_u->file could be multibyte, so we need to encode them. */ @@ -5601,8 +5600,8 @@ pdumper_load (const char *dump_filename, char *argv0) desired[i] = fingerprint[i]; if (memcmp (header->fingerprint, desired, sizeof desired) != 0) { - dump_fingerprint ("desired fingerprint", desired); - dump_fingerprint ("found fingerprint", header->fingerprint); + dump_fingerprint (stderr, "desired fingerprint", desired); + dump_fingerprint (stderr, "found fingerprint", header->fingerprint); goto out; } @@ -5710,6 +5709,7 @@ pdumper_load (const char *dump_filename, char *argv0) dump_mmap_release (§ions[i]); if (dump_fd >= 0) emacs_close (dump_fd); + return err; } @@ -5794,6 +5794,7 @@ syms_of_pdumper (void) DEFSYM (Qdumped_with_pdumper, "dumped-with-pdumper"); DEFSYM (Qload_time, "load-time"); DEFSYM (Qdump_file_name, "dump-file-name"); + DEFSYM (Qafter_pdump_load_hook, "after-pdump-load-hook"); defsubr (&Spdumper_stats); #endif /* HAVE_PDUMPER */ } diff --git a/src/pdumper.h b/src/pdumper.h index deec9af046d..7f1f5e46ad9 100644 --- a/src/pdumper.h +++ b/src/pdumper.h @@ -20,6 +20,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef EMACS_PDUMPER_H #define EMACS_PDUMPER_H +#include <stdio.h> +#include "fingerprint.h" #include "lisp.h" INLINE_HEADER_BEGIN @@ -50,6 +52,9 @@ enum { PDUMPER_NO_OBJECT = -1 }; #define PDUMPER_REMEMBER_SCALAR(thing) \ pdumper_remember_scalar (&(thing), sizeof (thing)) +extern void dump_fingerprint (FILE *output, const char *label, + unsigned char const fingerp[sizeof fingerprint]); + extern void pdumper_remember_scalar_impl (void *data, ptrdiff_t nbytes); INLINE void diff --git a/src/print.c b/src/print.c index d4301fd7b64..adadb289de0 100644 --- a/src/print.c +++ b/src/print.c @@ -564,7 +564,7 @@ temp_output_buffer_setup (const char *bufname) Fset_buffer (Fget_buffer_create (build_string (bufname), Qnil)); - Fkill_all_local_variables (); + Fkill_all_local_variables (Qnil); delete_all_overlays (current_buffer); bset_directory (current_buffer, BVAR (old, directory)); bset_read_only (current_buffer, Qnil); @@ -941,7 +941,11 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, else { Lisp_Object error_conditions = Fget (errname, Qerror_conditions); - errmsg = call1 (Qsubstitute_command_keys, Fget (errname, Qerror_message)); + errmsg = Fget (errname, Qerror_message); + /* During loadup 'substitute-command-keys' might not be available. */ + if (!NILP (Ffboundp (Qsubstitute_command_keys))) + errmsg = call1 (Qsubstitute_command_keys, errmsg); + file_error = Fmemq (Qfile_error, error_conditions); } @@ -1517,8 +1521,26 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, printchar ('>', printcharfun); break; - case PVEC_XWIDGET: case PVEC_XWIDGET_VIEW: - print_c_string ("#<xwidget ", printcharfun); + case PVEC_XWIDGET: +#ifdef HAVE_XWIDGETS + { +#ifdef USE_GTK + int len = sprintf (buf, "#<xwidget %u %p>", + XXWIDGET (obj)->xwidget_id, + XXWIDGET (obj)->widget_osr); +#else + int len = sprintf (buf, "#<xwidget %u %p>", + XXWIDGET (obj)->xwidget_id, + XXWIDGET (obj)->xwWidget); +#endif + strout (buf, len, len, printcharfun); + break; + } +#else + emacs_abort (); +#endif + case PVEC_XWIDGET_VIEW: + print_c_string ("#<xwidget view", printcharfun); printchar ('>', printcharfun); break; diff --git a/src/process.c b/src/process.c index 13deddea82c..42743f6531a 100644 --- a/src/process.c +++ b/src/process.c @@ -90,6 +90,7 @@ static struct rlimit nofile_limit; #include <c-ctype.h> #include <flexmember.h> +#include <nproc.h> #include <sig2str.h> #include <verify.h> @@ -682,6 +683,22 @@ clear_waiting_thread_info (void) } } +/* Return TRUE if the keyboard descriptor is being monitored by the + current thread, FALSE otherwise. */ +static bool +kbd_is_ours (void) +{ + for (int fd = 0; fd <= max_desc; ++fd) + { + if (fd_callback_info[fd].waiting_thread != current_thread) + continue; + if ((fd_callback_info[fd].flags & (FOR_READ | KEYBOARD_FD)) + == (FOR_READ | KEYBOARD_FD)) + return true; + } + return false; +} + /* Compute the Lisp form of the process status, p->status, from the numeric status that was returned by `wait'. */ @@ -1718,7 +1735,10 @@ to use a pty, or nil to use the default specified through :stderr STDERR -- STDERR is either a buffer or a pipe process attached to the standard error of subprocess. Specifying this implies `:connection-type' is set to `pipe'. If STDERR is nil, standard error -is mixed with standard output and sent to BUFFER or FILTER. +is mixed with standard output and sent to BUFFER or FILTER. (Note +that specifying :stderr will create a new, separate (but associated) +process, with its own filter and sentinel. See +Info node `(elisp) Asynchronous Processes' for more details.) :file-handler FILE-HANDLER -- If FILE-HANDLER is non-nil, then look for a file name handler for the current buffer's `default-directory' @@ -2147,7 +2167,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) p->pty_flag = pty_flag; pset_status (p, Qrun); - if (!EQ (p->command, Qt)) + if (!EQ (p->command, Qt) + && !EQ (p->filter, Qt)) add_process_read_fd (inchannel); ptrdiff_t count = SPECPDL_INDEX (); @@ -2265,7 +2286,8 @@ create_pty (Lisp_Object process) pset_status (p, Qrun); setup_process_coding_systems (process); - add_process_read_fd (pty_fd); + if (!EQ (p->filter, Qt)) + add_process_read_fd (pty_fd); pset_tty_name (p, build_string (pty_name)); } @@ -2374,7 +2396,8 @@ usage: (make-pipe-process &rest ARGS) */) pset_command (p, Qt); eassert (! p->pty_flag); - if (!EQ (p->command, Qt)) + if (!EQ (p->command, Qt) + && !EQ (p->filter, Qt)) add_process_read_fd (inchannel); p->adaptive_read_buffering = (NILP (Vprocess_adaptive_read_buffering) ? 0 @@ -3109,7 +3132,8 @@ usage: (make-serial-process &rest ARGS) */) pset_command (p, Qt); eassert (! p->pty_flag); - if (!EQ (p->command, Qt)) + if (!EQ (p->command, Qt) + && !EQ (p->filter, Qt)) add_process_read_fd (fd); update_process_mark (p); @@ -4001,7 +4025,7 @@ usage: (make-network-process &rest ARGS) */) if (!NILP (host)) { - ptrdiff_t portstringlen ATTRIBUTE_UNUSED; + MAYBE_UNUSED ptrdiff_t portstringlen; /* SERVICE can either be a string or int. Convert to a C string for later use by getaddrinfo. */ @@ -5308,13 +5332,13 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, wait_reading_process_output_1 (); } - /* Cause C-g and alarm signals to take immediate action, + /* Cause C-g signals to take immediate action, and cause input available signals to zero out timeout. It is important that we do this before checking for process activity. If we get a SIGCHLD after the explicit checks for process activity, timeout is the only way we will know. */ - if (read_kbd < 0) + if (read_kbd < 0 && kbd_is_ours ()) set_waiting_for_input (&timeout); /* If status of something has changed, and no input is @@ -5444,7 +5468,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, { clear_waiting_for_input (); redisplay_preserve_echo_area (11); - if (read_kbd < 0) + if (read_kbd < 0 && kbd_is_ours ()) set_waiting_for_input (&timeout); } @@ -6888,7 +6912,7 @@ If CURRENT-GROUP is `lambda', and if the shell owns the terminal, don't send the signal. This function calls the functions of `interrupt-process-functions' in -the order of the list, until one of them returns non-`nil'. */) +the order of the list, until one of them returns non-nil. */) (Lisp_Object process, Lisp_Object current_group) { return CALLN (Frun_hook_with_args_until_success, Qinterrupt_process_functions, @@ -8213,6 +8237,20 @@ integer or floating point values. return system_process_attributes (pid); } +DEFUN ("num-processors", Fnum_processors, Snum_processors, 0, 1, 0, + doc: /* Return the number of processors, a positive integer. +Each usable thread execution unit counts as a processor. +By default, count the number of available processors, +overridable via the OMP_NUM_THREADS environment variable. +If optional argument QUERY is `current', ignore OMP_NUM_THREADS. +If QUERY is `all', also count processors not available. */) + (Lisp_Object query) +{ + return make_uint (num_processors (EQ (query, Qall) ? NPROC_ALL + : EQ (query, Qcurrent) ? NPROC_CURRENT + : NPROC_CURRENT_OVERRIDABLE)); +} + #ifdef subprocesses /* Arrange to catch SIGCHLD if this hasn't already been arranged. Invoke this after init_process_emacs, and after glib and/or GNUstep @@ -8473,6 +8511,8 @@ syms_of_process (void) DEFSYM (Qpcpu, "pcpu"); DEFSYM (Qpmem, "pmem"); DEFSYM (Qargs, "args"); + DEFSYM (Qall, "all"); + DEFSYM (Qcurrent, "current"); DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes, doc: /* Non-nil means delete processes immediately when they exit. @@ -8515,7 +8555,7 @@ thus favoring processes with lower descriptors. */); doc: /* List of functions to be called for `interrupt-process'. The arguments of the functions are the same as for `interrupt-process'. These functions are called in the order of the list, until one of them -returns non-`nil'. */); +returns non-nil. */); Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process); DEFVAR_LISP ("internal--daemon-sockname", Vinternal__daemon_sockname, @@ -8634,4 +8674,5 @@ amounts of data in one go. */); defsubr (&Sprocess_inherit_coding_system_flag); defsubr (&Slist_system_processes); defsubr (&Sprocess_attributes); + defsubr (&Snum_processors); } diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 8350e54b54a..3224f65fa4c 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -2407,7 +2407,7 @@ regex_compile (re_char *pattern, ptrdiff_t size, if (lower_bound == 0) { - /* A succeed_n that starts with 0 is really a + /* A succeed_n that starts with 0 is really a simple on_failure_jump_loop. */ INSERT_JUMP (on_failure_jump_loop, laststart, b + 3 + nbytes); @@ -3828,7 +3828,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, /* Matching routines. */ /* re_match_2 matches the compiled pattern in BUFP against the - the (virtual) concatenation of STRING1 and STRING2 (of length SIZE1 + (virtual) concatenation of STRING1 and STRING2 (of length SIZE1 and SIZE2, respectively). We start matching at POS, and stop matching at STOP. diff --git a/src/search.c b/src/search.c index df384e1dcff..66e77d42b4a 100644 --- a/src/search.c +++ b/src/search.c @@ -30,6 +30,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "blockinput.h" #include "intervals.h" #include "pdumper.h" +#include "composite.h" #include "regex-emacs.h" @@ -259,7 +260,7 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, static Lisp_Object -looking_at_1 (Lisp_Object string, bool posix) +looking_at_1 (Lisp_Object string, bool posix, bool modify_data) { Lisp_Object val; unsigned char *p1, *p2; @@ -277,11 +278,11 @@ looking_at_1 (Lisp_Object string, bool posix) CHECK_STRING (string); /* Snapshot in case Lisp changes the value. */ - bool preserve_match_data = NILP (Vinhibit_changing_match_data); + bool modify_match_data = NILP (Vinhibit_changing_match_data) && modify_data; struct regexp_cache *cache_entry = compile_pattern ( string, - preserve_match_data ? &search_regs : NULL, + modify_match_data ? &search_regs : NULL, (!NILP (BVAR (current_buffer, case_fold_search)) ? BVAR (current_buffer, case_canon_table) : Qnil), posix, @@ -315,7 +316,7 @@ looking_at_1 (Lisp_Object string, bool posix) re_match_object = Qnil; i = re_match_2 (&cache_entry->buf, (char *) p1, s1, (char *) p2, s2, PT_BYTE - BEGV_BYTE, - preserve_match_data ? &search_regs : NULL, + modify_match_data ? &search_regs : NULL, ZV_BYTE - BEGV_BYTE); if (i == -2) @@ -325,7 +326,7 @@ looking_at_1 (Lisp_Object string, bool posix) } val = (i >= 0 ? Qt : Qnil); - if (preserve_match_data && i >= 0) + if (modify_match_data && i >= 0) { for (i = 0; i < search_regs.num_regs; i++) if (search_regs.start[i] >= 0) @@ -342,35 +343,37 @@ looking_at_1 (Lisp_Object string, bool posix) return unbind_to (count, val); } -DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0, +DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 2, 0, doc: /* Return t if text after point matches regular expression REGEXP. -This function modifies the match data that `match-beginning', -`match-end' and `match-data' access; save and restore the match -data if you want to preserve them. */) - (Lisp_Object regexp) +By default, this function modifies the match data that +`match-beginning', `match-end' and `match-data' access. If +INHIBIT-MODIFY is non-nil, don't modify the match data. */) + (Lisp_Object regexp, Lisp_Object inhibit_modify) { - return looking_at_1 (regexp, 0); + return looking_at_1 (regexp, 0, NILP (inhibit_modify)); } -DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0, +DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 2, 0, doc: /* Return t if text after point matches REGEXP according to Posix rules. Find the longest match, in accordance with Posix regular expression rules. -This function modifies the match data that `match-beginning', -`match-end' and `match-data' access; save and restore the match -data if you want to preserve them. */) - (Lisp_Object regexp) + +By default, this function modifies the match data that +`match-beginning', `match-end' and `match-data' access. If +INHIBIT-MODIFY is non-nil, don't modify the match data. */) + (Lisp_Object regexp, Lisp_Object inhibit_modify) { - return looking_at_1 (regexp, 1); + return looking_at_1 (regexp, 1, NILP (inhibit_modify)); } static Lisp_Object string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, - bool posix) + bool posix, bool modify_data) { ptrdiff_t val; struct re_pattern_buffer *bufp; EMACS_INT pos; ptrdiff_t pos_byte, i; + bool modify_match_data = NILP (Vinhibit_changing_match_data) && modify_data; if (running_asynch_code) save_search_regs (); @@ -399,8 +402,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, BVAR (current_buffer, case_eqv_table)); bufp = &compile_pattern (regexp, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : NULL), + (modify_match_data ? &search_regs : NULL), (!NILP (BVAR (current_buffer, case_fold_search)) ? BVAR (current_buffer, case_canon_table) : Qnil), posix, @@ -409,18 +411,17 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, val = re_search (bufp, SSDATA (string), SBYTES (string), pos_byte, SBYTES (string) - pos_byte, - (NILP (Vinhibit_changing_match_data) - ? &search_regs : NULL)); + (modify_match_data ? &search_regs : NULL)); /* Set last_thing_searched only when match data is changed. */ - if (NILP (Vinhibit_changing_match_data)) + if (modify_match_data) last_thing_searched = Qt; if (val == -2) matcher_overflow (); if (val < 0) return Qnil; - if (NILP (Vinhibit_changing_match_data)) + if (modify_match_data) for (i = 0; i < search_regs.num_regs; i++) if (search_regs.start[i] >= 0) { @@ -433,32 +434,42 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, return make_fixnum (string_byte_to_char (string, val)); } -DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0, +DEFUN ("string-match", Fstring_match, Sstring_match, 2, 4, 0, doc: /* Return index of start of first match for REGEXP in STRING, or nil. Matching ignores case if `case-fold-search' is non-nil. If third arg START is non-nil, start search at that index in STRING. -For index of first char beyond the match, do (match-end 0). -`match-end' and `match-beginning' also give indices of substrings -matched by parenthesis constructs in the pattern. -You can use the function `match-string' to extract the substrings -matched by the parenthesis constructions in REGEXP. */) - (Lisp_Object regexp, Lisp_Object string, Lisp_Object start) +If INHIBIT-MODIFY is non-nil, match data is not changed. + +If INHIBIT-MODIFY is nil or missing, match data is changed, and +`match-end' and `match-beginning' give indices of substrings matched +by parenthesis constructs in the pattern. You can use the function +`match-string' to extract the substrings matched by the parenthesis +constructions in REGEXP. For index of first char beyond the match, do +(match-end 0). */) + (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, + Lisp_Object inhibit_modify) { - return string_match_1 (regexp, string, start, 0); + return string_match_1 (regexp, string, start, 0, NILP (inhibit_modify)); } -DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0, +DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 4, 0, doc: /* Return index of start of first match for Posix REGEXP in STRING, or nil. Find the longest match, in accord with Posix regular expression rules. Case is ignored if `case-fold-search' is non-nil in the current buffer. -If third arg START is non-nil, start search at that index in STRING. -For index of first char beyond the match, do (match-end 0). -`match-end' and `match-beginning' also give indices of substrings -matched by parenthesis constructs in the pattern. */) - (Lisp_Object regexp, Lisp_Object string, Lisp_Object start) + +If INHIBIT-MODIFY is non-nil, match data is not changed. + +If INHIBIT-MODIFY is nil or missing, match data is changed, and +`match-end' and `match-beginning' give indices of substrings matched +by parenthesis constructs in the pattern. You can use the function +`match-string' to extract the substrings matched by the parenthesis +constructions in REGEXP. For index of first char beyond the match, do +(match-end 0). */) + (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, + Lisp_Object inhibit_modify) { - return string_match_1 (regexp, string, start, 1); + return string_match_1 (regexp, string, start, 1, NILP (inhibit_modify)); } /* Match REGEXP against STRING using translation table TABLE, @@ -2386,6 +2397,13 @@ since only regular expressions have distinguished subexpressions. */) if (! NILP (string)) CHECK_STRING (string); + /* Most replacement texts don't contain any backslash directives in + the replacements. Check whether that's the case, which will + enable us to take the fast path later. */ + if (NILP (literal) + && !memchr (SSDATA (newtext), '\\', SBYTES (newtext))) + literal = Qt; + case_action = nochange; /* We tried an initialization */ /* but some C compilers blew it */ @@ -2725,7 +2743,7 @@ since only regular expressions have distinguished subexpressions. */) newpoint = sub_start + SCHARS (newtext); /* Replace the old text with the new in the cleanest possible way. */ - replace_range (sub_start, sub_end, newtext, 1, 0, 1, true); + replace_range (sub_start, sub_end, newtext, 1, 0, 1, true, true); if (case_action == all_caps) Fupcase_region (make_fixnum (search_regs.start[sub]), @@ -2750,6 +2768,9 @@ since only regular expressions have distinguished subexpressions. */) /* 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; } diff --git a/src/syntax.c b/src/syntax.c index 7bba336744a..057a4c3b1f5 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -17,7 +17,6 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ - #include <config.h> #include "lisp.h" @@ -3547,8 +3546,10 @@ DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0, doc: /* Parse Lisp syntax starting at FROM until TO; return status of parse at TO. Parsing stops at TO or when certain criteria are met; point is set to where parsing stops. -If fifth arg OLDSTATE is omitted or nil, - parsing assumes that FROM is the beginning of a function. + +If OLDSTATE is omitted or nil, parsing assumes that FROM is the + beginning of a function. If not, OLDSTATE should be the state at + FROM. Value is a list of elements describing final state of parsing: 0. depth in parens. @@ -3594,6 +3595,9 @@ Sixth arg COMMENTSTOP non-nil means stop after the start of a comment. else target = TYPE_MINIMUM (EMACS_INT); /* We won't reach this depth. */ + if (fix_position (to) < fix_position (from)) + error ("End position is smaller than start position"); + validate_region (&from, &to); internalize_parse_state (oldstate, &state); scan_sexps_forward (&state, XFIXNUM (from), CHAR_TO_BYTE (XFIXNUM (from)), diff --git a/src/sysstdio.h b/src/sysstdio.h index d4df3d74567..d6ebfb455f5 100644 --- a/src/sysstdio.h +++ b/src/sysstdio.h @@ -26,7 +26,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <stdio.h> #include "unlocked-io.h" -extern FILE *emacs_fopen (char const *, char const *); +extern FILE *emacs_fopen (char const *, char const *) ATTRIBUTE_MALLOC; extern void errputc (int); extern void errwrite (void const *, ptrdiff_t); extern void close_output_streams (void); diff --git a/src/systhread.h b/src/systhread.h index 0f47d7c1a8a..601505f4f86 100644 --- a/src/systhread.h +++ b/src/systhread.h @@ -101,14 +101,11 @@ extern void sys_cond_signal (sys_cond_t *); extern void sys_cond_broadcast (sys_cond_t *); extern void sys_cond_destroy (sys_cond_t *); -extern sys_thread_t sys_thread_self (void) - NODISCARD; -extern bool sys_thread_equal (sys_thread_t, sys_thread_t) - NODISCARD; - -extern bool sys_thread_create (sys_thread_t *, thread_creation_function *, - void *) - NODISCARD; +NODISCARD extern sys_thread_t sys_thread_self (void); +NODISCARD extern bool sys_thread_equal (sys_thread_t, sys_thread_t); + +NODISCARD extern bool sys_thread_create (sys_thread_t *, + thread_creation_function *, void *); extern void sys_thread_yield (void); extern void sys_thread_set_name (const char *); diff --git a/src/term.c b/src/term.c index c995a4499cf..6f0b827cfc8 100644 --- a/src/term.c +++ b/src/term.c @@ -549,13 +549,14 @@ encode_terminal_code (struct glyph *src, int src_len, { if (src->type == COMPOSITE_GLYPH) { - struct composition *cmp UNINIT; + struct composition *cmp; Lisp_Object gstring UNINIT; int i; nbytes = buf - encode_terminal_src; if (src->u.cmp.automatic) { + cmp = NULL; gstring = composition_gstring_from_id (src->u.cmp.id); required = src->slice.cmp.to - src->slice.cmp.from + 1; } @@ -575,7 +576,7 @@ encode_terminal_code (struct glyph *src, int src_len, buf = encode_terminal_src + nbytes; } - if (src->u.cmp.automatic) + if (!cmp) for (i = src->slice.cmp.from; i <= src->slice.cmp.to; i++) { Lisp_Object g = LGSTRING_GLYPH (gstring, i); @@ -2169,6 +2170,14 @@ set_tty_color_mode (struct tty_display_info *tty, struct frame *f) #endif /* !DOS_NT */ +char * +tty_type_name (Lisp_Object terminal) +{ + struct terminal *t = decode_tty_terminal (terminal); + + return t? t->display_info.tty->type: NULL; +} + DEFUN ("tty-type", Ftty_type, Stty_type, 0, 1, 0, doc: /* Return the type of the tty device that TERMINAL uses. Returns nil if TERMINAL is not on a tty device. @@ -2177,10 +2186,9 @@ TERMINAL can be a terminal object, a frame, or nil (meaning the selected frame's terminal). */) (Lisp_Object terminal) { - struct terminal *t = decode_tty_terminal (terminal); + char *name = tty_type_name (terminal); - return (t && t->display_info.tty->type - ? build_string (t->display_info.tty->type) : Qnil); + return (name? build_string (name) : Qnil); } DEFUN ("controlling-tty-p", Fcontrolling_tty_p, Scontrolling_tty_p, 0, 1, 0, @@ -2568,21 +2576,8 @@ handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event) { f->mouse_moved = 0; term_mouse_click (&ie, event, f); - /* eassert (ie.kind == MOUSE_CLICK_EVENT); */ - if (tty_handle_tab_bar_click (f, event->x, event->y, - (ie.modifiers & down_modifier) != 0, &ie)) - { - /* eassert (ie.kind == MOUSE_CLICK_EVENT - * || ie.kind == TAB_BAR_EVENT); */ - /* tty_handle_tab_bar_click stores 2 events in the event - queue, so we are done here. */ - /* FIXME: Actually, `tty_handle_tab_bar_click` returns true - without storing any events, when - (ie.modifiers & down_modifier) != 0 */ - count += 2; - return count; - } - /* eassert (ie.kind == MOUSE_CLICK_EVENT); */ + ie.arg = tty_handle_tab_bar_click (f, event->x, event->y, + (ie.modifiers & down_modifier) != 0, &ie); kbd_buffer_store_event (&ie); count++; } diff --git a/src/termchar.h b/src/termchar.h index f50c1bfb6ea..7ab9337fbe7 100644 --- a/src/termchar.h +++ b/src/termchar.h @@ -234,7 +234,7 @@ extern struct tty_display_info *tty_list; #define CURTTY() FRAME_TTY (SELECTED_FRAME()) struct input_event; -extern bool tty_handle_tab_bar_click (struct frame *, int, int, bool, - struct input_event *); +extern Lisp_Object tty_handle_tab_bar_click (struct frame *, int, int, bool, + struct input_event *); #endif /* EMACS_TERMCHAR_H */ diff --git a/src/termhooks.h b/src/termhooks.h index 12f5d0cd6ec..7e8318c07af 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -256,6 +256,8 @@ enum event_kind #ifdef HAVE_XWIDGETS /* events generated by xwidgets*/ , XWIDGET_EVENT + /* Event generated when WebKit asks us to display another widget. */ + , XWIDGET_DISPLAY_EVENT #endif #ifdef USE_FILE_NOTIFY diff --git a/src/timefns.c b/src/timefns.c index f0e2e97f555..a9921cdc108 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -19,6 +19,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> +/* Work around GCC bug 102671. */ +#if 10 <= __GNUC__ +# pragma GCC diagnostic ignored "-Wanalyzer-null-dereference" +#endif + #include "systime.h" #include "blockinput.h" diff --git a/src/unexcw.c b/src/unexcw.c index 7a80b05963b..157e9f45607 100644 --- a/src/unexcw.c +++ b/src/unexcw.c @@ -48,7 +48,7 @@ static exe_header_t * read_exe_header (int fd, exe_header_t * exe_header_buffer) { int i; - int ret ATTRIBUTE_UNUSED; + MAYBE_UNUSED int ret; assert (fd >= 0); assert (exe_header_buffer != 0); @@ -111,7 +111,7 @@ fixup_executable (int fd) exe_header_t exe_header_buffer; exe_header_t *exe_header; int i; - int ret ATTRIBUTE_UNUSED; + MAYBE_UNUSED int ret; int found_data = 0; int found_bss = 0; @@ -269,7 +269,7 @@ unexec (const char *outfile, const char *infile) int fd_in; int fd_out; int ret; - int ret2 ATTRIBUTE_UNUSED; + MAYBE_UNUSED int ret2; infile = add_exe_suffix_if_necessary (infile, infile_buffer); outfile = add_exe_suffix_if_necessary (outfile, outfile_buffer); diff --git a/src/verbose.mk.in b/src/verbose.mk.in index 50d6ea32000..a5ff931ed09 100644 --- a/src/verbose.mk.in +++ b/src/verbose.mk.in @@ -25,6 +25,7 @@ AM_V_at = AM_V_CC = AM_V_CCLD = AM_V_ELC = +AM_V_ELN = AM_V_GEN = AM_V_GLOBALS = AM_V_NO_PD = @@ -37,11 +38,14 @@ AM_V_CCLD = @echo " CCLD " $@; ifeq ($(HAVE_NATIVE_COMP),yes) ifeq ($(NATIVE_DISABLED),1) AM_V_ELC = @echo " ELC " $@; +AM_V_ELN = else AM_V_ELC = @echo " ELC+ELN " $@; +AM_V_ELN = @echo " ELN " $@; endif else AM_V_ELC = @echo " ELC " $@; +AM_V_ELN = endif AM_V_GEN = @echo " GEN " $@; AM_V_GLOBALS = @echo " GEN " globals.h; diff --git a/src/vm-limit.c b/src/vm-limit.c index b9058d04352..e0547651bb9 100644 --- a/src/vm-limit.c +++ b/src/vm-limit.c @@ -126,7 +126,7 @@ get_lim_data (void) dos_memory_info (&totalram, &freeram, &totalswap, &freeswap); lim_data = freeram; - /* Don't believe they will give us more that 0.5 GB. */ + /* Don't believe they will give us more than 0.5 GB. */ if (lim_data > 512U * 1024U * 1024U) lim_data = 512U * 1024U * 1024U; } diff --git a/src/w16select.c b/src/w16select.c index 37239137cf0..bbd2ed4bb97 100644 --- a/src/w16select.c +++ b/src/w16select.c @@ -87,7 +87,7 @@ static size_t clipboard_storage_size; /* C functions to access the Windows 3.1x clipboard from DOS apps. The information was obtained from the Microsoft Knowledge Base, - article Q67675 and can be found at: + article Q67675 and can be found at: [broken link -- SK 2021-09-27] http://www.microsoft.com/kb/developr/win_dk/q67675.htm */ /* See also Ralf Brown's Interrupt List. diff --git a/src/w32.c b/src/w32.c index 968b4bbe489..e4b7ef3b95d 100644 --- a/src/w32.c +++ b/src/w32.c @@ -39,6 +39,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <sys/time.h> #include <sys/utime.h> #include <math.h> +#include <nproc.h> /* Include (most) CRT headers *before* ms-w32.h. */ #include <ms-w32.h> @@ -1962,6 +1963,16 @@ w32_get_nproc (void) return num_of_processors; } +/* Emulate Gnulib's 'num_processors'. We cannot use the Gnulib + version because it unconditionally calls APIs that aren't available + on old MS-Windows versions. */ +unsigned long +num_processors (enum nproc_query query) +{ + /* We ignore QUERY. */ + return w32_get_nproc (); +} + static void sample_system_load (ULONGLONG *idle, ULONGLONG *kernel, ULONGLONG *user) { @@ -2389,8 +2400,13 @@ rand_as183 (void) int random (void) { - /* rand_as183 () gives us 15 random bits...hack together 30 bits. */ + /* rand_as183 () gives us 15 random bits...hack together 30 bits for + Emacs with 32-bit EMACS_INT, and at least 31 bit for wider EMACS_INT. */ +#if EMACS_INT_MAX > INT_MAX + return ((rand_as183 () << 30) | (rand_as183 () << 15) | rand_as183 ()); +#else return ((rand_as183 () << 15) | rand_as183 ()); +#endif } void @@ -2804,53 +2820,6 @@ sys_putenv (char *str) #define REG_ROOT "SOFTWARE\\GNU\\Emacs" -LPBYTE -w32_get_resource (const char *key, LPDWORD lpdwtype) -{ - LPBYTE lpvalue; - HKEY hrootkey = NULL; - DWORD cbData; - - /* Check both the current user and the local machine to see if - we have any resources. */ - - if (RegOpenKeyEx (HKEY_CURRENT_USER, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) - { - lpvalue = NULL; - - if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS - && (lpvalue = xmalloc (cbData)) != NULL - && RegQueryValueEx (hrootkey, key, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS) - { - RegCloseKey (hrootkey); - return (lpvalue); - } - - xfree (lpvalue); - - RegCloseKey (hrootkey); - } - - if (RegOpenKeyEx (HKEY_LOCAL_MACHINE, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) - { - lpvalue = NULL; - - if (RegQueryValueEx (hrootkey, key, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS - && (lpvalue = xmalloc (cbData)) != NULL - && RegQueryValueEx (hrootkey, key, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS) - { - RegCloseKey (hrootkey); - return (lpvalue); - } - - xfree (lpvalue); - - RegCloseKey (hrootkey); - } - - return (NULL); -} - /* The argv[] array holds ANSI-encoded strings, and so this function works with ANS_encoded strings. */ void @@ -3061,7 +3030,7 @@ init_environment (char ** argv) int dont_free = 0; char bufc[SET_ENV_BUF_SIZE]; - if ((lpval = w32_get_resource (env_vars[i].name, &dwType)) == NULL + if ((lpval = w32_get_resource (REG_ROOT, env_vars[i].name, &dwType)) == NULL /* Also ignore empty environment variables. */ || *lpval == 0) { @@ -8753,7 +8722,7 @@ int _sys_read_ahead (int fd) { child_process * cp; - int rc; + int rc = 0; if (fd < 0 || fd >= MAXDESC) return STATUS_READ_ERROR; diff --git a/src/w32.h b/src/w32.h index ffa145b1484..b31d66646c9 100644 --- a/src/w32.h +++ b/src/w32.h @@ -155,14 +155,15 @@ extern unsigned int w32_get_short_filename (const char *, char *, int); /* Prepare our standard handles for proper inheritance by child processes. */ extern void prepare_standard_handles (int in, int out, - int err, HANDLE handles[4]); + int err, HANDLE handles[3]); /* Reset our standard handles to their original state. */ extern void reset_standard_handles (int in, int out, - int err, HANDLE handles[4]); + int err, HANDLE handles[3]); -/* Return the string resource associated with KEY of type TYPE. */ -extern LPBYTE w32_get_resource (const char * key, LPDWORD type); +/* Query Windows Registry and return the resource associated + associated with KEY and NAME of type TYPE. */ +extern LPBYTE w32_get_resource (const char * key, const char * name, LPDWORD type); extern void release_listen_threads (void); extern void init_ntproc (int); diff --git a/src/w32fns.c b/src/w32fns.c index 14d1154a2bc..c1686beaaa9 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -73,6 +73,20 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <imm.h> #include <windowsx.h> +/* + Internal/undocumented constants for Windows Dark mode. + See: https://github.com/microsoft/WindowsAppSDK/issues/41 +*/ +#define DARK_MODE_APP_NAME L"DarkMode_Explorer" +/* For Windows 10 version 1809, 1903, 1909. */ +#ifndef DWMWA_USE_IMMERSIVE_DARK_MODE_OLD +#define DWMWA_USE_IMMERSIVE_DARK_MODE_OLD 19 +#endif +/* For Windows 10 version 2004 and higher, and Windows 11. */ +#ifndef DWMWA_USE_IMMERSIVE_DARK_MODE +#define DWMWA_USE_IMMERSIVE_DARK_MODE 20 +#endif + #ifndef FOF_NO_CONNECTED_ELEMENTS #define FOF_NO_CONNECTED_ELEMENTS 0x2000 #endif @@ -185,6 +199,11 @@ typedef BOOL (WINAPI *IsDebuggerPresent_Proc) (void); typedef HRESULT (WINAPI *SetThreadDescription_Proc) (HANDLE hThread, PCWSTR lpThreadDescription); +typedef HRESULT (WINAPI * SetWindowTheme_Proc) + (IN HWND hwnd, IN LPCWSTR pszSubAppName, IN LPCWSTR pszSubIdList); +typedef HRESULT (WINAPI * DwmSetWindowAttribute_Proc) + (HWND hwnd, DWORD dwAttribute, IN LPCVOID pvAttribute, DWORD cbAttribute); + TrackMouseEvent_Proc track_mouse_event_fn = NULL; ImmGetCompositionString_Proc get_composition_string_fn = NULL; ImmGetContext_Proc get_ime_context_fn = NULL; @@ -199,6 +218,8 @@ EnumDisplayMonitors_Proc enum_display_monitors_fn = NULL; GetTitleBarInfo_Proc get_title_bar_info_fn = NULL; IsDebuggerPresent_Proc is_debugger_present = NULL; SetThreadDescription_Proc set_thread_description = NULL; +SetWindowTheme_Proc SetWindowTheme_fn = NULL; +DwmSetWindowAttribute_Proc DwmSetWindowAttribute_fn = NULL; extern AppendMenuW_Proc unicode_append_menu; @@ -252,6 +273,9 @@ int w32_major_version; int w32_minor_version; int w32_build_number; +/* If the OS is set to use dark mode. */ +BOOL w32_darkmode = FALSE; + /* Distinguish between Windows NT and Windows 95. */ int os_subtype; @@ -2279,10 +2303,36 @@ w32_init_class (HINSTANCE hinst) } } +/* Applies the Windows system theme (light or dark) to the window + handle HWND. */ +static void +w32_applytheme (HWND hwnd) +{ + if (w32_darkmode) + { + /* Set window theme to that of a built-in Windows app (Explorer), + because it has dark scroll bars and other UI elements. */ + if (SetWindowTheme_fn) + SetWindowTheme_fn (hwnd, DARK_MODE_APP_NAME, NULL); + + /* Set the titlebar to system dark mode. */ + if (DwmSetWindowAttribute_fn) + { + /* Windows 10 version 2004 and up, Windows 11. */ + DWORD attr = DWMWA_USE_IMMERSIVE_DARK_MODE; + /* Windows 10 older than 2004. */ + if (w32_build_number < 19041) + attr = DWMWA_USE_IMMERSIVE_DARK_MODE_OLD; + DwmSetWindowAttribute_fn (hwnd, attr, + &w32_darkmode, sizeof (w32_darkmode)); + } + } +} + static HWND w32_createvscrollbar (struct frame *f, struct scroll_bar * bar) { - return CreateWindow ("SCROLLBAR", "", + HWND hwnd = CreateWindow ("SCROLLBAR", "", /* Clip siblings so we don't draw over child frames. Apparently this is not always sufficient so we also try to make bar windows @@ -2291,12 +2341,15 @@ w32_createvscrollbar (struct frame *f, struct scroll_bar * bar) /* Position and size of scroll bar. */ bar->left, bar->top, bar->width, bar->height, FRAME_W32_WINDOW (f), NULL, hinst, NULL); + if (hwnd) + w32_applytheme (hwnd); + return hwnd; } static HWND w32_createhscrollbar (struct frame *f, struct scroll_bar * bar) { - return CreateWindow ("SCROLLBAR", "", + HWND hwnd = CreateWindow ("SCROLLBAR", "", /* Clip siblings so we don't draw over child frames. Apparently this is not always sufficient so we also try to make bar windows @@ -2305,6 +2358,9 @@ w32_createhscrollbar (struct frame *f, struct scroll_bar * bar) /* Position and size of scroll bar. */ bar->left, bar->top, bar->width, bar->height, FRAME_W32_WINDOW (f), NULL, hinst, NULL); + if (hwnd) + w32_applytheme (hwnd); + return hwnd; } static void @@ -2390,6 +2446,9 @@ w32_createwindow (struct frame *f, int *coords) /* Enable drag-n-drop. */ DragAcceptFiles (hwnd, TRUE); + /* Enable system light/dark theme. */ + w32_applytheme (hwnd); + /* Do this to discard the default setting specified by our parent. */ ShowWindow (hwnd, SW_HIDE); @@ -10257,6 +10316,60 @@ to be converted to forward slashes by the caller. */) } #endif /* WINDOWSNT */ + +/* Query a value from the Windows Registry (under HKCU and HKLM), + where `key` is the registry key, `name` is the name, and `lpdwtype` + is a pointer to the return value's type. `lpwdtype` can be NULL if + you do not care about the type. + + Returns: pointer to the value, or null pointer if the key/name does + not exist. */ +LPBYTE +w32_get_resource (const char *key, const char *name, LPDWORD lpdwtype) +{ + LPBYTE lpvalue; + HKEY hrootkey = NULL; + DWORD cbData; + + /* Check both the current user and the local machine to see if + we have any resources. */ + + if (RegOpenKeyEx (HKEY_CURRENT_USER, key, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) + { + lpvalue = NULL; + + if (RegQueryValueEx (hrootkey, name, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS + && (lpvalue = xmalloc (cbData)) != NULL + && RegQueryValueEx (hrootkey, name, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS) + { + RegCloseKey (hrootkey); + return (lpvalue); + } + + xfree (lpvalue); + + RegCloseKey (hrootkey); + } + + if (RegOpenKeyEx (HKEY_LOCAL_MACHINE, key, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS) + { + lpvalue = NULL; + + if (RegQueryValueEx (hrootkey, name, NULL, NULL, NULL, &cbData) == ERROR_SUCCESS + && (lpvalue = xmalloc (cbData)) != NULL + && RegQueryValueEx (hrootkey, name, NULL, lpdwtype, lpvalue, &cbData) == ERROR_SUCCESS) + { + RegCloseKey (hrootkey); + return (lpvalue); + } + + xfree (lpvalue); + + RegCloseKey (hrootkey); + } + + return (NULL); +} /*********************************************************************** Initialization @@ -11028,6 +11141,37 @@ globals_of_w32fns (void) set_thread_description = (SetThreadDescription_Proc) get_proc_addr (hm_kernel32, "SetThreadDescription"); + /* Support OS dark mode on Windows 10 version 1809 and higher. + See `w32_applytheme` which uses appropriate APIs per version of Windows. + For future wretches who may need to understand Windows build numbers: + https://docs.microsoft.com/en-us/windows/release-health/release-information + */ + if (os_subtype == OS_SUBTYPE_NT + && w32_major_version >= 10 && w32_build_number >= 17763) + { + /* Load dwmapi.dll and uxtheme.dll, which will be needed to set + window themes. */ + HMODULE dwmapi_lib = LoadLibrary("dwmapi.dll"); + DwmSetWindowAttribute_fn = (DwmSetWindowAttribute_Proc) + get_proc_addr (dwmapi_lib, "DwmSetWindowAttribute"); + HMODULE uxtheme_lib = LoadLibrary("uxtheme.dll"); + SetWindowTheme_fn = (SetWindowTheme_Proc) + get_proc_addr (uxtheme_lib, "SetWindowTheme"); + + /* Check Windows Registry for system theme and set w32_darkmode. + TODO: "Nice to have" would be to create a lisp setting (which + defaults to this Windows Registry value), then read that lisp + value here instead. This would allow the user to forcibly + override the system theme (which is also user-configurable in + Windows settings; see MS-Windows section in Emacs manual). */ + LPBYTE val = + w32_get_resource ("Software\\Microsoft\\Windows\\CurrentVersion\\Themes\\Personalize", + "AppsUseLightTheme", + NULL); + if (val && *val == 0) + w32_darkmode = TRUE; + } + except_code = 0; except_addr = 0; #ifndef CYGWIN diff --git a/src/w32font.c b/src/w32font.c index 6b9ab0468cd..4ceb4302cee 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -2000,11 +2000,11 @@ w32_encode_weight (int n) static Lisp_Object w32_to_fc_weight (int n) { - if (n >= FW_HEAVY) return intern ("black"); + if (n >= FW_HEAVY) return Qblack; if (n >= FW_EXTRABOLD) return Qextra_bold; if (n >= FW_BOLD) return Qbold; if (n >= FW_SEMIBOLD) return intern ("demibold"); - if (n >= FW_NORMAL) return intern ("medium"); + if (n >= FW_NORMAL) return Qmedium; if (n >= FW_LIGHT) return Qlight; if (n >= FW_EXTRALIGHT) return Qextra_light; return intern ("thin"); diff --git a/src/w32heap.c b/src/w32heap.c index 0f228bfb221..a0d4c070be3 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -189,6 +189,26 @@ malloc_fn the_malloc_fn; realloc_fn the_realloc_fn; free_fn the_free_fn; +static void * +heap_alloc (size_t size) +{ + void *p = size <= PTRDIFF_MAX ? HeapAlloc (heap, 0, size | !size) : NULL; + if (!p) + errno = ENOMEM; + return p; +} + +static void * +heap_realloc (void *ptr, size_t size) +{ + void *p = (size <= PTRDIFF_MAX + ? HeapReAlloc (heap, 0, ptr, size | !size) + : NULL); + if (!p) + errno = ENOMEM; + return p; +} + /* It doesn't seem to be useful to allocate from a file mapping. It would be if the memory was shared. https://stackoverflow.com/questions/307060/what-is-the-purpose-of-allocating-pages-in-the-pagefile-with-createfilemapping */ @@ -346,7 +366,7 @@ void * malloc_after_dump (size_t size) { /* Use the new private heap. */ - void *p = HeapAlloc (heap, 0, size); + void *p = heap_alloc (size); /* After dump, keep track of the "brk value" for sbrk(0). */ if (p) @@ -356,8 +376,6 @@ malloc_after_dump (size_t size) if (new_brk > data_region_end) data_region_end = new_brk; } - else - errno = ENOMEM; return p; } @@ -373,9 +391,7 @@ malloc_before_dump (size_t size) if (size < MaxBlockSize) { /* Use the private heap if possible. */ - p = HeapAlloc (heap, 0, size); - if (!p) - errno = ENOMEM; + p = heap_alloc (size); } else { @@ -433,18 +449,14 @@ realloc_after_dump (void *ptr, size_t size) if (FREEABLE_P (ptr)) { /* Reallocate the block since it lies in the new heap. */ - p = HeapReAlloc (heap, 0, ptr, size); - if (!p) - errno = ENOMEM; + p = heap_realloc (ptr, size); } else { /* If the block lies in the dumped data, do not free it. Only allocate a new one. */ - p = HeapAlloc (heap, 0, size); - if (!p) - errno = ENOMEM; - else if (ptr) + p = heap_alloc (size); + if (p && ptr) CopyMemory (p, ptr, size); } /* After dump, keep track of the "brk value" for sbrk(0). */ @@ -467,9 +479,7 @@ realloc_before_dump (void *ptr, size_t size) if (dumped_data < (unsigned char *)ptr && (unsigned char *)ptr < bc_limit && size <= MaxBlockSize) { - p = HeapReAlloc (heap, 0, ptr, size); - if (!p) - errno = ENOMEM; + p = heap_realloc (ptr, size); } else { diff --git a/src/w32inevt.c b/src/w32inevt.c index 1255072b7f3..9a69b32bcb0 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -586,9 +586,8 @@ do_mouse_event (MOUSE_EVENT_RECORD *event, int x = event->dwMousePosition.X; int y = event->dwMousePosition.Y; struct frame *f = get_frame (); - if (tty_handle_tab_bar_click (f, x, y, (button_state & mask) != 0, - emacs_ev)) - return 0; /* tty_handle_tab_bar_click adds the event to queue */ + emacs_ev->arg = tty_handle_tab_bar_click (f, x, y, (button_state & mask) != 0, + emacs_ev); emacs_ev->modifiers |= ((button_state & mask) ? down_modifier : up_modifier); @@ -597,7 +596,6 @@ do_mouse_event (MOUSE_EVENT_RECORD *event, XSETFASTINT (emacs_ev->x, x); XSETFASTINT (emacs_ev->y, y); XSETFRAME (emacs_ev->frame_or_window, f); - emacs_ev->arg = Qnil; return 1; } diff --git a/src/w32proc.c b/src/w32proc.c index 702ea122e65..360f45e9e11 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -3878,14 +3878,6 @@ w32_compare_strings (const char *s1, const char *s2, char *locname, return val - 2; } -DEFUN ("w32-get-nproc", Fw32_get_nproc, - Sw32_get_nproc, 0, 0, 0, - doc: /* Return the number of system's processor execution units. */) - (void) -{ - return make_fixnum (w32_get_nproc ()); -} - void syms_of_ntproc (void) @@ -3920,8 +3912,6 @@ syms_of_ntproc (void) defsubr (&Sw32_get_keyboard_layout); defsubr (&Sw32_set_keyboard_layout); - defsubr (&Sw32_get_nproc); - DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args, doc: /* Non-nil enables quoting of process arguments to ensure correct parsing. Because Windows does not directly pass argv arrays to child processes, diff --git a/src/w32term.c b/src/w32term.c index ad4d1a32829..07a5cd35649 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -168,8 +168,8 @@ int w32_keyboard_codepage; int w32_message_fd = -1; #endif /* CYGWIN */ -static void w32_handle_tab_bar_click (struct frame *, - struct input_event *); +static Lisp_Object w32_handle_tab_bar_click (struct frame *, + struct input_event *); static void w32_handle_tool_bar_click (struct frame *, struct input_event *); static void w32_define_cursor (Window, Emacs_Cursor); @@ -954,22 +954,6 @@ w32_set_cursor_gc (struct glyph_string *s) static void w32_set_mouse_face_gc (struct glyph_string *s) { - int face_id; - struct face *face; - - /* What face has to be used last for the mouse face? */ - face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id; - face = FACE_FROM_ID_OR_NULL (s->f, face_id); - if (face == NULL) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - - if (s->first_glyph->type == CHAR_GLYPH) - face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil); - else - face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil); - s->face = FACE_FROM_ID (s->f, face_id); - prepare_face_for_display (s->f, s->face); - /* If font in this face is same as S->font, use it. */ if (s->font == s->face->font) s->gc = s->face->gc; @@ -2031,11 +2015,14 @@ w32_draw_image_relief (struct glyph_string *s) if (s->hl == DRAW_IMAGE_SUNKEN || s->hl == DRAW_IMAGE_RAISED) { - thick = (tab_bar_button_relief < 0 - ? DEFAULT_TAB_BAR_BUTTON_RELIEF - : (tool_bar_button_relief < 0 - ? DEFAULT_TOOL_BAR_BUTTON_RELIEF - : min (tool_bar_button_relief, 1000000))); + if (s->face->id == TAB_BAR_FACE_ID) + thick = (tab_bar_button_relief < 0 + ? DEFAULT_TAB_BAR_BUTTON_RELIEF + : min (tab_bar_button_relief, 1000000)); + else + thick = (tool_bar_button_relief < 0 + ? DEFAULT_TOOL_BAR_BUTTON_RELIEF + : min (tool_bar_button_relief, 1000000)); raised_p = s->hl == DRAW_IMAGE_RAISED; } else @@ -2054,11 +2041,11 @@ w32_draw_image_relief (struct glyph_string *s) && FIXNUMP (XCAR (Vtab_bar_button_margin)) && FIXNUMP (XCDR (Vtab_bar_button_margin))) { - extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin)); - extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin)); + extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin)) - thick; + extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin)) - thick; } else if (FIXNUMP (Vtab_bar_button_margin)) - extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin); + extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin) - thick; } if (s->face->id == TOOL_BAR_FACE_ID) @@ -2420,29 +2407,15 @@ w32_draw_stretch_glyph_string (struct glyph_string *s) else if (!s->background_filled_p) { int background_width = s->background_width; - int x = s->x, text_left_x = window_box_left_offset (s->w, TEXT_AREA); + int x = s->x, text_left_x = window_box_left (s->w, TEXT_AREA); /* Don't draw into left fringe or scrollbar area except for header line and mode line. */ - if (x < text_left_x && !s->row->mode_line_p) + if (s->area == TEXT_AREA + && x < text_left_x && !s->row->mode_line_p) { - int left_x = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (s->w); - int right_x = text_left_x; - - if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w)) - left_x += WINDOW_LEFT_FRINGE_WIDTH (s->w); - else - right_x -= WINDOW_LEFT_FRINGE_WIDTH (s->w); - - /* Adjust X and BACKGROUND_WIDTH to fit inside the space - between LEFT_X and RIGHT_X. */ - if (x < left_x) - { - background_width -= left_x - x; - x = left_x; - } - if (x + background_width > right_x) - background_width = right_x - x; + background_width -= text_left_x - x; + x = text_left_x; } if (background_width > 0) w32_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height); @@ -3684,17 +3657,17 @@ w32_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, frame-relative coordinates X/Y. EVENT_TYPE is either ButtonPress or ButtonRelease. */ -static void +static Lisp_Object w32_handle_tab_bar_click (struct frame *f, struct input_event *button_event) { int x = XFIXNAT (button_event->x); int y = XFIXNAT (button_event->y); if (button_event->modifiers & down_modifier) - handle_tab_bar_click (f, x, y, 1, 0); + return handle_tab_bar_click (f, x, y, 1, 0); else - handle_tab_bar_click (f, x, y, 0, - button_event->modifiers & ~up_modifier); + return handle_tab_bar_click (f, x, y, 0, + button_event->modifiers & ~up_modifier); } @@ -5186,6 +5159,7 @@ w32_read_socket (struct terminal *terminal, { /* If we decide we want to generate an event to be seen by the rest of Emacs, we put it here. */ + Lisp_Object tab_bar_arg = Qnil; bool tab_bar_p = 0; bool tool_bar_p = 0; int button = 0; @@ -5208,12 +5182,12 @@ w32_read_socket (struct terminal *terminal, if (EQ (window, f->tab_bar_window)) { - w32_handle_tab_bar_click (f, &inev); + tab_bar_arg = w32_handle_tab_bar_click (f, &inev); tab_bar_p = 1; } } - if (tab_bar_p + if ((tab_bar_p && NILP (tab_bar_arg)) || (dpyinfo->w32_focus_frame && f != dpyinfo->w32_focus_frame /* This does not help when the click happens in @@ -5221,6 +5195,9 @@ w32_read_socket (struct terminal *terminal, && !frame_ancestor_p (f, dpyinfo->w32_focus_frame))) inev.kind = NO_EVENT; + if (!NILP (tab_bar_arg)) + inev.arg = tab_bar_arg; + /* Is this in the tool-bar? */ if (WINDOWP (f->tool_bar_window) && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window))) diff --git a/src/window.c b/src/window.c index a6e8ee0d534..e801ff821f1 100644 --- a/src/window.c +++ b/src/window.c @@ -20,6 +20,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> +/* Work around GCC bug 102671. */ +#if 10 <= __GNUC__ +# pragma GCC diagnostic ignored "-Wanalyzer-null-dereference" +#endif + #include "lisp.h" #include "buffer.h" #include "keyboard.h" @@ -760,6 +765,19 @@ selected one. */) { return make_fixnum (decode_live_window (window)->use_time); } + +DEFUN ("window-bump-use-time", Fwindow_bump_use_time, + Swindow_bump_use_time, 0, 1, 0, + doc: /* Mark WINDOW as having been most recently used. +WINDOW must be a live window and defaults to the selected one. */) + (Lisp_Object window) +{ + struct window *w = decode_live_window (window); + + w->use_time = ++window_select_count; + + return Qnil; +} DEFUN ("window-pixel-width", Fwindow_pixel_width, Swindow_pixel_width, 0, 1, 0, doc: /* Return the width of window WINDOW in pixels. @@ -3194,8 +3212,10 @@ function in a program gives strange scrolling, make sure the window-start value is reasonable when this function is called. */) (Lisp_Object window, Lisp_Object root) { - struct window *w, *r, *s; - struct frame *f; + struct window *w = decode_valid_window (window); + struct window *r, *s; + Lisp_Object frame = w->frame; + struct frame *f = XFRAME (frame); Lisp_Object sibling, pwindow, delta; Lisp_Object swindow UNINIT; ptrdiff_t startpos UNINIT, startbyte UNINIT; @@ -3203,9 +3223,7 @@ window-start value is reasonable when this function is called. */) int new_top; bool resize_failed = false; - w = decode_valid_window (window); XSETWINDOW (window, w); - f = XFRAME (w->frame); if (NILP (root)) /* ROOT is the frame's root window. */ @@ -3245,7 +3263,7 @@ window-start value is reasonable when this function is called. */) /* Make sure WINDOW is the frame's selected window. */ if (!EQ (window, FRAME_SELECTED_WINDOW (f))) { - if (EQ (selected_frame, w->frame)) + if (EQ (selected_frame, frame)) Fselect_window (window, Qnil); else /* Do not clear f->select_mini_window_flag here. If the @@ -3278,7 +3296,7 @@ window-start value is reasonable when this function is called. */) if (!EQ (swindow, FRAME_SELECTED_WINDOW (f))) { - if (EQ (selected_frame, w->frame)) + if (EQ (selected_frame, frame)) Fselect_window (swindow, Qnil); else fset_selected_window (f, swindow); @@ -3313,18 +3331,12 @@ window-start value is reasonable when this function is called. */) w->top_line = r->top_line; resize_root_window (window, delta, Qnil, Qnil, Qt); if (window_resize_check (w, false)) - { - window_resize_apply (w, false); - window_pixel_to_total (w->frame, Qnil); - } + window_resize_apply (w, false); else { resize_root_window (window, delta, Qnil, Qt, Qt); if (window_resize_check (w, false)) - { - window_resize_apply (w, false); - window_pixel_to_total (w->frame, Qnil); - } + window_resize_apply (w, false); else resize_failed = true; } @@ -3337,18 +3349,12 @@ window-start value is reasonable when this function is called. */) XSETINT (delta, r->pixel_width - w->pixel_width); resize_root_window (window, delta, Qt, Qnil, Qt); if (window_resize_check (w, true)) - { - window_resize_apply (w, true); - window_pixel_to_total (w->frame, Qt); - } + window_resize_apply (w, true); else { resize_root_window (window, delta, Qt, Qt, Qt); if (window_resize_check (w, true)) - { - window_resize_apply (w, true); - window_pixel_to_total (w->frame, Qt); - } + window_resize_apply (w, true); else resize_failed = true; } @@ -3390,6 +3396,12 @@ window-start value is reasonable when this function is called. */) } replace_window (root, window, true); + /* Assign new total sizes to all windows on FRAME. We can't do that + _before_ WINDOW replaces ROOT since 'window--pixel-to-total' works + on the whole frame and thus would work on the frame's old window + configuration (Bug#51007). */ + window_pixel_to_total (frame, Qnil); + window_pixel_to_total (frame, Qt); /* This must become SWINDOW anyway ....... */ if (BUFFERP (w->contents) && !resize_failed) @@ -8123,18 +8135,6 @@ and scrolling positions. */) return Qt; return Qnil; } - -DEFUN ("window-bump-use-time", Fwindow_bump_use_time, - Swindow_bump_use_time, 1, 1, 0, - doc: /* Mark WINDOW as having been recently used. */) - (Lisp_Object window) -{ - struct window *w = decode_valid_window (window); - - w->use_time = ++window_select_count; - return Qnil; -} - static void init_window_once_for_pdumper (void); diff --git a/src/xdisp.c b/src/xdisp.c index b81b27469d0..1ecc6aa9cfd 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1179,7 +1179,13 @@ static void append_stretch_glyph (struct it *, Lisp_Object, static Lisp_Object get_it_property (struct it *, Lisp_Object); static Lisp_Object calc_line_height_property (struct it *, Lisp_Object, struct font *, int, bool); - +static int adjust_glyph_width_for_mouse_face (struct glyph *, + struct glyph_row *, + struct window *, struct face *, + struct face *); +static void get_cursor_offset_for_mouse_face (struct window *w, + struct glyph_row *row, + int *offset); #endif /* HAVE_WINDOW_SYSTEM */ static void produce_special_glyphs (struct it *, enum display_element_type); @@ -4288,12 +4294,17 @@ handle_fontified_prop (struct it *it) struct buffer *obuf = current_buffer; ptrdiff_t begv = BEGV, zv = ZV; bool old_clip_changed = current_buffer->clip_changed; + bool saved_inhibit_flag = it->f->inhibit_clear_image_cache; val = Vfontification_functions; specbind (Qfontification_functions, Qnil); eassert (it->end_charpos == ZV); + /* Don't allow Lisp that runs from 'fontification-functions' + clear our face and image caches behind our back. */ + it->f->inhibit_clear_image_cache = true; + if (!CONSP (val) || EQ (XCAR (val), Qlambda)) safe_call1 (val, pos); else @@ -4327,6 +4338,7 @@ handle_fontified_prop (struct it *it) } } + it->f->inhibit_clear_image_cache = saved_inhibit_flag; unbind_to (count, Qnil); /* Fontification functions routinely call `save-restriction'. @@ -4472,7 +4484,13 @@ face_at_pos (const struct it *it, enum lface_attribute_index attr_filter) static enum prop_handled handle_face_prop (struct it *it) { + ptrdiff_t count = SPECPDL_INDEX (); + /* Don't allow the user to quit out of face-merging code, in case + this is called when redisplaying a non-selected window, with + point temporarily moved to window-point. */ + specbind (Qinhibit_quit, Qt); const int new_face_id = face_at_pos (it, 0); + unbind_to (count, Qnil); /* Is this a start of a run of characters with box face? @@ -4595,6 +4613,7 @@ face_before_or_after_it_pos (struct it *it, bool before_p) SAVE_IT (it_copy, *it, it_copy_data); IT_STRING_CHARPOS (it_copy) = 0; bidi_init_it (0, 0, FRAME_WINDOW_P (it_copy.f), &it_copy.bidi_it); + it_copy.bidi_it.scan_dir = 0; do { @@ -5781,8 +5800,15 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, #ifdef HAVE_WINDOW_SYSTEM else { + ptrdiff_t count = SPECPDL_INDEX (); + it->what = IT_IMAGE; + /* Don't allow quitting from lookup_image, for when we are + displaying a non-selected window, and the buffer's point + was temporarily moved to the window-point. */ + specbind (Qinhibit_quit, Qt); it->image_id = lookup_image (it->f, value, it->face_id); + unbind_to (count, Qnil); it->position = start_pos; it->object = NILP (object) ? it->w->contents : object; it->method = GET_FROM_IMAGE; @@ -7648,7 +7674,8 @@ get_next_display_element (struct it *it) /* Merge `nobreak-space' into the current face. */ face_id = merge_faces (it->w, Qnobreak_space, 0, it->face_id); - XSETINT (it->ctl_chars[0], it->c); + XSETINT (it->ctl_chars[0], + nobreak_char_ascii_display ? ' ' : it->c); ctl_len = 1; goto display_control; } @@ -7661,7 +7688,8 @@ get_next_display_element (struct it *it) /* Merge `nobreak-space' into the current face. */ face_id = merge_faces (it->w, Qnobreak_hyphen, 0, it->face_id); - XSETINT (it->ctl_chars[0], it->c); + XSETINT (it->ctl_chars[0], + nobreak_char_ascii_display ? '-' : it->c); ctl_len = 1; goto display_control; } @@ -10051,6 +10079,8 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos case MOVE_NEWLINE_OR_CR: max_current_x = max (it->current_x, max_current_x); + if (!IT_OVERFLOW_NEWLINE_INTO_FRINGE (it)) + it->override_ascent = -1; set_iterator_to_next (it, true); it->continuation_lines_width = 0; break; @@ -10598,10 +10628,12 @@ in_display_vector_p (struct it *it) DEFUN ("window-text-pixel-size", Fwindow_text_pixel_size, Swindow_text_pixel_size, 0, 6, 0, doc: /* Return the size of the text of WINDOW's buffer in pixels. -WINDOW must be a live window and defaults to the selected one. The +WINDOW can be any live window and defaults to the selected one. The return value is a cons of the maximum pixel-width of any text line and the pixel-height of all the text lines in the accessible portion of buffer text. +WINDOW can also be a buffer, in which case the selected window is used, +and the function behaves as if that window was displaying this buffer. This function exists to allow Lisp programs to adjust the dimensions of WINDOW to the buffer text it needs to display. @@ -10637,16 +10669,17 @@ position specified by TO. Since calculating the text height of a large buffer can take some time, it makes sense to specify this argument if the size of the buffer is large or unknown. -Optional argument MODE-AND-HEADER-LINE nil or omitted means do not -include the height of the mode- or header-line of WINDOW in the return -value. If it is either the symbol `mode-line' or `header-line', include +Optional argument MODE-LINES nil or omitted means do not include the +height of the mode-, tab- or header-line of WINDOW in the return value. +If it is the symbol `mode-line', 'tab-line' or `header-line', include only the height of that line, if present, in the return value. If t, -include the height of both, if present, in the return value. */) +include the height of any of these, if present, in the return value. */) (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit, - Lisp_Object y_limit, Lisp_Object mode_and_header_line) + Lisp_Object y_limit, Lisp_Object mode_lines) { - struct window *w = decode_live_window (window); - Lisp_Object buffer = w->contents; + struct window *w = BUFFERP (window) ? XWINDOW (selected_window) + : decode_live_window (window); + Lisp_Object buffer = BUFFERP (window) ? window : w->contents; struct buffer *b; struct it it; struct buffer *old_b = NULL; @@ -10817,20 +10850,42 @@ include the height of both, if present, in the return value. */) if (y > max_y) y = max_y; - if (EQ (mode_and_header_line, Qtab_line) - || EQ (mode_and_header_line, Qt)) - /* Re-add height of tab-line as requested. */ - y = y + WINDOW_TAB_LINE_HEIGHT (w); + if ((EQ (mode_lines, Qtab_line) || EQ (mode_lines, Qt)) + && window_wants_tab_line (w)) + /* Add height of tab-line as requested. */ + { + Lisp_Object window_tab_line_format + = window_parameter (w, Qtab_line_format); - if (EQ (mode_and_header_line, Qheader_line) - || EQ (mode_and_header_line, Qt)) - /* Re-add height of header-line as requested. */ - y = y + WINDOW_HEADER_LINE_HEIGHT (w); + y = y + display_mode_line (w, TAB_LINE_FACE_ID, + NILP (window_tab_line_format) + ? BVAR (current_buffer, tab_line_format) + : window_tab_line_format); + } + + if ((EQ (mode_lines, Qheader_line) || EQ (mode_lines, Qt)) + && window_wants_header_line (w)) + { + Lisp_Object window_header_line_format + = window_parameter (w, Qheader_line_format); + + y = y + display_mode_line (w, HEADER_LINE_FACE_ID, + NILP (window_header_line_format) + ? BVAR (current_buffer, header_line_format) + : window_header_line_format); + } + + if ((EQ (mode_lines, Qmode_line) || EQ (mode_lines, Qt)) + && window_wants_mode_line (w)) + { + Lisp_Object window_mode_line_format + = window_parameter (w, Qmode_line_format); - if (EQ (mode_and_header_line, Qmode_line) - || EQ (mode_and_header_line, Qt)) - /* Add height of mode-line as requested. */ - y = y + WINDOW_MODE_LINE_HEIGHT (w); + y = y + display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), + NILP (window_mode_line_format) + ? BVAR (current_buffer, mode_line_format) + : window_mode_line_format); + } bidi_unshelve_cache (itdata, false); @@ -11757,7 +11812,7 @@ display_echo_area (struct window *w) /* If there is no message, we must call display_echo_area_1 nevertheless because it resizes the window. But we will have to reset the echo_area_buffer in question to nil at the end because - with_echo_area_buffer will sets it to an empty buffer. */ + with_echo_area_buffer will set it to an empty buffer. */ bool i = display_last_displayed_message_p; /* According to the C99, C11 and C++11 standards, the integral value of a "bool" is always 0 or 1, so this array access is safe here, @@ -13745,7 +13800,7 @@ get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph, false for button release. MODIFIERS is event modifiers for button release. */ -void +Lisp_Object handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, int modifiers) { @@ -13759,16 +13814,13 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, frame_to_window_pixel_xy (w, &x, &y); ts = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p); - if (ts == -1 - /* If the button is released on a tab other than the one where - it was pressed, don't generate the tab-bar button click event. */ - || (ts != 0 && !down_p)) - return; + if (ts == -1) + return Fcons (Qtab_bar, Qnil); /* If item is disabled, do nothing. */ enabled_p = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_ENABLED_P); if (NILP (enabled_p)) - return; + return Qnil; if (down_p) { @@ -13779,24 +13831,24 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, } else { - Lisp_Object key, frame; - struct input_event event; - EVENT_INIT (event); - /* Show item in released state. */ if (!NILP (Vmouse_highlight)) show_mouse_face (hlinfo, DRAW_IMAGE_RAISED); - - key = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_KEY); - - XSETFRAME (frame, f); - event.kind = TAB_BAR_EVENT; - event.frame_or_window = frame; - event.arg = key; - event.modifiers = close_p ? ctrl_modifier | modifiers : modifiers; - kbd_buffer_store_event (&event); f->last_tab_bar_item = -1; } + + Lisp_Object caption = + Fcopy_sequence (AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_CAPTION)); + + AUTO_LIST2 (props, Qmenu_item, + list3 (AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_KEY), + AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_BINDING), + close_p ? Qt : Qnil)); + + Fadd_text_properties (make_fixnum (0), make_fixnum (SCHARS (caption)), + props, caption); + + return Fcons (Qtab_bar, Fcons (caption, make_fixnum (0))); } @@ -13842,15 +13894,18 @@ note_tab_bar_highlight (struct frame *f, int x, int y) clear_mouse_face (hlinfo); bool mouse_down_p = false; -#ifndef HAVE_NS - /* Mouse is down, but on different tab-bar item? */ + /* Mouse is down, but on different tab-bar item? Or alternatively, + the mouse might've been pressed somewhere we don't know about, + and then have moved onto the tab bar. In this case, + last_tab_bar_item is -1, so we DTRT and behave like other + programs by displaying the item as sunken. */ Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); mouse_down_p = (gui_mouse_grabbed (dpyinfo) && f == dpyinfo->last_mouse_frame); - if (mouse_down_p && f->last_tab_bar_item != prop_idx) + if (mouse_down_p && f->last_tab_bar_item != prop_idx + && f->last_tab_bar_item != -1) return; -#endif draw = mouse_down_p ? DRAW_IMAGE_SUNKEN : DRAW_IMAGE_RAISED; /* If tab-bar item is not enabled, don't highlight it. */ @@ -13894,7 +13949,7 @@ note_tab_bar_highlight (struct frame *f, int x, int y) /* Find the tab-bar item at X coordinate and return its information. */ static Lisp_Object -tty_get_tab_bar_item (struct frame *f, int x, int *idx, ptrdiff_t *end) +tty_get_tab_bar_item (struct frame *f, int x, int *prop_idx, bool *close_p) { ptrdiff_t clen = 0; @@ -13907,8 +13962,11 @@ tty_get_tab_bar_item (struct frame *f, int x, int *idx, ptrdiff_t *end) clen += SCHARS (caption); if (x < clen) { - *idx = i; - *end = clen; + *prop_idx = i; + *close_p = !NILP (Fget_text_property (make_fixnum (SCHARS (caption) + - (clen - x)), + Qclose_tab, + caption)); return caption; } } @@ -13920,61 +13978,45 @@ tty_get_tab_bar_item (struct frame *f, int x, int *idx, ptrdiff_t *end) structure, store it in keyboard queue, and return true; otherwise return false. MODIFIERS are event modifiers for generating the tab release event. */ -bool +Lisp_Object tty_handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, struct input_event *event) { /* Did they click on the tab bar? */ if (y < FRAME_MENU_BAR_LINES (f) || y >= FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f)) - return false; + return Qnil; /* Find the tab-bar item where the X,Y coordinates belong. */ int prop_idx; - ptrdiff_t clen; - Lisp_Object caption = tty_get_tab_bar_item (f, x, &prop_idx, &clen); + bool close_p; + Lisp_Object caption = tty_get_tab_bar_item (f, x, &prop_idx, &close_p); if (NILP (caption)) - return false; + return Qnil; if (NILP (AREF (f->tab_bar_items, prop_idx * TAB_BAR_ITEM_NSLOTS + TAB_BAR_ITEM_ENABLED_P))) - return false; + return Qnil; if (down_p) f->last_tab_bar_item = prop_idx; else - { - /* Force reset of up_modifier bit from the event modifiers. */ - if (event->modifiers & up_modifier) - event->modifiers &= ~up_modifier; - - /* Generate a TAB_BAR_EVENT event. */ - Lisp_Object frame; - Lisp_Object key = AREF (f->tab_bar_items, - prop_idx * TAB_BAR_ITEM_NSLOTS - + TAB_BAR_ITEM_KEY); - /* Kludge alert: we assume the last two characters of a tab - label are " x", and treat clicks on those 2 characters as a - Close Tab command. */ - eassert (STRINGP (caption)); - int lastc = SSDATA (caption)[SCHARS (caption) - 1]; - bool close_p = false; - if ((x == clen - 1 || (clen > 1 && x == clen - 2)) && lastc == 'x') - close_p = true; - - event->code = 0; - XSETFRAME (frame, f); - event->kind = TAB_BAR_EVENT; - event->frame_or_window = frame; - event->arg = key; - if (close_p) - event->modifiers |= ctrl_modifier; - kbd_buffer_store_event (event); - f->last_tab_bar_item = -1; - } + f->last_tab_bar_item = -1; - return true; + caption = Fcopy_sequence (caption); + + AUTO_LIST2 (props, Qmenu_item, + list3 (AREF (f->tab_bar_items, prop_idx * TAB_BAR_ITEM_NSLOTS + + TAB_BAR_ITEM_KEY), + AREF (f->tab_bar_items, prop_idx * TAB_BAR_ITEM_NSLOTS + + TAB_BAR_ITEM_BINDING), + close_p ? Qt : Qnil)); + + Fadd_text_properties (make_fixnum (0), make_fixnum (SCHARS (caption)), + props, caption); + + return Fcons (Qtab_bar, Fcons (caption, make_fixnum (0))); } @@ -14884,7 +14926,15 @@ hscroll_window_tree (Lisp_Object window) if (WINDOWP (w->contents)) hscrolled_p |= hscroll_window_tree (w->contents); - else if (w->cursor.vpos >= 0) + else if (w->cursor.vpos >= 0 + /* Don't allow hscroll in mini-windows that display + echo-area messages. This is because desired_matrix + of such windows was prepared while momentarily + switched to an echo-area buffer, which is different + from w->contents, and we simply cannot hscroll such + windows safely. */ + && !(w == XWINDOW (echo_area_window) + && !NILP (echo_area_buffer[0]))) { int h_margin; int text_area_width; @@ -15082,11 +15132,12 @@ hscroll_window_tree (Lisp_Object window) else { if (hscroll_relative_p) - wanted_x = text_area_width * hscroll_step_rel - + h_margin; + wanted_x = + text_area_width * hscroll_step_rel + h_margin + x_offset; else - wanted_x = hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f) - + h_margin; + wanted_x = + hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f) + + h_margin + x_offset; hscroll = max (0, it.current_x - wanted_x) / FRAME_COLUMN_WIDTH (it.f); } @@ -16054,12 +16105,13 @@ redisplay_internal (void) if (FRAME_VISIBLE_P (f) && !FRAME_OBSCURED_P (f)) { - /* Don't allow freeing images for this frame as long - as the frame's update wasn't completed. This - prevents crashes when some Lisp that runs from - the various hooks or font-lock decides to clear - the frame's image cache, when the images in that - cache are referenced by the desired matrix. */ + /* Don't allow freeing images and faces for this + frame as long as the frame's update wasn't + completed. This prevents crashes when some Lisp + that runs from the various hooks or font-lock + decides to clear the frame's image cache and face + cache, when the images and faces in those caches + are referenced by the desired matrix. */ f->inhibit_clear_image_cache = true; redisplay_windows (FRAME_ROOT_WINDOW (f)); } @@ -17274,8 +17326,11 @@ run_window_scroll_functions (Lisp_Object window, struct text_pos startp) if (!NILP (Vwindow_scroll_functions)) { + ptrdiff_t count = SPECPDL_INDEX (); + specbind (Qinhibit_quit, Qt); run_hook_with_args_2 (Qwindow_scroll_functions, window, make_fixnum (CHARPOS (startp))); + unbind_to (count, Qnil); SET_TEXT_POS_FROM_MARKER (startp, w->start); /* In case the hook functions switch buffers. */ set_buffer_internal (XBUFFER (w->contents)); @@ -19268,7 +19323,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) w->start_at_line_beg = (CHARPOS (startp) == BEGV || FETCH_BYTE (BYTEPOS (startp) - 1) == '\n'); - /* Display the mode line, if we must. */ + /* Display the mode line, header line, and tab-line, if we must. */ if ((update_mode_line /* If window not full width, must redo its mode line if (a) the window to its side is being redone and @@ -19287,8 +19342,11 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) || window_wants_header_line (w) || window_wants_tab_line (w))) { + ptrdiff_t count1 = SPECPDL_INDEX (); + specbind (Qinhibit_quit, Qt); display_mode_lines (w); + unbind_to (count1, Qnil); /* If mode line height has changed, arrange for a thorough immediate redisplay using the correct mode line height. */ @@ -19336,7 +19394,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) finish_menu_bars: /* When we reach a frame's selected window, redo the frame's menu - bar and the frame's title. */ + bar, tool bar, tab-bar, and the frame's title. */ if (update_mode_line && EQ (FRAME_SELECTED_WINDOW (f), window)) { @@ -22104,10 +22162,17 @@ extend_face_to_end_of_line (struct it *it) || WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0)) return; + ptrdiff_t count = SPECPDL_INDEX (); + + /* Don't allow the user to quit out of face-merging code, in case + this is called when redisplaying a non-selected window, with + point temporarily moved to window-point. */ + specbind (Qinhibit_quit, Qt); const int extend_face_id = (it->face_id == DEFAULT_FACE_ID || it->s != NULL) ? DEFAULT_FACE_ID : face_at_pos (it, LFACE_EXTEND_INDEX); + unbind_to (count, Qnil); /* Face extension extends the background and box of IT->extend_face_id to the end of the line. If the background equals the background @@ -24444,7 +24509,7 @@ See also `bidi-paragraph-direction'. */) DEFUN ("bidi-find-overridden-directionality", Fbidi_find_overridden_directionality, - Sbidi_find_overridden_directionality, 2, 3, 0, + Sbidi_find_overridden_directionality, 3, 4, 0, doc: /* Return position between FROM and TO where directionality was overridden. This function returns the first character position in the specified @@ -24463,12 +24528,18 @@ a buffer is preferable when the buffer is displayed in some window, because this function will then be able to correctly account for window-specific overlays, which can affect the results. +Optional argument BASE-DIR specifies the base paragraph directory +of the text. It should be a symbol, either `left-to-right' +or `right-to-left', and defaults to `left-to-right'. + Strong directional characters `L', `R', and `AL' can have their intrinsic directionality overridden by directional override -control characters RLO (u+202e) and LRO (u+202d). See the -function `get-char-code-property' for a way to inquire about +control characters RLO (u+202E) and LRO (u+202D). They can also +have their directionality affected by other formatting control +characters: LRE (u+202A), RLE (u+202B), LRI (u+2066), and RLI (u+2067). +See the function `get-char-code-property' for a way to inquire about the `bidi-class' property of a character. */) - (Lisp_Object from, Lisp_Object to, Lisp_Object object) + (Lisp_Object from, Lisp_Object to, Lisp_Object object, Lisp_Object base_dir) { struct buffer *buf = current_buffer; struct buffer *old = buf; @@ -24565,10 +24636,9 @@ the `bidi-class' property of a character. */) } ptrdiff_t found; + bidi_dir_t bdir = EQ (base_dir, Qright_to_left) ? R2L : L2R; do { - /* For the purposes of this function, the actual base direction of - the paragraph doesn't matter, so just set it to L2R. */ - bidi_paragraph_init (L2R, &itb, false); + bidi_paragraph_init (bdir, &itb, false); while ((found = bidi_find_first_overridden (&itb)) < from_pos) ; } while (found == ZV && itb.ch == '\n' && itb.charpos < to_pos); @@ -25432,8 +25502,9 @@ redisplay_mode_lines (Lisp_Object window, bool force) } -/* Display the mode and/or header line of window W. Value is the - sum number of mode lines and header lines displayed. */ +/* 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. */ static int display_mode_lines (struct window *w) @@ -25563,7 +25634,8 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) push_kboard (FRAME_KBOARD (it.f)); record_unwind_save_match_data (); - if (NILP (Vmode_line_compact)) + if (NILP (Vmode_line_compact) + || face_id == HEADER_LINE_FACE_ID || face_id == TAB_LINE_FACE_ID) { mode_line_target = MODE_LINE_DISPLAY; display_mode_element (&it, 0, 0, 0, format, Qnil, false); @@ -27013,7 +27085,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, Lisp_Object val = Qnil; if (STRINGP (curdir)) - val = call1 (intern ("file-remote-p"), curdir); + val = safe_call1 (intern ("file-remote-p"), curdir); val = unbind_to (count, val); @@ -28099,6 +28171,19 @@ fill_composite_glyph_string (struct glyph_string *s, struct face *base_face, s->font = s->face->font; } + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + int c = COMPOSITION_GLYPH (s->cmp, 0); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + + s->face = FACE_FROM_ID (s->f, FACE_FOR_CHAR (s->f, s->face, c, -1, Qnil)); + prepare_face_for_display (s->f, s->face); + } + /* All glyph strings for the same composition has the same width, i.e. the width set for the first component of the composition. */ s->width = s->first_glyph->pixel_width; @@ -28135,7 +28220,17 @@ fill_gstring_glyph_string (struct glyph_string *s, int face_id, s->cmp_id = glyph->u.cmp.id; s->cmp_from = glyph->slice.cmp.from; s->cmp_to = glyph->slice.cmp.to + 1; - s->face = FACE_FROM_ID (s->f, face_id); + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } + else + s->face = FACE_FROM_ID (s->f, face_id); lgstring = composition_gstring_from_id (s->cmp_id); s->font = XFONT_OBJECT (LGSTRING_FONT (lgstring)); /* The width of a composition glyph string is the sum of the @@ -28191,6 +28286,15 @@ fill_glyphless_glyph_string (struct glyph_string *s, int face_id, voffset = glyph->voffset; s->face = FACE_FROM_ID (s->f, face_id); s->font = s->face->font ? s->face->font : FRAME_FONT (s->f); + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->nchars = 1; s->width = glyph->pixel_width; glyph++; @@ -28254,6 +28358,19 @@ fill_glyph_string (struct glyph_string *s, int face_id, s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + s->face + = FACE_FROM_ID (s->f, FACE_FOR_CHAR (s->f, s->face, + s->first_glyph->u.ch, -1, Qnil)); + prepare_face_for_display (s->f, s->face); + } + /* If the specified font could not be loaded, use the frame's font, but record the fact that we couldn't load it in S->font_not_found_p so that we can draw rectangles for the @@ -28283,6 +28400,15 @@ fill_image_glyph_string (struct glyph_string *s) s->slice = s->first_glyph->slice.img; s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id); s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->width = s->first_glyph->pixel_width; /* Adjust base line for subscript/superscript text. */ @@ -28297,9 +28423,18 @@ fill_xwidget_glyph_string (struct glyph_string *s) eassert (s->first_glyph->type == XWIDGET_GLYPH); s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id); s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->width = s->first_glyph->pixel_width; s->ybase += s->first_glyph->voffset; - s->xwidget = s->first_glyph->u.xwidget; + s->xwidget = xwidget_from_id (s->first_glyph->u.xwidget); } #endif /* Fill glyph string S from a sequence of stretch glyphs. @@ -28322,6 +28457,15 @@ fill_stretch_glyph_string (struct glyph_string *s, int start, int end) face_id = glyph->face_id; s->face = FACE_FROM_ID (s->f, face_id); s->font = s->face->font; + if (s->hl == DRAW_MOUSE_FACE + || (s->hl == DRAW_CURSOR && cursor_in_mouse_face_p (s->w))) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (s->f); + s->face = FACE_FROM_ID_OR_NULL (s->f, hlinfo->mouse_face_face_id); + if (!s->face) + s->face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + prepare_face_for_display (s->f, s->face); + } s->width = glyph->pixel_width; s->nchars = 1; voffset = glyph->voffset; @@ -28569,7 +28713,12 @@ right_overwriting (struct glyph_string *s) /* Set background width of glyph string S. START is the index of the first glyph following S. LAST_X is the right-most x-position + 1 - in the drawing area. */ + in the drawing area. + + If S->hl is DRAW_CURSOR, S->f is a window system frame, and the + cursor in S's window is currently inside mouse face, also update + S->width to take into account potentially differing :box + properties between the original face and the mouse face. */ static void set_glyph_string_background_width (struct glyph_string *s, int start, int last_x) @@ -28591,7 +28740,27 @@ set_glyph_string_background_width (struct glyph_string *s, int start, int last_x if (s->extends_to_end_of_line_p) s->background_width = last_x - s->x + 1; else - s->background_width = s->width; + { + s->background_width = s->width; +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (s->f) + && s->hl == DRAW_CURSOR + && cursor_in_mouse_face_p (s->w)) + { + /* Adjust the background width of the glyph string, because + if the glyph's face has the :box attribute, its + pixel_width might be different when it's displayed in the + mouse-face, if that also has the :box attribute. */ + struct glyph *g = s->first_glyph; + struct face *regular_face = FACE_FROM_ID (s->f, g->face_id); + s->background_width += + adjust_glyph_width_for_mouse_face (g, s->row, s->w, + regular_face, s->face); + /* S->width is probably worth adjusting here as well. */ + s->width = s->background_width; + } +#endif + } } @@ -29140,7 +29309,6 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, for (s = head; s; s = s->next) FRAME_RIF (f)->draw_glyph_string (s); -#ifndef HAVE_NS /* When focus a sole frame and move horizontally, this clears on_p causing a failure to erase prev cursor position. */ if (area == TEXT_AREA @@ -29159,7 +29327,6 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, notice_overwritten_cursor (w, TEXT_AREA, x0, x1, row->y, MATRIX_ROW_BOTTOM_Y (row)); } -#endif /* Value is the x-position up to which drawn, relative to AREA of W. This doesn't include parts drawn because of overhangs. */ @@ -29502,6 +29669,8 @@ produce_image_glyph (struct it *it) if (face->box != FACE_NO_BOX) { + /* If you change the logic here, please change it in + get_cursor_offset_for_mouse_face as well. */ if (face->box_horizontal_line_width > 0) { if (slice.y == 0) @@ -29678,7 +29847,7 @@ produce_xwidget_glyph (struct it *it) glyph->padding_p = 0; glyph->glyph_not_available_p = 0; glyph->face_id = it->face_id; - glyph->u.xwidget = it->xwidget; + glyph->u.xwidget = it->xwidget->xwidget_id; glyph->font_type = FONT_TYPE_UNKNOWN; if (it->bidi_p) { @@ -31803,6 +31972,20 @@ erase_phys_cursor (struct window *w) && cursor_row->used[TEXT_AREA] > hpos && hpos >= 0) mouse_face_here_p = true; +#ifdef HAVE_WINDOW_SYSTEM + /* Since erasing the phys cursor will probably lead to corruption of + the mouse face display if the glyph's pixel_width is not kept up + to date with the :box property of the mouse face, just redraw the + mouse face. */ + if (FRAME_WINDOW_P (WINDOW_XFRAME (w)) && mouse_face_here_p) + { + w->phys_cursor_on_p = false; + w->phys_cursor_type = NO_CURSOR; + show_mouse_face (MOUSE_HL_INFO (WINDOW_XFRAME (w)), DRAW_MOUSE_FACE); + return; + } +#endif + /* Maybe clear the display under the cursor. */ if (w->phys_cursor_type == HOLLOW_BOX_CURSOR) { @@ -32074,6 +32257,9 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) && hlinfo->mouse_face_end_row < w->current_matrix->nrows) { bool phys_cursor_on_p = w->phys_cursor_on_p; +#ifdef HAVE_WINDOW_SYSTEM + int mouse_off = 0; +#endif struct glyph_row *row, *first, *last; first = MATRIX_ROW (w->current_matrix, hlinfo->mouse_face_beg_row); @@ -32147,6 +32333,15 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) row->mouse_face_p = draw == DRAW_MOUSE_FACE || draw == DRAW_IMAGE_RAISED; } +#ifdef HAVE_WINDOW_SYSTEM + /* Compute the cursor offset due to mouse-highlight. */ + if ((MATRIX_ROW_VPOS (row, w->current_matrix) == w->phys_cursor.vpos) + /* But not when highlighting a pseudo window, such as + the toolbar, which can't have a cursor anyway. */ + && !w->pseudo_window_p + && draw == DRAW_MOUSE_FACE) + get_cursor_offset_for_mouse_face (w, row, &mouse_off); +#endif } /* When we've written over the cursor, arrange for it to @@ -32156,6 +32351,7 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) { #ifdef HAVE_WINDOW_SYSTEM int hpos = w->phys_cursor.hpos; + int old_phys_cursor_x = w->phys_cursor.x; /* When the window is hscrolled, cursor hpos can legitimately be out of bounds, but we draw the cursor at the corresponding @@ -32167,7 +32363,11 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) block_input (); display_and_set_cursor (w, true, hpos, w->phys_cursor.vpos, - w->phys_cursor.x, w->phys_cursor.y); + w->phys_cursor.x + mouse_off, + w->phys_cursor.y); + /* Restore the original cursor coordinates, perhaps modified + to account for mouse-highlight. */ + w->phys_cursor.x = old_phys_cursor_x; unblock_input (); #endif /* HAVE_WINDOW_SYSTEM */ } @@ -33547,7 +33747,7 @@ note_mouse_highlight (struct frame *f, int x, int y) && y < FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f))) { int prop_idx; - ptrdiff_t ignore; + bool ignore; Lisp_Object caption = tty_get_tab_bar_item (f, x, &prop_idx, &ignore); if (!NILP (caption)) @@ -33630,7 +33830,21 @@ note_mouse_highlight (struct frame *f, int x, int y) if (EQ (window, f->tab_bar_window)) { note_tab_bar_highlight (f, x, y); - return; + if (tab_bar__dragging_in_progress) + { + cursor = FRAME_OUTPUT_DATA (f)->hand_cursor; + goto set_cursor; + } + else + return; + } + else + { + /* The mouse might have pressed into the tab bar, but might + also have been released outside the tab bar, so + f->last_tab_bar_item must be reset, in order to make sure the + item can be still highlighted again in the future. */ + f->last_tab_bar_item = -1; } #endif @@ -35021,6 +35235,26 @@ glyph followed by an ordinary space or hyphen. A value of nil means no special handling of these characters. */); Vnobreak_char_display = Qt; + DEFVAR_BOOL ("nobreak-char-ascii-display", nobreak_char_ascii_display, + doc: /* Control display of non-ASCII space and hyphen chars. +If the value of this variable is nil, the default, Emacs displays +non-ASCII chars which have the same appearance as an ASCII space +or hyphen as themselves, with the `nobreak-space' or `nobreak-hyphen' +face, respectively. + +If the value is t, these characters are displayed as their ASCII +counterparts: whitespace characters as ASCII space, hyphen characters +as ASCII hyphen (a.k.a. \"dash\"), using the `nobreak-space' or +the `nobreak-hyphen' face. + +This variable has effect only if `nobreak-char-display' is t; +otherwise it is ignored. + +All of the non-ASCII characters in the Unicode horizontal whitespace +character class, as well as U+00AD (soft hyphen), U+2010 (hyphen), and +U+2011 (non-breaking hyphen) are affected. */); + nobreak_char_ascii_display = false; + DEFVAR_LISP ("void-text-area-pointer", Vvoid_text_area_pointer, doc: /* The pointer shape to show in void text areas. A value of nil means to show the text pointer. Other options are @@ -35114,7 +35348,10 @@ not span the full frame width. A value of nil means to respect the value of `truncate-lines'. -If `word-wrap' is enabled, you might want to reduce this. */); +If `word-wrap' is enabled, you might want to reduce the value of this. + +Don't set this to a non-nil value when `visual-line-mode' is +turned on, as it could produce confusing results. */); Vtruncate_partial_width_windows = make_fixnum (50); DEFVAR_BOOL("word-wrap-by-category", word_wrap_by_category, doc: /* @@ -35423,7 +35660,7 @@ and `scroll-right' overrides this variable's effect. */); Vhscroll_step = make_fixnum (0); DEFVAR_BOOL ("message-truncate-lines", message_truncate_lines, - doc: /* If non-nil, messages are truncated instead of resizing the echo area. + doc: /* If non-nil, messages are truncated when displaying the echo area. Bind this around calls to `message' to let it take effect. */); message_truncate_lines = false; @@ -35737,6 +35974,10 @@ When nil, mouse-movement events will not be generated as long as the mouse stays within the extent of a single glyph (except for images). */); mouse_fine_grained_tracking = false; + DEFVAR_BOOL ("tab-bar--dragging-in-progress", tab_bar__dragging_in_progress, + doc: /* Non-nil when maybe dragging tab bar item. */); + tab_bar__dragging_in_progress = false; + DEFVAR_BOOL ("redisplay-skip-initial-frame", redisplay_skip_initial_frame, doc: /* Non-nil to skip redisplay in initial frame. The initial frame is not displayed anywhere, so skipping it is @@ -35916,4 +36157,121 @@ cancel_hourglass (void) } } +/* Return a correction to be applied to G->pixel_width when it is + displayed in MOUSE_FACE. This is needed for the first and the last + glyphs of text inside a face with :box when it is displayed with + MOUSE_FACE that has a different or no :box attribute. + ORIGINAL_FACE is the face G was originally drawn in, and MOUSE_FACE + is the face it will be drawn in now. ROW is the G's glyph row and + W is its window. */ +static int +adjust_glyph_width_for_mouse_face (struct glyph *g, struct glyph_row *row, + struct window *w, + struct face *original_face, + struct face *mouse_face) +{ + int sum = 0; + + bool do_left_box_p = g->left_box_line_p; + bool do_right_box_p = g->right_box_line_p; + + /* This is required because we test some parameters of the image + slice before applying the box in produce_image_glyph. */ + if (g->type == IMAGE_GLYPH) + { + if (!row->reversed_p) + { + struct image *img = IMAGE_FROM_ID (WINDOW_XFRAME (w), + g->u.img_id); + do_left_box_p = g->left_box_line_p && + g->slice.img.x == 0; + do_right_box_p = g->right_box_line_p && + g->slice.img.x + g->slice.img.width == img->width; + } + else + { + struct image *img = IMAGE_FROM_ID (WINDOW_XFRAME (w), + g->u.img_id); + do_left_box_p = g->left_box_line_p && + g->slice.img.x + g->slice.img.width == img->width; + do_right_box_p = g->right_box_line_p && + g->slice.img.x == 0; + } + } + + /* If the glyph has a left box line, subtract it from the offset. */ + if (do_left_box_p) + sum -= max (0, original_face->box_vertical_line_width); + /* Likewise with the right box line, as there may be a + box there as well. */ + if (do_right_box_p) + sum -= max (0, original_face->box_vertical_line_width); + /* Now add the line widths from the new face. */ + if (g->left_box_line_p) + sum += max (0, mouse_face->box_vertical_line_width); + if (g->right_box_line_p) + sum += max (0, mouse_face->box_vertical_line_width); + + return sum; +} + +/* Get the offset due to mouse-highlight to apply before drawing + phys_cursor, and return it in OFFSET. ROW should be the row that + is under mouse face and contains the phys cursor. + + This is required because the produce_XXX_glyph series of functions + add the width of the various vertical box lines to the total width + of the glyphs, but that must be updated when the row is put under + mouse face, which can have different box dimensions. */ +static void +get_cursor_offset_for_mouse_face (struct window *w, struct glyph_row *row, + int *offset) +{ + int sum = 0; + /* Return because the mode line can't possibly have a cursor. */ + if (row->mode_line_p) + return; + + block_input (); + + struct frame *f = WINDOW_XFRAME (w); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); + struct glyph *start, *end; + struct face *mouse_face = FACE_FROM_ID (f, hlinfo->mouse_face_face_id); + int hpos = w->phys_cursor.hpos; + end = &row->glyphs[TEXT_AREA][hpos]; + + if (!row->reversed_p) + { + if (MATRIX_ROW_VPOS (row, w->current_matrix) == + hlinfo->mouse_face_beg_row) + start = &row->glyphs[TEXT_AREA][hlinfo->mouse_face_beg_col]; + else + start = row->glyphs[TEXT_AREA]; + } + else + { + if (MATRIX_ROW_VPOS (row, w->current_matrix) == + hlinfo->mouse_face_end_row) + start = &row->glyphs[TEXT_AREA][hlinfo->mouse_face_end_col]; + else + start = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; + } + + /* Calculate the offset by which to correct phys_cursor x if we are + drawing the cursor inside mouse-face highlighted text. */ + + for ( ; row->reversed_p ? start > end : start < end; + row->reversed_p ? --start : ++start) + sum += adjust_glyph_width_for_mouse_face (start, row, w, + FACE_FROM_ID (f, start->face_id), + mouse_face); + + if (row->reversed_p) + sum = -sum; + + *offset = sum; + + unblock_input (); +} #endif /* HAVE_WINDOW_SYSTEM */ diff --git a/src/xfaces.c b/src/xfaces.c index 37ad11b713c..d4e6270e493 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -698,7 +698,8 @@ clear_face_cache (bool clear_fonts_p) { struct frame *f = XFRAME (frame); if (FRAME_WINDOW_P (f) - && FRAME_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS) + && FRAME_DISPLAY_INFO (f)->n_fonts > CLEAR_FONT_TABLE_NFONTS + && !f->inhibit_clear_image_cache) { clear_font_cache (f); free_all_realized_faces (frame); @@ -2443,11 +2444,11 @@ evaluate_face_filter (Lisp_Object filter, struct window *w, /* Determine whether FACE_REF is a "filter" face specification (case #4 in merge_face_ref). If it is, evaluate the filter, and if the filter matches, return the filtered face spec. If the filter does - not match, return `nil'. If FACE_REF is not a filtered face + not match, return nil. If FACE_REF is not a filtered face specification, return FACE_REF. On error, set *OK to false, having logged an error message if - ERR_MSGS is true, and return `nil'. Otherwise, *OK is not touched. + ERR_MSGS is true, and return nil. Otherwise, *OK is not touched. W is either NULL or a window used to evaluate filters. If W is NULL, no window-based face specification filter matches. @@ -2732,7 +2733,7 @@ merge_face_ref (struct window *w, { if (EQ (value, Qt)) value = make_fixnum (1); - if (FIXNUMP (value) + if ((FIXNUMP (value) && XFIXNUM (value) != 0) || STRINGP (value) || CONSP (value) || NILP (value)) @@ -5116,8 +5117,8 @@ gui_supports_face_attributes_p (struct frame *f, { Lisp_Object *def_attrs = def_face->lface; - /* Check that other specified attributes are different that the default - face. */ + /* Check that other specified attributes are different from the + default face. */ if ((!UNSPECIFIEDP (attrs[LFACE_UNDERLINE_INDEX]) && face_attr_equal_p (attrs[LFACE_UNDERLINE_INDEX], def_attrs[LFACE_UNDERLINE_INDEX])) @@ -5396,6 +5397,10 @@ DEFUN ("display-supports-face-attributes-p", The optional argument DISPLAY can be a display name, a frame, or nil (meaning the selected frame's display). +For instance, to check whether the display supports underlining: + + (display-supports-face-attributes-p \\='(:underline t)) + The definition of `supported' is somewhat heuristic, but basically means that a face containing all the attributes in ATTRIBUTES, when merged with the default face for display, can be represented in a way that's @@ -6956,13 +6961,20 @@ syms_of_xfaces (void) DEFSYM (Qpressed_button, "pressed-button"); DEFSYM (Qflat_button, "flat-button"); DEFSYM (Qnormal, "normal"); + DEFSYM (Qthin, "thin"); DEFSYM (Qextra_light, "extra-light"); + DEFSYM (Qultra_light, "ultra-light"); DEFSYM (Qlight, "light"); DEFSYM (Qsemi_light, "semi-light"); + DEFSYM (Qmedium, "medium"); DEFSYM (Qsemi_bold, "semi-bold"); + DEFSYM (Qbook, "book"); DEFSYM (Qbold, "bold"); DEFSYM (Qextra_bold, "extra-bold"); DEFSYM (Qultra_bold, "ultra-bold"); + DEFSYM (Qheavy, "heavy"); + DEFSYM (Qultra_heavy, "ultra-heavy"); + DEFSYM (Qblack, "black"); DEFSYM (Qoblique, "oblique"); DEFSYM (Qitalic, "italic"); diff --git a/src/xfns.c b/src/xfns.c index 81349d0b50d..785ae3baca5 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6222,7 +6222,7 @@ Otherwise, the return value is a vector with the following fields: static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object, Lisp_Object, int, int, int *, int *); -/* The frame of the currently visible tooltip. */ +/* The frame of the currently visible tooltip, or nil if none. */ static Lisp_Object tip_frame; /* The window-system window corresponding to the frame of the @@ -6710,7 +6710,7 @@ x_hide_tip (bool delete) if ((NILP (tip_last_frame) && NILP (tip_frame)) || (!x_gtk_use_system_tooltips && !delete - && FRAMEP (tip_frame) + && !NILP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame)) && !FRAME_VISIBLE_P (XFRAME (tip_frame)))) /* Either there's no tooltip to hide or it's an already invisible @@ -6727,7 +6727,7 @@ x_hide_tip (bool delete) specbind (Qinhibit_quit, Qt); /* Try to hide the GTK+ system tip first. */ - if (FRAMEP (tip_last_frame)) + if (!NILP (tip_last_frame)) { struct frame *f = XFRAME (tip_last_frame); @@ -6745,7 +6745,7 @@ x_hide_tip (bool delete) tip_last_frame = Qnil; /* Now look whether there's an Emacs tip around. */ - if (FRAMEP (tip_frame)) + if (!NILP (tip_frame)) { struct frame *f = XFRAME (tip_frame); @@ -6775,7 +6775,7 @@ x_hide_tip (bool delete) #else /* not USE_GTK */ if (NILP (tip_frame) || (!delete - && FRAMEP (tip_frame) + && !NILP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame)) && !FRAME_VISIBLE_P (XFRAME (tip_frame)))) return Qnil; @@ -6788,7 +6788,7 @@ x_hide_tip (bool delete) specbind (Qinhibit_redisplay, Qt); specbind (Qinhibit_quit, Qt); - if (FRAMEP (tip_frame)) + if (!NILP (tip_frame)) { struct frame *f = XFRAME (tip_frame); @@ -6931,7 +6931,7 @@ Text larger than the specified size is clipped. */) } #endif /* USE_GTK */ - if (FRAMEP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame))) + if (!NILP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame))) { if (FRAME_VISIBLE_P (XFRAME (tip_frame)) && EQ (frame, tip_last_frame) @@ -7016,7 +7016,7 @@ Text larger than the specified size is clipped. */) tip_last_string = string; tip_last_parms = parms; - if (!FRAMEP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame))) + if (NILP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame))) { /* Add default values to frame parameters. */ if (NILP (Fassq (Qname, parms))) @@ -7836,7 +7836,6 @@ syms_of_xfns (void) DEFSYM (Qfont_parameter, "font-parameter"); DEFSYM (Qmono, "mono"); DEFSYM (Qassq_delete_all, "assq-delete-all"); - DEFSYM (Qhide, "hide"); DEFSYM (Qresize_mode, "resize-mode"); #ifdef USE_CAIRO diff --git a/src/xmenu.c b/src/xmenu.c index a6762236bc4..ea2cbab2030 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1603,6 +1603,14 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, STRINGP (help) ? help : Qnil); if (prev_wv) prev_wv->next = wv; + else if (!save_wv) + { + /* This emacs_abort call pacifies gcc 11.2.1 when Emacs + is configured with --enable-gcc-warnings. FIXME: If + save_wv can be null, do something better; otherwise, + explain why save_wv cannot be null. */ + emacs_abort (); + } else save_wv->contents = wv; if (!NILP (descrip)) diff --git a/src/xterm.c b/src/xterm.c index 1887c3255d4..172abe919dd 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1563,22 +1563,6 @@ x_set_cursor_gc (struct glyph_string *s) static void x_set_mouse_face_gc (struct glyph_string *s) { - int face_id; - struct face *face; - - /* What face has to be used last for the mouse face? */ - face_id = MOUSE_HL_INFO (s->f)->mouse_face_face_id; - face = FACE_FROM_ID_OR_NULL (s->f, face_id); - if (face == NULL) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - - if (s->first_glyph->type == CHAR_GLYPH) - face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil); - else - face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil); - s->face = FACE_FROM_ID (s->f, face_id); - prepare_face_for_display (s->f, s->face); - if (s->font == s->face->font) s->gc = s->face->gc; else @@ -3209,11 +3193,14 @@ x_draw_image_relief (struct glyph_string *s) if (s->hl == DRAW_IMAGE_SUNKEN || s->hl == DRAW_IMAGE_RAISED) { - thick = (tab_bar_button_relief < 0 - ? DEFAULT_TAB_BAR_BUTTON_RELIEF - : (tool_bar_button_relief < 0 - ? DEFAULT_TOOL_BAR_BUTTON_RELIEF - : min (tool_bar_button_relief, 1000000))); + if (s->face->id == TAB_BAR_FACE_ID) + thick = (tab_bar_button_relief < 0 + ? DEFAULT_TAB_BAR_BUTTON_RELIEF + : min (tab_bar_button_relief, 1000000)); + else + thick = (tool_bar_button_relief < 0 + ? DEFAULT_TOOL_BAR_BUTTON_RELIEF + : min (tool_bar_button_relief, 1000000)); raised_p = s->hl == DRAW_IMAGE_RAISED; } else @@ -3232,11 +3219,11 @@ x_draw_image_relief (struct glyph_string *s) && FIXNUMP (XCAR (Vtab_bar_button_margin)) && FIXNUMP (XCDR (Vtab_bar_button_margin))) { - extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin)); - extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin)); + extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin)) - thick; + extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin)) - thick; } else if (FIXNUMP (Vtab_bar_button_margin)) - extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin); + extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin) - thick; } if (s->face->id == TOOL_BAR_FACE_ID) @@ -3585,29 +3572,15 @@ x_draw_stretch_glyph_string (struct glyph_string *s) else if (!s->background_filled_p) { int background_width = s->background_width; - int x = s->x, text_left_x = window_box_left_offset (s->w, TEXT_AREA); + int x = s->x, text_left_x = window_box_left (s->w, TEXT_AREA); /* Don't draw into left fringe or scrollbar area except for header line and mode line. */ - if (x < text_left_x && !s->row->mode_line_p) + if (s->area == TEXT_AREA + && x < text_left_x && !s->row->mode_line_p) { - int left_x = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (s->w); - int right_x = text_left_x; - - if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w)) - left_x += WINDOW_LEFT_FRINGE_WIDTH (s->w); - else - right_x -= WINDOW_LEFT_FRINGE_WIDTH (s->w); - - /* Adjust X and BACKGROUND_WIDTH to fit inside the space - between LEFT_X and RIGHT_X. */ - if (x < left_x) - { - background_width -= left_x - x; - x = left_x; - } - if (x + background_width > right_x) - background_width = right_x - x; + background_width -= text_left_x - x; + x = text_left_x; } if (background_width > 0) x_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height); @@ -4060,7 +4033,7 @@ x_delete_glyphs (struct frame *f, int n) /* Like XClearArea, but check that WIDTH and HEIGHT are reasonable. If they are <= 0, this is probably an error. */ -static ATTRIBUTE_UNUSED void +MAYBE_UNUSED static void x_clear_area1 (Display *dpy, Window window, int x, int y, int width, int height, int exposures) { @@ -4153,6 +4126,8 @@ x_show_hourglass (struct frame *f) XMapRaised (dpy, x->hourglass_window); XFlush (dpy); + /* Ensure that the spinning hourglass is shown. */ + flush_frame (f); } } } @@ -4416,6 +4391,99 @@ x_scroll_run (struct window *w, struct run *run) /* Cursor off. Will be switched on again in gui_update_window_end. */ gui_clear_cursor (w); +#ifdef HAVE_XWIDGETS + /* "Copy" xwidget windows in the area that will be scrolled. */ + Display *dpy = FRAME_X_DISPLAY (f); + Window window = FRAME_X_WINDOW (f); + + Window root, parent, *children; + unsigned int nchildren; + + if (XQueryTree (dpy, window, &root, &parent, &children, &nchildren)) + { + /* Now find xwidget views situated between from_y and to_y, and + attached to w. */ + for (unsigned int i = 0; i < nchildren; ++i) + { + Window child = children[i]; + struct xwidget_view *view = xwidget_view_from_window (child); + + if (view && !view->hidden) + { + int window_y = view->y + view->clip_top; + int window_height = view->clip_bottom - view->clip_top; + + Emacs_Rectangle r1, r2, result; + r1.x = w->pixel_left; + r1.y = from_y; + r1.width = w->pixel_width; + r1.height = height; + r2 = r1; + r2.y = window_y; + r2.height = window_height; + + /* The window is offscreen, just unmap it. */ + if (window_height == 0) + { + view->hidden = true; + XUnmapWindow (dpy, child); + continue; + } + + bool intersects_p = + gui_intersect_rectangles (&r1, &r2, &result); + + if (XWINDOW (view->w) == w && intersects_p) + { + int y = view->y + (to_y - from_y); + int text_area_x, text_area_y, text_area_width, text_area_height; + int clip_top, clip_bottom; + + window_box (w, TEXT_AREA, &text_area_x, &text_area_y, + &text_area_width, &text_area_height); + + view->y = y; + + clip_top = 0; + clip_bottom = XXWIDGET (view->model)->height; + + if (y < text_area_y) + clip_top = text_area_y - y; + + if ((y + clip_bottom) > (text_area_y + text_area_height)) + { + clip_bottom -= (y + clip_bottom) - (text_area_y + text_area_height); + } + + view->clip_top = clip_top; + view->clip_bottom = clip_bottom; + + /* This means the view has moved offscreen. Unmap + it and hide it here. */ + if ((view->clip_bottom - view->clip_top) <= 0) + { + view->hidden = true; + XUnmapWindow (dpy, child); + } + else + { + XMoveResizeWindow (dpy, child, view->x + view->clip_left, + view->y + view->clip_top, + view->clip_right - view->clip_left, + view->clip_bottom - view->clip_top); + cairo_xlib_surface_set_size (view->cr_surface, + view->clip_right - view->clip_left, + view->clip_bottom - view->clip_top); + } + xwidget_expose (view); + XFlush (dpy); + } + } + } + XFree (children); + } +#endif + #ifdef USE_CAIRO if (FRAME_CR_CONTEXT (f)) { @@ -4589,8 +4657,9 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra } } -/* Return the Emacs frame-object corresponding to an X window. - It could be the frame's main window or an icon window. */ +/* Return the Emacs frame-object corresponding to an X window. It + could be the frame's main window, an icon window, or an xwidget + window. */ static struct frame * x_window_to_frame (struct x_display_info *dpyinfo, int wdesc) @@ -4601,6 +4670,13 @@ x_window_to_frame (struct x_display_info *dpyinfo, int wdesc) if (wdesc == None) return NULL; +#ifdef HAVE_XWIDGETS + struct xwidget_view *xvw = xwidget_view_from_window (wdesc); + + if (xvw && xvw->frame) + return xvw->frame; +#endif + FOR_EACH_FRAME (tail, frame) { f = XFRAME (frame); @@ -5023,7 +5099,7 @@ x_x_to_emacs_modifiers (struct x_display_info *dpyinfo, int state) | ((state & dpyinfo->hyper_mod_mask) ? mod_hyper : 0)); } -static int +int x_emacs_to_x_modifiers (struct x_display_info *dpyinfo, intmax_t state) { EMACS_INT mod_ctrl = ctrl_modifier; @@ -8237,6 +8313,18 @@ handle_one_xevent (struct x_display_info *dpyinfo, case Expose: f = x_window_to_frame (dpyinfo, event->xexpose.window); +#ifdef HAVE_XWIDGETS + { + struct xwidget_view *xv = + xwidget_view_from_window (event->xexpose.window); + + if (xv) + { + xwidget_expose (xv); + goto OTHER; + } + } +#endif if (f) { if (!FRAME_VISIBLE_P (f)) @@ -8817,6 +8905,31 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_display_set_last_user_time (dpyinfo, event->xcrossing.time); x_detect_focus_change (dpyinfo, any, event, &inev.ie); +#ifdef HAVE_XWIDGETS + { + struct xwidget_view *xvw = xwidget_view_from_window (event->xcrossing.window); + Mouse_HLInfo *hlinfo; + + if (xvw) + { + xwidget_motion_or_crossing (xvw, event); + hlinfo = MOUSE_HL_INFO (xvw->frame); + + if (xvw->frame == hlinfo->mouse_face_mouse_frame) + { + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = 0; + } + + if (any_help_event_p) + { + do_help = -1; + } + goto OTHER; + } + } +#endif + f = any; if (f && x_mouse_click_focus_ignore_position) @@ -8860,6 +8973,17 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case LeaveNotify: +#ifdef HAVE_XWIDGETS + { + struct xwidget_view *xvw = xwidget_view_from_window (event->xcrossing.window); + + if (xvw) + { + xwidget_motion_or_crossing (xvw, event); + goto OTHER; + } + } +#endif x_display_set_last_user_time (dpyinfo, event->xcrossing.time); x_detect_focus_change (dpyinfo, any, event, &inev.ie); @@ -8910,6 +9034,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (f && xg_event_is_for_scrollbar (f, event)) f = 0; #endif +#ifdef HAVE_XWIDGETS + struct xwidget_view *xvw = xwidget_view_from_window (event->xmotion.window); + + if (xvw) + xwidget_motion_or_crossing (xvw, event); +#endif if (f) { /* Maybe generate a SELECT_WINDOW_EVENT for @@ -9164,8 +9294,27 @@ handle_one_xevent (struct x_display_info *dpyinfo, case ButtonRelease: case ButtonPress: { +#ifdef HAVE_XWIDGETS + struct xwidget_view *xvw = xwidget_view_from_window (event->xmotion.window); + + if (xvw) + { + xwidget_button (xvw, event->type == ButtonPress, + event->xbutton.x, event->xbutton.y, + event->xbutton.button, event->xbutton.state, + event->xbutton.time); + + if (!EQ (selected_window, xvw->w)) + { + inev.ie.kind = SELECT_WINDOW_EVENT; + inev.ie.frame_or_window = xvw->w; + } + goto OTHER; + } +#endif /* If we decide we want to generate an event to be seen by the rest of Emacs, we put it here. */ + Lisp_Object tab_bar_arg = Qnil; bool tab_bar_p = false; bool tool_bar_p = false; @@ -9214,8 +9363,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, window = window_from_coordinates (f, x, y, 0, true, true); tab_bar_p = EQ (window, f->tab_bar_window); - if (tab_bar_p && event->xbutton.button < 4) - handle_tab_bar_click + if (tab_bar_p) + tab_bar_arg = handle_tab_bar_click (f, x, y, event->xbutton.type == ButtonPress, x_x_to_emacs_modifiers (dpyinfo, event->xbutton.state)); } @@ -9239,7 +9388,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #endif /* !USE_GTK */ - if (!tab_bar_p && !tool_bar_p) + if (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p) #if defined (USE_X_TOOLKIT) || defined (USE_GTK) if (! popup_activated ()) #endif @@ -9257,6 +9406,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, } else x_construct_mouse_click (&inev.ie, &event->xbutton, f); + + if (!NILP (tab_bar_arg)) + inev.ie.arg = tab_bar_arg; } if (FRAME_X_EMBEDDED_P (f)) xembed_send_message (f, event->xbutton.time, @@ -10140,8 +10292,9 @@ x_connection_closed (Display *dpy, const char *error_message, bool ioerror) frame on it. */ dpyinfo->reference_count++; dpyinfo->terminal->reference_count++; + if (ioerror) + dpyinfo->display = 0; } - if (ioerror) dpyinfo->display = 0; /* First delete frames whose mini-buffers are on frames that are on the dead display. */ @@ -12129,6 +12282,10 @@ x_free_frame_resources (struct frame *f) xfree (f->shell_position); #else /* !USE_X_TOOLKIT */ +#ifdef HAVE_XWIDGETS + kill_frame_xwidget_views (f); +#endif + #ifdef USE_GTK xg_free_frame_widgets (f); #endif /* USE_GTK */ diff --git a/src/xterm.h b/src/xterm.h index de6ea50385d..9d9534dd629 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1108,6 +1108,7 @@ extern void x_mouse_leave (struct x_display_info *); extern int x_dispatch_event (XEvent *, Display *); #endif extern int x_x_to_emacs_modifiers (struct x_display_info *, int); +extern int x_emacs_to_x_modifiers (struct x_display_info *, intmax_t); #ifdef USE_CAIRO extern void x_cr_destroy_frame_context (struct frame *); extern void x_cr_update_surface_desired_size (struct frame *, int, int); diff --git a/src/xwidget.c b/src/xwidget.c index ce55af8a4b4..6e2e8a9270e 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -19,6 +19,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> +#include "buffer.h" #include "xwidget.h" #include "lisp.h" @@ -35,10 +36,27 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifdef USE_GTK #include <webkit2/webkit2.h> #include <JavaScriptCore/JavaScript.h> +#include <cairo.h> +#include <X11/Xlib.h> #elif defined NS_IMPL_COCOA #include "nsxwidget.h" #endif +static Lisp_Object id_to_xwidget_map; +static uint32_t xwidget_counter = 0; + +#ifdef USE_GTK +static Lisp_Object x_window_to_xwv_map; +static gboolean offscreen_damage_event (GtkWidget *, GdkEvent *, gpointer); +static void synthesize_focus_in_event (GtkWidget *); +static GdkDevice *find_suitable_keyboard (struct frame *); +static gboolean webkit_script_dialog_cb (WebKitWebView *, WebKitScriptDialog *, + gpointer); +static void record_osr_embedder (struct xwidget_view *); +static void from_embedder (GdkWindow *, double, double, gpointer, gpointer, gpointer); +static void to_embedder (GdkWindow *, double, double, gpointer, gpointer, gpointer); +#endif + static struct xwidget * allocate_xwidget (void) { @@ -64,18 +82,32 @@ static void webkit_javascript_finished_cb (GObject *, GAsyncResult *, gpointer); static gboolean webkit_download_cb (WebKitWebContext *, WebKitDownload *, gpointer); - +static GtkWidget *webkit_create_cb (WebKitWebView *, WebKitNavigationAction *, gpointer); static gboolean webkit_decide_policy_cb (WebKitWebView *, WebKitPolicyDecision *, WebKitPolicyDecisionType, gpointer); +static GtkWidget *find_widget_at_pos (GtkWidget *, int, int, int *, int *); + +struct widget_search_data +{ + int x; + int y; + bool foundp; + bool first; + GtkWidget *data; +}; + +static void find_widget (GtkWidget *t, struct widget_search_data *); +static void mouse_target_changed (WebKitWebView *, WebKitHitTestResult *, guint, + gpointer); #endif DEFUN ("make-xwidget", Fmake_xwidget, Smake_xwidget, - 5, 6, 0, + 4, 7, 0, doc: /* Make an xwidget of TYPE. If BUFFER is nil, use the current buffer. If BUFFER is a string and no such buffer exists, create it. @@ -83,10 +115,13 @@ TYPE is a symbol which can take one of the following values: - webkit -Returns the newly constructed xwidget, or nil if construction fails. */) +RELATED is nil, or an xwidget. When constructing a WebKit widget, it +will share the same settings and internal subprocess as RELATED. +Returns the newly constructed xwidget, or nil if construction +fails. */) (Lisp_Object type, Lisp_Object title, Lisp_Object width, Lisp_Object height, - Lisp_Object arguments, Lisp_Object buffer) + Lisp_Object arguments, Lisp_Object buffer, Lisp_Object related) { #ifdef USE_GTK if (!xg_gtk_initialized) @@ -96,6 +131,9 @@ Returns the newly constructed xwidget, or nil if construction fails. */) CHECK_FIXNAT (width); CHECK_FIXNAT (height); + if (!EQ (type, Qwebkit)) + error ("Bad xwidget type"); + struct xwidget *xw = allocate_xwidget (); Lisp_Object val; xw->type = type; @@ -108,13 +146,19 @@ Returns the newly constructed xwidget, or nil if construction fails. */) XSETXWIDGET (val, xw); Vxwidget_list = Fcons (val, Vxwidget_list); xw->plist = Qnil; + xw->xwidget_id = ++xwidget_counter; + xw->find_text = NULL; + + Fputhash (make_fixnum (xw->xwidget_id), val, id_to_xwidget_map); #ifdef USE_GTK xw->widgetwindow_osr = NULL; xw->widget_osr = NULL; + xw->hit_result = 0; if (EQ (xw->type, Qwebkit)) { block_input (); + WebKitSettings *settings; WebKitWebContext *webkit_context = webkit_web_context_get_default (); # if WEBKIT_CHECK_VERSION (2, 26, 0) @@ -132,18 +176,33 @@ Returns the newly constructed xwidget, or nil if construction fails. */) if (EQ (xw->type, Qwebkit)) { - xw->widget_osr = webkit_web_view_new (); - - /* webkitgtk uses GSubprocess which sets sigaction causing - Emacs to not catch SIGCHLD with its usual handle setup in - catch_child_signal(). This resets the SIGCHLD - sigaction. */ - struct sigaction old_action; - sigaction (SIGCHLD, NULL, &old_action); - webkit_web_view_load_uri(WEBKIT_WEB_VIEW (xw->widget_osr), - "about:blank"); - sigaction (SIGCHLD, &old_action, NULL); - } + WebKitWebView *related_view; + + if (NILP (related) + || !XWIDGETP (related) + || !EQ (XXWIDGET (related)->type, Qwebkit)) + { + xw->widget_osr = webkit_web_view_new (); + + /* webkitgtk uses GSubprocess which sets sigaction causing + Emacs to not catch SIGCHLD with its usual handle setup in + 'catch_child_signal'. This resets the SIGCHLD sigaction. */ + struct sigaction old_action; + sigaction (SIGCHLD, NULL, &old_action); + webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), + "about:blank"); + sigaction (SIGCHLD, &old_action, NULL); + } + else + { + related_view = WEBKIT_WEB_VIEW (XXWIDGET (related)->widget_osr); + xw->widget_osr = webkit_web_view_new_with_related_view (related_view); + } + + /* Enable the developer extras. */ + settings = webkit_web_view_get_settings (WEBKIT_WEB_VIEW (xw->widget_osr)); + g_object_set (G_OBJECT (settings), "enable-developer-extras", TRUE, NULL); + } gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, xw->height); @@ -161,6 +220,13 @@ Returns the newly constructed xwidget, or nil if construction fails. */) gtk_widget_show (xw->widget_osr); gtk_widget_show (xw->widgetwindow_osr); + synthesize_focus_in_event (xw->widgetwindow_osr); + + + g_signal_connect (G_OBJECT (gtk_widget_get_window (xw->widgetwindow_osr)), + "from-embedder", G_CALLBACK (from_embedder), NULL); + g_signal_connect (G_OBJECT (gtk_widget_get_window (xw->widgetwindow_osr)), + "to-embedder", G_CALLBACK (to_embedder), NULL); /* Store some xwidget data in the gtk widgets for convenient retrieval in the event handlers. */ @@ -183,8 +249,24 @@ Returns the newly constructed xwidget, or nil if construction fails. */) G_CALLBACK (webkit_decide_policy_cb), xw); + + g_signal_connect (G_OBJECT (xw->widget_osr), + "mouse-target-changed", + G_CALLBACK (mouse_target_changed), + xw); + g_signal_connect (G_OBJECT (xw->widget_osr), + "create", + G_CALLBACK (webkit_create_cb), + xw); + g_signal_connect (G_OBJECT (xw->widget_osr), + "script-dialog", + G_CALLBACK (webkit_script_dialog_cb), + NULL); } + g_signal_connect (G_OBJECT (xw->widgetwindow_osr), "damage-event", + G_CALLBACK (offscreen_damage_event), xw); + unblock_input (); } #elif defined NS_IMPL_COCOA @@ -194,6 +276,156 @@ Returns the newly constructed xwidget, or nil if construction fails. */) return val; } +#ifdef USE_GTK +static void +set_widget_if_text_view (GtkWidget *widget, void *data) +{ + GtkWidget **pointer = data; + + if (GTK_IS_TEXT_VIEW (widget)) + *pointer = widget; +} +#endif + +DEFUN ("xwidget-perform-lispy-event", + Fxwidget_perform_lispy_event, Sxwidget_perform_lispy_event, + 2, 3, 0, doc: /* Send a lispy event to XWIDGET. +EVENT should be the event that will be sent. FRAME should be the +frame which generated the event, and defaults to the selected frame. +On X11, modifier keys will not be processed if FRAME is nil and the +selected frame is not an X-Windows frame. */) + (Lisp_Object xwidget, Lisp_Object event, Lisp_Object frame) +{ + struct xwidget *xw; + struct frame *f = NULL; + int character = -1, keycode = -1; + int modifiers = 0; + +#ifdef USE_GTK + GdkEvent *xg_event; + GtkContainerClass *klass; + GtkWidget *widget; + GtkWidget *temp = NULL; +#endif + + CHECK_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + + if (!NILP (frame)) + f = decode_window_system_frame (frame); + else if (FRAME_X_P (SELECTED_FRAME ())) + f = SELECTED_FRAME (); + +#ifdef USE_GTK + widget = gtk_window_get_focus (GTK_WINDOW (xw->widgetwindow_osr)); + + if (!widget) + widget = xw->widget_osr; + + if (RANGED_FIXNUMP (0, event, INT_MAX)) + { + character = XFIXNUM (event); + + if (character < 32) + modifiers |= ctrl_modifier; + + modifiers |= character & meta_modifier; + modifiers |= character & hyper_modifier; + modifiers |= character & super_modifier; + modifiers |= character & shift_modifier; + modifiers |= character & ctrl_modifier; + + character = character & ~(1 << 21); + + if (character < 32) + character += '_'; + + if (f) + modifiers = x_emacs_to_x_modifiers (FRAME_DISPLAY_INFO (f), modifiers); + else + modifiers = 0; + } + else if (SYMBOLP (event)) + { + Lisp_Object decoded = parse_modifiers (event); + Lisp_Object decoded_name = SYMBOL_NAME (XCAR (decoded)); + + int off = 0; + bool found = false; + + while (off < 256) + { + if (lispy_function_keys[off] + && !strcmp (lispy_function_keys[off], + SSDATA (decoded_name))) + { + found = true; + break; + } + ++off; + } + + if (f) + modifiers = x_emacs_to_x_modifiers (FRAME_DISPLAY_INFO (f), + XFIXNUM (XCAR (XCDR (decoded)))); + else + modifiers = 0; + + if (found) + keycode = off + 0xff00; + } + + if (character == -1 && keycode == -1) + return Qnil; + + block_input (); + xg_event = gdk_event_new (GDK_KEY_PRESS); + xg_event->any.window = gtk_widget_get_window (xw->widget_osr); + g_object_ref (xg_event->any.window); + + if (character > -1) + keycode = gdk_unicode_to_keyval (character); + + xg_event->key.keyval = keycode; + xg_event->key.state = modifiers; + + if (keycode > -1) + { + /* WebKitGTK internals abuse follows. */ + if (WEBKIT_IS_WEB_VIEW (widget)) + { + /* WebKitGTK relies on an internal GtkTextView object to + "translate" keys such as backspace. We must find that + widget and activate its binding to this key if any. */ + klass = GTK_CONTAINER_CLASS (G_OBJECT_GET_CLASS (widget)); + + klass->forall (GTK_CONTAINER (xw->widget_osr), TRUE, + set_widget_if_text_view, &temp); + + if (GTK_IS_WIDGET (temp)) + { + if (!gtk_widget_get_realized (temp)) + gtk_widget_realize (temp); + + gtk_bindings_activate (G_OBJECT (temp), keycode, modifiers); + } + } + } + + if (f) + gdk_event_set_device (xg_event, + find_suitable_keyboard (SELECTED_FRAME ())); + + gtk_main_do_event (xg_event); + xg_event->type = GDK_KEY_RELEASE; + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + unblock_input (); +#endif + + return Qnil; +} + DEFUN ("get-buffer-xwidgets", Fget_buffer_xwidgets, Sget_buffer_xwidgets, 1, 1, 0, doc: /* Return a list of xwidgets associated with BUFFER. @@ -225,16 +457,505 @@ xwidget_hidden (struct xwidget_view *xv) return xv->hidden; } +struct xwidget * +xwidget_from_id (uint32_t id) +{ + Lisp_Object key = make_fixnum (id); + Lisp_Object xwidget = Fgethash (key, id_to_xwidget_map, Qnil); + + if (NILP (xwidget)) + emacs_abort (); + + return XXWIDGET (xwidget); +} + #ifdef USE_GTK static void +record_osr_embedder (struct xwidget_view *view) +{ + struct xwidget *xw; + GdkWindow *window, *embedder; + + xw = XXWIDGET (view->model); + window = gtk_widget_get_window (xw->widgetwindow_osr); + embedder = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (view->frame)); + + gdk_offscreen_window_set_embedder (window, embedder); + xw->embedder = view->frame; + xw->embedder_view = view; +} + +static struct xwidget * +find_xwidget_for_offscreen_window (GdkWindow *window) +{ + Lisp_Object tem; + struct xwidget *xw; + GdkWindow *w; + + for (tem = Vxwidget_list; CONSP (tem); tem = XCDR (tem)) + { + if (XWIDGETP (XCAR (tem))) + { + xw = XXWIDGET (XCAR (tem)); + w = gtk_widget_get_window (xw->widgetwindow_osr); + + if (w == window) + return xw; + } + } + + return NULL; +} + +static void +from_embedder (GdkWindow *window, double x, double y, + gpointer x_out_ptr, gpointer y_out_ptr, + gpointer user_data) +{ + double *xout = x_out_ptr; + double *yout = y_out_ptr; + struct xwidget *xw = find_xwidget_for_offscreen_window (window); + struct xwidget_view *xvw; + gint xoff, yoff; + + if (!xw) + emacs_abort (); + + xvw = xw->embedder_view; + + if (!xvw) + { + *xout = x; + *yout = y; + } + else + { + gtk_widget_translate_coordinates (FRAME_GTK_WIDGET (xvw->frame), + FRAME_GTK_OUTER_WIDGET (xvw->frame), + 0, 0, &xoff, &yoff); + + *xout = x - xvw->x - xoff; + *yout = y - xvw->y - yoff; + } +} + +static void +to_embedder (GdkWindow *window, double x, double y, + gpointer x_out_ptr, gpointer y_out_ptr, + gpointer user_data) +{ + double *xout = x_out_ptr; + double *yout = y_out_ptr; + struct xwidget *xw = find_xwidget_for_offscreen_window (window); + struct xwidget_view *xvw; + gint xoff, yoff; + + if (!xw) + emacs_abort (); + + xvw = xw->embedder_view; + + if (!xvw) + { + *xout = x; + *yout = y; + } + else + { + gtk_widget_translate_coordinates (FRAME_GTK_WIDGET (xvw->frame), + FRAME_GTK_OUTER_WIDGET (xvw->frame), + 0, 0, &xoff, &yoff); + + *xout = x + xvw->x + xoff; + *yout = y + xvw->y + yoff; + } +} + +static GdkDevice * +find_suitable_pointer (struct frame *f) +{ + GdkSeat *seat = gdk_display_get_default_seat + (gtk_widget_get_display (FRAME_GTK_WIDGET (f))); + + if (!seat) + return NULL; + + return gdk_seat_get_pointer (seat); +} + +static GdkDevice * +find_suitable_keyboard (struct frame *f) +{ + GdkSeat *seat = gdk_display_get_default_seat + (gtk_widget_get_display (FRAME_GTK_WIDGET (f))); + + if (!seat) + return NULL; + + return gdk_seat_get_keyboard (seat); +} + +static void +find_widget_cb (GtkWidget *widget, void *user) +{ + find_widget (widget, user); +} + +static void +find_widget (GtkWidget *widget, + struct widget_search_data *data) +{ + GtkAllocation new_allocation; + GdkWindow *window; + int x_offset = 0; + int y_offset = 0; + + gtk_widget_get_allocation (widget, &new_allocation); + + if (gtk_widget_get_has_window (widget)) + { + new_allocation.x = 0; + new_allocation.y = 0; + } + + if (gtk_widget_get_parent (widget) && !data->first) + { + window = gtk_widget_get_window (widget); + while (window != gtk_widget_get_window (gtk_widget_get_parent (widget))) + { + gint tx, ty, twidth, theight; + + if (!window) + return; + + twidth = gdk_window_get_width (window); + theight = gdk_window_get_height (window); + + if (new_allocation.x < 0) + { + new_allocation.width += new_allocation.x; + new_allocation.x = 0; + } + + if (new_allocation.y < 0) + { + new_allocation.height += new_allocation.y; + new_allocation.y = 0; + } + + if (new_allocation.x + new_allocation.width > twidth) + new_allocation.width = twidth - new_allocation.x; + if (new_allocation.y + new_allocation.height > theight) + new_allocation.height = theight - new_allocation.y; + + gdk_window_get_position (window, &tx, &ty); + new_allocation.x += tx; + x_offset += tx; + new_allocation.y += ty; + y_offset += ty; + + window = gdk_window_get_parent (window); + } + } + + if ((data->x >= new_allocation.x) && (data->y >= new_allocation.y) && + (data->x < new_allocation.x + new_allocation.width) && + (data->y < new_allocation.y + new_allocation.height)) + { + /* First, check if the drag is in a valid drop site in one of + our children. */ + if (GTK_IS_CONTAINER (widget)) + { + struct widget_search_data new_data = *data; + + new_data.x -= x_offset; + new_data.y -= y_offset; + new_data.foundp = false; + new_data.first = false; + + gtk_container_forall (GTK_CONTAINER (widget), + find_widget_cb, &new_data); + + data->foundp = new_data.foundp; + if (data->foundp) + data->data = new_data.data; + } + + /* If not, and this widget is registered as a drop site, check + to emit "drag_motion" to check if we are actually in a drop + site. */ + if (!data->foundp) + { + data->foundp = true; + data->data = widget; + } + } +} + +static GtkWidget * +find_widget_at_pos (GtkWidget *w, int x, int y, + int *new_x, int *new_y) +{ + struct widget_search_data data; + + data.x = x; + data.y = y; + data.foundp = false; + data.first = true; + + find_widget (w, &data); + + if (data.foundp) + { + gtk_widget_translate_coordinates (w, data.data, x, + y, new_x, new_y); + return data.data; + } + + *new_x = x; + *new_y = y; + + return NULL; +} + +static Emacs_Cursor +cursor_for_hit (guint result, struct frame *frame) +{ + Emacs_Cursor cursor = FRAME_OUTPUT_DATA (frame)->nontext_cursor; + + if ((result & WEBKIT_HIT_TEST_RESULT_CONTEXT_EDITABLE) + || (result & WEBKIT_HIT_TEST_RESULT_CONTEXT_SELECTION) + || (result & WEBKIT_HIT_TEST_RESULT_CONTEXT_DOCUMENT)) + cursor = FRAME_X_OUTPUT (frame)->text_cursor; + + if (result & WEBKIT_HIT_TEST_RESULT_CONTEXT_SCROLLBAR) + cursor = FRAME_X_OUTPUT (frame)->vertical_drag_cursor; + + if (result & WEBKIT_HIT_TEST_RESULT_CONTEXT_LINK) + cursor = FRAME_X_OUTPUT (frame)->hand_cursor; + + return cursor; +} + +static void +define_cursors (struct xwidget *xw, WebKitHitTestResult *res) +{ + struct xwidget_view *xvw; + + xw->hit_result = webkit_hit_test_result_get_context (res); + + for (Lisp_Object tem = Vxwidget_view_list; CONSP (tem); + tem = XCDR (tem)) + { + if (XWIDGET_VIEW_P (XCAR (tem))) + { + xvw = XXWIDGET_VIEW (XCAR (tem)); + + if (XXWIDGET (xvw->model) == xw) + { + xvw->cursor = cursor_for_hit (xw->hit_result, xvw->frame); + if (xvw->wdesc != None) + XDefineCursor (xvw->dpy, xvw->wdesc, xvw->cursor); + } + } + } +} + +static void +mouse_target_changed (WebKitWebView *webview, + WebKitHitTestResult *hitresult, + guint modifiers, gpointer xw) +{ + define_cursors (xw, hitresult); +} + + +static void +xwidget_button_1 (struct xwidget_view *view, + bool down_p, int x, int y, int button, + int modifier_state, Time time) +{ + GdkEvent *xg_event = gdk_event_new (down_p ? GDK_BUTTON_PRESS : GDK_BUTTON_RELEASE); + struct xwidget *model = XXWIDGET (view->model); + GtkWidget *target; + + /* X and Y should be relative to the origin of view->wdesc. */ + x += view->clip_left; + y += view->clip_top; + + target = find_widget_at_pos (model->widgetwindow_osr, x, y, &x, &y); + + if (!target) + target = model->widget_osr; + + xg_event->any.window = gtk_widget_get_window (target); + g_object_ref (xg_event->any.window); /* The window will be unrefed + later by gdk_event_free. */ + + xg_event->button.x = x; + xg_event->button.x_root = x; + xg_event->button.y = y; + xg_event->button.y_root = y; + xg_event->button.button = button; + xg_event->button.state = modifier_state; + xg_event->button.time = time; + xg_event->button.device = find_suitable_pointer (view->frame); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); +} + +void +xwidget_button (struct xwidget_view *view, + bool down_p, int x, int y, int button, + int modifier_state, Time time) +{ + record_osr_embedder (view); + + if (button < 4 || button > 8) + xwidget_button_1 (view, down_p, x, y, button, modifier_state, time); + else + { + GdkEvent *xg_event = gdk_event_new (GDK_SCROLL); + struct xwidget *model = XXWIDGET (view->model); + GtkWidget *target; + + x += view->clip_left; + y += view->clip_top; + + target = find_widget_at_pos (model->widgetwindow_osr, x, y, &x, &y); + + if (!target) + target = model->widget_osr; + + xg_event->any.window = gtk_widget_get_window (target); + g_object_ref (xg_event->any.window); /* The window will be unrefed + later by gdk_event_free. */ + if (button == 4) + xg_event->scroll.direction = GDK_SCROLL_UP; + else if (button == 5) + xg_event->scroll.direction = GDK_SCROLL_DOWN; + else if (button == 6) + xg_event->scroll.direction = GDK_SCROLL_LEFT; + else + xg_event->scroll.direction = GDK_SCROLL_RIGHT; + + xg_event->scroll.device = find_suitable_pointer (view->frame); + + xg_event->scroll.x = x; + xg_event->scroll.x_root = x; + xg_event->scroll.y = y; + xg_event->scroll.y_root = y; + xg_event->scroll.state = modifier_state; + xg_event->scroll.time = time; + + xg_event->scroll.delta_x = 0; + xg_event->scroll.delta_y = 0; + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + } +} + +void +xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event) +{ + GdkEvent *xg_event = gdk_event_new (event->type == MotionNotify + ? GDK_MOTION_NOTIFY + : (event->type == LeaveNotify + ? GDK_LEAVE_NOTIFY + : GDK_ENTER_NOTIFY)); + struct xwidget *model = XXWIDGET (view->model); + int x; + int y; + GtkWidget *target = find_widget_at_pos (model->widgetwindow_osr, + (event->type == MotionNotify + ? event->xmotion.x + view->clip_left + : event->xcrossing.x + view->clip_left), + (event->type == MotionNotify + ? event->xmotion.y + view->clip_top + : event->xcrossing.y + view->clip_top), + &x, &y); + + if (!target) + target = model->widget_osr; + + record_osr_embedder (view); + xg_event->any.window = gtk_widget_get_window (target); + g_object_ref (xg_event->any.window); /* The window will be unrefed + later by gdk_event_free. */ + + if (event->type == MotionNotify) + { + xg_event->motion.x = x; + xg_event->motion.y = y; + xg_event->motion.x_root = event->xmotion.x_root; + xg_event->motion.y_root = event->xmotion.y_root; + xg_event->motion.time = event->xmotion.time; + xg_event->motion.state = event->xmotion.state; + xg_event->motion.device = find_suitable_pointer (view->frame); + } + else + { + xg_event->crossing.detail = min (5, event->xcrossing.detail); + xg_event->crossing.time = event->xcrossing.time; + xg_event->crossing.x = x; + xg_event->crossing.y = y; + xg_event->crossing.x_root = event->xcrossing.x_root; + xg_event->crossing.y_root = event->xcrossing.y_root; + gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + } + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); +} + +static void +synthesize_focus_in_event (GtkWidget *offscreen_window) +{ + GdkWindow *wnd; + GdkEvent *focus_event; + + if (!gtk_widget_get_realized (offscreen_window)) + gtk_widget_realize (offscreen_window); + + wnd = gtk_widget_get_window (offscreen_window); + + focus_event = gdk_event_new (GDK_FOCUS_CHANGE); + focus_event->any.window = wnd; + focus_event->focus_change.in = TRUE; + + if (FRAME_WINDOW_P (SELECTED_FRAME ())) + gdk_event_set_device (focus_event, + find_suitable_pointer (SELECTED_FRAME ())); + + g_object_ref (wnd); + + gtk_main_do_event (focus_event); + gdk_event_free (focus_event); +} + +struct xwidget_view * +xwidget_view_from_window (Window wdesc) +{ + Lisp_Object key = make_fixnum (wdesc); + Lisp_Object xwv = Fgethash (key, x_window_to_xwv_map, Qnil); + + if (NILP (xwv)) + return NULL; + + return XXWIDGET_VIEW (xwv); +} + +static void xwidget_show_view (struct xwidget_view *xv) { xv->hidden = false; - gtk_widget_show (xv->widgetwindow); - gtk_fixed_move (GTK_FIXED (xv->emacswindow), - xv->widgetwindow, - xv->x + xv->clip_left, - xv->y + xv->clip_top); + XMoveWindow (xv->dpy, xv->wdesc, + xv->x + xv->clip_left, + xv->y + xv->clip_top); + XMapWindow (xv->dpy, xv->wdesc); + XFlush (xv->dpy); } /* Hide an xwidget view. */ @@ -242,28 +963,64 @@ static void xwidget_hide_view (struct xwidget_view *xv) { xv->hidden = true; - gtk_fixed_move (GTK_FIXED (xv->emacswindow), xv->widgetwindow, - 10000, 10000); + XUnmapWindow (xv->dpy, xv->wdesc); + XFlush (xv->dpy); +} + +static void +xv_do_draw (struct xwidget_view *xw, struct xwidget *w) +{ + GtkOffscreenWindow *wnd; + cairo_surface_t *surface; + block_input (); + wnd = GTK_OFFSCREEN_WINDOW (w->widgetwindow_osr); + surface = gtk_offscreen_window_get_surface (wnd); + + cairo_save (xw->cr_context); + if (surface) + { + cairo_translate (xw->cr_context, -xw->clip_left, -xw->clip_top); + cairo_set_source_surface (xw->cr_context, surface, 0, 0); + cairo_set_operator (xw->cr_context, CAIRO_OPERATOR_SOURCE); + cairo_paint (xw->cr_context); + } + cairo_restore (xw->cr_context); + + unblock_input (); } /* When the off-screen webkit master view changes this signal is called. It copies the bitmap from the off-screen instance. */ static gboolean offscreen_damage_event (GtkWidget *widget, GdkEvent *event, - gpointer xv_widget) -{ - /* Queue a redraw of onscreen widget. - There is a guard against receiving an invalid widget, - which should only happen if we failed to remove the - specific signal handler for the damage event. */ - if (GTK_IS_WIDGET (xv_widget)) - gtk_widget_queue_draw (GTK_WIDGET (xv_widget)); - else - message ("Warning, offscreen_damage_event received invalid xv pointer:%p\n", - xv_widget); + gpointer xwidget) +{ + block_input (); + + for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); + tail = XCDR (tail)) + { + if (XWIDGET_VIEW_P (XCAR (tail))) + { + struct xwidget_view *view = XXWIDGET_VIEW (XCAR (tail)); + + if (view->wdesc && XXWIDGET (view->model) == xwidget) + xv_do_draw (view, XXWIDGET (view->model)); + } + } + + unblock_input (); return FALSE; } + +void +xwidget_expose (struct xwidget_view *xv) +{ + struct xwidget *xw = XXWIDGET (xv->model); + + xv_do_draw (xv, xw); +} #endif /* USE_GTK */ void @@ -317,22 +1074,108 @@ store_xwidget_js_callback_event (struct xwidget *xw, #ifdef USE_GTK +static void +store_xwidget_display_event (struct xwidget *xw) +{ + struct input_event evt; + Lisp_Object val; + + XSETXWIDGET (val, xw); + EVENT_INIT (evt); + evt.kind = XWIDGET_DISPLAY_EVENT; + evt.frame_or_window = Qnil; + evt.arg = val; + kbd_buffer_store_event (&evt); +} + +static void +webkit_ready_to_show (WebKitWebView *new_view, + gpointer user_data) +{ + Lisp_Object tem; + struct xwidget *xw; + + for (tem = Vxwidget_list; CONSP (tem); tem = XCDR (tem)) + { + if (XWIDGETP (XCAR (tem))) + { + xw = XXWIDGET (XCAR (tem)); + + if (EQ (xw->type, Qwebkit) + && WEBKIT_WEB_VIEW (xw->widget_osr) == new_view) + store_xwidget_display_event (xw); + } + } +} + +static GtkWidget * +webkit_create_cb_1 (WebKitWebView *webview, + struct xwidget_view *xv) +{ + Lisp_Object related; + Lisp_Object xwidget; + GtkWidget *widget; + + XSETXWIDGET (related, xv); + xwidget = Fmake_xwidget (Qwebkit, Qnil, make_fixnum (0), + make_fixnum (0), Qnil, + build_string (" *detached xwidget buffer*"), + related); + + if (NILP (xwidget)) + return NULL; + + widget = XXWIDGET (xwidget)->widget_osr; + + g_signal_connect (G_OBJECT (widget), "ready-to-show", + G_CALLBACK (webkit_ready_to_show), NULL); + + return widget; +} + +static GtkWidget * +webkit_create_cb (WebKitWebView *webview, + WebKitNavigationAction *nav_action, + gpointer user_data) +{ + switch (webkit_navigation_action_get_navigation_type (nav_action)) + { + case WEBKIT_NAVIGATION_TYPE_OTHER: + return webkit_create_cb_1 (webview, user_data); + + case WEBKIT_NAVIGATION_TYPE_BACK_FORWARD: + case WEBKIT_NAVIGATION_TYPE_RELOAD: + case WEBKIT_NAVIGATION_TYPE_FORM_SUBMITTED: + case WEBKIT_NAVIGATION_TYPE_FORM_RESUBMITTED: + case WEBKIT_NAVIGATION_TYPE_LINK_CLICKED: + default: + return NULL; + } +} + void webkit_view_load_changed_cb (WebKitWebView *webkitwebview, WebKitLoadEvent load_event, gpointer data) { - switch (load_event) { - case WEBKIT_LOAD_FINISHED: + struct xwidget *xw = g_object_get_data (G_OBJECT (webkitwebview), + XG_XWIDGET); + + switch (load_event) { - struct xwidget *xw = g_object_get_data (G_OBJECT (webkitwebview), - XG_XWIDGET); - store_xwidget_event_string (xw, "load-changed", ""); + case WEBKIT_LOAD_FINISHED: + store_xwidget_event_string (xw, "load-changed", "load-finished"); + break; + case WEBKIT_LOAD_STARTED: + store_xwidget_event_string (xw, "load-changed", "load-started"); + break; + case WEBKIT_LOAD_REDIRECTED: + store_xwidget_event_string (xw, "load-changed", "load-redirected"); + break; + case WEBKIT_LOAD_COMMITTED: + store_xwidget_event_string (xw, "load-changed", "load-committed"); break; } - default: - break; - } } /* Recursively convert a JavaScript value to a Lisp value. */ @@ -483,6 +1326,33 @@ webkit_decide_policy_cb (WebKitWebView *webView, break; } case WEBKIT_POLICY_DECISION_TYPE_NEW_WINDOW_ACTION: + { + WebKitNavigationPolicyDecision *navigation_decision = + WEBKIT_NAVIGATION_POLICY_DECISION (decision); + WebKitNavigationAction *navigation_action = + webkit_navigation_policy_decision_get_navigation_action (navigation_decision); + WebKitURIRequest *request = + webkit_navigation_action_get_request (navigation_action); + WebKitWebView *newview; + struct xwidget *xw = g_object_get_data (G_OBJECT (webView), XG_XWIDGET); + Lisp_Object val, new_xwidget; + + XSETXWIDGET (val, xw); + + new_xwidget = Fmake_xwidget (Qwebkit, Qnil, make_fixnum (0), + make_fixnum (0), Qnil, + build_string (" *detached xwidget buffer*"), + val); + + if (NILP (new_xwidget)) + return FALSE; + + newview = WEBKIT_WEB_VIEW (XXWIDGET (new_xwidget)->widget_osr); + webkit_web_view_load_request (newview, request); + + store_xwidget_display_event (XXWIDGET (new_xwidget)); + return TRUE; + } case WEBKIT_POLICY_DECISION_TYPE_NAVIGATION_ACTION: { WebKitNavigationPolicyDecision *navigation_decision = @@ -503,58 +1373,75 @@ webkit_decide_policy_cb (WebKitWebView *webView, } } - -/* For gtk3 offscreen rendered widgets. */ static gboolean -xwidget_osr_draw_cb (GtkWidget *widget, cairo_t *cr, gpointer data) +webkit_script_dialog_cb (WebKitWebView *webview, + WebKitScriptDialog *script_dialog, + gpointer user) { - struct xwidget *xw = g_object_get_data (G_OBJECT (widget), XG_XWIDGET); - struct xwidget_view *xv = g_object_get_data (G_OBJECT (widget), - XG_XWIDGET_VIEW); + struct frame *f = SELECTED_FRAME (); + WebKitScriptDialogType type; + GtkWidget *widget; + GtkWidget *dialog; + GtkWidget *entry; + GtkWidget *content_area; + GtkWidget *box; + GtkWidget *label; + const gchar *content; + const gchar *message; + gint result; + + /* Return TRUE to prevent WebKit from showing the default script + dialog in the offscreen window, which runs a nested main loop + Emacs can't respond to, and as such can't pass X events to. */ + if (!FRAME_WINDOW_P (f)) + return TRUE; + + type = webkit_script_dialog_get_dialog_type (script_dialog);; + widget = FRAME_GTK_OUTER_WIDGET (f); + content = webkit_script_dialog_get_message (script_dialog); + + if (type == WEBKIT_SCRIPT_DIALOG_ALERT) + dialog = gtk_dialog_new_with_buttons ("Alert", GTK_WINDOW (widget), + GTK_DIALOG_MODAL, + "Dismiss", 1, NULL); + else + dialog = gtk_dialog_new_with_buttons ("Question", GTK_WINDOW (widget), + GTK_DIALOG_MODAL, + "OK", 0, "Cancel", 1, NULL); - cairo_rectangle (cr, 0, 0, xv->clip_right, xv->clip_bottom); - cairo_clip (cr); + box = gtk_box_new (GTK_ORIENTATION_VERTICAL, 8); + label = gtk_label_new (content); + content_area = gtk_dialog_get_content_area (GTK_DIALOG (dialog)); + gtk_container_add (GTK_CONTAINER (content_area), box); -#ifdef HAVE_PGTK - gtk_container_check_resize (GTK_CONTAINER (xw->widgetwindow_osr)); -#endif + gtk_widget_show (box); + gtk_widget_show (label); - gtk_widget_draw (xw->widget_osr, cr); - return FALSE; -} + gtk_box_pack_start (GTK_BOX (box), label, TRUE, TRUE, 0); -static gboolean -xwidget_osr_event_forward (GtkWidget *widget, GdkEvent *event, - gpointer user_data) -{ - /* Copy events that arrive at the outer widget to the offscreen widget. */ - struct xwidget *xw = g_object_get_data (G_OBJECT (widget), XG_XWIDGET); - GdkEvent *eventcopy = gdk_event_copy (event); - eventcopy->any.window = gtk_widget_get_window (xw->widget_osr); + if (type == WEBKIT_SCRIPT_DIALOG_PROMPT) + { + entry = gtk_entry_new (); + message = webkit_script_dialog_prompt_get_default_text (script_dialog); + + gtk_widget_show (entry); + gtk_entry_set_text (GTK_ENTRY (entry), message); + gtk_box_pack_end (GTK_BOX (box), entry, TRUE, TRUE, 0); + } - /* TODO: This might leak events. They should be deallocated later, - perhaps in xwgir_event_cb. */ - gtk_main_do_event (eventcopy); + result = gtk_dialog_run (GTK_DIALOG (dialog)); -#ifdef HAVE_PGTK - /* Pgtk code needs this event */ - if (event->type == GDK_MOTION_NOTIFY) - return FALSE; -#endif - /* Don't propagate this event further. */ - return TRUE; -} + if (type == WEBKIT_SCRIPT_DIALOG_CONFIRM + || type == WEBKIT_SCRIPT_DIALOG_BEFORE_UNLOAD_CONFIRM) + webkit_script_dialog_confirm_set_confirmed (script_dialog, result == 0); -static gboolean -xwidget_osr_event_set_embedder (GtkWidget *widget, GdkEvent *event, - gpointer data) -{ - struct xwidget_view *xv = data; - struct xwidget *xww = XXWIDGET (xv->model); - gdk_offscreen_window_set_embedder (gtk_widget_get_window - (xww->widgetwindow_osr), - gtk_widget_get_window (xv->widget)); - return FALSE; + if (type == WEBKIT_SCRIPT_DIALOG_PROMPT) + webkit_script_dialog_prompt_set_text (script_dialog, + gtk_entry_get_text (GTK_ENTRY (entry))); + + gtk_widget_destroy (GTK_WIDGET (dialog)); + + return TRUE; } #endif /* USE_GTK */ @@ -581,63 +1468,19 @@ xwidget_init_view (struct xwidget *xww, XSETXWIDGET (xv->model, xww); #ifdef USE_GTK - if (EQ (xww->type, Qwebkit)) - { - xv->widget = gtk_drawing_area_new (); - /* Expose event handling. */ - gtk_widget_set_app_paintable (xv->widget, TRUE); - gtk_widget_add_events (xv->widget, GDK_ALL_EVENTS_MASK); - - /* Draw the view on damage-event. */ - g_signal_connect (G_OBJECT (xww->widgetwindow_osr), "damage-event", - G_CALLBACK (offscreen_damage_event), xv->widget); + xv->dpy = FRAME_X_DISPLAY (s->f); - if (EQ (xww->type, Qwebkit)) - { - g_signal_connect (G_OBJECT (xv->widget), "button-press-event", - G_CALLBACK (xwidget_osr_event_forward), NULL); - g_signal_connect (G_OBJECT (xv->widget), "button-release-event", - G_CALLBACK (xwidget_osr_event_forward), NULL); - g_signal_connect (G_OBJECT (xv->widget), "motion-notify-event", - G_CALLBACK (xwidget_osr_event_forward), NULL); - } - else - { - /* xwgir debug, orthogonal to forwarding. */ - g_signal_connect (G_OBJECT (xv->widget), "enter-notify-event", - G_CALLBACK (xwidget_osr_event_set_embedder), xv); - } - g_signal_connect (G_OBJECT (xv->widget), "draw", - G_CALLBACK (xwidget_osr_draw_cb), NULL); - } - - /* Widget realization. - - Make container widget first, and put the actual widget inside the - container later. Drawing should crop container window if necessary - to handle case where xwidget is partially obscured by other Emacs - windows. Other containers than gtk_fixed where explored, but - gtk_fixed had the most predictable behavior so far. */ - - xv->emacswindow = FRAME_GTK_WIDGET (s->f); - xv->widgetwindow = gtk_fixed_new (); - gtk_widget_set_has_window (xv->widgetwindow, TRUE); - gtk_container_add (GTK_CONTAINER (xv->widgetwindow), xv->widget); - - /* Store some xwidget data in the gtk widgets. */ - g_object_set_data (G_OBJECT (xv->widget), XG_FRAME_DATA, s->f); - g_object_set_data (G_OBJECT (xv->widget), XG_XWIDGET, xww); - g_object_set_data (G_OBJECT (xv->widget), XG_XWIDGET_VIEW, xv); - g_object_set_data (G_OBJECT (xv->widgetwindow), XG_XWIDGET, xww); - g_object_set_data (G_OBJECT (xv->widgetwindow), XG_XWIDGET_VIEW, xv); - - gtk_widget_set_size_request (GTK_WIDGET (xv->widget), xww->width, - xww->height); - gtk_widget_set_size_request (xv->widgetwindow, xww->width, xww->height); - gtk_fixed_put (GTK_FIXED (FRAME_GTK_WIDGET (s->f)), xv->widgetwindow, x, y); xv->x = x; xv->y = y; - gtk_widget_show_all (xv->widgetwindow); + + xv->clip_left = 0; + xv->clip_right = xww->width; + xv->clip_top = 0; + xv->clip_bottom = xww->height; + + xv->wdesc = None; + xv->frame = s->f; + xv->cursor = cursor_for_hit (xww->hit_result, s->f); #elif defined NS_IMPL_COCOA nsxwidget_init_view (xv, xww, s, x, y); nsxwidget_resize_view(xv, xww->width, xww->height); @@ -694,19 +1537,6 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) window_box (s->w, TEXT_AREA, &text_area_x, &text_area_y, &text_area_width, &text_area_height); - /* Resize xwidget webkit if its container window size is changed in - some ways, for example, a buffer became hidden in small split - window, then it can appear front in merged whole window. */ - if (EQ (xww->type, Qwebkit) - && (xww->width != text_area_width || xww->height != text_area_height)) - { - Lisp_Object xwl; - XSETXWIDGET (xwl, xww); - Fxwidget_resize (xwl, - make_int (text_area_width), - make_int (text_area_height)); - } - clip_left = max (0, text_area_x - x); clip_right = max (clip_left, min (xww->width, text_area_x + text_area_width - x)); @@ -724,15 +1554,58 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) later. */ bool moved = (xv->x + xv->clip_left != x + clip_left || xv->y + xv->clip_top != y + clip_top); + +#ifdef USE_GTK + bool wdesc_was_none = xv->wdesc == None; +#endif xv->x = x; xv->y = y; +#ifdef USE_GTK + block_input (); + if (xv->wdesc == None) + { + Lisp_Object xvw; + XSETXWIDGET_VIEW (xvw, xv); + XSetWindowAttributes a; + a.event_mask = (ExposureMask | ButtonPressMask | ButtonReleaseMask + | PointerMotionMask | EnterWindowMask | LeaveWindowMask); + + if (clip_right - clip_left <= 0 + || clip_bottom - clip_top <= 0) + { + unblock_input (); + return; + } + + xv->wdesc = XCreateWindow (xv->dpy, FRAME_X_WINDOW (s->f), + x + clip_left, y + clip_top, + clip_right - clip_left, + clip_bottom - clip_top, 0, + CopyFromParent, CopyFromParent, + CopyFromParent, CWEventMask, &a); + XDefineCursor (xv->dpy, xv->wdesc, xv->cursor); + xv->cr_surface = cairo_xlib_surface_create (xv->dpy, + xv->wdesc, + FRAME_DISPLAY_INFO (s->f)->visual, + clip_right - clip_left, + clip_bottom - clip_top); + xv->cr_context = cairo_create (xv->cr_surface); + Fputhash (make_fixnum (xv->wdesc), xvw, x_window_to_xwv_map); + + moved = false; + } +#endif + /* Has it moved? */ if (moved) { #ifdef USE_GTK - gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (s->f)), - xv->widgetwindow, x + clip_left, y + clip_top); + XMoveResizeWindow (xv->dpy, xv->wdesc, x + clip_left, y + clip_top, + clip_right - clip_left, clip_bottom - clip_top); + XFlush (xv->dpy); + cairo_xlib_surface_set_size (xv->cr_surface, clip_right - clip_left, + clip_bottom - clip_top); #elif defined NS_IMPL_COCOA nsxwidget_move_view (xv, x + clip_left, y + clip_top); #endif @@ -748,10 +1621,23 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) || xv->clip_top != clip_top || xv->clip_left != clip_left) { #ifdef USE_GTK - gtk_widget_set_size_request (xv->widgetwindow, clip_right - clip_left, - clip_bottom - clip_top); - gtk_fixed_move (GTK_FIXED (xv->widgetwindow), xv->widget, -clip_left, - -clip_top); + if (!wdesc_was_none && !moved) + { + if (clip_right - clip_left <= 0 + || clip_bottom - clip_top <= 0) + { + XUnmapWindow (xv->dpy, xv->wdesc); + xv->hidden = true; + } + else + { + XResizeWindow (xv->dpy, xv->wdesc, clip_right - clip_left, + clip_bottom - clip_top); + } + XFlush (xv->dpy); + cairo_xlib_surface_set_size (xv->cr_surface, clip_right - clip_left, + clip_bottom - clip_top); + } #elif defined NS_IMPL_COCOA nsxwidget_resize_view (xv, clip_right - clip_left, clip_bottom - clip_top); @@ -771,12 +1657,15 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) if (!xwidget_hidden (xv)) { #ifdef USE_GTK - gtk_widget_queue_draw (xv->widgetwindow); - gtk_widget_queue_draw (xv->widget); + gtk_widget_queue_draw (xww->widget_osr); #elif defined NS_IMPL_COCOA nsxwidget_set_needsdisplay (xv); #endif } + +#ifdef USE_GTK + unblock_input (); +#endif } static bool @@ -852,21 +1741,32 @@ DEFUN ("xwidget-webkit-goto-uri", DEFUN ("xwidget-webkit-goto-history", Fxwidget_webkit_goto_history, Sxwidget_webkit_goto_history, 2, 2, 0, - doc: /* Make the XWIDGET webkit load REL-POS (-1, 0, 1) page in browse history. */) + doc: /* Make the XWIDGET webkit the REL-POSth element in load history. + +If REL-POS is 0, the widget will be just reload the current element in +history. If REL-POS is more or less than 0, the widget will load the +REL-POSth element around the current spot in the load history. */) (Lisp_Object xwidget, Lisp_Object rel_pos) { WEBKIT_FN_INIT (); - /* Should be one of -1, 0, 1 */ - if (XFIXNUM (rel_pos) < -1 || XFIXNUM (rel_pos) > 1) - args_out_of_range_3 (rel_pos, make_fixnum (-1), make_fixnum (1)); + CHECK_FIXNUM (rel_pos); #ifdef USE_GTK WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr); - switch (XFIXNAT (rel_pos)) + WebKitBackForwardList *list; + WebKitBackForwardListItem *it; + + if (XFIXNUM (rel_pos) == 0) + webkit_web_view_reload (wkwv); + else { - case -1: webkit_web_view_go_back (wkwv); break; - case 0: webkit_web_view_reload (wkwv); break; - case 1: webkit_web_view_go_forward (wkwv); break; + list = webkit_web_view_get_back_forward_list (wkwv); + it = webkit_back_forward_list_get_nth_item (list, XFIXNUM (rel_pos)); + + if (!it) + error ("There is no item at this index"); + + webkit_web_view_go_to_back_forward_list_item (wkwv, it); } #elif defined NS_IMPL_COCOA nsxwidget_webkit_goto_history (xw, XFIXNAT (rel_pos)); @@ -974,12 +1874,10 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, #ifndef HAVE_PGTK gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width, xw->height); -#else - gtk_container_check_resize (GTK_CONTAINER (xw->widgetwindow_osr)); -#endif - gtk_container_resize_children (GTK_CONTAINER (xw->widgetwindow_osr)); gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, xw->height); + + gtk_widget_queue_allocate (GTK_WIDGET (xw->widget_osr)); } #elif defined NS_IMPL_COCOA nsxwidget_resize (xw); @@ -992,16 +1890,13 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, struct xwidget_view *xv = XXWIDGET_VIEW (XCAR (tail)); if (XXWIDGET (xv->model) == xw) { -#ifdef USE_GTK - gtk_widget_set_size_request (GTK_WIDGET (xv->widget), xw->width, - xw->height); -#elif defined NS_IMPL_COCOA - nsxwidget_resize_view(xv, xw->width, xw->height); -#endif + wset_redisplay (XWINDOW (xv->w)); } } } + redisplay (); + return Qnil; } @@ -1101,13 +1996,28 @@ DEFUN ("delete-xwidget-view", CHECK_XWIDGET_VIEW (xwidget_view); struct xwidget_view *xv = XXWIDGET_VIEW (xwidget_view); #ifdef USE_GTK - gtk_widget_destroy (xv->widgetwindow); - /* xv->model still has signals pointing to the view. There can be - several views. Find the matching signals and delete them all. */ - g_signal_handlers_disconnect_matched (XXWIDGET (xv->model)->widgetwindow_osr, - G_SIGNAL_MATCH_DATA, - 0, 0, 0, 0, - xv->widget); + struct xwidget *xw = XXWIDGET (xv->model); + GdkWindow *w; + + if (xv->wdesc != None) + { + block_input (); + cairo_destroy (xv->cr_context); + cairo_surface_destroy (xv->cr_surface); + XDestroyWindow (xv->dpy, xv->wdesc); + Fremhash (make_fixnum (xv->wdesc), x_window_to_xwv_map); + unblock_input (); + } + + if (xw->embedder_view == xv) + { + w = gtk_widget_get_window (xw->widgetwindow_osr); + + XXWIDGET (xv->model)->embedder_view = NULL; + XXWIDGET (xv->model)->embedder = NULL; + + gdk_offscreen_window_set_embedder (w, NULL); + } #elif defined NS_IMPL_COCOA nsxwidget_delete_view (xv); #endif @@ -1162,6 +2072,19 @@ DEFUN ("xwidget-buffer", return XXWIDGET (xwidget)->buffer; } +DEFUN ("set-xwidget-buffer", + Fset_xwidget_buffer, Sset_xwidget_buffer, + 2, 2, 0, + doc: /* Set XWIDGET's buffer to BUFFER. */) + (Lisp_Object xwidget, Lisp_Object buffer) +{ + CHECK_XWIDGET (xwidget); + CHECK_BUFFER (buffer); + + XXWIDGET (xwidget)->buffer = buffer; + return Qnil; +} + DEFUN ("set-xwidget-plist", Fset_xwidget_plist, Sset_xwidget_plist, 2, 2, 0, @@ -1200,6 +2123,166 @@ DEFUN ("xwidget-query-on-exit-flag", return (XXWIDGET (xwidget)->kill_without_query ? Qnil : Qt); } +DEFUN ("xwidget-webkit-search", Fxwidget_webkit_search, Sxwidget_webkit_search, + 2, 5, 0, + doc: /* Begin an incremental search operation in an xwidget. +QUERY should be a string containing the text to search for. XWIDGET +should be a WebKit xwidget where the search will take place. When the +search operation is complete, callers should also call +`xwidget-webkit-finish-search' to complete the search operation. + +CASE-INSENSITIVE, when non-nil, will cause the search to ignore the +case of characters inside QUERY. BACKWARDS, when non-nil, will cause +the search to proceed towards the beginning of the widget's contents. +WRAP-AROUND, when nil, will cause the search to stop upon hitting the +end of the widget's contents. + +It is OK to call this function even when a search is already in +progress. In that case, the previous search query will be replaced +with QUERY. */) + (Lisp_Object query, Lisp_Object xwidget, Lisp_Object case_insensitive, + Lisp_Object backwards, Lisp_Object wrap_around) +{ +#ifdef USE_GTK + WebKitWebView *webview; + WebKitFindController *controller; + WebKitFindOptions opt; + struct xwidget *xw; + gchar *g_query; +#endif + + CHECK_STRING (query); + CHECK_XWIDGET (xwidget); + +#ifdef USE_GTK + xw = XXWIDGET (xwidget); + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + query = ENCODE_UTF_8 (query); + opt = WEBKIT_FIND_OPTIONS_NONE; + g_query = xstrdup (SSDATA (query)); + + if (!NILP (case_insensitive)) + opt |= WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE; + if (!NILP (backwards)) + opt |= WEBKIT_FIND_OPTIONS_BACKWARDS; + if (!NILP (wrap_around)) + opt |= WEBKIT_FIND_OPTIONS_WRAP_AROUND; + + if (xw->find_text) + xfree (xw->find_text); + xw->find_text = g_query; + + block_input (); + controller = webkit_web_view_get_find_controller (webview); + webkit_find_controller_search (controller, g_query, opt, G_MAXUINT); + unblock_input (); +#endif + + return Qnil; +} + +DEFUN ("xwidget-webkit-next-result", Fxwidget_webkit_next_result, + Sxwidget_webkit_next_result, 1, 1, 0, + doc: /* Show the next result matching the current search query. + +XWIDGET should be an xwidget that currently has a search query. +Before calling this function, you should start a search operation +using `xwidget-webkit-search'. */) + (Lisp_Object xwidget) +{ + struct xwidget *xw; +#ifdef USE_GTK + WebKitWebView *webview; + WebKitFindController *controller; +#endif + + CHECK_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + + if (!xw->find_text) + error ("Widget has no ongoing search operation"); + +#ifdef USE_GTK + block_input (); + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + controller = webkit_web_view_get_find_controller (webview); + webkit_find_controller_search_next (controller); + unblock_input (); +#endif + + return Qnil; +} + +DEFUN ("xwidget-webkit-previous-result", Fxwidget_webkit_previous_result, + Sxwidget_webkit_previous_result, 1, 1, 0, + doc: /* Show the previous result matching the current search query. + +XWIDGET should be an xwidget that currently has a search query. +Before calling this function, you should start a search operation +using `xwidget-webkit-search'. */) + (Lisp_Object xwidget) +{ + struct xwidget *xw; +#ifdef USE_GTK + WebKitWebView *webview; + WebKitFindController *controller; +#endif + + CHECK_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + + if (!xw->find_text) + error ("Widget has no ongoing search operation"); + +#ifdef USE_GTK + block_input (); + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + controller = webkit_web_view_get_find_controller (webview); + webkit_find_controller_search_previous (controller); + unblock_input (); +#endif + + return Qnil; +} + +DEFUN ("xwidget-webkit-finish-search", Fxwidget_webkit_finish_search, + Sxwidget_webkit_finish_search, 1, 1, 0, + doc: /* Finish XWIDGET's search operation. + +XWIDGET should be an xwidget that currently has a search query. +Before calling this function, you should start a search operation +using `xwidget-webkit-search'. */) + (Lisp_Object xwidget) +{ + struct xwidget *xw; +#ifdef USE_GTK + WebKitWebView *webview; + WebKitFindController *controller; +#endif + + CHECK_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + + if (!xw->find_text) + error ("Widget has no ongoing search operation"); + +#ifdef USE_GTK + block_input (); + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + controller = webkit_web_view_get_find_controller (webview); + webkit_find_controller_search_finish (controller); + + if (xw->find_text) + { + xfree (xw->find_text); + xw->find_text = NULL; + } + unblock_input (); +#endif + + return Qnil; +} + void syms_of_xwidget (void) { @@ -1232,6 +2315,12 @@ syms_of_xwidget (void) defsubr (&Sxwidget_plist); defsubr (&Sxwidget_buffer); defsubr (&Sset_xwidget_plist); + defsubr (&Sxwidget_perform_lispy_event); + defsubr (&Sxwidget_webkit_search); + defsubr (&Sxwidget_webkit_finish_search); + defsubr (&Sxwidget_webkit_next_result); + defsubr (&Sxwidget_webkit_previous_result); + defsubr (&Sset_xwidget_buffer); DEFSYM (QCxwidget, ":xwidget"); DEFSYM (QCtitle, ":title"); @@ -1253,6 +2342,15 @@ syms_of_xwidget (void) Vxwidget_view_list = Qnil; Fprovide (intern ("xwidget-internal"), Qnil); + + id_to_xwidget_map = CALLN (Fmake_hash_table, QCtest, Qeq); + staticpro (&id_to_xwidget_map); + +#ifdef USE_GTK + x_window_to_xwv_map = CALLN (Fmake_hash_table, QCtest, Qeq); + + staticpro (&x_window_to_xwv_map); +#endif } @@ -1391,7 +2489,7 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix) /* The only call to xwidget_end_redisplay is in dispnew. xwidget_end_redisplay (w->current_matrix); */ struct xwidget_view *xv - = xwidget_view_lookup (glyph->u.xwidget, w); + = xwidget_view_lookup (xwidget_from_id (glyph->u.xwidget), w); #ifdef USE_GTK /* FIXME: Is it safe to assume xwidget_view_lookup always succeeds here? If so, this comment can be removed. @@ -1441,6 +2539,25 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix) } } +#ifdef USE_GTK +void +kill_frame_xwidget_views (struct frame *f) +{ + Lisp_Object rem = Qnil; + + for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); + tail = XCDR (tail)) + { + if (XWIDGET_VIEW_P (XCAR (tail)) + && XXWIDGET_VIEW (XCAR (tail))->frame == f) + rem = Fcons (XCAR (tail), rem); + } + + for (; CONSP (rem); rem = XCDR (rem)) + Fdelete_xwidget_view (XCAR (rem)); +} +#endif + /* Kill all xwidget in BUFFER. */ void kill_buffer_xwidgets (Lisp_Object buffer) @@ -1454,12 +2571,15 @@ kill_buffer_xwidgets (Lisp_Object buffer) { CHECK_XWIDGET (xwidget); struct xwidget *xw = XXWIDGET (xwidget); + Fremhash (make_fixnum (xw->xwidget_id), id_to_xwidget_map); #ifdef USE_GTK if (xw->widget_osr && xw->widgetwindow_osr) { gtk_widget_destroy (xw->widget_osr); gtk_widget_destroy (xw->widgetwindow_osr); } + if (xw->find_text) + xfree (xw->find_text); if (!NILP (xw->script_callbacks)) for (ptrdiff_t idx = 0; idx < ASIZE (xw->script_callbacks); idx++) { diff --git a/src/xwidget.h b/src/xwidget.h index 591f23489db..6e6b39c8b4f 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -32,6 +32,8 @@ struct window; #if defined (USE_GTK) #include <gtk/gtk.h> +#include <X11/Xlib.h> +#include "xterm.h" #elif defined (NS_IMPL_COCOA) && defined (__OBJC__) #import <AppKit/NSView.h> #import "nsxwidget.h" @@ -59,11 +61,16 @@ struct xwidget int height; int width; + uint32_t xwidget_id; + char *find_text; #if defined (USE_GTK) /* For offscreen widgets, unused if not osr. */ GtkWidget *widget_osr; GtkWidget *widgetwindow_osr; + struct frame *embedder; + struct xwidget_view *embedder_view; + guint hit_result; #elif defined (NS_IMPL_COCOA) # ifdef __OBJC__ /* For offscreen widgets, unused if not osr. */ @@ -98,9 +105,13 @@ struct xwidget_view bool hidden; #if defined (USE_GTK) - GtkWidget *widget; - GtkWidget *widgetwindow; - GtkWidget *emacswindow; + Display *dpy; + Window wdesc; + Emacs_Cursor cursor; + struct frame *frame; + + cairo_surface_t *cr_surface; + cairo_t *cr_context; #elif defined (NS_IMPL_COCOA) # ifdef __OBJC__ XvWindow *xvWindow; @@ -162,6 +173,18 @@ void store_xwidget_download_callback_event (struct xwidget *xw, void store_xwidget_js_callback_event (struct xwidget *xw, Lisp_Object proc, Lisp_Object argument); + +extern struct xwidget *xwidget_from_id (uint32_t id); + +#ifdef HAVE_X_WINDOWS +struct xwidget_view *xwidget_view_from_window (Window wdesc); +void xwidget_expose (struct xwidget_view *xv); +extern void kill_frame_xwidget_views (struct frame *f); +extern void xwidget_button (struct xwidget_view *, bool, int, + int, int, int, Time); +extern void xwidget_motion_or_crossing (struct xwidget_view *, + const XEvent *); +#endif #else INLINE_HEADER_BEGIN INLINE void syms_of_xwidget (void) {} |