diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/.gdbinit | 20 | ||||
| -rw-r--r-- | src/Makefile.in | 129 | ||||
| -rw-r--r-- | src/alloc.c | 808 | ||||
| -rw-r--r-- | src/atimer.c | 47 | ||||
| -rw-r--r-- | src/bidi.c | 48 | ||||
| -rw-r--r-- | src/bignum.c | 102 | ||||
| -rw-r--r-- | src/bignum.h | 1 | ||||
| -rw-r--r-- | src/buffer.c | 49 | ||||
| -rw-r--r-- | src/bytecode.c | 637 | ||||
| -rw-r--r-- | src/callint.c | 8 | ||||
| -rw-r--r-- | src/callproc.c | 54 | ||||
| -rw-r--r-- | src/casefiddle.c | 57 | ||||
| -rw-r--r-- | src/ccl.c | 1 | ||||
| -rw-r--r-- | src/character.c | 15 | ||||
| -rw-r--r-- | src/charset.c | 4 | ||||
| -rw-r--r-- | src/coding.c | 16 | ||||
| -rw-r--r-- | src/comp.c | 437 | ||||
| -rw-r--r-- | src/comp.h | 4 | ||||
| -rw-r--r-- | src/composite.c | 34 | ||||
| -rw-r--r-- | src/conf_post.h | 52 | ||||
| -rw-r--r-- | src/cygw32.c | 8 | ||||
| -rw-r--r-- | src/data.c | 290 | ||||
| -rw-r--r-- | src/decompress.c | 12 | ||||
| -rw-r--r-- | src/deps.mk | 2 | ||||
| -rw-r--r-- | src/dired.c | 8 | ||||
| -rw-r--r-- | src/dispextern.h | 78 | ||||
| -rw-r--r-- | src/dispnew.c | 41 | ||||
| -rw-r--r-- | src/doc.c | 75 | ||||
| -rw-r--r-- | src/dynlib.c | 16 | ||||
| -rw-r--r-- | src/dynlib.h | 2 | ||||
| -rw-r--r-- | src/editfns.c | 12 | ||||
| -rw-r--r-- | src/emacs-module.c | 4 | ||||
| -rw-r--r-- | src/emacs-module.h.in | 13 | ||||
| -rw-r--r-- | src/emacs.c | 132 | ||||
| -rw-r--r-- | src/emacsgtkfixed.c | 143 | ||||
| -rw-r--r-- | src/emacsgtkfixed.h | 9 | ||||
| -rw-r--r-- | src/eval.c | 872 | ||||
| -rw-r--r-- | src/fileio.c | 59 | ||||
| -rw-r--r-- | src/filelock.c | 69 | ||||
| -rw-r--r-- | src/floatfns.c | 15 | ||||
| -rw-r--r-- | src/fns.c | 852 | ||||
| -rw-r--r-- | src/font.c | 116 | ||||
| -rw-r--r-- | src/font.h | 4 | ||||
| -rw-r--r-- | src/frame.c | 151 | ||||
| -rw-r--r-- | src/frame.h | 35 | ||||
| -rw-r--r-- | src/fringe.c | 27 | ||||
| -rw-r--r-- | src/ftcrfont.c | 93 | ||||
| -rw-r--r-- | src/ftfont.c | 27 | ||||
| -rw-r--r-- | src/ftfont.h | 7 | ||||
| -rw-r--r-- | src/gnutls.c | 6 | ||||
| -rw-r--r-- | src/gnutls.h | 1 | ||||
| -rw-r--r-- | src/gtkutil.c | 1506 | ||||
| -rw-r--r-- | src/gtkutil.h | 34 | ||||
| -rw-r--r-- | src/haiku.c | 286 | ||||
| -rw-r--r-- | src/haiku_draw_support.cc | 487 | ||||
| -rw-r--r-- | src/haiku_font_support.cc | 647 | ||||
| -rw-r--r-- | src/haiku_io.c | 225 | ||||
| -rw-r--r-- | src/haiku_select.cc | 483 | ||||
| -rw-r--r-- | src/haiku_support.cc | 4276 | ||||
| -rw-r--r-- | src/haiku_support.h | 644 | ||||
| -rw-r--r-- | src/haikufns.c | 2717 | ||||
| -rw-r--r-- | src/haikufont.c | 1101 | ||||
| -rw-r--r-- | src/haikugui.h | 98 | ||||
| -rw-r--r-- | src/haikuimage.c | 116 | ||||
| -rw-r--r-- | src/haikumenu.c | 788 | ||||
| -rw-r--r-- | src/haikuselect.c | 865 | ||||
| -rw-r--r-- | src/haikuselect.h | 88 | ||||
| -rw-r--r-- | src/haikuterm.c | 4200 | ||||
| -rw-r--r-- | src/haikuterm.h | 316 | ||||
| -rw-r--r-- | src/image.c | 1657 | ||||
| -rw-r--r-- | src/indent.c | 66 | ||||
| -rw-r--r-- | src/insdel.c | 6 | ||||
| -rw-r--r-- | src/intervals.c | 22 | ||||
| -rw-r--r-- | src/json.c | 10 | ||||
| -rw-r--r-- | src/keyboard.c | 696 | ||||
| -rw-r--r-- | src/keyboard.h | 4 | ||||
| -rw-r--r-- | src/keymap.c | 236 | ||||
| -rw-r--r-- | src/lisp.h | 668 | ||||
| -rw-r--r-- | src/lread.c | 408 | ||||
| -rw-r--r-- | src/macfont.m | 59 | ||||
| -rw-r--r-- | src/macros.c | 14 | ||||
| -rw-r--r-- | src/menu.c | 55 | ||||
| -rw-r--r-- | src/menu.h | 6 | ||||
| -rw-r--r-- | src/minibuf.c | 126 | ||||
| -rw-r--r-- | src/module-env-29.h | 3 | ||||
| -rw-r--r-- | src/msdos.c | 5 | ||||
| -rw-r--r-- | src/nsfns.m | 111 | ||||
| -rw-r--r-- | src/nsfont.m | 1211 | ||||
| -rw-r--r-- | src/nsgui.h | 3 | ||||
| -rw-r--r-- | src/nsimage.m | 2 | ||||
| -rw-r--r-- | src/nsmenu.m | 151 | ||||
| -rw-r--r-- | src/nsselect.m | 84 | ||||
| -rw-r--r-- | src/nsterm.h | 61 | ||||
| -rw-r--r-- | src/nsterm.m | 1074 | ||||
| -rw-r--r-- | src/pdumper.c | 42 | ||||
| -rw-r--r-- | src/pdumper.h | 5 | ||||
| -rw-r--r-- | src/pgtkfns.c | 4005 | ||||
| -rw-r--r-- | src/pgtkgui.h | 119 | ||||
| -rw-r--r-- | src/pgtkim.c | 313 | ||||
| -rw-r--r-- | src/pgtkmenu.c | 1138 | ||||
| -rw-r--r-- | src/pgtkselect.c | 536 | ||||
| -rw-r--r-- | src/pgtkselect.h | 31 | ||||
| -rw-r--r-- | src/pgtkterm.c | 7152 | ||||
| -rw-r--r-- | src/pgtkterm.h | 603 | ||||
| -rw-r--r-- | src/print.c | 542 | ||||
| -rw-r--r-- | src/process.c | 168 | ||||
| -rw-r--r-- | src/regex-emacs.c | 2 | ||||
| -rw-r--r-- | src/search.c | 102 | ||||
| -rw-r--r-- | src/sort.c | 974 | ||||
| -rw-r--r-- | src/sound.c | 26 | ||||
| -rw-r--r-- | src/sqlite.c | 753 | ||||
| -rw-r--r-- | src/syntax.c | 7 | ||||
| -rw-r--r-- | src/syntax.h | 4 | ||||
| -rw-r--r-- | src/sysdep.c | 310 | ||||
| -rw-r--r-- | src/syssignal.h | 2 | ||||
| -rw-r--r-- | src/sysstdio.h | 6 | ||||
| -rw-r--r-- | src/systhread.h | 2 | ||||
| -rw-r--r-- | src/systime.h | 5 | ||||
| -rw-r--r-- | src/term.c | 36 | ||||
| -rw-r--r-- | src/termhooks.h | 121 | ||||
| -rw-r--r-- | src/terminal.c | 6 | ||||
| -rw-r--r-- | src/textprop.c | 14 | ||||
| -rw-r--r-- | src/thread.c | 39 | ||||
| -rw-r--r-- | src/thread.h | 23 | ||||
| -rw-r--r-- | src/timefns.c | 95 | ||||
| -rw-r--r-- | src/tparam.h | 2 | ||||
| -rw-r--r-- | src/undo.c | 2 | ||||
| -rw-r--r-- | src/verbose.mk.in | 51 | ||||
| -rw-r--r-- | src/w16select.c | 2 | ||||
| -rw-r--r-- | src/w32.c | 77 | ||||
| -rw-r--r-- | src/w32.h | 6 | ||||
| -rw-r--r-- | src/w32fns.c | 192 | ||||
| -rw-r--r-- | src/w32font.c | 38 | ||||
| -rw-r--r-- | src/w32image.c | 1 | ||||
| -rw-r--r-- | src/w32inevt.c | 14 | ||||
| -rw-r--r-- | src/w32menu.c | 8 | ||||
| -rw-r--r-- | src/w32proc.c | 21 | ||||
| -rw-r--r-- | src/w32term.c | 150 | ||||
| -rw-r--r-- | src/widget.c | 17 | ||||
| -rw-r--r-- | src/widget.h | 2 | ||||
| -rw-r--r-- | src/window.c | 60 | ||||
| -rw-r--r-- | src/window.h | 3 | ||||
| -rw-r--r-- | src/xdisp.c | 1313 | ||||
| -rw-r--r-- | src/xfaces.c | 149 | ||||
| -rw-r--r-- | src/xfns.c | 1929 | ||||
| -rw-r--r-- | src/xfont.c | 26 | ||||
| -rw-r--r-- | src/xftfont.c | 118 | ||||
| -rw-r--r-- | src/xgselect.c | 68 | ||||
| -rw-r--r-- | src/xmenu.c | 381 | ||||
| -rw-r--r-- | src/xselect.c | 108 | ||||
| -rw-r--r-- | src/xsettings.c | 54 | ||||
| -rw-r--r-- | src/xsettings.h | 14 | ||||
| -rw-r--r-- | src/xterm.c | 11580 | ||||
| -rw-r--r-- | src/xterm.h | 376 | ||||
| -rw-r--r-- | src/xwidget.c | 3314 | ||||
| -rw-r--r-- | src/xwidget.h | 70 |
156 files changed, 62253 insertions, 6391 deletions
diff --git a/src/.gdbinit b/src/.gdbinit index 04ff6259a90..9ec536a96d1 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -41,6 +41,11 @@ handle SIGUSR2 noprint pass # debugging. handle SIGALRM ignore +# On selection send failed. +if defined_HAVE_PGTK + handle SIGPIPE nostop noprint +end + # Use $bugfix so that the value isn't a constant. # Using a constant runs into GDB bugs sometimes. define xgetptr @@ -746,6 +751,15 @@ Print $ as a overlay pointer. This command assumes that $ is an Emacs Lisp overlay value. end +define xsymwithpos + xgetptr $ + print (struct Lisp_Symbol_With_Pos *) $ptr +end +document xsymwithpos +Print $ as a symbol with position. +This command assumes that $ is an Emacs Lisp symbol with position value. +end + define xsymbol set $sym = $ xgetsym $sym @@ -1011,6 +1025,9 @@ define xpr if $vec == PVEC_OVERLAY xoverlay end + if $vec == PVEC_SYMBOL_WITH_POS + xsymwithpos + end if $vec == PVEC_PROCESS xprocess end @@ -1224,6 +1241,9 @@ set print pretty on set print sevenbit-strings show environment DISPLAY +if defined_HAVE_PGTK + show environment WAYLAND_DISPLAY +end show environment TERM # When debugging, it is handy to be able to "return" from diff --git a/src/Makefile.in b/src/Makefile.in index 29e1513ab5f..7d15b7afd51 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -34,6 +34,7 @@ top_builddir = @top_builddir@ abs_top_srcdir=@abs_top_srcdir@ VPATH = $(srcdir) CC = @CC@ +CXX = @CXX@ CFLAGS = @CFLAGS@ CPPFLAGS = @CPPFLAGS@ LDFLAGS = @LDFLAGS@ @@ -124,7 +125,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@ @@ -145,6 +146,7 @@ M17N_FLT_LIBS = @M17N_FLT_LIBS@ LIB_ACL=@LIB_ACL@ LIB_CLOCK_GETTIME=@LIB_CLOCK_GETTIME@ LIB_EACCESS=@LIB_EACCESS@ +LIB_NANOSLEEP=@LIB_NANOSLEEP@ LIB_TIMER_TIME=@LIB_TIMER_TIME@ DBUS_CFLAGS = @DBUS_CFLAGS@ @@ -223,6 +225,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@ @@ -235,6 +239,8 @@ IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@ LIBXML2_LIBS = @LIBXML2_LIBS@ LIBXML2_CFLAGS = @LIBXML2_CFLAGS@ +SQLITE3_LIBS = @SQLITE3_LIBS@ + GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@ LCMS2_LIBS = @LCMS2_LIBS@ @@ -256,9 +262,21 @@ XINERAMA_CFLAGS = @XINERAMA_CFLAGS@ XFIXES_LIBS = @XFIXES_LIBS@ XFIXES_CFLAGS = @XFIXES_CFLAGS@ +XINPUT_LIBS = @XINPUT_LIBS@ +XINPUT_CFLAGS = @XINPUT_CFLAGS@ + +XSYNC_LIBS = @XSYNC_LIBS@ +XSYNC_CFLAGS = @XSYNC_CFLAGS@ + XDBE_LIBS = @XDBE_LIBS@ XDBE_CFLAGS = @XDBE_CFLAGS@ +XCOMPOSITE_LIBS = @XCOMPOSITE_LIBS@ +XCOMPOSITE_CFLAGS = @XCOMPOSITE_CFLAGS@ + +XSHAPE_LIBS = @XSHAPE_LIBS@ +XSHAPE_CFLAGS = @XSHAPE_CFLAGS@ + ## widget.o if USE_X_TOOLKIT, otherwise empty. WIDGET_OBJ=@WIDGET_OBJ@ @@ -289,6 +307,9 @@ W32_OBJ=@W32_OBJ@ ## -lkernel32 if CYGWIN but not HAVE_W32, else empty. W32_LIBS=@W32_LIBS@ +PGTK_OBJ=@PGTK_OBJ@ +PGTK_LIBS=@PGTK_LIBS@ + ## emacs.res if HAVE_W32 EMACSRES = @EMACSRES@ ## If HAVE_W32, compiler arguments for including @@ -341,10 +362,17 @@ BUILD_DETAILS = @BUILD_DETAILS@ UNEXEC_OBJ = @UNEXEC_OBJ@ +HAIKU_OBJ = @HAIKU_OBJ@ +HAIKU_CXX_OBJ = @HAIKU_CXX_OBJ@ +HAIKU_LIBS = @HAIKU_LIBS@ +HAIKU_CFLAGS = @HAIKU_CFLAGS@ + DUMPING=@DUMPING@ CHECK_STRUCTS = @CHECK_STRUCTS@ HAVE_PDUMPER = @HAVE_PDUMPER@ +HAVE_BE_APP = @HAVE_BE_APP@ + ## ARM Macs require that all code have a valid signature. Since pdump ## invalidates the signature, we must re-sign to fix it. DO_CODESIGN=$(patsubst aarch64-apple-darwin%,yes,@configuration@) @@ -361,7 +389,10 @@ pdmp := endif # Flags that might be in WARN_CFLAGS but are not valid for Objective C. -NON_OBJC_CFLAGS = -Wignored-attributes -Wignored-qualifiers -Wopenmp-simd +NON_OBJC_CFLAGS = -Wignored-attributes -Wignored-qualifiers -Wopenmp-simd -Wnested-externs +# Ditto, but for C++. +NON_CXX_CFLAGS = -Wmissing-prototypes -Wnested-externs -Wold-style-definition \ + -Wstrict-prototypes -Wno-override-init # -Demacs makes some files produce the correct version for use in Emacs. # MYCPPFLAGS is for by-hand Emacs-specific overrides, e.g., @@ -372,22 +403,26 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ $(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \ $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(LIBGCCJIT_CFLAGS) $(DBUS_CFLAGS) \ $(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) $(XDBE_CFLAGS) \ - $(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \ + $(XINPUT_CFLAGS) $(WEBP_CFLAGS) $(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \ $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ $(HARFBUZZ_CFLAGS) $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ - $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) \ + $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) $(XSYNC_CFLAGS) \ $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ - $(WERROR_CFLAGS) + $(WERROR_CFLAGS) $(HAIKU_CFLAGS) $(XCOMPOSITE_CFLAGS) $(XSHAPE_CFLAGS) ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS) ALL_OBJC_CFLAGS = $(EMACS_CFLAGS) \ $(filter-out $(NON_OBJC_CFLAGS),$(WARN_CFLAGS)) $(CFLAGS) \ $(GNU_OBJC_CFLAGS) +ALL_CXX_CFLAGS = $(EMACS_CFLAGS) \ + $(filter-out $(NON_CXX_CFLAGS),$(WARN_CFLAGS)) $(CXXFLAGS) -.SUFFIXES: .m +.SUFFIXES: .m .cc .c.o: $(AM_V_CC)$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $(PROFILING_CFLAGS) $< .m.o: $(AM_V_CC)$(CC) -c $(CPPFLAGS) $(ALL_OBJC_CFLAGS) $(PROFILING_CFLAGS) $< +.cc.o: + $(AM_V_CXX)$(CXX) -c $(CPPFLAGS) $(ALL_CXX_CFLAGS) $(PROFILING_CFLAGS) $< ## lastfile must follow all files whose initialized data areas should ## be dumped as pure by dump-emacs. @@ -399,18 +434,20 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ minibuf.o fileio.o dired.o \ cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \ alloc.o pdumper.o data.o doc.o editfns.o callint.o \ - eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \ + eval.o floatfns.o fns.o sort.o font.o print.o lread.o $(MODULES_OBJ) \ syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \ process.o gnutls.o callproc.o \ region-cache.o sound.o timefns.o atimer.o \ doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \ $(XWIDGETS_OBJ) \ profiler.o decompress.o \ - thread.o systhread.o \ + thread.o systhread.o sqlite.o \ $(if $(HYBRID_MALLOC),sheap.o) \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \ - $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) -obj = $(base_obj) $(NS_OBJC_OBJ) + $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \ + $(HAIKU_OBJ) $(PGTK_OBJ) +doc_obj = $(base_obj) $(NS_OBJC_OBJ) +obj = $(doc_obj) $(HAIKU_CXX_OBJ) ## Object files used on some machine or other. ## These go in the DOC file on all machines in case they are needed. @@ -424,7 +461,8 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ w32.o w32console.o w32cygwinx.o w32fns.o w32heap.o w32inevt.o w32notify.o \ w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \ w16select.o widget.o xfont.o ftfont.o xftfont.o gtkutil.o \ - xsettings.o xgselect.o termcap.o hbfont.o + xsettings.o xgselect.o termcap.o hbfont.o \ + haikuterm.o haikufns.o haikumenu.o haikufont.o ## gmalloc.o if !SYSTEM_MALLOC && !DOUG_LEA_MALLOC, else empty. GMALLOC_OBJ=@GMALLOC_OBJ@ @@ -450,7 +488,11 @@ FIRSTFILE_OBJ=@FIRSTFILE_OBJ@ ALLOBJS = $(FIRSTFILE_OBJ) $(VMLIMIT_OBJ) $(obj) $(otherobj) # Must be first, before dep inclusion! +ifneq ($(HAVE_BE_APP),yes) all: emacs$(EXEEXT) $(pdmp) $(OTHER_FILES) +else +all: Emacs Emacs.pdmp $(OTHER_FILES) +endif ifeq ($(HAVE_NATIVE_COMP):$(NATIVE_DISABLED),yes:) all: ../native-lisp endif @@ -493,11 +535,11 @@ endif ## but the second one seems like it could be more future-proof. shortlisp = lisp.mk: $(lispsource)/loadup.el - @rm -f $@ ${AM_V_GEN}( printf 'shortlisp = \\\n'; \ sed -n 's/^[ \t]*(load "\([^"]*\)".*/\1/p' $< | \ sed -e 's/$$/.elc \\/' -e 's/\.el\.elc/.el/'; \ - echo "" ) > $@ + echo "" ) > $@.tmp + $(AM_V_at)mv -f $@.tmp $@ -include lisp.mk shortlisp_filter = leim/leim-list.el site-load.elc site-init.elc @@ -510,19 +552,20 @@ export LISP_PRELOADED = ${shortlisp} lisp = $(addprefix ${lispsource}/,${shortlisp}) ## Construct full set of libraries to be linked. -LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ +LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(PGTK_LIBS) $(LIBX_BASE) $(LIBIMAGE) \ $(LIBX_OTHER) $(LIBSOUND) \ $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_ACL) $(LIB_CLOCK_GETTIME) \ - $(WEBKIT_LIBS) \ + $(LIB_NANOSLEEP) $(WEBKIT_LIBS) \ $(LIB_EACCESS) $(LIB_TIMER_TIME) $(DBUS_LIBS) \ $(LIB_EXECINFO) $(XRANDR_LIBS) $(XINERAMA_LIBS) $(XFIXES_LIBS) \ - $(XDBE_LIBS) \ + $(XDBE_LIBS) $(XSYNC_LIBS) \ $(LIBXML2_LIBS) $(LIBGPM) $(LIBS_SYSTEM) $(CAIRO_LIBS) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ $(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_LIBS) + $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS) \ + $(SQLITE3_LIBS) $(XCOMPOSITE_LIBS) $(XSHAPE_LIBS) ## FORCE it so that admin/unidata can decide whether this file is ## up-to-date. Although since charprop depends on bootstrap-emacs, @@ -579,6 +622,18 @@ else rm -f $@ && cp -f temacs$(EXEEXT) $@ endif +## On Haiku, also produce a binary named Emacs with the appropriate +## icon set. + +ifeq ($(HAVE_BE_APP),yes) +Emacs: emacs$(EXEEXT) $(libsrc)/be-resources + $(AM_V_GEN) cp -f emacs$(EXEEXT) $@ + $(AM_V_at) $(libsrc)/be-resources \ + $(etc)/images/icons/hicolor/32x32/apps/emacs.png $@ +Emacs.pdmp: $(pdmp) + $(AM_V_GEN) cp -f $(pdmp) $@ +endif + ifeq ($(DUMPING),pdumper) $(pdmp): emacs$(EXEEXT) LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=pdump \ @@ -597,13 +652,13 @@ endif ## for the first time, this prevents any variation between configurations ## in the contents of the DOC file. ## -$(etc)/DOC: lisp.mk $(libsrc)/make-docfile$(EXEEXT) $(obj) $(lisp) +$(etc)/DOC: $(libsrc)/make-docfile$(EXEEXT) $(doc_obj) $(lispsource)/loaddefs.el $(AM_V_GEN)$(MKDIR_P) $(etc) $(AM_V_at)rm -f $(etc)/DOC $(AM_V_at)$(libsrc)/make-docfile -d $(srcdir) \ - $(SOME_MACHINE_OBJECTS) $(obj) > $(etc)/DOC + $(SOME_MACHINE_OBJECTS) $(doc_obj) > $(etc)/DOC $(AM_V_at)$(libsrc)/make-docfile -a $(etc)/DOC -d $(lispsource) \ - $(shortlisp) + loaddefs.el $(libsrc)/make-docfile$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT): \ $(lib)/libgnu.a @@ -619,7 +674,7 @@ buildobj.h: Makefile GLOBAL_SOURCES = $(base_obj:.o=.c) $(NS_OBJC_OBJ:.o=.m) gl-stamp: $(libsrc)/make-docfile$(EXEEXT) $(GLOBAL_SOURCES) - $(AM_V_GLOBALS)$(libsrc)/make-docfile -d $(srcdir) -g $(obj) > globals.tmp + $(AM_V_GLOBALS)$(libsrc)/make-docfile -d $(srcdir) -g $(doc_obj) > globals.tmp $(AM_V_at)$(top_srcdir)/build-aux/move-if-change globals.tmp globals.h $(AM_V_at)echo timestamp > $@ @@ -633,9 +688,9 @@ $(LIBEGNU_ARCHIVE): $(config_h) $(MAKE) -C $(dir $@) all ifeq ($(HAVE_PDUMPER),yes) - MAKE_PDUMPER_FINGERPRINT = $(libsrc)/make-fingerprint$(EXEEXT) +MAKE_PDUMPER_FINGERPRINT = $(libsrc)/make-fingerprint$(EXEEXT) else - MAKE_PDUMPER_FINGERPRINT = +MAKE_PDUMPER_FINGERPRINT = endif ## We have to create $(etc) here because init_cmdargs tests its @@ -644,9 +699,15 @@ endif ## to start if Vinstallation_directory has the wrong value. temacs$(EXEEXT): $(LIBXMENU) $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(EMACSRES) \ $(charsets) $(charscript) ${emoji-zwj} $(MAKE_PDUMPER_FINGERPRINT) - $(AM_V_CCLD)$(CC) -o $@.tmp \ +ifeq ($(HAVE_BE_APP),yes) + $(AM_V_CXXLD)$(CXX) -o $@.tmp \ $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \ + $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES) -lstdc++ +else + $(AM_V_CCLD)$(CC) -o $@.tmp \ + $(ALL_CFLAGS) $(CXXFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \ $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES) +endif ifeq ($(HAVE_PDUMPER),yes) $(AM_V_at)$(MAKE_PDUMPER_FINGERPRINT) $@.tmp ifeq ($(DO_CODESIGN),yes) @@ -731,6 +792,7 @@ ${ETAGS}: FORCE # to be built before we can get TAGS. ctagsfiles1 = $(filter-out ${srcdir}/macuvs.h, $(wildcard ${srcdir}/*.[hc])) ctagsfiles2 = $(wildcard ${srcdir}/*.m) +ctagsfiles3 = $(wildcard ${srcdir}/*.cc) ## In out-of-tree builds, TAGS are generated in the build dir, like ## other non-bootstrap build products (see Bug#31744). @@ -745,7 +807,8 @@ TAGS: ${ETAGS} $(ctagsfiles1) $(ctagsfiles2) $(ctagsfiles1) \ --regex='{objc}/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/\1/' \ --regex='{objc}/[ ]*DEFVAR_[A-Z_ (]+"[^"]+",[ ]\([A-Za-z0-9_]+\)/\1/' \ - $(ctagsfiles2) + $(ctagsfiles2) \ + $(ctagsfiles3) ## Arrange to make tags tables for ../lisp and ../lwlib, ## which the above TAGS file for the C files includes by reference. @@ -796,16 +859,6 @@ elnlisp := \ international/charscript.eln \ emacs-lisp/comp.eln \ emacs-lisp/comp-cstr.eln \ - emacs-lisp/cl-macs.eln \ - emacs-lisp/rx.eln \ - emacs-lisp/cl-seq.eln \ - help-mode.eln \ - emacs-lisp/cl-extra.eln \ - emacs-lisp/gv.eln \ - emacs-lisp/seq.eln \ - emacs-lisp/cl-lib.eln \ - emacs-lisp/warnings.eln \ - emacs-lisp/subr-x.eln \ international/emoji-zwj.eln elnlisp := $(addprefix ${lispsource}/,${elnlisp}) $(lisp:.elc=.eln) @@ -860,6 +913,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) @@ -868,6 +924,9 @@ $(bootstrap_pdmp): bootstrap-emacs$(EXEEXT) $(RUN_TEMACS) --batch $(BUILD_DETAILS) -l loadup --temacs=pbootstrap \ --bin-dest $(BIN_DESTDIR) --eln-dest $(ELN_DESTDIR) @: Compile some files earlier to speed up further compilation. + @: First, byte compile these files, .... + ANCIENT=yes $(MAKE) -C ../lisp compile-first EMACS="$(bootstrap_exe)" + @: .... then use their .elcs in native compiling these and other files. $(MAKE) -C ../lisp compile-first EMACS="$(bootstrap_exe)" endif diff --git a/src/alloc.c b/src/alloc.c index 5ad80973949..8fd981a51f9 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -125,6 +125,7 @@ union emacs_align_type struct Lisp_Overlay Lisp_Overlay; struct Lisp_Sub_Char_Table Lisp_Sub_Char_Table; struct Lisp_Subr Lisp_Subr; + struct Lisp_Sqlite Lisp_Sqlite; struct Lisp_User_Ptr Lisp_User_Ptr; struct Lisp_Vector Lisp_Vector; struct terminal terminal; @@ -444,26 +445,11 @@ static void compact_small_strings (void); static void free_large_strings (void); extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; -/* Forward declare mark accessor functions: they're used all over the - place. */ - -inline static bool vector_marked_p (const struct Lisp_Vector *v); -inline static void set_vector_marked (struct Lisp_Vector *v); - -inline static bool vectorlike_marked_p (const union vectorlike_header *v); -inline static void set_vectorlike_marked (union vectorlike_header *v); - -inline static bool cons_marked_p (const struct Lisp_Cons *c); -inline static void set_cons_marked (struct Lisp_Cons *c); - -inline static bool string_marked_p (const struct Lisp_String *s); -inline static void set_string_marked (struct Lisp_String *s); - -inline static bool symbol_marked_p (const struct Lisp_Symbol *s); -inline static void set_symbol_marked (struct Lisp_Symbol *s); - -inline static bool interval_marked_p (INTERVAL i); -inline static void set_interval_marked (INTERVAL i); +static bool vector_marked_p (struct Lisp_Vector const *); +static bool vectorlike_marked_p (union vectorlike_header const *); +static void set_vectorlike_marked (union vectorlike_header *); +static bool interval_marked_p (INTERVAL); +static void set_interval_marked (INTERVAL); /* When scanning the C stack for live Lisp objects, Emacs keeps track of what memory allocated via lisp_malloc and lisp_align_malloc is intended @@ -591,7 +577,7 @@ pointer_align (void *ptr, int alignment) static ATTRIBUTE_NO_SANITIZE_UNDEFINED void * XPNTR (Lisp_Object a) { - return (SYMBOLP (a) + return (BARE_SYMBOL_P (a) ? (char *) lispsym + (XLI (a) - LISP_WORD_TAG (Lisp_Symbol)) : (char *) XLP (a) - (XLI (a) & ~VALMASK)); } @@ -765,7 +751,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 +768,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 +782,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; @@ -988,8 +974,7 @@ record_xmalloc (size_t size) /* Like malloc but used for allocating Lisp data. NBYTES is the number of bytes to allocate, TYPE describes the intended use of the - allocated memory block (for strings, for conses, ...). - NBYTES must be positive. */ + allocated memory block (for strings, for conses, ...). */ #if ! USE_LSB_TAG void *lisp_malloc_loser EXTERNALLY_VISIBLE; @@ -1330,16 +1315,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 @@ -1353,8 +1342,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 @@ -1362,7 +1356,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; @@ -1377,7 +1371,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) @@ -1844,7 +1838,8 @@ allocate_string (void) static void allocate_string_data (struct Lisp_String *s, - EMACS_INT nchars, EMACS_INT nbytes, bool clearit) + EMACS_INT nchars, EMACS_INT nbytes, bool clearit, + bool immovable) { sdata *data; struct sblock *b; @@ -1858,7 +1853,7 @@ allocate_string_data (struct Lisp_String *s, MALLOC_BLOCK_INPUT; - if (nbytes > LARGE_STRING_BYTES) + if (nbytes > LARGE_STRING_BYTES || immovable) { size_t size = FLEXSIZEOF (struct sblock, data, needed); @@ -1958,7 +1953,7 @@ resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte, } else { - allocate_string_data (XSTRING (string), nchars, new_nbytes, false); + allocate_string_data (XSTRING (string), nchars, new_nbytes, false, false); unsigned char *new_data = SDATA (string); new_charaddr = new_data + cidx_byte; memcpy (new_charaddr + new_clen, data + cidx_byte + clen, @@ -2474,7 +2469,7 @@ make_clear_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes, bool clearit) s = allocate_string (); s->u.s.intervals = NULL; - allocate_string_data (s, nchars, nbytes, clearit); + allocate_string_data (s, nchars, nbytes, clearit, false); XSETSTRING (string, s); string_chars_consed += nbytes; return string; @@ -2504,6 +2499,29 @@ make_formatted_string (char *buf, const char *format, ...) return make_string (buf, length); } +/* Pin a unibyte string in place so that it won't move during GC. */ +void +pin_string (Lisp_Object string) +{ + eassert (STRINGP (string) && !STRING_MULTIBYTE (string)); + struct Lisp_String *s = XSTRING (string); + ptrdiff_t size = STRING_BYTES (s); + unsigned char *data = s->u.s.data; + + if (!(size > LARGE_STRING_BYTES + || PURE_P (data) || pdumper_object_p (data) + || s->u.s.size_byte == -3)) + { + eassert (s->u.s.size_byte == -1); + sdata *old_sdata = SDATA_OF_STRING (s); + allocate_string_data (s, size, size, false, true); + memcpy (s->u.s.data, data, size); + old_sdata->string = NULL; + SDATA_NBYTES (old_sdata) = size; + } + s->u.s.size_byte = -3; +} + /*********************************************************************** Float Allocation @@ -3506,6 +3524,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT && FIXNATP (args[COMPILED_STACK_DEPTH]))) error ("Invalid byte-code object"); + pin_string (args[COMPILED_BYTECODE]); // Bytecode must be immovable. + /* We used to purecopy everything here, if purify-flag was set. This worked OK for Emacs-23, but with Emacs-24's lexical binding code, it can be dangerous, since make-byte-code is used during execution to build @@ -3590,13 +3610,13 @@ static struct Lisp_Symbol *symbol_free_list; static void set_symbol_name (Lisp_Object sym, Lisp_Object name) { - XSYMBOL (sym)->u.s.name = name; + XBARE_SYMBOL (sym)->u.s.name = name; } void init_symbol (Lisp_Object val, Lisp_Object name) { - struct Lisp_Symbol *p = XSYMBOL (val); + struct Lisp_Symbol *p = XBARE_SYMBOL (val); set_symbol_name (val, name); set_symbol_plist (val, Qnil); p->u.s.redirect = SYMBOL_PLAINVAL; @@ -3659,6 +3679,21 @@ make_misc_ptr (void *a) return make_lisp_ptr (p, Lisp_Vectorlike); } +/* Return a new symbol with position with the specified SYMBOL and POSITION. */ +Lisp_Object +build_symbol_with_pos (Lisp_Object symbol, Lisp_Object position) +{ + Lisp_Object val; + struct Lisp_Symbol_With_Pos *p + = (struct Lisp_Symbol_With_Pos *) allocate_vector (2); + XSETVECTOR (val, p); + XSETPVECTYPESIZE (XVECTOR (val), PVEC_SYMBOL_WITH_POS, 2, 0); + p->sym = symbol; + p->pos = position; + + return val; +} + /* Return a new overlay with specified START, END and PLIST. */ Lisp_Object @@ -3841,7 +3876,7 @@ run_finalizer_handler (Lisp_Object args) static void run_finalizer_function (Lisp_Object function) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef HAVE_PDUMPER ++number_finalizers_run; #endif @@ -3879,6 +3914,7 @@ count as reachable for the purpose of deciding whether to run FUNCTION. FUNCTION will be run once per finalizer object. */) (Lisp_Object function) { + CHECK_TYPE (FUNCTIONP (function), Qfunctionp, function); struct Lisp_Finalizer *finalizer = ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, function, PVEC_FINALIZER); finalizer->function = function; @@ -4874,10 +4910,10 @@ mark_maybe_pointer (void *p, bool symbol_only) miss objects if __alignof__ were used. */ #define GC_POINTER_ALIGNMENT alignof (void *) -/* Mark Lisp objects referenced from the address range START+OFFSET..END - or END+OFFSET..START. */ +/* Mark Lisp objects referenced from the address range START..END + or END..START. */ -static void ATTRIBUTE_NO_SANITIZE_ADDRESS +void ATTRIBUTE_NO_SANITIZE_ADDRESS mark_memory (void const *start, void const *end) { char const *pp; @@ -4946,7 +4982,7 @@ marking. Emacs has determined that the method it uses to do the\n\ marking will likely work on your system, but this isn't sure.\n\ \n\ If you are a system-programmer, or can get the help of a local wizard\n\ -who is, please take a look at the function mark_stack in alloc.c, and\n\ +who is, please take a look at the function mark_c_stack in alloc.c, and\n\ verify that the methods used are appropriate for your system.\n\ \n\ Please mail the result to <emacs-devel@gnu.org>.\n\ @@ -4959,7 +4995,7 @@ marking. Emacs has determined that the default method it uses to do the\n\ marking will not work on your system. We will need a system-dependent\n\ solution for your system.\n\ \n\ -Please take a look at the function mark_stack in alloc.c, and\n\ +Please take a look at the function mark_c_stack in alloc.c, and\n\ try to find a way to make it work on your system.\n\ \n\ Note that you may get false negatives, depending on the compiler.\n\ @@ -5101,7 +5137,7 @@ typedef union from the stack start. */ void -mark_stack (char const *bottom, char const *end) +mark_c_stack (char const *bottom, char const *end) { /* This assumes that the stack is a contiguous region in memory. If that's not the case, something has to be done here to iterate @@ -5202,7 +5238,7 @@ valid_lisp_object_p (Lisp_Object obj) if (PURE_P (p)) return 1; - if (SYMBOLP (obj) && c_symbol_p (p)) + if (BARE_SYMBOL_P (obj) && c_symbol_p (p)) return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0; if (p == &buffer_defaults || p == &buffer_local_symbols) @@ -5628,14 +5664,18 @@ purecopy (Lisp_Object obj) memcpy (vec, objp, nbytes); for (i = 0; i < size; i++) vec->contents[i] = purecopy (vec->contents[i]); + // Byte code strings must be pinned. + if (COMPILEDP (obj) && size >= 2 && STRINGP (vec->contents[1]) + && !STRING_MULTIBYTE (vec->contents[1])) + pin_string (vec->contents[1]); XSETVECTOR (obj, vec); } - else if (SYMBOLP (obj)) + else if (BARE_SYMBOL_P (obj)) { - if (!XSYMBOL (obj)->u.s.pinned && !c_symbol_p (XSYMBOL (obj))) + if (!XBARE_SYMBOL (obj)->u.s.pinned && !c_symbol_p (XBARE_SYMBOL (obj))) { /* We can't purify them, but they appear in many pure objects. Mark them as `pinned' so we know to mark them at every GC cycle. */ - XSYMBOL (obj)->u.s.pinned = true; + XBARE_SYMBOL (obj)->u.s.pinned = true; symbol_block_pinned = symbol_block; } /* Don't hash-cons it. */ @@ -5689,10 +5729,10 @@ allow_garbage_collection (intmax_t consing) garbage_collection_inhibited--; } -ptrdiff_t +specpdl_ref inhibit_garbage_collection (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_intmax (allow_garbage_collection, consing_until_gc); garbage_collection_inhibited++; consing_until_gc = HI_THRESHOLD; @@ -6045,6 +6085,8 @@ maybe_garbage_collect (void) garbage_collect (); } +static inline bool mark_stack_empty_p (void); + /* Subroutine of Fgarbage_collect that does most of the work. */ void garbage_collect (void) @@ -6052,7 +6094,7 @@ garbage_collect (void) Lisp_Object tail, buffer; char stack_top_variable; bool message_p; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct timespec start; eassert (weak_hash_tables == NULL); @@ -6060,6 +6102,8 @@ garbage_collect (void) if (garbage_collection_inhibited) return; + eassert(mark_stack_empty_p ()); + /* Record this function, so it appears on the profiler's backtraces. */ record_in_backtrace (QAutomatic_GC, 0, 0); @@ -6136,15 +6180,26 @@ garbage_collect (void) mark_terminals (); mark_kboards (); mark_threads (); +#ifdef HAVE_PGTK + mark_pgtkterm (); +#endif #ifdef USE_GTK xg_mark_data (); #endif +#ifdef HAVE_HAIKU + mark_haiku_display (); +#endif + #ifdef HAVE_WINDOW_SYSTEM mark_fringe_data (); #endif +#ifdef HAVE_X_WINDOWS + mark_xterm (); +#endif + /* Everything is now marked, except for the data in font caches, undo lists, and finalizers. The first two are compacted by removing an items which aren't reachable otherwise. */ @@ -6175,6 +6230,8 @@ garbage_collect (void) mark_and_sweep_weak_table_contents (); eassert (weak_hash_tables == NULL); + eassert (mark_stack_empty_p ()); + gc_sweep (); unmark_main_thread (); @@ -6203,7 +6260,7 @@ garbage_collect (void) if (!NILP (Vpost_gc_hook)) { - ptrdiff_t gc_count = inhibit_garbage_collection (); + specpdl_ref gc_count = inhibit_garbage_collection (); safe_run_hooks (Qpost_gc_hook); unbind_to (gc_count, Qnil); } @@ -6256,7 +6313,10 @@ For further details, see Info node `(elisp)Garbage Collection'. */) if (garbage_collection_inhibited) return Qnil; + specpdl_ref count = SPECPDL_INDEX (); + specbind (Qsymbols_with_pos_enabled, Qnil); garbage_collect (); + unbind_to (count, Qnil); struct gcstat gcst = gcstat; Lisp_Object total[] = { @@ -6345,15 +6405,25 @@ mark_glyph_matrix (struct glyph_matrix *matrix) } } +/* Whether to remember a few of the last marked values for debugging. */ +#define GC_REMEMBER_LAST_MARKED 0 + +#if GC_REMEMBER_LAST_MARKED enum { LAST_MARKED_SIZE = 1 << 9 }; /* Must be a power of 2. */ Lisp_Object last_marked[LAST_MARKED_SIZE] EXTERNALLY_VISIBLE; static int last_marked_index; +#endif + +/* Whether to enable the mark_object_loop_halt debugging feature. */ +#define GC_CDR_COUNT 0 +#if GC_CDR_COUNT /* For debugging--call abort when we cdr down this many links of a list, in mark_object. In debugging, the call to abort will hit a breakpoint. Normally this is zero and the check never goes off. */ ptrdiff_t mark_object_loop_halt EXTERNALLY_VISIBLE; +#endif static void mark_vectorlike (union vectorlike_header *header) @@ -6395,7 +6465,7 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype) Lisp_Object val = ptr->contents[i]; if (FIXNUMP (val) || - (SYMBOLP (val) && symbol_marked_p (XSYMBOL (val)))) + (BARE_SYMBOL_P (val) && symbol_marked_p (XBARE_SYMBOL (val)))) continue; if (SUB_CHAR_TABLE_P (val)) { @@ -6407,19 +6477,6 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype) } } -NO_INLINE /* To reduce stack depth in mark_object. */ -static Lisp_Object -mark_compiled (struct Lisp_Vector *ptr) -{ - int i, size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; - - set_vector_marked (ptr); - for (i = 0; i < size; i++) - if (i != COMPILED_CONSTANTS) - mark_object (ptr->contents[i]); - return size > COMPILED_CONSTANTS ? ptr->contents[COMPILED_CONSTANTS] : Qnil; -} - /* Mark the chain of overlays starting at PTR. */ static void @@ -6572,110 +6629,160 @@ mark_window (struct Lisp_Vector *ptr) (w, mark_discard_killed_buffers (w->next_buffers)); } -static void -mark_hash_table (struct Lisp_Vector *ptr) -{ - struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr; - - mark_vectorlike (&h->header); - mark_object (h->test.name); - mark_object (h->test.user_hash_function); - mark_object (h->test.user_cmp_function); - /* If hash table is not weak, mark all keys and values. For weak - tables, mark only the vector and not its contents --- that's what - makes it weak. */ - if (NILP (h->weak)) - mark_object (h->key_and_value); - else +/* Entry of the mark stack. */ +struct mark_entry +{ + ptrdiff_t n; /* number of values, or 0 if a single value */ + union { + Lisp_Object value; /* when n = 0 */ + Lisp_Object *values; /* when n > 0 */ + } u; +}; + +/* This stack is used during marking for traversing data structures without + using C recursion. */ +struct mark_stack +{ + struct mark_entry *stack; /* base of stack */ + ptrdiff_t size; /* allocated size in entries */ + ptrdiff_t sp; /* current number of entries */ +}; + +static struct mark_stack mark_stk = {NULL, 0, 0}; + +static inline bool +mark_stack_empty_p (void) +{ + return mark_stk.sp <= 0; +} + +/* Pop and return a value from the mark stack (which must be nonempty). */ +static inline Lisp_Object +mark_stack_pop (void) +{ + eassume (!mark_stack_empty_p ()); + struct mark_entry *e = &mark_stk.stack[mark_stk.sp - 1]; + if (e->n == 0) /* single value */ { - eassert (h->next_weak == NULL); - h->next_weak = weak_hash_tables; - weak_hash_tables = h; - set_vector_marked (XVECTOR (h->key_and_value)); + --mark_stk.sp; + return e->u.value; } + /* Array of values: pop them left to right, which seems to be slightly + faster than right to left. */ + e->n--; + if (e->n == 0) + --mark_stk.sp; /* last value consumed */ + return (++e->u.values)[-1]; } -void -mark_objects (Lisp_Object *obj, ptrdiff_t n) +NO_INLINE static void +grow_mark_stack (void) { - for (ptrdiff_t i = 0; i < n; i++) - mark_object (obj[i]); + struct mark_stack *ms = &mark_stk; + eassert (ms->sp == ms->size); + ptrdiff_t min_incr = ms->sp == 0 ? 8192 : 1; + ms->stack = xpalloc (ms->stack, &ms->size, min_incr, -1, sizeof *ms->stack); + eassert (ms->sp < ms->size); } -/* Determine type of generic Lisp_Object and mark it accordingly. +/* Push VALUE onto the mark stack. */ +static inline void +mark_stack_push_value (Lisp_Object value) +{ + if (mark_stk.sp >= mark_stk.size) + grow_mark_stack (); + mark_stk.stack[mark_stk.sp++] = (struct mark_entry){.n = 0, .u.value = value}; +} - This function implements a straightforward depth-first marking - algorithm and so the recursion depth may be very high (a few - tens of thousands is not uncommon). To minimize stack usage, - a few cold paths are moved out to NO_INLINE functions above. - In general, inlining them doesn't help you to gain more speed. */ +/* Push the N values at VALUES onto the mark stack. */ +static inline void +mark_stack_push_values (Lisp_Object *values, ptrdiff_t n) +{ + eassume (n >= 0); + if (n == 0) + return; + if (mark_stk.sp >= mark_stk.size) + grow_mark_stack (); + mark_stk.stack[mark_stk.sp++] = (struct mark_entry){.n = n, + .u.values = values}; +} -void -mark_object (Lisp_Object arg) +/* Traverse and mark objects on the mark stack above BASE_SP. + + Traversal is depth-first using the mark stack for most common + object types. Recursion is used for other types, in the hope that + they are rare enough that C stack usage is kept low. */ +static void +process_mark_stack (ptrdiff_t base_sp) { - register Lisp_Object obj; - void *po; #if GC_CHECK_MARKED_OBJECTS struct mem_node *m = NULL; #endif +#if GC_CDR_COUNT ptrdiff_t cdr_count = 0; +#endif - obj = arg; - loop: + eassume (mark_stk.sp >= base_sp && base_sp >= 0); - po = XPNTR (obj); - if (PURE_P (po)) - return; + while (mark_stk.sp > base_sp) + { + Lisp_Object obj = mark_stack_pop (); + mark_obj: ; + void *po = XPNTR (obj); + if (PURE_P (po)) + continue; - last_marked[last_marked_index++] = obj; - last_marked_index &= LAST_MARKED_SIZE - 1; +#if GC_REMEMBER_LAST_MARKED + last_marked[last_marked_index++] = obj; + last_marked_index &= LAST_MARKED_SIZE - 1; +#endif - /* Perform some sanity checks on the objects marked here. Abort if - we encounter an object we know is bogus. This increases GC time - by ~80%. */ + /* Perform some sanity checks on the objects marked here. Abort if + we encounter an object we know is bogus. This increases GC time + by ~80%. */ #if GC_CHECK_MARKED_OBJECTS - /* Check that the object pointed to by PO is known to be a Lisp - structure allocated from the heap. */ + /* Check that the object pointed to by PO is known to be a Lisp + structure allocated from the heap. */ #define CHECK_ALLOCATED() \ - do { \ - if (pdumper_object_p (po)) \ - { \ - if (!pdumper_object_p_precise (po)) \ - emacs_abort (); \ - break; \ - } \ - m = mem_find (po); \ - if (m == MEM_NIL) \ - emacs_abort (); \ - } while (0) - - /* Check that the object pointed to by PO is live, using predicate - function LIVEP. */ -#define CHECK_LIVE(LIVEP, MEM_TYPE) \ - do { \ - if (pdumper_object_p (po)) \ - break; \ - if (! (m->type == MEM_TYPE && LIVEP (m, po))) \ - emacs_abort (); \ - } while (0) - - /* Check both of the above conditions, for non-symbols. */ -#define CHECK_ALLOCATED_AND_LIVE(LIVEP, MEM_TYPE) \ - do { \ - CHECK_ALLOCATED (); \ - CHECK_LIVE (LIVEP, MEM_TYPE); \ - } while (false) - - /* Check both of the above conditions, for symbols. */ -#define CHECK_ALLOCATED_AND_LIVE_SYMBOL() \ - do { \ - if (!c_symbol_p (ptr)) \ - { \ - CHECK_ALLOCATED (); \ - CHECK_LIVE (live_symbol_p, MEM_TYPE_SYMBOL); \ - } \ - } while (false) + do { \ + if (pdumper_object_p (po)) \ + { \ + if (!pdumper_object_p_precise (po)) \ + emacs_abort (); \ + break; \ + } \ + m = mem_find (po); \ + if (m == MEM_NIL) \ + emacs_abort (); \ + } while (0) + + /* Check that the object pointed to by PO is live, using predicate + function LIVEP. */ +#define CHECK_LIVE(LIVEP, MEM_TYPE) \ + do { \ + if (pdumper_object_p (po)) \ + break; \ + if (! (m->type == MEM_TYPE && LIVEP (m, po))) \ + emacs_abort (); \ + } while (0) + + /* Check both of the above conditions, for non-symbols. */ +#define CHECK_ALLOCATED_AND_LIVE(LIVEP, MEM_TYPE) \ + do { \ + CHECK_ALLOCATED (); \ + CHECK_LIVE (LIVEP, MEM_TYPE); \ + } while (false) + + /* Check both of the above conditions, for symbols. */ +#define CHECK_ALLOCATED_AND_LIVE_SYMBOL() \ + do { \ + if (!c_symbol_p (ptr)) \ + { \ + CHECK_ALLOCATED (); \ + CHECK_LIVE (live_symbol_p, MEM_TYPE_SYMBOL); \ + } \ + } while (false) #else /* not GC_CHECK_MARKED_OBJECTS */ @@ -6684,199 +6791,220 @@ mark_object (Lisp_Object arg) #endif /* not GC_CHECK_MARKED_OBJECTS */ - switch (XTYPE (obj)) - { - case Lisp_String: - { - register struct Lisp_String *ptr = XSTRING (obj); - if (string_marked_p (ptr)) - break; - CHECK_ALLOCATED_AND_LIVE (live_string_p, MEM_TYPE_STRING); - set_string_marked (ptr); - mark_interval_tree (ptr->u.s.intervals); + switch (XTYPE (obj)) + { + case Lisp_String: + { + register struct Lisp_String *ptr = XSTRING (obj); + if (string_marked_p (ptr)) + break; + CHECK_ALLOCATED_AND_LIVE (live_string_p, MEM_TYPE_STRING); + set_string_marked (ptr); + mark_interval_tree (ptr->u.s.intervals); #ifdef GC_CHECK_STRING_BYTES - /* Check that the string size recorded in the string is the - same as the one recorded in the sdata structure. */ - string_bytes (ptr); + /* Check that the string size recorded in the string is the + same as the one recorded in the sdata structure. */ + string_bytes (ptr); #endif /* GC_CHECK_STRING_BYTES */ - } - break; + } + break; - case Lisp_Vectorlike: - { - register struct Lisp_Vector *ptr = XVECTOR (obj); + case Lisp_Vectorlike: + { + register struct Lisp_Vector *ptr = XVECTOR (obj); - if (vector_marked_p (ptr)) - break; + if (vector_marked_p (ptr)) + break; - enum pvec_type pvectype - = PSEUDOVECTOR_TYPE (ptr); + enum pvec_type pvectype + = PSEUDOVECTOR_TYPE (ptr); #ifdef GC_CHECK_MARKED_OBJECTS - if (!pdumper_object_p (po) && !SUBRP (obj) && !main_thread_p (po)) - { - m = mem_find (po); - if (m == MEM_NIL) - emacs_abort (); - if (m->type == MEM_TYPE_VECTORLIKE) - CHECK_LIVE (live_large_vector_p, MEM_TYPE_VECTORLIKE); - else - CHECK_LIVE (live_small_vector_p, MEM_TYPE_VECTOR_BLOCK); - } + if (!pdumper_object_p (po) && !SUBRP (obj) && !main_thread_p (po)) + { + m = mem_find (po); + if (m == MEM_NIL) + emacs_abort (); + if (m->type == MEM_TYPE_VECTORLIKE) + CHECK_LIVE (live_large_vector_p, MEM_TYPE_VECTORLIKE); + else + CHECK_LIVE (live_small_vector_p, MEM_TYPE_VECTOR_BLOCK); + } #endif - switch (pvectype) - { - case PVEC_BUFFER: - mark_buffer ((struct buffer *) ptr); - break; - - case PVEC_COMPILED: - /* Although we could treat this just like a vector, mark_compiled - returns the COMPILED_CONSTANTS element, which is marked at the - next iteration of goto-loop here. This is done to avoid a few - recursive calls to mark_object. */ - obj = mark_compiled (ptr); - if (!NILP (obj)) - goto loop; - break; - - case PVEC_FRAME: - mark_frame (ptr); - break; - - case PVEC_WINDOW: - mark_window (ptr); - break; - - case PVEC_HASH_TABLE: - mark_hash_table (ptr); - break; - - case PVEC_CHAR_TABLE: - case PVEC_SUB_CHAR_TABLE: - mark_char_table (ptr, (enum pvec_type) pvectype); - break; - - case PVEC_BOOL_VECTOR: - /* bool vectors in a dump are permanently "marked", since - they're in the old section and don't have mark bits. - If we're looking at a dumped bool vector, we should - have aborted above when we called vector_marked_p, so - we should never get here. */ - eassert (!pdumper_object_p (ptr)); - set_vector_marked (ptr); - break; - - case PVEC_OVERLAY: - mark_overlay (XOVERLAY (obj)); - break; - - case PVEC_SUBR: -#ifdef HAVE_NATIVE_COMP - if (SUBR_NATIVE_COMPILEDP (obj)) + switch (pvectype) { + case PVEC_BUFFER: + mark_buffer ((struct buffer *) ptr); + break; + + case PVEC_FRAME: + mark_frame (ptr); + break; + + case PVEC_WINDOW: + mark_window (ptr); + break; + + case PVEC_HASH_TABLE: + { + struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *)ptr; + ptrdiff_t size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK; + set_vector_marked (ptr); + mark_stack_push_values (ptr->contents, size); + mark_stack_push_value (h->test.name); + mark_stack_push_value (h->test.user_hash_function); + mark_stack_push_value (h->test.user_cmp_function); + if (NILP (h->weak)) + mark_stack_push_value (h->key_and_value); + else + { + /* For weak tables, mark only the vector and not its + contents --- that's what makes it weak. */ + eassert (h->next_weak == NULL); + h->next_weak = weak_hash_tables; + weak_hash_tables = h; + set_vector_marked (XVECTOR (h->key_and_value)); + } + break; + } + + case PVEC_CHAR_TABLE: + case PVEC_SUB_CHAR_TABLE: + mark_char_table (ptr, (enum pvec_type) pvectype); + break; + + case PVEC_BOOL_VECTOR: + /* bool vectors in a dump are permanently "marked", since + they're in the old section and don't have mark bits. + If we're looking at a dumped bool vector, we should + have aborted above when we called vector_marked_p, so + we should never get here. */ + eassert (!pdumper_object_p (ptr)); set_vector_marked (ptr); - struct Lisp_Subr *subr = XSUBR (obj); - mark_object (subr->native_intspec); - mark_object (subr->native_comp_u); - mark_object (subr->lambda_list); - mark_object (subr->type); - } + break; + + case PVEC_OVERLAY: + mark_overlay (XOVERLAY (obj)); + break; + + case PVEC_SUBR: +#ifdef HAVE_NATIVE_COMP + if (SUBR_NATIVE_COMPILEDP (obj)) + { + set_vector_marked (ptr); + struct Lisp_Subr *subr = XSUBR (obj); + mark_stack_push_value (subr->native_intspec); + mark_stack_push_value (subr->command_modes); + mark_stack_push_value (subr->native_comp_u); + mark_stack_push_value (subr->lambda_list); + mark_stack_push_value (subr->type); + } #endif - break; + break; - case PVEC_FREE: - emacs_abort (); + case PVEC_FREE: + emacs_abort (); - default: - /* A regular vector, or a pseudovector needing no special - treatment. */ - mark_vectorlike (&ptr->header); + default: + { + /* A regular vector or pseudovector needing no special + treatment. */ + ptrdiff_t size = ptr->header.size; + if (size & PSEUDOVECTOR_FLAG) + size &= PSEUDOVECTOR_SIZE_MASK; + set_vector_marked (ptr); + mark_stack_push_values (ptr->contents, size); + } + break; + } } - } - break; + break; - case Lisp_Symbol: - { - struct Lisp_Symbol *ptr = XSYMBOL (obj); - nextsym: - if (symbol_marked_p (ptr)) - break; - CHECK_ALLOCATED_AND_LIVE_SYMBOL (); - set_symbol_marked (ptr); - /* Attempt to catch bogus objects. */ - eassert (valid_lisp_object_p (ptr->u.s.function)); - mark_object (ptr->u.s.function); - mark_object (ptr->u.s.plist); - switch (ptr->u.s.redirect) + case Lisp_Symbol: { - case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break; - case SYMBOL_VARALIAS: - { - Lisp_Object tem; - XSETSYMBOL (tem, SYMBOL_ALIAS (ptr)); - mark_object (tem); + struct Lisp_Symbol *ptr = XBARE_SYMBOL (obj); + nextsym: + if (symbol_marked_p (ptr)) break; - } - case SYMBOL_LOCALIZED: - mark_localized_symbol (ptr); - break; - case SYMBOL_FORWARDED: - /* If the value is forwarded to a buffer or keyboard field, - these are marked when we see the corresponding object. - And if it's forwarded to a C variable, either it's not - a Lisp_Object var, or it's staticpro'd already. */ - break; - default: emacs_abort (); + CHECK_ALLOCATED_AND_LIVE_SYMBOL (); + set_symbol_marked (ptr); + /* Attempt to catch bogus objects. */ + eassert (valid_lisp_object_p (ptr->u.s.function)); + mark_stack_push_value (ptr->u.s.function); + mark_stack_push_value (ptr->u.s.plist); + switch (ptr->u.s.redirect) + { + case SYMBOL_PLAINVAL: + mark_stack_push_value (SYMBOL_VAL (ptr)); + break; + case SYMBOL_VARALIAS: + { + Lisp_Object tem; + XSETSYMBOL (tem, SYMBOL_ALIAS (ptr)); + mark_stack_push_value (tem); + break; + } + case SYMBOL_LOCALIZED: + mark_localized_symbol (ptr); + break; + case SYMBOL_FORWARDED: + /* If the value is forwarded to a buffer or keyboard field, + these are marked when we see the corresponding object. + And if it's forwarded to a C variable, either it's not + a Lisp_Object var, or it's staticpro'd already. */ + break; + default: emacs_abort (); + } + if (!PURE_P (XSTRING (ptr->u.s.name))) + set_string_marked (XSTRING (ptr->u.s.name)); + mark_interval_tree (string_intervals (ptr->u.s.name)); + /* Inner loop to mark next symbol in this bucket, if any. */ + po = ptr = ptr->u.s.next; + if (ptr) + goto nextsym; } - if (!PURE_P (XSTRING (ptr->u.s.name))) - set_string_marked (XSTRING (ptr->u.s.name)); - mark_interval_tree (string_intervals (ptr->u.s.name)); - /* Inner loop to mark next symbol in this bucket, if any. */ - po = ptr = ptr->u.s.next; - if (ptr) - goto nextsym; - } - break; - - case Lisp_Cons: - { - struct Lisp_Cons *ptr = XCONS (obj); - if (cons_marked_p (ptr)) break; - CHECK_ALLOCATED_AND_LIVE (live_cons_p, MEM_TYPE_CONS); - set_cons_marked (ptr); - /* If the cdr is nil, avoid recursion for the car. */ - if (NILP (ptr->u.s.u.cdr)) + + case Lisp_Cons: { + struct Lisp_Cons *ptr = XCONS (obj); + if (cons_marked_p (ptr)) + break; + CHECK_ALLOCATED_AND_LIVE (live_cons_p, MEM_TYPE_CONS); + set_cons_marked (ptr); + /* Avoid growing the stack if the cdr is nil. + In any case, make sure the car is expanded first. */ + if (!NILP (ptr->u.s.u.cdr)) + { + mark_stack_push_value (ptr->u.s.u.cdr); +#if GC_CDR_COUNT + cdr_count++; + if (cdr_count == mark_object_loop_halt) + emacs_abort (); +#endif + } + /* Speedup hack for the common case (successive list elements). */ obj = ptr->u.s.car; - cdr_count = 0; - goto loop; + goto mark_obj; } - mark_object (ptr->u.s.car); - obj = ptr->u.s.u.cdr; - cdr_count++; - if (cdr_count == mark_object_loop_halt) - emacs_abort (); - goto loop; - } - case Lisp_Float: - CHECK_ALLOCATED_AND_LIVE (live_float_p, MEM_TYPE_FLOAT); - /* Do not mark floats stored in a dump image: these floats are - "cold" and do not have mark bits. */ - if (pdumper_object_p (XFLOAT (obj))) - eassert (pdumper_cold_object_p (XFLOAT (obj))); - else if (!XFLOAT_MARKED_P (XFLOAT (obj))) - XFLOAT_MARK (XFLOAT (obj)); - break; + case Lisp_Float: + CHECK_ALLOCATED_AND_LIVE (live_float_p, MEM_TYPE_FLOAT); + /* Do not mark floats stored in a dump image: these floats are + "cold" and do not have mark bits. */ + if (pdumper_object_p (XFLOAT (obj))) + eassert (pdumper_cold_object_p (XFLOAT (obj))); + else if (!XFLOAT_MARKED_P (XFLOAT (obj))) + XFLOAT_MARK (XFLOAT (obj)); + break; - case_Lisp_Int: - break; + case_Lisp_Int: + break; - default: - emacs_abort (); + default: + emacs_abort (); + } } #undef CHECK_LIVE @@ -6884,6 +7012,22 @@ mark_object (Lisp_Object arg) #undef CHECK_ALLOCATED_AND_LIVE } +void +mark_object (Lisp_Object obj) +{ + ptrdiff_t sp = mark_stk.sp; + mark_stack_push_value (obj); + process_mark_stack (sp); +} + +void +mark_objects (Lisp_Object *objs, ptrdiff_t n) +{ + ptrdiff_t sp = mark_stk.sp; + mark_stack_push_values (objs, n); + process_mark_stack (sp); +} + /* Mark the Lisp pointers in the terminal objects. Called by Fgarbage_collect. */ @@ -6920,7 +7064,7 @@ survives_gc_p (Lisp_Object obj) break; case Lisp_Symbol: - survives_p = symbol_marked_p (XSYMBOL (obj)); + survives_p = symbol_marked_p (XBARE_SYMBOL (obj)); break; case Lisp_String: @@ -7320,7 +7464,8 @@ Frames, windows, buffers, and subprocesses count as vectors make_int (strings_consed)); } -#if defined GNU_LINUX && defined __GLIBC__ +#if defined GNU_LINUX && defined __GLIBC__ && \ + (__GLIBC__ > 2 || __GLIBC_MINOR__ >= 10) DEFUN ("malloc-info", Fmalloc_info, Smalloc_info, 0, 0, "", doc: /* Report malloc information to stderr. This function outputs to stderr an XML-formatted @@ -7337,7 +7482,7 @@ arenas. */) static bool symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj) { - struct Lisp_Symbol *sym = XSYMBOL (symbol); + struct Lisp_Symbol *sym = XBARE_SYMBOL (symbol); Lisp_Object val = find_symbol_value (symbol); return (EQ (val, obj) || EQ (sym->u.s.function, obj) @@ -7356,7 +7501,7 @@ Lisp_Object which_symbols (Lisp_Object obj, EMACS_INT find_max) { struct symbol_block *sblk; - ptrdiff_t gc_count = inhibit_garbage_collection (); + specpdl_ref gc_count = inhibit_garbage_collection (); Lisp_Object found = Qnil; if (! deadp (obj)) @@ -7680,7 +7825,9 @@ N should be nonnegative. */); defsubr (&Sgarbage_collect_maybe); defsubr (&Smemory_info); defsubr (&Smemory_use_counts); -#if defined GNU_LINUX && defined __GLIBC__ +#if defined GNU_LINUX && defined __GLIBC__ && \ + (__GLIBC__ > 2 || __GLIBC_MINOR__ >= 10) + defsubr (&Smalloc_info); #endif defsubr (&Ssuspicious_object); @@ -7708,6 +7855,12 @@ enum defined_HAVE_X_WINDOWS { defined_HAVE_X_WINDOWS = true }; enum defined_HAVE_X_WINDOWS { defined_HAVE_X_WINDOWS = false }; #endif +#ifdef HAVE_PGTK +enum defined_HAVE_PGTK { defined_HAVE_PGTK = true }; +#else +enum defined_HAVE_PGTK { defined_HAVE_PGTK = false }; +#endif + /* When compiled with GCC, GDB might say "No enum type named pvec_type" if we don't have at least one symbol with that type, and then xbacktrace could fail. Similarly for the other enums and @@ -7727,5 +7880,6 @@ union enum More_Lisp_Bits More_Lisp_Bits; enum pvec_type pvec_type; enum defined_HAVE_X_WINDOWS defined_HAVE_X_WINDOWS; + enum defined_HAVE_PGTK defined_HAVE_PGTK; } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; #endif /* __GNUC__ */ diff --git a/src/atimer.c b/src/atimer.c index fa29cd9033f..1c6c881fc02 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -305,18 +305,34 @@ 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; + if (alarm_timer_ok + && timer_settime (alarm_timer, TIMER_ABSTIME, &ispec, 0) == 0) + exit = true; + + /* Don't start both timerfd and POSIX timers on Cygwin; this + causes a slowdown (bug#51734). Prefer POSIX timers + because the timerfd notifications aren't delivered while + Emacs is busy, which prevents things like the hourglass + pointer from being displayed reliably (bug#19776). */ +# ifdef CYGWIN + if (exit) + return; +# endif + # ifdef HAVE_TIMERFD - if (timerfd_settime (timerfd, TFD_TIMER_ABSTIME, &ispec, 0) == 0) + if (0 <= timerfd + && timerfd_settime (timerfd, TFD_TIMER_ABSTIME, &ispec, 0) == 0) { add_timer_wait_descriptor (timerfd); - return; + exit = true; } # endif - if (alarm_timer_ok - && timer_settime (alarm_timer, TIMER_ABSTIME, &ispec, 0) == 0) + + if (exit) return; } #endif @@ -333,9 +349,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)); } } @@ -583,15 +598,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 9449e099446..4d2c74b17cd 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -1462,7 +1462,7 @@ bidi_at_paragraph_end (ptrdiff_t charpos, ptrdiff_t bytepos) /* Prevent quitting inside re_match_2, as redisplay_window could have temporarily moved point. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); val = fast_looking_at (sep_re, charpos, bytepos, ZV, ZV_BYTE, Qnil); @@ -1552,7 +1552,7 @@ bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte) /* Prevent quitting inside re_match_2, as redisplay_window could have temporarily moved point. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); while (pos_byte > BEGV_BYTE @@ -2927,8 +2927,11 @@ bidi_resolve_brackets (struct bidi_it *bidi_it) else if (bidi_it->bracket_enclosed_type == STRONG_L /* N0c, N0d */ || bidi_it->bracket_enclosed_type == STRONG_R) { - eassert (bidi_it->prev_for_neutral.type != UNKNOWN_BT); - switch (bidi_it->prev_for_neutral.type) + bidi_type_t prev_type_for_neutral = bidi_it->prev_for_neutral.type; + + if (prev_type_for_neutral == UNKNOWN_BT) + prev_type_for_neutral = embedding_type; + switch (prev_type_for_neutral) { case STRONG_R: case WEAK_EN: @@ -3566,11 +3569,21 @@ 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; + ptrdiff_t eob + = STRINGP (bidi_it->string.lstring) ? bidi_it->string.schars : ZV; + ptrdiff_t found_pos = eob; + /* 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 { @@ -3578,14 +3591,31 @@ 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 + } while (found_pos == eob + && bidi_it->charpos < eob && bidi_it->ch != BIDI_EOB && bidi_it->ch != '\n'); diff --git a/src/bignum.c b/src/bignum.c index 6c6c369ddd8..e4e4d45d686 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -53,6 +53,15 @@ init_bignum (void) { eassert (mp_bits_per_limb == GMP_NUMB_BITS); integer_width = 1 << 16; + + /* FIXME: The Info node `(gmp) Custom Allocation' states: "No error + return is allowed from any of these functions, if they return + then they must have performed the specified operation. [...] + There's currently no defined way for the allocation functions to + recover from an error such as out of memory, they must terminate + program execution. A 'longjmp' or throwing a C++ exception will + have undefined results." But xmalloc and xrealloc do call + 'longjmp'. */ mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp); for (int i = 0; i < ARRAYELTS (mpz); i++) @@ -467,3 +476,96 @@ check_int_nonnegative (Lisp_Object x) CHECK_INTEGER (x); return NILP (Fnatnump (x)) ? 0 : check_integer_range (x, 0, INT_MAX); } + +/* Return a random mp_limb_t. */ + +static mp_limb_t +get_random_limb (void) +{ + if (GMP_NUMB_BITS <= ULONG_WIDTH) + return get_random_ulong (); + + /* Work around GCC -Wshift-count-overflow false alarm. */ + int shift = GMP_NUMB_BITS <= ULONG_WIDTH ? 0 : ULONG_WIDTH; + + /* This is in case someone builds GMP with unusual definitions for + MINI_GMP_LIMB_TYPE or _LONG_LONG_LIMB. */ + mp_limb_t r = 0; + for (int i = 0; i < GMP_NUMB_BITS; i += ULONG_WIDTH) + r = (r << shift) | get_random_ulong (); + return r; +} + +/* Return a random mp_limb_t I in the range 0 <= I < LIM. + If LIM is zero, simply return a random mp_limb_t. */ + +static mp_limb_t +get_random_limb_lim (mp_limb_t lim) +{ + /* Return the remainder of a random mp_limb_t R divided by LIM, + except reject the rare case where R is so close to the maximum + mp_limb_t that the remainder isn't random. */ + mp_limb_t difflim = - lim, diff, remainder; + do + { + mp_limb_t r = get_random_limb (); + if (lim == 0) + return r; + remainder = r % lim; + diff = r - remainder; + } + while (difflim < diff); + + return remainder; +} + +/* Return a random Lisp integer I in the range 0 <= I < LIMIT, + where LIMIT is a positive bignum. */ + +Lisp_Object +get_random_bignum (struct Lisp_Bignum const *limit) +{ + mpz_t const *lim = bignum_val (limit); + mp_size_t nlimbs = mpz_size (*lim); + eassume (0 < nlimbs); + mp_limb_t *r_limb = mpz_limbs_write (mpz[0], nlimbs); + mp_limb_t const *lim_limb = mpz_limbs_read (*lim); + mp_limb_t limhi = lim_limb[nlimbs - 1]; + eassert (limhi); + bool edgy; + + do + { + /* Generate the result one limb at a time, most significant first. + Choose the most significant limb RHI randomly from 0..LIMHI, + where LIMHI is the LIM's first limb, except choose from + 0..(LIMHI-1) if there is just one limb. RHI == LIMHI is an + unlucky edge case as later limbs might cause the result to be + exceed or equal LIM; if this happens, it causes another + iteration in the outer loop. */ + + mp_limb_t rhi = get_random_limb_lim (limhi + (1 < nlimbs)); + edgy = rhi == limhi; + r_limb[nlimbs - 1] = rhi; + + for (mp_size_t i = nlimbs - 1; 0 < i--; ) + { + /* get_random_limb_lim (edgy ? limb_lim[i] + 1 : 0) + would be wrong here, as the full mp_limb_t range is + needed in later limbs for the edge case to have the + proper weighting. */ + mp_limb_t ri = get_random_limb (); + if (edgy) + { + if (lim_limb[i] < ri) + break; + edgy = lim_limb[i] == ri; + } + r_limb[i] = ri; + } + } + while (edgy); + + mpz_limbs_finish (mpz[0], nlimbs); + return make_integer_mpz (); +} diff --git a/src/bignum.h b/src/bignum.h index 5f94ce850cf..de9ee17c027 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -51,6 +51,7 @@ extern void emacs_mpz_mul_2exp (mpz_t, mpz_t const, EMACS_INT) extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long) ARG_NONNULL ((1, 2)); extern double mpz_get_d_rounded (mpz_t const) ATTRIBUTE_CONST; +extern Lisp_Object get_random_bignum (struct Lisp_Bignum const *); INLINE_HEADER_BEGIN diff --git a/src/buffer.c b/src/buffer.c index 321bc88ed2c..f8a7a4f5109 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -912,6 +912,10 @@ does not run the hooks `kill-buffer-hook', Fset (intern ("buffer-save-without-query"), Qnil); Fset (intern ("buffer-file-number"), Qnil); Fset (intern ("buffer-stale-function"), Qnil); + /* Cloned buffers need extra setup, to do things such as deep + variable copies for list variables that might be mangled due + to destructive operations in the indirect buffer. */ + run_hook (Qclone_indirect_buffer_hook); set_buffer_internal_1 (old_b); } @@ -1155,11 +1159,9 @@ is first appended to NAME, to speed up finding a non-existent buffer. */) else { char number[sizeof "-999999"]; - - /* Use XFIXNUM instead of XFIXNAT to work around GCC bug 80776. */ - int i = XFIXNUM (Frandom (make_fixnum (1000000))); - eassume (0 <= i && i < 1000000); - + EMACS_INT r = get_random (); + eassume (0 <= r); + int i = r % 1000000; AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i)); genbase = concat2 (name, lnumber); if (NILP (Fget_buffer (genbase))) @@ -1247,7 +1249,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer) { /* Look in local_var_alist. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ - result = Fassoc (variable, BVAR (buf, local_var_alist), Qnil); + result = assq_no_quit (variable, BVAR (buf, local_var_alist)); if (!NILP (result)) { if (blv->fwd.fwdptr) @@ -1552,7 +1554,7 @@ This does not change the name of the visited file (if any). */) /* Catch redisplay's attention. Unless we do this, the mode lines for any windows displaying current_buffer will stay unchanged. */ - update_mode_lines = 11; + bset_update_mode_line (current_buffer); XSETBUFFER (buf, current_buffer); Fsetcar (Frassq (buf, Vbuffer_alist), newname); @@ -1562,6 +1564,9 @@ This does not change the name of the visited file (if any). */) run_buffer_list_update_hook (current_buffer); + call2 (intern ("uniquify--rename-buffer-advice"), + BVAR (current_buffer, name), unique); + /* Refetch since that last call may have done GC. */ return BVAR (current_buffer, name); } @@ -1767,7 +1772,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 (); + specpdl_ref count = SPECPDL_INDEX (); bool modified; record_unwind_protect_excursion (); @@ -2090,7 +2095,6 @@ Use this function before selecting the buffer, since it may need to inspect the current buffer's major mode. */) (Lisp_Object buffer) { - ptrdiff_t count; Lisp_Object function; CHECK_BUFFER (buffer); @@ -2113,7 +2117,7 @@ the current buffer's major mode. */) `hack-local-variables' get run. */ return Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* To select a nonfundamental mode, select the buffer temporarily and then call the mode function. */ @@ -2805,7 +2809,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 @@ -2816,18 +2820,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. */ @@ -4026,7 +4032,7 @@ buffer. */) { struct buffer *b, *ob = 0; Lisp_Object obuffer; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t n_beg, n_end; ptrdiff_t o_beg UNINIT, o_end UNINIT; @@ -4147,7 +4153,7 @@ DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0, { Lisp_Object buffer; struct buffer *b; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); CHECK_OVERLAY (overlay); @@ -5564,6 +5570,8 @@ syms_of_buffer (void) Fput (Qprotected_field, Qerror_message, build_pure_c_string ("Attempt to modify a protected field")); + DEFSYM (Qclone_indirect_buffer_hook, "clone-indirect-buffer-hook"); + DEFVAR_PER_BUFFER ("tab-line-format", &BVAR (current_buffer, tab_line_format), Qnil, @@ -6387,6 +6395,13 @@ If `delete-auto-save-files' is nil, any autosave deletion is inhibited. */); This is the default. If nil, auto-save file deletion is inhibited. */); delete_auto_save_files = 1; + DEFVAR_LISP ("clone-indirect-buffer-hook", Vclone_indirect_buffer_hook, + doc: /* Normal hook to run in the new buffer at the end of `make-indirect-buffer'. + +Since `clone-indirect-buffer' calls `make-indirect-buffer', this hook +will run for `clone-indirect-buffer' calls as well. */); + Vclone_indirect_buffer_hook = Qnil; + defsubr (&Sbuffer_live_p); defsubr (&Sbuffer_list); defsubr (&Sget_buffer); diff --git a/src/bytecode.c b/src/bytecode.c index 472992be180..62464986160 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -21,11 +21,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "lisp.h" #include "blockinput.h" +#include "sysstdio.h" #include "character.h" #include "buffer.h" #include "keyboard.h" #include "syntax.h" #include "window.h" +#include "puresize.h" /* Work around GCC bug 54561. */ #if GNUC_PREREQ (4, 3, 0) @@ -185,6 +187,7 @@ DEFINE (Bfollowing_char, 0147) \ DEFINE (Bpreceding_char, 0150) \ DEFINE (Bcurrent_column, 0151) \ DEFINE (Bindent_to, 0152) \ +/* 0153 was Bscan_buffer in v17. */ \ DEFINE (Beolp, 0154) \ DEFINE (Beobp, 0155) \ DEFINE (Bbolp, 0156) \ @@ -192,6 +195,7 @@ DEFINE (Bbobp, 0157) \ DEFINE (Bcurrent_buffer, 0160) \ DEFINE (Bset_buffer, 0161) \ DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \ +/* 0163 was Bset_mark in v17. */ \ DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1. */ \ \ DEFINE (Bforward_char, 0165) \ @@ -226,7 +230,7 @@ DEFINE (Bcondition_case, 0217) /* Obsolete since Emacs-25. */ \ DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \ DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \ \ -DEFINE (Bunbind_all, 0222) /* Obsolete. Never used. */ \ +/* 0222 was Bunbind_all, never used. */ \ \ DEFINE (Bset_marker, 0223) \ DEFINE (Bmatch_beginning, 0224) \ @@ -252,11 +256,7 @@ DEFINE (Brem, 0246) \ DEFINE (Bnumberp, 0247) \ DEFINE (Bintegerp, 0250) \ \ -DEFINE (BRgoto, 0252) \ -DEFINE (BRgotoifnil, 0253) \ -DEFINE (BRgotoifnonnil, 0254) \ -DEFINE (BRgotoifnilelsepop, 0255) \ -DEFINE (BRgotoifnonnilelsepop, 0256) \ +/* 0252-0256 were relative jumps, apparently never used. */ \ \ DEFINE (BlistN, 0257) \ DEFINE (BconcatN, 0260) \ @@ -276,11 +276,6 @@ enum byte_code_op #define DEFINE(name, value) name = value, BYTE_CODES #undef DEFINE - -#if BYTE_CODE_SAFE - Bscan_buffer = 0153, /* No longer generated as of v18. */ - Bset_mark = 0163, /* this loser is no longer generated as of v18 */ -#endif }; /* Fetch the next byte from the bytecode stream. */ @@ -290,7 +285,7 @@ enum byte_code_op /* Fetch two bytes from the bytecode stream and make a 16-bit number out of them. */ -#define FETCH2 (op = FETCH, op + (FETCH << 8)) +#define FETCH2 (op = FETCH, op | (FETCH << 8)) /* Push X onto the execution stack. The expression X should not contain TOP, to avoid competing side effects. */ @@ -330,8 +325,8 @@ If the third argument is incorrect, Emacs may crash. */) the original unibyte form. */ bytestr = Fstring_as_unibyte (bytestr); } - - return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); + Lisp_Object fun = CALLN (Fmake_byte_code, 0, bytestr, vector, maxdepth); + return exec_byte_code (fun, 0, 0, NULL); } static void @@ -340,70 +335,213 @@ bcall0 (Lisp_Object f) Ffuncall (1, &f); } -/* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and - MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect, - emacs may crash!). If ARGS_TEMPLATE is non-nil, it should be a lisp - argument list (including &rest, &optional, etc.), and ARGS, of size - NARGS, should be a vector of the actual arguments. The arguments in - ARGS are pushed on the stack according to ARGS_TEMPLATE before - executing BYTESTR. */ +/* The bytecode stack size in bytes. + This is a fairly generous amount, but: + - if users need more, we could allocate more, or just reserve the address + space and allocate on demand + - if threads are used more, then it might be a good idea to reduce the + per-thread overhead in time and space + - for maximum flexibility but a small runtime penalty, we could allocate + the stack in smaller chunks as needed +*/ +#define BC_STACK_SIZE (512 * 1024 * sizeof (Lisp_Object)) + +/* Bytecode interpreter stack: + + |--------------| -- + |fun | | ^ stack growth + |saved_pc | | | direction + |saved_top ------- | + fp--->|saved_fp ---- | | current frame + |--------------| | | | (called from bytecode in this example) + | (free) | | | | + top-->| ...stack... | | | | + : ... : | | | + |incoming args | | | | + |--------------| | | -- + |fun | | | | + |saved_pc | | | | + |saved_top | | | | + |saved_fp |<- | | previous frame + |--------------| | | + | (free) | | | + | ...stack... |<---- | + : ... : | + |incoming args | | + |--------------| -- + : : +*/ + +/* bytecode stack frame header (footer, actually) */ +struct bc_frame { + struct bc_frame *saved_fp; /* previous frame pointer, + NULL if bottommost frame */ + + /* In a frame called directly from C, the following two members are NULL. */ + Lisp_Object *saved_top; /* previous stack pointer */ + const unsigned char *saved_pc; /* previous program counter */ + + Lisp_Object fun; /* current function object */ + + Lisp_Object next_stack[]; /* data stack of next frame */ +}; + +void +init_bc_thread (struct bc_thread_state *bc) +{ + bc->stack = xmalloc (BC_STACK_SIZE); + bc->stack_end = bc->stack + BC_STACK_SIZE; + /* Put a dummy header at the bottom to indicate the first free location. */ + bc->fp = (struct bc_frame *)bc->stack; + memset (bc->fp, 0, sizeof *bc->fp); +} + +void +free_bc_thread (struct bc_thread_state *bc) +{ + xfree (bc->stack); +} + +void +mark_bytecode (struct bc_thread_state *bc) +{ + struct bc_frame *fp = bc->fp; + Lisp_Object *top = NULL; /* stack pointer of topmost frame not known */ + for (;;) + { + struct bc_frame *next_fp = fp->saved_fp; + /* Only the dummy frame at the bottom has saved_fp = NULL. */ + if (!next_fp) + break; + mark_object (fp->fun); + Lisp_Object *frame_base = next_fp->next_stack; + if (top) + { + /* The stack pointer of a frame is known: mark the part of the stack + above it conservatively. This includes any outgoing arguments. */ + mark_memory (top + 1, fp); + /* Mark the rest of the stack precisely. */ + mark_objects (frame_base, top + 1 - frame_base); + } + else + { + /* The stack pointer is unknown -- mark everything conservatively. */ + mark_memory (frame_base, fp); + } + top = fp->saved_top; + fp = next_fp; + } +} + +DEFUN ("internal-stack-stats", Finternal_stack_stats, Sinternal_stack_stats, + 0, 0, 0, + doc: /* internal */) + (void) +{ + struct bc_thread_state *bc = ¤t_thread->bc; + int nframes = 0; + int nruns = 0; + for (struct bc_frame *fp = bc->fp; fp; fp = fp->saved_fp) + { + nframes++; + if (fp->saved_top == NULL) + nruns++; + } + fprintf (stderr, "%d stack frames, %d runs\n", nframes, nruns); + return Qnil; +} + +/* Whether a stack pointer is valid in the current frame. */ +static bool +valid_sp (struct bc_thread_state *bc, Lisp_Object *sp) +{ + struct bc_frame *fp = bc->fp; + return sp < (Lisp_Object *)fp && sp + 1 >= fp->saved_fp->next_stack; +} + +/* Execute the byte-code in FUN. ARGS_TEMPLATE is the function arity + encoded as an integer (the one in FUN is ignored), and ARGS, of + size NARGS, should be a vector of the actual arguments. The + arguments in ARGS are pushed on the stack according to + ARGS_TEMPLATE before executing FUN. */ Lisp_Object -exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, - Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args) +exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, + ptrdiff_t nargs, Lisp_Object *args) { #ifdef BYTE_CODE_METER int volatile this_op = 0; #endif + unsigned char quitcounter = 1; + struct bc_thread_state *bc = ¤t_thread->bc; - eassert (!STRING_MULTIBYTE (bytestr)); + /* Values used for the first stack record when called from C. */ + Lisp_Object *top = NULL; + unsigned char const *pc = NULL; + Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); + + setup_frame: ; + eassert (!STRING_MULTIBYTE (bytestr)); + eassert (string_immovable_p (bytestr)); + /* FIXME: in debug mode (!NDEBUG, BYTE_CODE_SAFE or enabled checking), + save the specpdl index on function entry and check that it is the same + when returning, to detect unwind imbalances. This would require adding + a field to the frame header. */ + + Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); + Lisp_Object maxdepth = AREF (fun, COMPILED_STACK_DEPTH); ptrdiff_t const_length = ASIZE (vector); ptrdiff_t bytestr_length = SCHARS (bytestr); Lisp_Object *vectorp = XVECTOR (vector)->contents; - unsigned char quitcounter = 1; - EMACS_INT stack_items = XFIXNAT (maxdepth) + 1; - USE_SAFE_ALLOCA; - void *alloc; - SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length); - Lisp_Object *stack_base = alloc; - Lisp_Object *top = stack_base; - *top = vector; /* Ensure VECTOR survives GC (Bug#33014). */ - Lisp_Object *stack_lim = stack_base + stack_items; - unsigned char const *bytestr_data = memcpy (stack_lim, - SDATA (bytestr), bytestr_length); - unsigned char const *pc = bytestr_data; - ptrdiff_t count = SPECPDL_INDEX (); - - if (!NILP (args_template)) - { - eassert (FIXNUMP (args_template)); - ptrdiff_t at = XFIXNUM (args_template); - bool rest = (at & 128) != 0; - int mandatory = at & 127; - ptrdiff_t nonrest = at >> 8; - ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest; - if (! (mandatory <= nargs && nargs <= maxargs)) - Fsignal (Qwrong_number_of_arguments, - list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)), - make_fixnum (nargs))); - ptrdiff_t pushedargs = min (nonrest, nargs); - for (ptrdiff_t i = 0; i < pushedargs; i++, args++) - PUSH (*args); - if (nonrest < nargs) - PUSH (Flist (nargs - nonrest, args)); - else - for (ptrdiff_t i = nargs - rest; i < nonrest; i++) - PUSH (Qnil); - } + EMACS_INT max_stack = XFIXNAT (maxdepth); + Lisp_Object *frame_base = bc->fp->next_stack; + struct bc_frame *fp = (struct bc_frame *)(frame_base + max_stack); + + if ((char *)fp->next_stack > bc->stack_end) + error ("Bytecode stack overflow"); + + /* Save the function object so that the bytecode and vector are + held from removal by the GC. */ + fp->fun = fun; + /* Save previous stack pointer and pc in the new frame. If we came + directly from outside, these will be NULL. */ + fp->saved_top = top; + fp->saved_pc = pc; + fp->saved_fp = bc->fp; + bc->fp = fp; + + top = frame_base - 1; + unsigned char const *bytestr_data = SDATA (bytestr); + pc = bytestr_data; + + /* ARGS_TEMPLATE is composed of bit fields: + bits 0..6 minimum number of arguments + bits 7 1 iff &rest argument present + bits 8..14 maximum number of arguments */ + bool rest = (args_template & 128) != 0; + int mandatory = args_template & 127; + ptrdiff_t nonrest = args_template >> 8; + if (! (mandatory <= nargs && (rest || nargs <= nonrest))) + Fsignal (Qwrong_number_of_arguments, + list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)), + make_fixnum (nargs))); + ptrdiff_t pushedargs = min (nonrest, nargs); + for (ptrdiff_t i = 0; i < pushedargs; i++, args++) + PUSH (*args); + if (nonrest < nargs) + PUSH (Flist (nargs - nonrest, args)); + else + for (ptrdiff_t i = nargs - rest; i < nonrest; i++) + PUSH (Qnil); while (true) { int op; enum handlertype type; - if (BYTE_CODE_SAFE && ! (stack_base <= top && top < stack_lim)) + if (BYTE_CODE_SAFE && !valid_sp (bc, top)) emacs_abort (); #ifdef BYTE_CODE_METER @@ -451,17 +589,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, #ifdef BYTE_CODE_THREADED - /* A convenience define that saves us a lot of typing and makes - the table clearer. */ -#define LABEL(OP) [OP] = &&insn_ ## OP - /* This is the dispatch table for the threaded interpreter. */ static const void *const targets[256] = { [0 ... (Bconstant - 1)] = &&insn_default, [Bconstant ... 255] = &&insn_Bconstant, -#define DEFINE(name, value) LABEL (name) , +#define DEFINE(name, value) [name] = &&insn_ ## name, BYTE_CODES #undef DEFINE }; @@ -629,7 +763,59 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } } #endif - TOP = Ffuncall (op + 1, &TOP); + maybe_quit (); + + if (++lisp_eval_depth > max_lisp_eval_depth) + { + if (max_lisp_eval_depth < 100) + max_lisp_eval_depth = 100; + if (lisp_eval_depth > max_lisp_eval_depth) + error ("Lisp nesting exceeds `max-lisp-eval-depth'"); + } + + ptrdiff_t call_nargs = op; + Lisp_Object call_fun = TOP; + Lisp_Object *call_args = &TOP + 1; + + specpdl_ref count1 = record_in_backtrace (call_fun, + call_args, call_nargs); + maybe_gc (); + if (debug_on_next_call) + do_debug_on_call (Qlambda, count1); + + Lisp_Object original_fun = call_fun; + if (SYMBOLP (call_fun)) + call_fun = XSYMBOL (call_fun)->u.s.function; + Lisp_Object template; + Lisp_Object bytecode; + if (COMPILEDP (call_fun) + // Lexical binding only. + && (template = AREF (call_fun, COMPILED_ARGLIST), + FIXNUMP (template)) + // No autoloads. + && (bytecode = AREF (call_fun, COMPILED_BYTECODE), + !CONSP (bytecode))) + { + fun = call_fun; + bytestr = bytecode; + args_template = XFIXNUM (template); + nargs = call_nargs; + args = call_args; + goto setup_frame; + } + + Lisp_Object val; + if (SUBRP (call_fun) && !SUBR_NATIVE_COMPILED_DYNP (call_fun)) + val = funcall_subr (XSUBR (call_fun), call_nargs, call_args); + else + val = funcall_general (original_fun, call_nargs, call_args); + + lisp_eval_depth--; + if (backtrace_debug_on_exit (specpdl_ptr - 1)) + val = call_debugger (list2 (Qexit, val)); + specpdl_ptr--; + + TOP = val; NEXT; } @@ -649,20 +835,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bunbind5): op -= Bunbind; dounbind: - unbind_to (SPECPDL_INDEX () - op, Qnil); - NEXT; - - CASE (Bunbind_all): /* Obsolete. Never used. */ - /* To unbind back to the beginning of this frame. Not used yet, - but will be needed for tail-recursion elimination. */ - unbind_to (count, Qnil); + unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -op), Qnil); NEXT; CASE (Bgoto): op = FETCH2; op_branch: op -= pc - bytestr_data; - op_relative_branch: if (BYTE_CODE_SAFE && ! (bytestr_data - pc <= op && op < bytestr_data + bytestr_length - pc)) @@ -697,38 +876,41 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, DISCARD (1); NEXT; - CASE (BRgoto): - op = FETCH - 128; - goto op_relative_branch; - - CASE (BRgotoifnil): - op = FETCH - 128; - if (NILP (POP)) - goto op_relative_branch; - NEXT; - - CASE (BRgotoifnonnil): - op = FETCH - 128; - if (!NILP (POP)) - goto op_relative_branch; - NEXT; - - CASE (BRgotoifnilelsepop): - op = FETCH - 128; - if (NILP (TOP)) - goto op_relative_branch; - DISCARD (1); - NEXT; - - CASE (BRgotoifnonnilelsepop): - op = FETCH - 128; - if (!NILP (TOP)) - goto op_relative_branch; - DISCARD (1); - NEXT; - CASE (Breturn): - goto exit; + { + Lisp_Object *saved_top = bc->fp->saved_top; + if (saved_top) + { + Lisp_Object val = TOP; + + lisp_eval_depth--; + if (backtrace_debug_on_exit (specpdl_ptr - 1)) + val = call_debugger (list2 (Qexit, val)); + specpdl_ptr--; + + top = saved_top; + pc = bc->fp->saved_pc; + struct bc_frame *fp = bc->fp->saved_fp; + bc->fp = fp; + + Lisp_Object fun = fp->fun; + Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); + Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); + bytestr_data = SDATA (bytestr); + vectorp = XVECTOR (vector)->contents; + if (BYTE_CODE_SAFE) + { + /* Only required for checking, not for execution. */ + const_length = ASIZE (vector); + bytestr_length = SCHARS (bytestr); + } + + TOP = val; + NEXT; + } + else + goto exit; + } CASE (Bdiscard): DISCARD (1); @@ -749,7 +931,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bsave_window_excursion): /* Obsolete since 24.1. */ { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); record_unwind_protect (restore_window_configuration, Fcurrent_window_configuration (Qnil)); TOP = Fprogn (TOP); @@ -783,9 +965,23 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, if (sys_setjmp (c->jmp)) { struct handler *c = handlerlist; + handlerlist = c->next; top = c->bytecode_top; op = c->bytecode_dest; - handlerlist = c->next; + struct bc_frame *fp = bc->fp; + + Lisp_Object fun = fp->fun; + Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); + Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); + bytestr_data = SDATA (bytestr); + vectorp = XVECTOR (vector)->contents; + if (BYTE_CODE_SAFE) + { + /* Only required for checking, not for execution. */ + const_length = ASIZE (vector); + bytestr_length = SCHARS (bytestr); + } + pc = bytestr_data; PUSH (c->val); goto op_branch; } @@ -825,7 +1021,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, temp_output_buffer_show (TOP); TOP = v1; /* pop binding of standard-output */ - unbind_to (SPECPDL_INDEX () - 1, Qnil); + unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -1), Qnil); NEXT; } @@ -903,15 +1099,39 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Baref): { - Lisp_Object v1 = POP; - TOP = Faref (TOP, v1); + Lisp_Object idxval = POP; + Lisp_Object arrayval = TOP; + ptrdiff_t size; + ptrdiff_t idx; + if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true)) + || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true))) + && FIXNUMP (idxval) + && (idx = XFIXNUM (idxval), + idx >= 0 && idx < size)) + TOP = AREF (arrayval, idx); + else + TOP = Faref (arrayval, idxval); NEXT; } CASE (Baset): { - Lisp_Object v2 = POP, v1 = POP; - TOP = Faset (TOP, v1, v2); + Lisp_Object newelt = POP; + Lisp_Object idxval = POP; + Lisp_Object arrayval = TOP; + ptrdiff_t size; + ptrdiff_t idx; + if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true)) + || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true))) + && FIXNUMP (idxval) + && (idx = XFIXNUM (idxval), + idx >= 0 && idx < size)) + { + ASET (arrayval, idx, newelt); + TOP = newelt; + } + else + TOP = Faset (arrayval, idxval, newelt); NEXT; } @@ -986,43 +1206,72 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Beqlsign): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_EQUAL); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = BASE_EQ(v1, v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_EQUAL); NEXT; } CASE (Bgtr): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_GRTR); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) > XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_GRTR); NEXT; } CASE (Blss): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_LESS); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) < XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_LESS); NEXT; } CASE (Bleq): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) <= XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_LESS_OR_EQUAL); NEXT; } CASE (Bgeq): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) >= XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_GRTR_OR_EQUAL); NEXT; } CASE (Bdiff): - DISCARD (1); - TOP = Fminus (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + EMACS_INT res; + if (FIXNUMP (v1) && FIXNUMP (v2) + && (res = XFIXNUM (v1) - XFIXNUM (v2), + !FIXNUM_OVERFLOW_P (res))) + TOP = make_fixnum (res); + else + TOP = Fminus (2, &TOP); + NEXT; + } CASE (Bnegate): TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM @@ -1031,34 +1280,83 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bplus): - DISCARD (1); - TOP = Fplus (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + EMACS_INT res; + if (FIXNUMP (v1) && FIXNUMP (v2) + && (res = XFIXNUM (v1) + XFIXNUM (v2), + !FIXNUM_OVERFLOW_P (res))) + TOP = make_fixnum (res); + else + TOP = Fplus (2, &TOP); + NEXT; + } CASE (Bmax): - DISCARD (1); - TOP = Fmax (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + { + if (XFIXNUM (v2) > XFIXNUM (v1)) + TOP = v2; + } + else + TOP = Fmax (2, &TOP); + NEXT; + } CASE (Bmin): - DISCARD (1); - TOP = Fmin (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + { + if (XFIXNUM (v2) < XFIXNUM (v1)) + TOP = v2; + } + else + TOP = Fmin (2, &TOP); + NEXT; + } CASE (Bmult): - DISCARD (1); - TOP = Ftimes (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + intmax_t res; + if (FIXNUMP (v1) && FIXNUMP (v2) + && !INT_MULTIPLY_WRAPV (XFIXNUM (v1), XFIXNUM (v2), &res) + && !FIXNUM_OVERFLOW_P (res)) + TOP = make_fixnum (res); + else + TOP = Ftimes (2, &TOP); + NEXT; + } CASE (Bquo): - DISCARD (1); - TOP = Fquo (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + EMACS_INT res; + if (FIXNUMP (v1) && FIXNUMP (v2) && XFIXNUM (v2) != 0 + && (res = XFIXNUM (v1) / XFIXNUM (v2), + !FIXNUM_OVERFLOW_P (res))) + TOP = make_fixnum (res); + else + TOP = Fquo (2, &TOP); + NEXT; + } CASE (Brem): { - Lisp_Object v1 = POP; - TOP = Frem (TOP, v1); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2) && XFIXNUM (v2) != 0) + TOP = make_fixnum (XFIXNUM (v1) % XFIXNUM (v2)); + else + TOP = Frem (v1, v2); NEXT; } @@ -1081,12 +1379,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bpoint_max): - { - Lisp_Object v1; - XSETFASTINT (v1, ZV); - PUSH (v1); - NEXT; - } + PUSH (make_fixed_natnum (ZV)); + NEXT; CASE (Bpoint_min): PUSH (make_fixed_natnum (BEGV)); @@ -1167,13 +1461,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bchar_syntax): - { - CHECK_CHARACTER (TOP); - int c = XFIXNAT (TOP); - if (NILP (BVAR (current_buffer, enable_multibyte_characters))) - c = make_char_multibyte (c); - XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]); - } + TOP = Fchar_syntax (TOP); NEXT; CASE (Bbuffer_substring): @@ -1291,15 +1579,23 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bsetcar): { - Lisp_Object v1 = POP; - TOP = Fsetcar (TOP, v1); + Lisp_Object newval = POP; + Lisp_Object cell = TOP; + CHECK_CONS (cell); + CHECK_IMPURE (cell, XCONS (cell)); + XSETCAR (cell, newval); + TOP = newval; NEXT; } CASE (Bsetcdr): { - Lisp_Object v1 = POP; - TOP = Fsetcdr (TOP, v1); + Lisp_Object newval = POP; + Lisp_Object cell = TOP; + CHECK_CONS (cell); + CHECK_IMPURE (cell, XCONS (cell)); + XSETCDR (cell, newval); + TOP = newval; NEXT; } @@ -1324,19 +1620,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, TOP = INTEGERP (TOP) ? Qt : Qnil; NEXT; -#if BYTE_CODE_SAFE - /* These are intentionally written using 'case' syntax, - because they are incompatible with the threaded - interpreter. */ - - case Bset_mark: - error ("set-mark is an obsolete bytecode"); - break; - case Bscan_buffer: - error ("scan-buffer is an obsolete bytecode"); - break; -#endif - CASE_ABORT: /* Actually this is Bstack_ref with offset 0, but we use Bdup for that instead. */ @@ -1437,16 +1720,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, exit: - /* Binds and unbinds are supposed to be compiled balanced. */ - if (SPECPDL_INDEX () != count) - { - if (SPECPDL_INDEX () > count) - unbind_to (count, Qnil); - error ("binding stack not balanced (serious byte compiler bug)"); - } + bc->fp = bc->fp->saved_fp; Lisp_Object result = TOP; - SAFE_FREE (); return result; } @@ -1468,6 +1744,7 @@ void syms_of_bytecode (void) { defsubr (&Sbyte_code); + defsubr (&Sinternal_stack_stats); #ifdef BYTE_CODE_METER diff --git a/src/callint.c b/src/callint.c index ce77c893f48..31919d6bb81 100644 --- a/src/callint.c +++ b/src/callint.c @@ -251,7 +251,7 @@ return non-nil. usage: (funcall-interactively FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t speccount = SPECPDL_INDEX (); + specpdl_ref speccount = SPECPDL_INDEX (); temporarily_switch_to_single_kboard (NULL); /* Nothing special to do here, all the work is inside @@ -279,7 +279,7 @@ invoke it (via an `interactive' spec that contains, for instance, an `this-command-keys-vector' is used. */) (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys) { - ptrdiff_t speccount = SPECPDL_INDEX (); + specpdl_ref speccount = SPECPDL_INDEX (); bool arg_from_tty = false; ptrdiff_t key_count; @@ -541,7 +541,7 @@ invoke it (via an `interactive' spec that contains, for instance, an case 'k': /* Key sequence. */ { - ptrdiff_t speccount1 = SPECPDL_INDEX (); + specpdl_ref speccount1 = SPECPDL_INDEX (); specbind (Qcursor_in_echo_area, Qt); /* Prompt in `minibuffer-prompt' face. */ Fput_text_property (make_fixnum (0), @@ -571,7 +571,7 @@ invoke it (via an `interactive' spec that contains, for instance, an case 'K': /* Key sequence to be defined. */ { - ptrdiff_t speccount1 = SPECPDL_INDEX (); + specpdl_ref speccount1 = SPECPDL_INDEX (); specbind (Qcursor_in_echo_area, Qt); /* Prompt in `minibuffer-prompt' face. */ Fput_text_property (make_fixnum (0), diff --git a/src/callproc.c b/src/callproc.c index 07eeadb3aa9..dd162f36a6c 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -34,8 +34,7 @@ extern char **environ; /* In order to be able to use `posix_spawn', it needs to support some variant of `chdir' as well as `setsid'. */ -#if defined DARWIN_OS \ - && defined HAVE_SPAWN_H && defined HAVE_POSIX_SPAWN \ +#if defined HAVE_SPAWN_H && defined HAVE_POSIX_SPAWN \ && defined HAVE_POSIX_SPAWNATTR_SETFLAGS \ && (defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR \ || defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR_NP) \ @@ -86,6 +85,10 @@ extern char **environ; #include "nsterm.h" #endif +#ifdef HAVE_PGTK +#include "pgtkterm.h" +#endif + /* Pattern used by call-process-region to make temp files. */ static Lisp_Object Vtemp_file_name_pattern; @@ -123,7 +126,7 @@ enum CALLPROC_FDS }; -static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, ptrdiff_t); +static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, specpdl_ref); #ifdef DOS_NT # define CHILD_SETUP_TYPE int @@ -290,7 +293,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * { Lisp_Object infile, encoded_infile; int filefd; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (nargs >= 2 && ! NILP (args[1])) { @@ -311,12 +314,13 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * if (filefd < 0) report_file_error ("Opening process input file", infile); record_unwind_protect_int (close_file_unwind, filefd); - return unbind_to (count, call_process (nargs, args, filefd, -1)); + return unbind_to (count, call_process (nargs, args, filefd, + make_invalid_specpdl_ref ())); } /* Like Fcall_process (NARGS, ARGS), except use FILEFD as the input file. - If TEMPFILE_INDEX is nonnegative, it is the specpdl index of an + If TEMPFILE_INDEX is valid, it is the specpdl index of an unwinder that is intended to remove the input temporary file; in this case NARGS must be at least 2 and ARGS[1] is the file's name. @@ -324,7 +328,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * static Lisp_Object call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, - ptrdiff_t tempfile_index) + specpdl_ref tempfile_index) { Lisp_Object buffer, current_dir, path; bool display_p; @@ -332,7 +336,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, int callproc_fd[CALLPROC_FDS]; int status; ptrdiff_t i; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); USE_SAFE_ALLOCA; char **new_argv; @@ -617,7 +621,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, callproc_fd[i] = -1; } emacs_close (filefd); - clear_unwind_protect (count - 1); + clear_unwind_protect (specpdl_ref_add (count, -1)); if (tempfile) { @@ -655,7 +659,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, if (FIXNUMP (buffer)) { - if (tempfile_index < 0) + if (!specpdl_ref_valid_p (tempfile_index)) record_deleted_pid (pid, Qnil); else { @@ -682,7 +686,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, callproc_fd[i] = -1; } emacs_close (filefd); - clear_unwind_protect (count - 1); + clear_unwind_protect (specpdl_ref_add (count, -1)); #endif /* not MSDOS */ @@ -814,7 +818,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, else { /* We have to decode the input. */ Lisp_Object curbuf; - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); XSETBUFFER (curbuf, current_buffer); /* We cannot allow after-change-functions be run @@ -958,7 +962,6 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args, { Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir); char *tempfile; - ptrdiff_t count; #ifdef WINDOWSNT /* Cannot use the result of Fexpand_file_name, because it @@ -978,7 +981,7 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args, filename_string = Fcopy_sequence (ENCODE_FILE (pattern)); tempfile = SSDATA (filename_string); - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_nothing (); fd = mkostemp (tempfile, O_BINARY | O_CLOEXEC); if (fd < 0) @@ -1010,7 +1013,7 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args, val = complement_process_encoding_system (val); { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); specbind (intern ("coding-system-for-write"), val); /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we @@ -1070,7 +1073,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object infile, val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object start = args[0]; Lisp_Object end = args[1]; bool empty_input; @@ -1124,7 +1127,8 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r } args[1] = infile; - val = call_process (nargs, args, fd, empty_input ? -1 : count); + val = call_process (nargs, args, fd, + empty_input ? make_invalid_specpdl_ref () : count); return unbind_to (count, val); } @@ -1484,7 +1488,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, if (pty != NULL) pid = fork (); else - pid = vfork (); + pid = VFORK (); #else pid = vfork (); #endif @@ -1687,6 +1691,7 @@ getenv_internal (const char *var, ptrdiff_t varlen, char **value, /* For DISPLAY try to get the values from the frame or the initial env. */ if (strcmp (var, "DISPLAY") == 0) { +#ifndef HAVE_PGTK Lisp_Object display = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay); if (STRINGP (display)) @@ -1695,6 +1700,7 @@ getenv_internal (const char *var, ptrdiff_t varlen, char **value, *valuelen = SBYTES (display); return 1; } +#endif /* If still not found, Look for DISPLAY in Vinitial_environment. */ if (getenv_internal_1 (var, varlen, value, valuelen, Vinitial_environment)) @@ -1812,6 +1818,18 @@ make_environment_block (Lisp_Object current_dir) if (NILP (display)) { Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay); + +#ifdef HAVE_PGTK + /* The only time GDK actually returns correct information is + when it's running under X Windows. DISPLAY shouldn't be + set to a Wayland display either, since that's an X specific + variable. */ + if (FRAME_WINDOW_P (SELECTED_FRAME ()) + && strcmp (G_OBJECT_TYPE_NAME (FRAME_X_DISPLAY (SELECTED_FRAME ())), + "GdkX11Display")) + tmp = Qnil; +#endif + if (!STRINGP (tmp) && CONSP (Vinitial_environment)) /* If still not found, Look for DISPLAY in Vinitial_environment. */ tmp = Fgetenv_internal (build_string ("DISPLAY"), diff --git a/src/casefiddle.c b/src/casefiddle.c index 140466f4812..2ea5f09b4c5 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/ccl.c b/src/ccl.c index 377eb3a0ea5..a3121f72782 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -33,6 +33,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "charset.h" #include "ccl.h" #include "coding.h" +#include "keyboard.h" /* Table of registered CCL programs. Each element is a vector of NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the diff --git a/src/character.c b/src/character.c index eba417d005d..c1a1b553891 100644 --- a/src/character.c +++ b/src/character.c @@ -654,15 +654,14 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes, ptrdiff_t count_size_as_multibyte (const unsigned char *str, ptrdiff_t len) { - const unsigned char *endp = str + len; + /* Count the number of non-ASCII (raw) bytes, since they will occupy + two bytes in a multibyte string. */ + ptrdiff_t nonascii = 0; + for (ptrdiff_t i = 0; i < len; i++) + nonascii += str[i] >> 7; ptrdiff_t bytes; - - for (bytes = 0; str < endp; str++) - { - int n = *str < 0x80 ? 1 : 2; - if (INT_ADD_WRAPV (bytes, n, &bytes)) - string_overflow (); - } + if (INT_ADD_WRAPV (len, nonascii, &bytes)) + string_overflow (); return bytes; } diff --git a/src/charset.c b/src/charset.c index b9e1584083f..9edbd4c8c84 100644 --- a/src/charset.c +++ b/src/charset.c @@ -483,7 +483,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, AUTO_STRING (map, ".map"); AUTO_STRING (txt, ".txt"); AUTO_LIST2 (suffixes, map, txt); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_nothing (); specbind (Qfile_name_handler_alist, Qnil); fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil, false, false); @@ -495,7 +495,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, report_file_errno ("Loading charset map", mapfile, open_errno); } set_unwind_protect_ptr (count, fclose_unwind, fp); - unbind_to (count + 1, Qnil); + unbind_to (specpdl_ref_add (count, 1), Qnil); /* Use record_xmalloc, as `charset_map_entries' is large (larger than MAX_ALLOCA). */ diff --git a/src/coding.c b/src/coding.c index df6c423caaa..2bed293d571 100644 --- a/src/coding.c +++ b/src/coding.c @@ -1131,7 +1131,6 @@ detect_coding_utf_8 (struct coding_system *coding, ptrdiff_t consumed_chars = 0; bool bom_found = 0; ptrdiff_t nchars = coding->head_ascii; - int eol_seen = coding->eol_seen; detect_info->checked |= CATEGORY_MASK_UTF_8; /* A coding system of this category is always ASCII compatible. */ @@ -1161,15 +1160,10 @@ detect_coding_utf_8 (struct coding_system *coding, { if (src < src_end && *src == '\n') { - eol_seen |= EOL_SEEN_CRLF; src++; nchars++; } - else - eol_seen |= EOL_SEEN_CR; } - else if (c == '\n') - eol_seen |= EOL_SEEN_LF; continue; } ONE_MORE_BYTE (c1); @@ -7907,7 +7901,7 @@ coding_restore_undo_list (Lisp_Object arg) void decode_coding_gap (struct coding_system *coding, ptrdiff_t bytes) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object attrs; eassert (GPT_BYTE == PT_BYTE); @@ -8071,7 +8065,7 @@ decode_coding_object (struct coding_system *coding, ptrdiff_t to, ptrdiff_t to_byte, Lisp_Object dst_object) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); unsigned char *destination UNINIT; ptrdiff_t dst_bytes UNINIT; ptrdiff_t chars = to - from; @@ -8170,7 +8164,7 @@ decode_coding_object (struct coding_system *coding, ptrdiff_t prev_Z = Z, prev_Z_BYTE = Z_BYTE; Lisp_Object val; Lisp_Object undo_list = BVAR (current_buffer, undo_list); - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); record_unwind_protect (coding_restore_undo_list, Fcons (undo_list, Fcurrent_buffer ())); @@ -8290,7 +8284,7 @@ encode_coding_object (struct coding_system *coding, ptrdiff_t to, ptrdiff_t to_byte, Lisp_Object dst_object) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t chars = to - from; ptrdiff_t bytes = to_byte - from_byte; Lisp_Object attrs; @@ -8584,7 +8578,7 @@ are lower-case). */) (Lisp_Object prompt, Lisp_Object default_coding_system) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (SYMBOLP (default_coding_system)) default_coding_system = SYMBOL_NAME (default_coding_system); diff --git a/src/comp.c b/src/comp.c index 188dc6ea005..398f35ddb0b 100644 --- a/src/comp.c +++ b/src/comp.c @@ -447,13 +447,14 @@ load_gccjit_if_necessary (bool mandatory) /* Increase this number to force a new Vcomp_abi_hash to be generated. */ -#define ABI_VERSION "4" +#define ABI_VERSION "5" /* Length of the hashes used for eln file naming. */ #define HASH_LENGTH 8 /* C symbols emitted for the load relocation mechanism. */ #define CURRENT_THREAD_RELOC_SYM "current_thread_reloc" +#define F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM "f_symbols_with_pos_enabled_reloc" #define PURE_RELOC_SYM "pure_reloc" #define DATA_RELOC_SYM "d_reloc" #define DATA_RELOC_IMPURE_SYM "d_reloc_imp" @@ -479,6 +480,10 @@ load_gccjit_if_necessary (bool mandatory) #define THIRD(x) \ XCAR (XCDR (XCDR (x))) +/* Like call0 but stringify and intern. */ +#define CALL0I(fun) \ + CALLN (Ffuncall, intern_c_string (STR (fun))) + /* Like call1 but stringify and intern. */ #define CALL1I(fun, arg) \ CALLN (Ffuncall, intern_c_string (STR (fun)), arg) @@ -511,8 +516,6 @@ typedef struct { ptrdiff_t size; } f_reloc_t; -sigset_t saved_sigset; - static f_reloc_t freloc; #define NUM_CAST_TYPES 15 @@ -542,6 +545,7 @@ typedef struct { gcc_jit_type *emacs_int_type; gcc_jit_type *emacs_uint_type; gcc_jit_type *void_ptr_type; + gcc_jit_type *bool_ptr_type; gcc_jit_type *char_ptr_type; gcc_jit_type *ptrdiff_type; gcc_jit_type *uintptr_type; @@ -563,6 +567,16 @@ typedef struct { gcc_jit_field *lisp_cons_u_s_u_cdr; gcc_jit_type *lisp_cons_type; gcc_jit_type *lisp_cons_ptr_type; + /* struct Lisp_Symbol_With_Position */ + gcc_jit_rvalue *f_symbols_with_pos_enabled_ref; + gcc_jit_struct *lisp_symbol_with_position; + gcc_jit_field *lisp_symbol_with_position_header; + gcc_jit_field *lisp_symbol_with_position_sym; + gcc_jit_field *lisp_symbol_with_position_pos; + gcc_jit_type *lisp_symbol_with_position_type; + gcc_jit_type *lisp_symbol_with_position_ptr_type; + gcc_jit_function *get_symbol_with_position; + gcc_jit_function *symbol_with_pos_sym; /* struct jmp_buf. */ gcc_jit_struct *jmp_buf_s; /* struct handler. */ @@ -632,7 +646,7 @@ typedef struct { static comp_t comp; -FILE *logfile = NULL; +static FILE *logfile; /* This is used for serialized objects by the reload mechanism. */ typedef struct { @@ -650,13 +664,16 @@ typedef struct { Helper functions called by the run-time. */ -void helper_unwind_protect (Lisp_Object handler); -Lisp_Object helper_temp_output_buffer_setup (Lisp_Object x); -Lisp_Object helper_unbind_n (Lisp_Object n); -void helper_save_restriction (void); -bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code); +static void helper_unwind_protect (Lisp_Object); +static Lisp_Object helper_unbind_n (Lisp_Object); +static void helper_save_restriction (void); +static bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object, enum pvec_type); +static struct Lisp_Symbol_With_Pos * +helper_GET_SYMBOL_WITH_POSITION (Lisp_Object); -void *helper_link_table[] = +/* Note: helper_link_table must match the list created by + `declare_runtime_imported_funcs'. */ +static void *helper_link_table[] = { wrong_type_argument, helper_PSEUDOVECTOR_TYPEP_XUNTAG, pure_write_error, @@ -664,6 +681,7 @@ void *helper_link_table[] = record_unwind_protect_excursion, helper_unbind_n, helper_save_restriction, + helper_GET_SYMBOL_WITH_POSITION, record_unwind_current_buffer, set_internal, helper_unwind_protect, @@ -1328,9 +1346,9 @@ emit_XCONS (gcc_jit_rvalue *a) } static gcc_jit_rvalue * -emit_EQ (gcc_jit_rvalue *x, gcc_jit_rvalue *y) +emit_BASE_EQ (gcc_jit_rvalue *x, gcc_jit_rvalue *y) { - emit_comment ("EQ"); + emit_comment ("BASE_EQ"); return gcc_jit_context_new_comparison ( comp.ctxt, @@ -1341,6 +1359,30 @@ emit_EQ (gcc_jit_rvalue *x, gcc_jit_rvalue *y) } static gcc_jit_rvalue * +emit_AND (gcc_jit_rvalue *x, gcc_jit_rvalue *y) +{ + return gcc_jit_context_new_binary_op ( + comp.ctxt, + NULL, + GCC_JIT_BINARY_OP_LOGICAL_AND, + comp.bool_type, + x, + y); +} + +static gcc_jit_rvalue * +emit_OR (gcc_jit_rvalue *x, gcc_jit_rvalue *y) +{ + return gcc_jit_context_new_binary_op ( + comp.ctxt, + NULL, + GCC_JIT_BINARY_OP_LOGICAL_OR, + comp.bool_type, + x, + y); +} + +static gcc_jit_rvalue * emit_TAGGEDP (gcc_jit_rvalue *obj, Lisp_Word_tag tag) { /* (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ @@ -1402,6 +1444,85 @@ emit_CONSP (gcc_jit_rvalue *obj) } static gcc_jit_rvalue * +emit_BARE_SYMBOL_P (gcc_jit_rvalue *obj) +{ + emit_comment ("BARE_SYMBOL_P"); + + return gcc_jit_context_new_cast (comp.ctxt, + NULL, + emit_TAGGEDP (obj, Lisp_Symbol), + comp.bool_type); +} + +static gcc_jit_rvalue * +emit_SYMBOL_WITH_POS_P (gcc_jit_rvalue *obj) +{ + emit_comment ("SYMBOL_WITH_POS_P"); + + gcc_jit_rvalue *args[] = + { obj, + gcc_jit_context_new_rvalue_from_int (comp.ctxt, + comp.int_type, + PVEC_SYMBOL_WITH_POS) + }; + + return gcc_jit_context_new_call (comp.ctxt, + NULL, + comp.pseudovectorp, + 2, + args); +} + +static gcc_jit_rvalue * +emit_SYMBOL_WITH_POS_SYM (gcc_jit_rvalue *obj) +{ + emit_comment ("SYMBOL_WITH_POS_SYM"); + + gcc_jit_rvalue *arg [] = { obj }; + return gcc_jit_context_new_call (comp.ctxt, + NULL, + comp.symbol_with_pos_sym, + 1, + arg); +} + +static gcc_jit_rvalue * +emit_EQ (gcc_jit_rvalue *x, gcc_jit_rvalue *y) +{ + return + emit_OR ( + gcc_jit_context_new_comparison ( + comp.ctxt, NULL, + GCC_JIT_COMPARISON_EQ, + emit_XLI (x), emit_XLI (y)), + emit_AND ( + gcc_jit_lvalue_as_rvalue ( + gcc_jit_rvalue_dereference (comp.f_symbols_with_pos_enabled_ref, + NULL)), + emit_OR ( + emit_AND ( + emit_SYMBOL_WITH_POS_P (x), + emit_OR ( + emit_AND ( + emit_SYMBOL_WITH_POS_P (y), + emit_BASE_EQ ( + emit_XLI (emit_SYMBOL_WITH_POS_SYM (x)), + emit_XLI (emit_SYMBOL_WITH_POS_SYM (y)))), + emit_AND ( + emit_BARE_SYMBOL_P (y), + emit_BASE_EQ ( + emit_XLI (emit_SYMBOL_WITH_POS_SYM (x)), + emit_XLI (y))))), + emit_AND ( + emit_BARE_SYMBOL_P (x), + emit_AND ( + emit_SYMBOL_WITH_POS_P (y), + emit_BASE_EQ ( + emit_XLI (x), + emit_XLI (emit_SYMBOL_WITH_POS_SYM (y)))))))); +} + +static gcc_jit_rvalue * emit_FLOATP (gcc_jit_rvalue *obj) { emit_comment ("FLOATP"); @@ -1601,7 +1722,7 @@ emit_lisp_obj_rval (Lisp_Object obj) emit_comment (format_string ("const lisp obj: %s", SSDATA (Fprin1_to_string (obj, Qnil)))); - if (EQ (obj, Qnil)) + if (NILP (obj)) { gcc_jit_rvalue *n; n = emit_rvalue_from_lisp_word ((Lisp_Word) iQnil); @@ -1615,7 +1736,7 @@ static gcc_jit_rvalue * emit_NILP (gcc_jit_rvalue *x) { emit_comment ("NILP"); - return emit_EQ (x, emit_lisp_obj_rval (Qnil)); + return emit_BASE_EQ (x, emit_lisp_obj_rval (Qnil)); } static gcc_jit_rvalue * @@ -1731,6 +1852,29 @@ emit_CHECK_CONS (gcc_jit_rvalue *x) args)); } +static void +emit_CHECK_SYMBOL_WITH_POS (gcc_jit_rvalue *x) +{ + emit_comment ("CHECK_SYMBOL_WITH_POS"); + + gcc_jit_rvalue *args[] = + { gcc_jit_context_new_cast (comp.ctxt, + NULL, + emit_SYMBOL_WITH_POS_P (x), + comp.int_type), + emit_lisp_obj_rval (Qsymbol_with_pos_p), + x }; + + gcc_jit_block_add_eval ( + comp.block, + NULL, + gcc_jit_context_new_call (comp.ctxt, + NULL, + comp.check_type, + 3, + args)); +} + static gcc_jit_rvalue * emit_car_addr (gcc_jit_rvalue *c) { @@ -2095,7 +2239,13 @@ emit_limple_insn (Lisp_Object insn) gcc_jit_block *target1 = retrive_block (arg[2]); gcc_jit_block *target2 = retrive_block (arg[3]); - emit_cond_jump (emit_EQ (a, b), target1, target2); + if ((!NILP (CALL1I (comp-cstr-imm-vld-p, arg[0])) + && NILP (CALL1I (comp-cstr-imm, arg[0]))) + || (!NILP (CALL1I (comp-cstr-imm-vld-p, arg[1])) + && NILP (CALL1I (comp-cstr-imm, arg[1])))) + emit_cond_jump (emit_BASE_EQ (a, b), target1, target2); + else + emit_cond_jump (emit_EQ (a, b), target1, target2); } else if (EQ (op, Qcond_jump_narg_leq)) { @@ -2487,7 +2637,7 @@ emit_static_object (const char *name, Lisp_Object obj) strings cause of this funny bug that will affect all pre gcc10 era gccs: https://gcc.gnu.org/ml/jit/2019-q3/msg00013.html */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Preserve uninterned symbols, this is specifically necessary for CL macro expansion in dynamic scope code (bug#42088). See `byte-compile-output-file-form'. */ @@ -2714,7 +2864,8 @@ declare_imported_data (void) /* Declare as imported all the functions that are requested from the runtime. - These are either subrs or not. + These are either subrs or not. Note that the list created here must match + the array `helper_link_table'. */ static Lisp_Object declare_runtime_imported_funcs (void) @@ -2751,6 +2902,10 @@ declare_runtime_imported_funcs (void) ADD_IMPORTED (helper_save_restriction, comp.void_type, 0, NULL); + args[0] = comp.lisp_obj_type; + ADD_IMPORTED (helper_GET_SYMBOL_WITH_POSITION, comp.lisp_symbol_with_position_ptr_type, + 1, args); + ADD_IMPORTED (record_unwind_current_buffer, comp.void_type, 0, NULL); args[0] = args[1] = args[2] = comp.lisp_obj_type; @@ -2798,6 +2953,15 @@ emit_ctxt_code (void) gcc_jit_type_get_pointer (comp.thread_state_ptr_type), CURRENT_THREAD_RELOC_SYM)); + comp.f_symbols_with_pos_enabled_ref = + gcc_jit_lvalue_as_rvalue ( + gcc_jit_context_new_global ( + comp.ctxt, + NULL, + GCC_JIT_GLOBAL_EXPORTED, + comp.bool_ptr_type, + F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM)); + comp.pure_ptr = gcc_jit_lvalue_as_rvalue ( gcc_jit_context_new_global ( @@ -2977,6 +3141,39 @@ define_lisp_cons (void) } +static void +define_lisp_symbol_with_position (void) +{ + comp.lisp_symbol_with_position_header = + gcc_jit_context_new_field (comp.ctxt, + NULL, + comp.ptrdiff_type, + "header"); + comp.lisp_symbol_with_position_sym = + gcc_jit_context_new_field (comp.ctxt, + NULL, + comp.lisp_obj_type, + "sym"); + comp.lisp_symbol_with_position_pos = + gcc_jit_context_new_field (comp.ctxt, + NULL, + comp.lisp_obj_type, + "pos"); + gcc_jit_field *fields [3] = {comp.lisp_symbol_with_position_header, + comp.lisp_symbol_with_position_sym, + comp.lisp_symbol_with_position_pos}; + comp.lisp_symbol_with_position = + gcc_jit_context_new_struct_type (comp.ctxt, + NULL, + "comp_lisp_symbol_with_position", + 3, + fields); + comp.lisp_symbol_with_position_type = + gcc_jit_struct_as_type (comp.lisp_symbol_with_position); + comp.lisp_symbol_with_position_ptr_type = + gcc_jit_type_get_pointer (comp.lisp_symbol_with_position_type); +} + /* Opaque jmp_buf definition. */ static void @@ -3673,6 +3870,82 @@ define_PSEUDOVECTORP (void) } static void +define_GET_SYMBOL_WITH_POSITION (void) +{ + gcc_jit_param *param[] = + { gcc_jit_context_new_param (comp.ctxt, + NULL, + comp.lisp_obj_type, + "a") }; + + comp.get_symbol_with_position = + gcc_jit_context_new_function (comp.ctxt, NULL, + GCC_JIT_FUNCTION_INTERNAL, + comp.lisp_symbol_with_position_ptr_type, + "GET_SYMBOL_WITH_POSITION", + 1, + param, + 0); + + DECL_BLOCK (entry_block, comp.get_symbol_with_position); + + comp.block = entry_block; + comp.func = comp.get_symbol_with_position; + + gcc_jit_rvalue *args[] = + { gcc_jit_param_as_rvalue (param[0]) }; + /* FIXME use XUNTAG now that's available. */ + gcc_jit_block_end_with_return ( + entry_block, + NULL, + emit_call (intern_c_string ("helper_GET_SYMBOL_WITH_POSITION"), + comp.lisp_symbol_with_position_ptr_type, + 1, args, false)); +} + +static void define_SYMBOL_WITH_POS_SYM (void) +{ + gcc_jit_rvalue *tmpr, *swp; + gcc_jit_lvalue *tmpl; + + gcc_jit_param *param [] = + { gcc_jit_context_new_param (comp.ctxt, + NULL, + comp.lisp_obj_type, + "a") }; + comp.symbol_with_pos_sym = + gcc_jit_context_new_function (comp.ctxt, NULL, + GCC_JIT_FUNCTION_INTERNAL, + comp.lisp_obj_type, + "SYMBOL_WITH_POS_SYM", + 1, + param, + 0); + + DECL_BLOCK (entry_block, comp.symbol_with_pos_sym); + comp.func = comp.symbol_with_pos_sym; + comp.block = entry_block; + + emit_CHECK_SYMBOL_WITH_POS (gcc_jit_param_as_rvalue (param [0])); + + gcc_jit_rvalue *args[] = { gcc_jit_param_as_rvalue (param [0]) }; + + swp = gcc_jit_context_new_call (comp.ctxt, + NULL, + comp.get_symbol_with_position, + 1, + args); + tmpl = gcc_jit_rvalue_dereference (swp, NULL); + tmpr = gcc_jit_lvalue_as_rvalue (tmpl); + gcc_jit_block_end_with_return (entry_block, + NULL, + gcc_jit_rvalue_access_field ( + tmpr, + NULL, + comp.lisp_symbol_with_position_sym)); +} + +static void define_CHECK_IMPURE (void) { gcc_jit_param *param[] = @@ -4123,7 +4396,7 @@ one for the file name and another for its contents, followed by .eln. */) 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 = @@ -4309,6 +4582,7 @@ Return t on success. */) gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_LONG_LONG); comp.unsigned_long_long_type = gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_UNSIGNED_LONG_LONG); + comp.bool_ptr_type = gcc_jit_type_get_pointer (comp.bool_type); comp.char_ptr_type = gcc_jit_type_get_pointer (comp.char_type); comp.emacs_int_type = gcc_jit_context_get_int_type (comp.ctxt, sizeof (EMACS_INT), @@ -4381,6 +4655,7 @@ Return t on success. */) /* Define data structures. */ define_lisp_cons (); + define_lisp_symbol_with_position (); define_jmp_buf (); define_handler_struct (); define_thread_state_struct (); @@ -4602,7 +4877,9 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, /* Define inline functions. */ define_CAR_CDR (); define_PSEUDOVECTORP (); + define_GET_SYMBOL_WITH_POSITION (); define_CHECK_TYPE (); + define_SYMBOL_WITH_POS_SYM (); define_CHECK_IMPURE (); define_bool_to_lisp_obj (); define_setcar_setcdr (); @@ -4692,12 +4969,11 @@ unknown (before GCC version 10). */) /******************************************************************************/ /* Helper functions called from the run-time. */ -/* These can't be statics till shared mechanism is used to solve relocations. */ /* Note: this are all potentially definable directly to gcc and are here just */ /* for laziness. Change this if a performance impact is measured. */ /******************************************************************************/ -void +static void helper_unwind_protect (Lisp_Object handler) { /* Support for a function here is new in 24.4. */ @@ -4705,28 +4981,20 @@ helper_unwind_protect (Lisp_Object handler) handler); } -Lisp_Object -helper_temp_output_buffer_setup (Lisp_Object x) -{ - CHECK_STRING (x); - temp_output_buffer_setup (SSDATA (x)); - return Vstandard_output; -} - -Lisp_Object +static Lisp_Object helper_unbind_n (Lisp_Object n) { - return unbind_to (SPECPDL_INDEX () - XFIXNUM (n), Qnil); + return unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -XFIXNUM (n)), Qnil); } -void +static void helper_save_restriction (void) { record_unwind_protect (save_restriction_restore, save_restriction_save ()); } -bool +static bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code) { return PSEUDOVECTOR_TYPEP (XUNTAG (a, Lisp_Vectorlike, @@ -4734,6 +5002,14 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code) code); } +static struct Lisp_Symbol_With_Pos * +helper_GET_SYMBOL_WITH_POSITION (Lisp_Object a) +{ + if (!SYMBOL_WITH_POS_P (a)) + wrong_type_argument (Qwrong_type_argument, a); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); +} + /* `native-comp-eln-load-path' clean-up support code. */ @@ -4745,6 +5021,12 @@ return_nil (Lisp_Object arg) { return Qnil; } + +static Lisp_Object +directory_files_matching (Lisp_Object name, Lisp_Object match) +{ + return Fdirectory_files (name, Qt, match, Qnil, Qnil); +} #endif /* Windows does not let us delete a .eln file that is currently loaded @@ -4762,11 +5044,11 @@ eln_load_path_final_clean_up (void) FOR_EACH_TAIL (dir_tail) { Lisp_Object files_in_dir = - internal_condition_case_5 (Fdirectory_files, + internal_condition_case_2 (directory_files_matching, Fexpand_file_name (Vcomp_native_version_dir, XCAR (dir_tail)), - Qt, build_string ("\\.eln\\.old\\'"), Qnil, - Qnil, Qt, return_nil); + build_string ("\\.eln\\.old\\'"), + Qt, return_nil); FOR_EACH_TAIL (files_in_dir) internal_delete_file (XCAR (files_in_dir)); } @@ -4786,10 +5068,6 @@ register_native_comp_unit (Lisp_Object comp_u) /* Deferred compilation mechanism. */ /***********************************/ -/* List of sources we'll compile and load after having conventionally - loaded the compiler and its dependencies. */ -static Lisp_Object delayed_sources; - /* Queue an asynchronous compilation for the source file defining FUNCTION_NAME and perform a late load. @@ -4844,32 +5122,19 @@ maybe_defer_native_compilation (Lisp_Object function_name, return; } + Fputhash (function_name, definition, Vcomp_deferred_pending_h); + /* This is so deferred compilation is able to compile comp dependencies breaking circularity. */ - if (!NILP (Ffeaturep (Qcomp, Qnil))) + if (comp__compilable) { - /* Comp already loaded. */ - if (!NILP (delayed_sources)) - { - CALLN (Ffuncall, intern_c_string ("native--compile-async"), - delayed_sources, Qnil, Qlate); - delayed_sources = Qnil; - } - Fputhash (function_name, definition, Vcomp_deferred_pending_h); + /* Startup is done, comp is usable. */ + CALL0I (startup--require-comp-safely); CALLN (Ffuncall, intern_c_string ("native--compile-async"), src, Qnil, Qlate); } else - { - delayed_sources = Fcons (src, delayed_sources); - /* Require comp only once. */ - static bool comp_required = false; - if (!comp_required) - { - comp_required = true; - Frequire (Qcomp, Qnil, Qnil); - } - } + Vcomp__delayed_sources = Fcons (src, Vcomp__delayed_sources); } @@ -5000,7 +5265,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, identify is we have at least another load active on it. */ bool recursive_load = comp_u->load_ongoing; comp_u->load_ongoing = true; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (!recursive_load) record_unwind_protect (unset_cu_load_ongoing, comp_u_lisp_obj); @@ -5018,12 +5283,15 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, { struct thread_state ***current_thread_reloc = dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); + bool **f_symbols_with_pos_enabled_reloc = + dynlib_sym (handle, F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM); void **pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM); Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); Lisp_Object *data_imp_relocs = comp_u->data_imp_relocs; void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM); if (!(current_thread_reloc + && f_symbols_with_pos_enabled_reloc && pure_reloc && data_relocs && data_imp_relocs @@ -5035,6 +5303,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file); *current_thread_reloc = ¤t_thread; + *f_symbols_with_pos_enabled_reloc = &symbols_with_pos_enabled; *pure_reloc = pure; /* Imported functions. */ @@ -5137,7 +5406,7 @@ native_function_doc (Lisp_Object function) static Lisp_Object make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg, Lisp_Object c_name, Lisp_Object type, Lisp_Object doc_idx, - Lisp_Object intspec, Lisp_Object comp_u) + Lisp_Object intspec, Lisp_Object command_modes, Lisp_Object comp_u) { struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u); dynlib_handle_ptr handle = cu->handle; @@ -5171,6 +5440,7 @@ make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg, x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; x->s.symbol_name = xstrdup (SSDATA (symbol_name)); x->s.native_intspec = intspec; + x->s.command_modes = command_modes; x->s.doc = XFIXNUM (doc_idx); #ifdef HAVE_NATIVE_COMP x->s.native_comp_u = comp_u; @@ -5193,12 +5463,15 @@ This gets called by top_level_run during the load phase. */) { Lisp_Object doc_idx = FIRST (rest); Lisp_Object intspec = SECOND (rest); + Lisp_Object command_modes = THIRD (rest); + struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u); if (cu->loaded_once) return Qnil; Lisp_Object tem = - make_subr (c_name, minarg, maxarg, c_name, type, doc_idx, intspec, comp_u); + make_subr (c_name, minarg, maxarg, c_name, type, doc_idx, intspec, + command_modes, comp_u); /* We must protect it against GC because the function is not reachable through symbols. */ @@ -5223,23 +5496,13 @@ This gets called by top_level_run during the load phase. */) { Lisp_Object doc_idx = FIRST (rest); Lisp_Object intspec = SECOND (rest); + Lisp_Object command_modes = THIRD (rest); + Lisp_Object tem = make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, type, doc_idx, - intspec, comp_u); - - if (AUTOLOADP (XSYMBOL (name)->u.s.function)) - /* Remember that the function was already an autoload. */ - LOADHIST_ATTACH (Fcons (Qt, name)); - LOADHIST_ATTACH (Fcons (Qdefun, name)); - - { /* Handle automatic advice activation (bug#42038). - See `defalias'. */ - Lisp_Object hook = Fget (name, Qdefalias_fset_function); - if (!NILP (hook)) - call2 (hook, name, tem); - else - Ffset (name, tem); - } + intspec, command_modes, comp_u); + + defalias (name, tem); return tem; } @@ -5268,7 +5531,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. */ @@ -5295,16 +5559,16 @@ LATE_LOAD has to be non-nil when loading for deferred compilation. */) Fmake_temp_file_internal (filename, Qnil, build_string (".eln.tmp"), Qnil); if (NILP (Ffile_writable_p (tmp_filename))) - comp_u->handle = dynlib_open (SSDATA (encoded_filename)); + comp_u->handle = dynlib_open_for_eln (SSDATA (encoded_filename)); else { Frename_file (filename, tmp_filename, Qt); - comp_u->handle = dynlib_open (SSDATA (ENCODE_FILE (tmp_filename))); + comp_u->handle = dynlib_open_for_eln (SSDATA (ENCODE_FILE (tmp_filename))); Frename_file (tmp_filename, filename, Qnil); } } else - comp_u->handle = dynlib_open (SSDATA (encoded_filename)); + comp_u->handle = dynlib_open_for_eln (SSDATA (encoded_filename)); if (!comp_u->handle) xsignal2 (Qnative_lisp_load_failed, filename, @@ -5335,6 +5599,13 @@ void syms_of_comp (void) { #ifdef HAVE_NATIVE_COMP + DEFVAR_LISP ("comp--delayed-sources", Vcomp__delayed_sources, + doc: /* List of sources to be native-compiled when startup is finished. +For internal use. */); + DEFVAR_BOOL ("comp--compilable", + comp__compilable, + doc: /* Non-nil when comp.el can be native compiled. +For internal use. */); /* Compiler control customizes. */ DEFVAR_BOOL ("native-comp-deferred-compilation", native_comp_deferred_compilation, @@ -5396,6 +5667,7 @@ compiled one. */); DEFSYM (Qnumberp, "numberp"); DEFSYM (Qintegerp, "integerp"); DEFSYM (Qcomp_maybe_gc_or_quit, "comp-maybe-gc-or-quit"); + DEFSYM (Qsymbol_with_pos_p, "symbol-with-pos-p"); /* Allocation classes. */ DEFSYM (Qd_default, "d-default"); @@ -5475,8 +5747,6 @@ compiled one. */); staticpro (&comp.func_blocks_h); staticpro (&comp.emitter_dispatcher); comp.emitter_dispatcher = Qnil; - staticpro (&delayed_sources); - delayed_sources = Qnil; staticpro (&loadsearch_re_list); loadsearch_re_list = Qnil; @@ -5548,3 +5818,6 @@ be preloaded. */); defsubr (&Snative_comp_available_p); } +/* Local Variables: */ +/* c-file-offsets: ((arglist-intro . +)) */ +/* End: */ diff --git a/src/comp.h b/src/comp.h index 40f1e9b979c..da53f32971e 100644 --- a/src/comp.h +++ b/src/comp.h @@ -53,6 +53,8 @@ struct Lisp_Native_Comp_Unit #ifdef HAVE_NATIVE_COMP +INLINE_HEADER_BEGIN + INLINE bool NATIVE_COMP_UNITP (Lisp_Object a) { @@ -99,6 +101,8 @@ void unload_comp_unit (struct Lisp_Native_Comp_Unit *cu) extern void syms_of_comp (void); +INLINE_HEADER_END + #endif /* #ifdef HAVE_NATIVE_COMP */ #endif /* #ifndef COMP_H */ diff --git a/src/composite.c b/src/composite.c index a4db66b92d8..c2ade90d54a 100644 --- a/src/composite.c +++ b/src/composite.c @@ -575,7 +575,7 @@ update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask) } if (min_pos < max_pos) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); @@ -704,8 +704,8 @@ DEFUN ("clear-composition-cache", Fclear_composition_cache, Clear composition cache. */) (void) { - Lisp_Object args[] = {QCtest, Qequal, QCsize, make_fixnum (311)}; - gstring_hash_table = CALLMANY (Fmake_hash_table, args); + gstring_hash_table = CALLN (Fmake_hash_table, QCtest, Qequal, + QCsize, make_fixnum (311)); /* Fixme: We call Fclear_face_cache to force complete re-building of display glyphs. But, it may be better to call this function from Fclear_face_cache instead. */ @@ -892,7 +892,7 @@ 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, int ch) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object pos = make_fixnum (charpos); ptrdiff_t to; ptrdiff_t pt = PT, pt_byte = PT_BYTE; @@ -988,7 +988,9 @@ inhibit_auto_composition (void) less than CHARPOS, search backward to ENDPOS+1 assuming that set_iterator_to_next works in reverse order. In this case, if a composition closest to CHARPOS is found, set cmp_it->stop_pos to - the last character of the composition. + the last character of the composition. STRING, if non-nil, is + the string (as opposed to a buffer) whose characters should be + tested for being composable. If no composition is found, set cmp_it->ch to -2. If a static composition is found, set cmp_it->ch to -1. Otherwise, set @@ -996,7 +998,9 @@ inhibit_auto_composition (void) composition. */ void -composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t endpos, Lisp_Object string) +composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, + ptrdiff_t bytepos, ptrdiff_t endpos, + Lisp_Object string) { ptrdiff_t start, end; int c; @@ -1035,7 +1039,9 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, cmp_it->stop_pos = endpos = start; cmp_it->ch = -1; } - if (NILP (BVAR (current_buffer, enable_multibyte_characters)) + if ((NILP (string) + && NILP (BVAR (current_buffer, enable_multibyte_characters))) + || (STRINGP (string) && !STRING_MULTIBYTE (string)) || inhibit_auto_composition ()) return; if (bytepos < 0) @@ -1292,6 +1298,16 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos, if (cmp_it->lookback > 0) { cpos = charpos - cmp_it->lookback; + /* Reject the composition if it starts before ENDPOS, + which here can only happen if + composition-break-at-point is non-nil and point is + inside the composition. */ + if (cpos < endpos) + { + eassert (composition_break_at_point); + eassert (endpos == PT); + goto no_composition; + } if (STRINGP (string)) bpos = string_char_to_byte (string, cpos); else @@ -1961,7 +1977,9 @@ See `find-composition' for more details. */) if (!find_composition (from, to, &start, &end, &prop, string)) { - if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) + if (((NILP (string) + && !NILP (BVAR (current_buffer, enable_multibyte_characters))) + || (!NILP (string) && STRING_MULTIBYTE (string))) && ! inhibit_auto_composition () && find_automatic_composition (from, to, (ptrdiff_t) -1, &start, &end, &gstring, string)) diff --git a/src/conf_post.h b/src/conf_post.h index 6db76a2dfad..5108e44efbd 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -32,13 +32,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* To help make dependencies clearer elsewhere, this file typically does not #include other files. The exceptions are stdbool.h because it is unlikely to interfere with configuration and bool is - such a core part of the C language, attribute.h because its - ATTRIBUTE_* macros are used here, and ms-w32.h (DOS_NT + such a core part of the C language, and ms-w32.h (DOS_NT only) because it historically was included here and changing that would take some work. */ #include <stdbool.h> -#include <attribute.h> #if defined WINDOWSNT && !defined DEFER_MS_W32_H # include <ms-w32.h> @@ -182,6 +180,26 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ # define SIZE_MAX 4294967295U #endif +/* Things that lib/reg* wants. */ + +#define mbrtowc(pwc, s, n, ps) mbtowc ((pwc), (s), (n)) +#define wcrtomb(s, wc, ps) wctomb ((s), (wc)) +#define btowc(b) ((wchar_t) (b)) +#define towupper(chr) toupper (chr) +#define towlower(chr) tolower (chr) +#define iswalnum(chr) isalnum (chr) +#define wctype(name) ((wctype_t) 0) +#define iswctype(wc, type) false +#define mbsinit(ps) 1 + +/* Some things that lib/at-func.c wants. */ +#define GNULIB_SUPPORT_ONLY_AT_FDCWD + +/* Needed by lib/lchmod.c. */ +#define EOPNOTSUPP EINVAL + +#define MALLOC_0_IS_NONNULL 1 + /* We must intercept 'opendir' calls to stash away the directory name, so we could reuse it in readlinkat; see msdos.c. */ #define opendir sys_opendir @@ -259,8 +277,8 @@ extern void _DebPrint (const char *fmt, ...); extern char *emacs_getenv_TZ (void); extern int emacs_setenv_TZ (char const *); -#define NO_INLINE ATTRIBUTE_NOINLINE -#define EXTERNALLY_VISIBLE ATTRIBUTE_EXTERNALLY_VISIBLE +#define NO_INLINE _GL_ATTRIBUTE_NOINLINE +#define EXTERNALLY_VISIBLE _GL_ATTRIBUTE_EXTERNALLY_VISIBLE #if GNUC_PREREQ (4, 4, 0) && defined __GLIBC_MINOR__ # define PRINTF_ARCHETYPE __gnu_printf__ @@ -290,9 +308,9 @@ extern int emacs_setenv_TZ (char const *); # define PRINTF_ARCHETYPE __printf__ #endif #define ATTRIBUTE_FORMAT_PRINTF(string_index, first_to_check) \ - ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check)) + _GL_ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check)) -#define ARG_NONNULL ATTRIBUTE_NONNULL +#define ARG_NONNULL _GL_ATTRIBUTE_NONNULL /* 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 @@ -300,15 +318,16 @@ extern int emacs_setenv_TZ (char const *); behavior, even if options like gcc -fstrict-aliasing are used. */ #define DECLARE_POINTER_ALIAS(name, type, addr) \ - type ATTRIBUTE_MAY_ALIAS *name = (type *) (addr) + type _GL_ATTRIBUTE_MAY_ALIAS *name = (type *) (addr) #if 3 <= __GNUC__ # define ATTRIBUTE_SECTION(name) __attribute__((section (name))) #else -#define ATTRIBUTE_SECTION(name) +# define ATTRIBUTE_SECTION(name) #endif -#define ATTRIBUTE_MALLOC_SIZE(args) ATTRIBUTE_MALLOC ATTRIBUTE_ALLOC_SIZE (args) +#define ATTRIBUTE_MALLOC_SIZE(args) \ + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_ALLOC_SIZE (args) /* Work around GCC bug 59600: when a function is inlined, the inlined code may have its addresses sanitized even if the function has the @@ -353,6 +372,19 @@ extern int emacs_setenv_TZ (char const *); # define vfork fork #endif +/* vfork is deprecated on at least macOS 11.6 and later, but it still works + and is faster than fork, so silence the warning as if we knew what we + are doing. */ +#ifdef DARWIN_OS +#define VFORK() \ + (_Pragma("clang diagnostic push") \ + _Pragma("clang diagnostic ignored \"-Wdeprecated-declarations\"") \ + vfork () \ + _Pragma("clang diagnostic pop")) +#else +#define VFORK() vfork () +#endif + #if ! (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__) # undef PROFILING #endif diff --git a/src/cygw32.c b/src/cygw32.c index 1b43de2c05e..759d9af94de 100644 --- a/src/cygw32.c +++ b/src/cygw32.c @@ -56,7 +56,7 @@ conv_filename_to_w32_unicode (Lisp_Object in, int absolute_p) ssize_t converted_len; Lisp_Object converted; unsigned flags; - int count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); chdir_to_default_directory (); @@ -85,7 +85,7 @@ conv_filename_from_w32_unicode (const wchar_t* in, int absolute_p) ssize_t converted_len; Lisp_Object converted; unsigned flags; - int count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); chdir_to_default_directory (); @@ -115,7 +115,7 @@ For the reverse operation, see `cygwin-convert-file-name-from-windows'. */) (Lisp_Object file, Lisp_Object absolute_p) { return from_unicode ( - conv_filename_to_w32_unicode (file, EQ (absolute_p, Qnil) ? 0 : 1)); + conv_filename_to_w32_unicode (file, NILP (absolute_p) ? 0 : 1)); } DEFUN ("cygwin-convert-file-name-from-windows", @@ -128,7 +128,7 @@ For the reverse operation, see `cygwin-convert-file-name-to-windows'. */) (Lisp_Object file, Lisp_Object absolute_p) { return conv_filename_from_w32_unicode (to_unicode (file, &file), - EQ (absolute_p, Qnil) ? 0 : 1); + NILP (absolute_p) ? 0 : 1); } void diff --git a/src/data.c b/src/data.c index 57205d88081..f06b561dcc6 100644 --- a/src/data.c +++ b/src/data.c @@ -216,6 +216,7 @@ for example, (type-of 1) returns `integer'. */) case PVEC_NORMAL_VECTOR: return Qvector; case PVEC_BIGNUM: return Qinteger; case PVEC_MARKER: return Qmarker; + case PVEC_SYMBOL_WITH_POS: return Qsymbol_with_pos; case PVEC_OVERLAY: return Qoverlay; case PVEC_FINALIZER: return Qfinalizer; case PVEC_USER_PTR: return Quser_ptr; @@ -259,6 +260,8 @@ for example, (type-of 1) returns `integer'. */) return Qxwidget; case PVEC_XWIDGET_VIEW: return Qxwidget_view; + case PVEC_SQLITE: + return Qsqlite; /* "Impossible" cases. */ case PVEC_MISC_PTR: case PVEC_OTHER: @@ -316,6 +319,26 @@ DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, return Qt; } +DEFUN ("bare-symbol-p", Fbare_symbol_p, Sbare_symbol_p, 1, 1, 0, + doc: /* Return t if OBJECT is a symbol, but not a symbol together with position. */ + attributes: const) + (Lisp_Object object) +{ + if (BARE_SYMBOL_P (object)) + return Qt; + return Qnil; +} + +DEFUN ("symbol-with-pos-p", Fsymbol_with_pos_p, Ssymbol_with_pos_p, 1, 1, 0, + doc: /* Return t if OBJECT is a symbol together with position. */ + attributes: const) + (Lisp_Object object) +{ + if (SYMBOL_WITH_POS_P (object)) + return Qt; + return Qnil; +} + DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, doc: /* Return t if OBJECT is a symbol. */ attributes: const) @@ -753,11 +776,66 @@ DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, return name; } +DEFUN ("bare-symbol", Fbare_symbol, Sbare_symbol, 1, 1, 0, + doc: /* Extract, if need be, the bare symbol from SYM, a symbol. */) + (register Lisp_Object sym) +{ + if (BARE_SYMBOL_P (sym)) + return sym; + /* Type checking is done in the following macro. */ + return SYMBOL_WITH_POS_SYM (sym); +} + +DEFUN ("symbol-with-pos-pos", Fsymbol_with_pos_pos, Ssymbol_with_pos_pos, 1, 1, 0, + doc: /* Extract the position from a symbol with position. */) + (register Lisp_Object ls) +{ + /* Type checking is done in the following macro. */ + return SYMBOL_WITH_POS_POS (ls); +} + +DEFUN ("remove-pos-from-symbol", Fremove_pos_from_symbol, + Sremove_pos_from_symbol, 1, 1, 0, + doc: /* If ARG is a symbol with position, return it without the position. +Otherwise, return ARG unchanged. Compare with `bare-symbol'. */) + (register Lisp_Object arg) +{ + if (SYMBOL_WITH_POS_P (arg)) + return (SYMBOL_WITH_POS_SYM (arg)); + return arg; +} + +DEFUN ("position-symbol", Fposition_symbol, Sposition_symbol, 2, 2, 0, + doc: /* Create a new symbol with position. +SYM is a symbol, with or without position, the symbol to position. +POS, the position, is either a fixnum or a symbol with position from which +the position will be taken. */) + (register Lisp_Object sym, register Lisp_Object pos) +{ + Lisp_Object bare; + Lisp_Object position; + + if (BARE_SYMBOL_P (sym)) + bare = sym; + else if (SYMBOL_WITH_POS_P (sym)) + bare = XSYMBOL_WITH_POS (sym)->sym; + else + wrong_type_argument (Qsymbolp, sym); + + if (FIXNUMP (pos)) + position = pos; + else if (SYMBOL_WITH_POS_P (pos)) + position = XSYMBOL_WITH_POS (pos)->pos; + else + wrong_type_argument (Qfixnum_or_symbol_with_pos_p, pos); + + return build_symbol_with_pos (bare, position); +} + DEFUN ("fset", Ffset, Sfset, 2, 2, 0, doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. */) (register Lisp_Object symbol, Lisp_Object definition) { - register Lisp_Object function; CHECK_SYMBOL (symbol); /* Perhaps not quite the right error signal, but seems good enough. */ if (NILP (symbol) && !NILP (definition)) @@ -765,17 +843,11 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, think this one little sanity check is worth its cost, but anyway. */ xsignal1 (Qsetting_constant, symbol); - function = XSYMBOL (symbol)->u.s.function; - - if (!NILP (Vautoload_queue) && !NILP (function)) - Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); - - if (AUTOLOADP (function)) - Fput (symbol, Qautoload, XCDR (function)); - eassert (valid_lisp_object_p (definition)); #ifdef HAVE_NATIVE_COMP + register Lisp_Object function = XSYMBOL (symbol)->u.s.function; + if (comp_enable_subr_trampolines && SUBRP (function) && !SUBR_NATIVE_COMPILEDP (function)) @@ -787,6 +859,75 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, return definition; } +static void +add_to_function_history (Lisp_Object symbol, Lisp_Object olddef) +{ + eassert (!NILP (olddef)); + + Lisp_Object past = Fget (symbol, Qfunction_history); + Lisp_Object file = Qnil; + /* FIXME: Sadly, `Vload_file_name` gives less precise information + (it's sometimes non-nil when it shoujld be nil). */ + Lisp_Object tail = Vcurrent_load_list; + FOR_EACH_TAIL_SAFE (tail) + if (NILP (XCDR (tail)) && STRINGP (XCAR (tail))) + file = XCAR (tail); + + Lisp_Object tem = Fplist_member (past, file); + if (!NILP (tem)) + { /* New def from a file used before. + Overwrite the previous record associated with this file. */ + if (EQ (tem, past)) + /* The new def is from the same file as the last change, so + there's nothing to do: unloading the file should revert to + the status before the last change rather than before this load. */ + return; + Lisp_Object pastlen = Flength (past); + Lisp_Object temlen = Flength (tem); + EMACS_INT tempos = XFIXNUM (pastlen) - XFIXNUM (temlen); + eassert (tempos > 1); + Lisp_Object prev = Fnthcdr (make_fixnum (tempos - 2), past); + /* Remove the previous info for this file. + E.g. change `hist` from (... OTHERFILE DEF3 THISFILE DEF2 ...) + to (... OTHERFILE DEF2). */ + XSETCDR (prev, XCDR (tem)); + } + /* Push new def from new file. */ + Fput (symbol, Qfunction_history, Fcons (file, Fcons (olddef, past))); +} + +void +defalias (Lisp_Object symbol, Lisp_Object definition) +{ + { + bool autoload = AUTOLOADP (definition); + if (!will_dump_p () || !autoload) + { /* Only add autoload entries after dumping, because the ones before are + not useful and else we get loads of them from the loaddefs.el. + That saves us about 110KB in the pdmp file (Jan 2022). */ + LOADHIST_ATTACH (Fcons (Qdefun, symbol)); + } + } + + { + Lisp_Object olddef = XSYMBOL (symbol)->u.s.function; + if (!NILP (olddef)) + { + if (!NILP (Vautoload_queue)) + Vautoload_queue = Fcons (symbol, Vautoload_queue); + add_to_function_history (symbol, olddef); + } + } + + { /* Handle automatic advice activation. */ + Lisp_Object hook = Fget (symbol, Qdefalias_fset_function); + if (!NILP (hook)) + call2 (hook, symbol, definition); + else + Ffset (symbol, definition); + } +} + DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0, doc: /* Set SYMBOL's function definition to DEFINITION. Associates the function with the current load file, if any. @@ -806,26 +947,7 @@ The return value is undefined. */) && !KEYMAPP (definition)) definition = Fpurecopy (definition); - { - bool autoload = AUTOLOADP (definition); - if (!will_dump_p () || !autoload) - { /* Only add autoload entries after dumping, because the ones before are - not useful and else we get loads of them from the loaddefs.el. */ - - if (AUTOLOADP (XSYMBOL (symbol)->u.s.function)) - /* Remember that the function was already an autoload. */ - LOADHIST_ATTACH (Fcons (Qt, symbol)); - LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol)); - } - } - - { /* Handle automatic advice activation. */ - Lisp_Object hook = Fget (symbol, Qdefalias_fset_function); - if (!NILP (hook)) - call2 (hook, symbol, definition); - else - Ffset (symbol, definition); - } + defalias (symbol, definition); maybe_defer_native_compilation (symbol, definition); @@ -1022,9 +1144,6 @@ Value, if non-nil, is a list (interactive SPEC). */) return Qnil; } -/* Note that this doesn't work for native-compiled functions in Emacs - 28.1, but it's fixed in later Emacs versions. */ - DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0, doc: /* Return the modes COMMAND is defined for. If COMMAND is not a command, the return value is nil. @@ -1048,7 +1167,11 @@ The value, if non-nil, is a list of mode name symbols. */) fun = Fsymbol_function (fun); } - if (COMPILEDP (fun)) + if (SUBRP (fun)) + { + return XSUBR (fun)->command_modes; + } + else if (COMPILEDP (fun)) { if (PVSIZE (fun) <= COMPILED_INTERACTIVE) return Qnil; @@ -1718,7 +1841,7 @@ notify_variable_watchers (Lisp_Object symbol, { symbol = Findirect_variable (symbol); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect (restore_symbol_trapped_write, symbol); /* Avoid recursion. */ set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE); @@ -2104,7 +2227,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) /* Make sure this buffer has its own value of symbol. */ XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ - tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); + tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); if (NILP (tem)) { if (let_shadows_buffer_binding_p (sym)) @@ -2184,7 +2307,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) /* Get rid of this buffer's alist element, if any. */ XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ - tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); + tem = assq_no_quit (variable, BVAR (current_buffer, local_var_alist)); if (!NILP (tem)) bset_local_var_alist (current_buffer, @@ -2225,7 +2348,7 @@ Also see `buffer-local-boundp'.*/) case SYMBOL_PLAINVAL: return Qnil; case SYMBOL_LOCALIZED: { - Lisp_Object tail, elt, tmp; + Lisp_Object tmp; struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); XSETBUFFER (tmp, buf); XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ @@ -2233,13 +2356,9 @@ Also see `buffer-local-boundp'.*/) if (EQ (blv->where, tmp)) /* The binding is already loaded. */ return blv_found (blv) ? Qt : Qnil; else - for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) - { - elt = XCAR (tail); - if (EQ (variable, XCAR (elt))) - return Qt; - } - return Qnil; + return NILP (assq_no_quit (variable, BVAR (buf, local_var_alist))) + ? Qnil + : Qt; } case SYMBOL_FORWARDED: { @@ -2698,6 +2817,9 @@ DEFUN ("<", Flss, Slss, 1, MANY, 0, usage: (< NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { + if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1])) + return XFIXNUM (args[0]) < XFIXNUM (args[1]) ? Qt : Qnil; + return arithcompare_driver (nargs, args, ARITH_LESS); } @@ -2706,6 +2828,9 @@ DEFUN (">", Fgtr, Sgtr, 1, MANY, 0, usage: (> NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { + if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1])) + return XFIXNUM (args[0]) > XFIXNUM (args[1]) ? Qt : Qnil; + return arithcompare_driver (nargs, args, ARITH_GRTR); } @@ -2714,6 +2839,9 @@ DEFUN ("<=", Fleq, Sleq, 1, MANY, 0, usage: (<= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { + if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1])) + return XFIXNUM (args[0]) <= XFIXNUM (args[1]) ? Qt : Qnil; + return arithcompare_driver (nargs, args, ARITH_LESS_OR_EQUAL); } @@ -2722,6 +2850,9 @@ DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0, usage: (>= NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS) */) (ptrdiff_t nargs, Lisp_Object *args) { + if (nargs == 2 && FIXNUMP (args[0]) && FIXNUMP (args[1])) + return XFIXNUM (args[0]) >= XFIXNUM (args[1]) ? Qt : Qnil; + return arithcompare_driver (nargs, args, ARITH_GRTR_OR_EQUAL); } @@ -2853,6 +2984,29 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) return val; } +/* Render NUMBER in decimal into BUFFER which ends right before END. + Return the start of the string; the end is always at END. + The string is not null-terminated. */ +char * +fixnum_to_string (EMACS_INT number, char *buffer, char *end) +{ + EMACS_INT x = number; + bool negative = x < 0; + if (negative) + x = -x; + char *p = end; + do + { + eassume (p > buffer && p - 1 < end); + *--p = '0' + x % 10; + x /= 10; + } + while (x); + if (negative) + *--p = '-'; + return p; +} + DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0, doc: /* Return the decimal representation of NUMBER as a string. Uses a minus sign if negative. @@ -2860,19 +3014,22 @@ NUMBER may be an integer or a floating point number. */) (Lisp_Object number) { char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))]; - int len; - CHECK_NUMBER (number); + if (FIXNUMP (number)) + { + char *end = buffer + sizeof buffer; + char *p = fixnum_to_string (XFIXNUM (number), buffer, end); + return make_unibyte_string (p, end - p); + } if (BIGNUMP (number)) return bignum_to_string (number, 10); if (FLOATP (number)) - len = float_to_string (buffer, XFLOAT_DATA (number)); - else - len = sprintf (buffer, "%"pI"d", XFIXNUM (number)); + return make_unibyte_string (buffer, + float_to_string (buffer, XFLOAT_DATA (number))); - return make_unibyte_string (buffer, len); + wrong_type_argument (Qnumberp, number); } DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0, @@ -3897,7 +4054,7 @@ A is a bool vector, B is t or nil, and I is an index into A. */) void syms_of_data (void) { - Lisp_Object error_tail, arith_tail; + Lisp_Object error_tail, arith_tail, recursion_tail; DEFSYM (Qquote, "quote"); DEFSYM (Qlambda, "lambda"); @@ -3932,8 +4089,14 @@ syms_of_data (void) DEFSYM (Qmark_inactive, "mark-inactive"); DEFSYM (Qinhibited_interaction, "inhibited-interaction"); + DEFSYM (Qrecursion_error, "recursion-error"); + DEFSYM (Qexcessive_variable_binding, "excessive-variable-binding"); + DEFSYM (Qexcessive_lisp_nesting, "excessive-lisp-nesting"); + DEFSYM (Qlistp, "listp"); DEFSYM (Qconsp, "consp"); + DEFSYM (Qbare_symbol_p, "bare-symbol-p"); + DEFSYM (Qsymbol_with_pos_p, "symbol-with-pos-p"); DEFSYM (Qsymbolp, "symbolp"); DEFSYM (Qfixnump, "fixnump"); DEFSYM (Qintegerp, "integerp"); @@ -3959,6 +4122,7 @@ syms_of_data (void) DEFSYM (Qchar_table_p, "char-table-p"); DEFSYM (Qvector_or_char_table_p, "vector-or-char-table-p"); + DEFSYM (Qfixnum_or_symbol_with_pos_p, "fixnum-or-symbol-with-pos-p"); DEFSYM (Qsubrp, "subrp"); DEFSYM (Qunevalled, "unevalled"); @@ -4037,12 +4201,23 @@ syms_of_data (void) PUT_ERROR (Qunderflow_error, Fcons (Qrange_error, arith_tail), "Arithmetic underflow error"); + recursion_tail = pure_cons (Qrecursion_error, error_tail); + Fput (Qrecursion_error, Qerror_conditions, recursion_tail); + Fput (Qrecursion_error, Qerror_message, build_pure_c_string + ("Excessive recursive calling error")); + + PUT_ERROR (Qexcessive_variable_binding, recursion_tail, + "Variable binding depth exceeds max-specpdl-size"); + PUT_ERROR (Qexcessive_lisp_nesting, recursion_tail, + "Lisp nesting exceeds `max-lisp-eval-depth'"); + /* Types that type-of returns. */ DEFSYM (Qinteger, "integer"); DEFSYM (Qsymbol, "symbol"); DEFSYM (Qstring, "string"); DEFSYM (Qcons, "cons"); DEFSYM (Qmarker, "marker"); + DEFSYM (Qsymbol_with_pos, "symbol-with-pos"); DEFSYM (Qoverlay, "overlay"); DEFSYM (Qfinalizer, "finalizer"); DEFSYM (Qmodule_function, "module-function"); @@ -4075,6 +4250,7 @@ syms_of_data (void) DEFSYM (Qinteractive_form, "interactive-form"); DEFSYM (Qdefalias_fset_function, "defalias-fset-function"); + DEFSYM (Qfunction_history, "function-history"); DEFSYM (Qbyte_code_function_p, "byte-code-function-p"); @@ -4094,6 +4270,8 @@ syms_of_data (void) defsubr (&Snumber_or_marker_p); defsubr (&Sfloatp); defsubr (&Snatnump); + defsubr (&Sbare_symbol_p); + defsubr (&Ssymbol_with_pos_p); defsubr (&Ssymbolp); defsubr (&Skeywordp); defsubr (&Sstringp); @@ -4124,6 +4302,10 @@ syms_of_data (void) defsubr (&Sindirect_function); defsubr (&Ssymbol_plist); defsubr (&Ssymbol_name); + defsubr (&Sbare_symbol); + defsubr (&Ssymbol_with_pos_pos); + defsubr (&Sremove_pos_from_symbol); + defsubr (&Sposition_symbol); defsubr (&Smakunbound); defsubr (&Sfmakunbound); defsubr (&Sboundp); @@ -4206,6 +4388,12 @@ This variable cannot be set; trying to do so will signal an error. */); Vmost_negative_fixnum = make_fixnum (MOST_NEGATIVE_FIXNUM); make_symbol_constant (intern_c_string ("most-negative-fixnum")); + DEFSYM (Qsymbols_with_pos_enabled, "symbols-with-pos-enabled"); + DEFVAR_BOOL ("symbols-with-pos-enabled", symbols_with_pos_enabled, + doc: /* Non-nil when "symbols with position" can be used as symbols. +Bind this to non-nil in applications such as the byte compiler. */); + symbols_with_pos_enabled = false; + DEFSYM (Qwatchers, "watchers"); DEFSYM (Qmakunbound, "makunbound"); DEFSYM (Qunlet, "unlet"); diff --git a/src/decompress.c b/src/decompress.c index 60f8bfd6a26..dbdc9104a37 100644 --- a/src/decompress.c +++ b/src/decompress.c @@ -67,8 +67,9 @@ init_zlib_functions (void) #endif /* WINDOWSNT */ +#ifdef HAVE_NATIVE_COMP -#define MD5_BLOCKSIZE 32768 /* From md5.c */ +# define MD5_BLOCKSIZE 32768 /* From md5.c */ static char acc_buff[2 * MD5_BLOCKSIZE]; static size_t acc_size; @@ -106,7 +107,7 @@ md5_gz_stream (FILE *source, void *resblock) unsigned char in[MD5_BLOCKSIZE]; unsigned char out[MD5_BLOCKSIZE]; -#ifdef WINDOWSNT +# ifdef WINDOWSNT if (!zlib_initialized) zlib_initialized = init_zlib_functions (); if (!zlib_initialized) @@ -114,7 +115,7 @@ md5_gz_stream (FILE *source, void *resblock) message1 ("zlib library not found"); return -1; } -#endif +# endif eassert (!acc_size); @@ -164,7 +165,8 @@ md5_gz_stream (FILE *source, void *resblock) return 0; } -#undef MD5_BLOCKSIZE +# undef MD5_BLOCKSIZE +#endif @@ -239,7 +241,7 @@ This function can be called only in unibyte buffers. */) z_stream stream; int inflate_status; struct decompress_unwind_data unwind_data; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); validate_region (&start, &end); diff --git a/src/deps.mk b/src/deps.mk index deffab93eca..39edd5c1dd3 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -279,7 +279,7 @@ eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h frame.h \ dispextern.h lisp.h globals.h $(config_h) coding.h composite.h xterm.h \ msdos.h floatfns.o: floatfns.c syssignal.h lisp.h globals.h $(config_h) -fns.o: fns.c commands.h lisp.h $(config_h) frame.h buffer.h character.h \ +fns.o: fns.c sort.c commands.h lisp.h $(config_h) frame.h buffer.h character.h \ keyboard.h keymap.h window.h $(INTERVALS_H) coding.h ../lib/md5.h \ ../lib/sha1.h ../lib/sha256.h ../lib/sha512.h blockinput.h atimer.h \ systime.h xterm.h ../lib/unistd.h globals.h diff --git a/src/dired.c b/src/dired.c index 7fb54f2f67b..cd50012ddc7 100644 --- a/src/dired.c +++ b/src/dired.c @@ -195,7 +195,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, /* Unfortunately, we can now invoke expand-file-name and file-attributes on filenames, both of which can throw, so we must do a proper unwind-protect. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_ptr (directory_files_internal_unwind, d); #ifdef WINDOWSNT @@ -289,7 +289,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, #endif /* Discard the unwind protect. */ - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl_ref_to_ptr (count); if (NILP (nosort)) list = Fsort (Fnreverse (list), @@ -455,7 +455,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, anything. */ bool includeall = 1; bool check_decoded = false; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); elt = Qnil; @@ -944,7 +944,7 @@ file_attributes (int fd, char const *name, Lisp_Object dirname, Lisp_Object filename, Lisp_Object id_format) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct stat s; /* An array to hold the mode string generated by filemodestring, diff --git a/src/dispextern.h b/src/dispextern.h index 65801596d5d..e9b19a7f135 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -123,15 +123,25 @@ typedef HDC Emacs_Pix_Context; #ifdef HAVE_NS #include "nsgui.h" -#define FACE_COLOR_TO_PIXEL(face_color, frame) (FRAME_NS_P (frame) \ - ? ns_color_index_to_rgba (face_color, frame) \ - : face_color) /* Following typedef needed to accommodate the MSDOS port, believe it or not. */ typedef struct ns_display_info Display_Info; typedef Emacs_Pixmap Emacs_Pix_Container; typedef Emacs_Pixmap Emacs_Pix_Context; -#else -#define FACE_COLOR_TO_PIXEL(face_color, frame) face_color +#endif + +#ifdef HAVE_PGTK +#include "pgtkgui.h" +/* Following typedef needed to accommodate the MSDOS port, believe it or not. */ +typedef struct pgtk_display_info Display_Info; +typedef Emacs_Pixmap XImagePtr; +typedef XImagePtr XImagePtr_or_DC; +#endif /* HAVE_PGTK */ + +#ifdef HAVE_HAIKU +#include "haikugui.h" +typedef struct haiku_display_info Display_Info; +typedef Emacs_Pixmap Emacs_Pix_Container; +typedef Emacs_Pixmap Emacs_Pix_Context; #endif #ifdef HAVE_WINDOW_SYSTEM @@ -536,8 +546,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. */ @@ -1393,6 +1403,9 @@ struct glyph_string Emacs_GC *gc; HDC hdc; #endif +#if defined (HAVE_PGTK) + Emacs_GC xgcv; +#endif /* A pointer to the first glyph in the string. This glyph corresponds to char2b[0]. Needed to draw rectangles if @@ -1470,21 +1483,23 @@ struct glyph_string compared against minibuf_window (if SELW doesn't match), and SCRW which is compared against minibuf_selected_window (if MBW matches). */ -#define CURRENT_MODE_LINE_FACE_ID_3(SELW, MBW, SCRW) \ +#define CURRENT_MODE_LINE_ACTIVE_FACE_ID_3(SELW, MBW, SCRW) \ ((!mode_line_in_non_selected_windows \ || (SELW) == XWINDOW (selected_window) \ || (minibuf_level > 0 \ && !NILP (minibuf_selected_window) \ && (MBW) == XWINDOW (minibuf_window) \ && (SCRW) == XWINDOW (minibuf_selected_window))) \ - ? MODE_LINE_FACE_ID \ + ? MODE_LINE_ACTIVE_FACE_ID \ : MODE_LINE_INACTIVE_FACE_ID) /* Return the desired face id for the mode line of window W. */ -#define CURRENT_MODE_LINE_FACE_ID(W) \ - (CURRENT_MODE_LINE_FACE_ID_3((W), XWINDOW (selected_window), (W))) +#define CURRENT_MODE_LINE_ACTIVE_FACE_ID(W) \ + (CURRENT_MODE_LINE_ACTIVE_FACE_ID_3((W), \ + XWINDOW (selected_window), \ + (W))) /* Return the current height of the mode line of window W. If not known from W->mode_line_height, look at W's current glyph matrix, or return @@ -1497,7 +1512,7 @@ struct glyph_string = (MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \ ? MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \ : estimate_mode_line_height \ - (XFRAME ((W)->frame), CURRENT_MODE_LINE_FACE_ID (W))))) + (XFRAME ((W)->frame), CURRENT_MODE_LINE_ACTIVE_FACE_ID (W))))) /* Return the current height of the header line of window W. If not known from W->header_line_height, look at W's current glyph matrix, or return @@ -1705,6 +1720,12 @@ struct face int box_vertical_line_width; int box_horizontal_line_width; + + /* The amount of pixels above the descent line the underline should + be displayed. It does not take effect unless + `underline_at_descent_line_p` is t. */ + int underline_pixels_above_descent_line; + /* Type of box drawn. A value of FACE_NO_BOX means no box is drawn around text in this face. A value of FACE_SIMPLE_BOX means a box of width box_line_width is drawn in color box_color. A value of @@ -1738,6 +1759,9 @@ struct face bool_bf strike_through_color_defaulted_p : 1; bool_bf box_color_defaulted_p : 1; + /* True means the underline should be drawn at the descent line. */ + bool_bf underline_at_descent_line_p : 1; + /* TTY appearances. Colors are found in `lface' with empty color string meaning the default color of the TTY. */ bool_bf tty_bold_p : 1; @@ -1811,7 +1835,7 @@ face_tty_specified_color (unsigned long color) enum face_id { DEFAULT_FACE_ID, - MODE_LINE_FACE_ID, + MODE_LINE_ACTIVE_FACE_ID, MODE_LINE_INACTIVE_FACE_ID, TOOL_BAR_FACE_ID, FRINGE_FACE_ID, @@ -2538,7 +2562,8 @@ struct it enum line_wrap_method line_wrap; /* The ID of the default face to use. One of DEFAULT_FACE_ID, - MODE_LINE_FACE_ID, etc, depending on what we are displaying. */ + MODE_LINE_ACTIVE_FACE_ID, etc, depending on what we are + displaying. */ int base_face_id; /* If `what' == IT_CHARACTER, the character and the length in bytes @@ -2739,6 +2764,12 @@ struct it /* For iterating over bidirectional text. */ struct bidi_it bidi_it; bidi_dir_t paragraph_embedding; + + /* For handling the :min-width property. The object is the text + property we're testing the `eq' of (nil if none), and the integer + is the x position of the start of the run of glyphs. */ + Lisp_Object min_width_property; + int min_width_start; }; @@ -3011,7 +3042,7 @@ struct redisplay_interface #ifdef HAVE_WINDOW_SYSTEM # if (defined USE_CAIRO || defined HAVE_XRENDER \ - || defined HAVE_NS || defined HAVE_NTGUI) + || defined HAVE_NS || defined HAVE_NTGUI || defined HAVE_HAIKU) # define HAVE_NATIVE_TRANSFORMS # endif @@ -3050,6 +3081,14 @@ struct image #ifdef HAVE_NTGUI XFORM xform; #endif +#ifdef HAVE_HAIKU + /* Non-zero if the image has not yet been transformed for display. */ + int have_be_transforms_p; + + double be_rotate; + double be_scale_x; + double be_scale_y; +#endif /* Colors allocated for this image, if any. Allocated via xmalloc. */ unsigned long *colors; @@ -3162,7 +3201,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 */ @@ -3421,6 +3460,8 @@ 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); +extern void handle_tool_bar_click_with_device (struct frame *, int, int, bool, + int, Lisp_Object); extern void expose_frame (struct frame *, int, int, int, int); extern bool gui_intersect_rectangles (const Emacs_Rectangle *, @@ -3492,7 +3533,8 @@ bool valid_image_p (Lisp_Object); void prepare_image_for_display (struct frame *, struct image *); ptrdiff_t lookup_image (struct frame *, Lisp_Object, int); -#if defined HAVE_X_WINDOWS || defined USE_CAIRO || defined HAVE_NS +#if defined HAVE_X_WINDOWS || defined USE_CAIRO || defined HAVE_NS \ + || defined HAVE_HAIKU #define RGB_PIXEL_COLOR unsigned long #endif @@ -3725,10 +3767,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 332ba54ee74..0d959047f3a 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3850,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)) @@ -4446,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. */ @@ -6153,7 +6146,7 @@ sit_for (Lisp_Object timeout, bool reading, int display_option) wrong_type_argument (Qnumberp, timeout); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) gobble_input (); #endif @@ -6183,15 +6176,13 @@ Return t if redisplay was performed, nil if redisplay was preempted immediately by pending input. */) (Lisp_Object force) { - ptrdiff_t count; - swallow_events (true); if ((detect_input_pending_run_timers (1) && NILP (force) && !redisplay_dont_pause) || !NILP (Vexecuting_kbd_macro)) return Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (!NILP (force) && !redisplay_dont_pause) specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (2); @@ -6460,6 +6451,24 @@ init_display_interactive (void) } #endif +#ifdef HAVE_PGTK + if (!inhibit_window_system && !will_dump_p ()) + { + Vinitial_window_system = Qpgtk; + Vwindow_system_version = make_fixnum (3); + return; + } +#endif + +#ifdef HAVE_HAIKU + if (!inhibit_window_system && !will_dump_p ()) + { + Vinitial_window_system = Qhaiku; + Vwindow_system_version = make_fixnum (1); + return; + } +#endif + /* If no window system has been specified, try to use the terminal. */ if (! isatty (STDIN_FILENO)) fatal ("standard input is not a tty"); @@ -6651,6 +6660,8 @@ The value is a symbol: `w32' for an Emacs frame that is a window on MS-Windows display, `ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, `pc' for a direct-write MS-DOS frame. + `pgtk' for an Emacs frame using pure GTK facilities. + `haiku' for an Emacs frame running in Haiku. Use of this variable as a boolean is deprecated. Instead, use `display-graphic-p' or any of the other `display-*-p' @@ -6664,6 +6675,8 @@ The value is a symbol: `w32' for an Emacs frame that is a window on MS-Windows display, `ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, `pc' for a direct-write MS-DOS frame. + `pgtk' for an Emacs frame using pure GTK facilities. + `haiku' for an Emacs frame running in Haiku. Use of this variable as a boolean is deprecated. Instead, use `display-graphic-p' or any of the other `display-*-p' diff --git a/src/doc.c b/src/doc.c index 25c79de56cb..5326195c6a0 100644 --- a/src/doc.c +++ b/src/doc.c @@ -83,17 +83,20 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) { char *from, *to, *name, *p, *p1; Lisp_Object file, pos; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); + Lisp_Object dir; USE_SAFE_ALLOCA; if (FIXNUMP (filepos)) { file = Vdoc_file_name; + dir = Vdoc_directory; pos = filepos; } else if (CONSP (filepos)) { file = XCAR (filepos); + dir = Fsymbol_value (Qlisp_directory); pos = XCDR (filepos); } else @@ -101,7 +104,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) EMACS_INT position = eabs (XFIXNUM (pos)); - if (!STRINGP (Vdoc_directory)) + if (!STRINGP (dir)) return Qnil; if (!STRINGP (file)) @@ -113,7 +116,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) Lisp_Object tem = Ffile_name_absolute_p (file); file = ENCODE_FILE (file); Lisp_Object docdir - = NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string; + = NILP (tem) ? ENCODE_FILE (dir) : empty_unibyte_string; ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1; if (will_dump_p ()) docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc); @@ -338,56 +341,8 @@ string is passed through `substitute-command-keys'. */) else if (MODULE_FUNCTIONP (fun)) doc = module_function_documentation (XMODULE_FUNCTION (fun)); #endif - else if (COMPILEDP (fun)) - { - if (PVSIZE (fun) <= COMPILED_DOC_STRING) - return Qnil; - else - { - Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING); - if (STRINGP (tem)) - doc = tem; - else if (FIXNATP (tem) || CONSP (tem)) - doc = tem; - else - return Qnil; - } - } - else if (STRINGP (fun) || VECTORP (fun)) - { - return build_string ("Keyboard macro."); - } - else if (CONSP (fun)) - { - Lisp_Object funcar = XCAR (fun); - if (!SYMBOLP (funcar)) - xsignal1 (Qinvalid_function, fun); - else if (EQ (funcar, Qkeymap)) - return build_string ("Prefix command (definition is a keymap associating keystrokes with commands)."); - else if (EQ (funcar, Qlambda) - || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1)) - || EQ (funcar, Qautoload)) - { - Lisp_Object tem1 = Fcdr (Fcdr (fun)); - Lisp_Object tem = Fcar (tem1); - if (STRINGP (tem)) - doc = tem; - /* Handle a doc reference--but these never come last - in the function body, so reject them if they are last. */ - else if ((FIXNATP (tem) || (CONSP (tem) && FIXNUMP (XCDR (tem)))) - && !NILP (XCDR (tem1))) - doc = tem; - else - return Qnil; - } - else - goto oops; - } else - { - oops: - xsignal1 (Qinvalid_function, fun); - } + doc = call1 (intern ("function-documentation"), fun); /* If DOC is 0, it's typically because of a dumped file missing from the DOC file (bug in src/Makefile.in). */ @@ -511,11 +466,19 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) { /* This bytecode object must have a slot for the docstring, since we've found a docstring for it. */ - if (PVSIZE (fun) > COMPILED_DOC_STRING) + if (PVSIZE (fun) > COMPILED_DOC_STRING + /* Don't overwrite a non-docstring value placed there, + * such as the symbols used for Oclosures. */ + && (FIXNUMP (AREF (fun, COMPILED_DOC_STRING)) + || STRINGP (AREF (fun, COMPILED_DOC_STRING)) + || CONSP (AREF (fun, COMPILED_DOC_STRING)))) ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset)); else { - AUTO_STRING (format, "No docstring slot for %s"); + AUTO_STRING (format, + (PVSIZE (fun) > COMPILED_DOC_STRING + ? "Docstring slot busy for %s" + : "No docstring slot for %s")); CALLN (Fmessage, format, (SYMBOLP (obj) ? SYMBOL_NAME (obj) @@ -542,7 +505,6 @@ the same file name is found in the `doc-directory'. */) EMACS_INT pos; Lisp_Object sym; char *p, *name; - ptrdiff_t count; char const *dirname; ptrdiff_t dirlen; /* Preloaded defcustoms using custom-initialize-delay are added to @@ -566,7 +528,7 @@ the same file name is found in the `doc-directory'. */) dirlen = SBYTES (Vdoc_directory); } - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); USE_SAFE_ALLOCA; name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1); lispstpcpy (stpcpy (name, dirname), filename); /*** Add this line ***/ @@ -703,6 +665,7 @@ See variable `text-quoting-style'. */) void syms_of_doc (void) { + DEFSYM (Qlisp_directory, "lisp-directory"); DEFSYM (Qsubstitute_command_keys, "substitute-command-keys"); DEFSYM (Qfunction_documentation, "function-documentation"); DEFSYM (Qgrave, "grave"); diff --git a/src/dynlib.c b/src/dynlib.c index 751396b0894..e2c71f14489 100644 --- a/src/dynlib.c +++ b/src/dynlib.c @@ -104,6 +104,12 @@ dynlib_open (const char *dll_fname) return (dynlib_handle_ptr) hdll; } +dynlib_handle_ptr +dynlib_open_for_eln (const char *dll_fname) +{ + return dynlib_open (dll_fname); +} + void * dynlib_sym (dynlib_handle_ptr h, const char *sym) { @@ -270,8 +276,16 @@ dynlib_close (dynlib_handle_ptr h) dynlib_handle_ptr dynlib_open (const char *path) { + return dlopen (path, RTLD_LAZY | RTLD_GLOBAL); +} + +# ifdef HAVE_NATIVE_COMP +dynlib_handle_ptr +dynlib_open_for_eln (const char *path) +{ return dlopen (path, RTLD_LAZY); } +# endif void * dynlib_sym (dynlib_handle_ptr h, const char *sym) @@ -301,11 +315,13 @@ dynlib_error (void) return dlerror (); } +# ifdef HAVE_NATIVE_COMP int dynlib_close (dynlib_handle_ptr h) { return dlclose (h) == 0; } +# endif #else diff --git a/src/dynlib.h b/src/dynlib.h index c7c56007134..03b8f983564 100644 --- a/src/dynlib.h +++ b/src/dynlib.h @@ -20,10 +20,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef DYNLIB_H #define DYNLIB_H +#include <attribute.h> #include <stdbool.h> typedef void *dynlib_handle_ptr; dynlib_handle_ptr dynlib_open (const char *path); +dynlib_handle_ptr dynlib_open_for_eln (const char *path); int dynlib_close (dynlib_handle_ptr h); const char *dynlib_error (void); diff --git a/src/editfns.c b/src/editfns.c index 790f66e3a02..6cb684d4d85 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -847,7 +847,7 @@ usage: (save-excursion &rest BODY) */) (Lisp_Object args) { register Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_excursion (); @@ -861,7 +861,7 @@ BODY is executed just like `progn'. usage: (save-current-buffer &rest BODY) */) (Lisp_Object args) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); return unbind_to (count, Fprogn (args)); @@ -2022,7 +2022,7 @@ nil. */) return Qt; } - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t diags = size_a + size_b + 3; @@ -2247,7 +2247,7 @@ Both characters must have the same length of multi-byte form. */) ptrdiff_t changed = 0; unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH]; unsigned char *p; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #define COMBINING_NO 0 #define COMBINING_BEFORE 1 #define COMBINING_AFTER 2 @@ -2820,7 +2820,7 @@ usage: (save-restriction &rest BODY) */) (Lisp_Object body) { register Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect (save_restriction_restore, save_restriction_save ()); val = Fprogn (body); @@ -3112,7 +3112,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) ptrdiff_t bufsize = sizeof initial_buffer; ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1; char *p; - ptrdiff_t buf_save_value_index UNINIT; + specpdl_ref buf_save_value_index UNINIT; char *format, *end; ptrdiff_t nchars; /* When we make a multibyte string, we must pay attention to the diff --git a/src/emacs-module.c b/src/emacs-module.c index 392b3ba9659..0974a199e5e 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1137,7 +1137,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, rt->private_members = &rt_priv; rt->get_environment = module_get_environment; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_module (SPECPDL_MODULE_RUNTIME, rt); record_unwind_protect_module (SPECPDL_MODULE_ENVIRONMENT, rt_priv.env); @@ -1166,7 +1166,7 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) emacs_env pub; struct emacs_env_private priv; emacs_env *env = initialize_environment (&pub, &priv); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_module (SPECPDL_MODULE_ENVIRONMENT, env); USE_SAFE_ALLOCA; diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index cb19c33e282..6642b55d932 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 0f96716fb38..a35996c07aa 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -109,6 +109,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "getpagesize.h" #include "gnutls.h" +#ifdef HAVE_HAIKU +#include <kernel/OS.h> +#endif + #ifdef PROFILING # include <sys/gmon.h> extern void moncontrol (int mode); @@ -133,8 +137,13 @@ extern char etext; #endif #include "pdumper.h" +#include "fingerprint.h" #include "epaths.h" +/* Include these only because of INLINE. */ +#include "comp.h" +#include "thread.h" + static const char emacs_version[] = PACKAGE_VERSION; static const char emacs_copyright[] = COPYRIGHT; static const char emacs_bugreport[] = PACKAGE_BUGREPORT; @@ -185,8 +194,11 @@ static uintmax_t heap_bss_diff; We mark being in the exec'd process by a daemon name argument of form "--daemon=\nFD0,FD1\nNAME" where FD are the pipe file descriptors, - NAME is the original daemon name, if any. */ -#if defined NS_IMPL_COCOA || defined CYGWIN + NAME is the original daemon name, if any. + + On Haiku, the table of semaphores used for looper locks doesn't + persist across forked processes. */ +#if defined NS_IMPL_COCOA || defined CYGWIN || defined HAVE_HAIKU # define DAEMON_MUST_EXEC #endif @@ -255,11 +267,12 @@ 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 "\ ---sandbox=FILE read Seccomp BPF filter from FILE\n\ +--seccomp=FILE read Seccomp BPF filter from FILE\n\ " #endif "\ @@ -447,7 +460,7 @@ init_cmdargs (int argc, char **argv, int skip_args, char const *original_pwd) { int i; Lisp_Object name, dir, handler; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object raw_name; AUTO_STRING (slash_colon, "/:"); @@ -830,6 +843,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" @@ -867,9 +882,14 @@ load_pdump (int argc, char **argv) } /* Where's our executable? */ - ptrdiff_t bufsize, exec_bufsize; + ptrdiff_t bufsize; +#ifndef NS_SELF_CONTAINED + ptrdiff_t exec_bufsize; +#endif emacs_executable = load_pdump_find_executable (argv[0], &bufsize); +#ifndef NS_SELF_CONTAINED exec_bufsize = bufsize; +#endif /* If we couldn't find our executable, go straight to looking for the dump in the hardcoded location. */ @@ -924,12 +944,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 +963,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. */ @@ -1420,6 +1446,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 ()) @@ -1690,12 +1734,25 @@ main (int argc, char **argv) sockfd = SD_LISTEN_FDS_START; #endif /* HAVE_LIBSYSTEMD */ -#ifdef USE_GTK + /* On X, the bug happens because we call abort to avoid GLib + crashes upon a longjmp in our X error handler. + + On PGTK, GTK calls exit in its own error handlers for either + X or Wayland. Display different messages depending on the + window system to avoid referring users to the wrong GTK bug + report. */ +#ifdef HAVE_PGTK + fputs ("Due to a limitation in GTK 3, Emacs built with PGTK will simply exit when a\n" + "display connection is closed. The problem is especially difficult to fix,\n" + "such that Emacs on Wayland with multiple displays is unlikely ever to be able\n" + "to survive disconnects.\n", + stderr); +#elif defined USE_GTK fputs ("\nWarning: due to a long standing Gtk+ bug\nhttps://gitlab.gnome.org/GNOME/gtk/issues/221\n\ Emacs might crash when run in daemon mode and the X11 connection is unexpectedly lost.\n\ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem.\n", stderr); -#endif /* USE_GTK */ +#endif if (daemon_type == 2) { @@ -1877,7 +1934,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_bignum (); init_threads (); init_eval (); - init_atimer (); +#ifdef HAVE_PGTK + init_pgtkterm (); /* before init_atimer(). */ +#endif running_asynch_code = 0; init_random (); @@ -2039,6 +2098,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 @@ -2149,6 +2211,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #endif syms_of_window (); syms_of_xdisp (); + syms_of_sqlite (); syms_of_font (); #ifdef HAVE_WINDOW_SYSTEM syms_of_fringe (); @@ -2210,6 +2273,27 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_fontset (); #endif /* HAVE_NS */ +#ifdef HAVE_PGTK + syms_of_pgtkterm (); + syms_of_pgtkfns (); + syms_of_pgtkselect (); + syms_of_pgtkmenu (); + syms_of_pgtkim (); + syms_of_fontset (); + syms_of_xsettings (); +#endif /* HAVE_PGTK */ +#ifdef HAVE_HAIKU + syms_of_haikuterm (); + syms_of_haikufns (); + syms_of_haikumenu (); + syms_of_haikufont (); + syms_of_haikuselect (); +#ifdef HAVE_NATIVE_IMAGE_API + syms_of_haikuimage (); +#endif + syms_of_fontset (); +#endif /* HAVE_HAIKU */ + syms_of_gnutls (); #ifdef HAVE_INOTIFY @@ -2264,6 +2348,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #if defined WINDOWSNT || defined HAVE_NTGUI globals_of_w32select (); #endif + +#ifdef HAVE_HAIKU + init_haiku_select (); +#endif } init_charset (); @@ -2277,7 +2365,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #ifdef HAVE_DBUS init_dbusbind (); #endif -#ifdef USE_GTK +#if defined(USE_GTK) && !defined(HAVE_PGTK) init_xterm (); #endif @@ -2349,6 +2437,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 (); @@ -2371,6 +2464,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 }, @@ -2396,6 +2492,7 @@ static const struct standard_args standard_args[] = { "-quick", 0, 55, 0 }, { "-q", "--no-init-file", 50, 0 }, { "-no-init-file", 0, 50, 0 }, + { "-init-directory", "--init-directory", 30, 1 }, { "-no-x-resources", "--no-x-resources", 40, 0 }, { "-no-site-file", "--no-site-file", 40, 0 }, { "-u", "--user", 30, 1 }, @@ -2743,6 +2840,10 @@ shut_down_emacs (int sig, Lisp_Object stuff) if (sig && sig != SIGTERM) { static char const fmt[] = "Fatal error %d: %n%s\n"; +#ifdef HAVE_HAIKU + if (haiku_debug_on_fatal_error) + debugger ("Fatal error in Emacs"); +#endif char buf[max ((sizeof fmt - sizeof "%d%n%s\n" + INT_STRLEN_BOUND (int) + 1), min (PIPE_BUF, MAX_ALLOCA))]; @@ -2817,7 +2918,7 @@ You must run Emacs in batch mode in order to dump it. */) { Lisp_Object tem; Lisp_Object symbol; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); check_pure_size (); @@ -3235,6 +3336,7 @@ Special values: `ms-dos' compiled as an MS-DOS application. `windows-nt' compiled as a native W32 application. `cygwin' compiled using the Cygwin library. + `haiku' compiled for a Haiku system. Anything else (in Emacs 26, the possibilities are: aix, berkeley-unix, hpux, usg-unix-v) indicates some sort of Unix system. */); Vsystem_type = intern_c_string (SYSTEM_TYPE); diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c index c83544f0d5e..f2c9fa7b7db 100644 --- a/src/emacsgtkfixed.c +++ b/src/emacsgtkfixed.c @@ -22,8 +22,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "lisp.h" #include "frame.h" +#ifdef HAVE_PGTK +#include "pgtkterm.h" +#else #include "xterm.h" -#include "xwidget.h" +#endif #include "emacsgtkfixed.h" /* Silence a bogus diagnostic; see GNOME bug 683906. */ @@ -47,7 +50,9 @@ static void emacs_fixed_get_preferred_width (GtkWidget *widget, static void emacs_fixed_get_preferred_height (GtkWidget *widget, gint *minimum, gint *natural); +#ifndef HAVE_PGTK static GType emacs_fixed_get_type (void); +#endif G_DEFINE_TYPE (EmacsFixed, emacs_fixed, GTK_TYPE_FIXED) static EmacsFixed * @@ -57,92 +62,6 @@ EMACS_FIXED (GtkWidget *widget) EmacsFixed); } -#ifdef HAVE_XWIDGETS - -static EmacsFixedClass * -EMACS_FIXED_GET_CLASS (GtkWidget *widget) -{ - return G_TYPE_INSTANCE_GET_CLASS (widget, emacs_fixed_get_type (), - EmacsFixedClass); -} - -struct GtkFixedPrivateL -{ - GList *children; -}; - -static void -emacs_fixed_gtk_widget_size_allocate (GtkWidget *widget, - GtkAllocation *allocation) -{ - /* For xwidgets. - - This basically re-implements the base class method and adds an - additional case for an xwidget view. - - It would be nicer if the bse class method could be called first, - and the xview modification only would remain here. It wasn't - possible to solve it that way yet. */ - EmacsFixedClass *klass; - GtkWidgetClass *parent_class; - struct GtkFixedPrivateL *priv; - - klass = EMACS_FIXED_GET_CLASS (widget); - parent_class = g_type_class_peek_parent (klass); - parent_class->size_allocate (widget, allocation); - - priv = G_TYPE_INSTANCE_GET_PRIVATE (widget, GTK_TYPE_FIXED, - struct GtkFixedPrivateL); - - gtk_widget_set_allocation (widget, allocation); - - if (gtk_widget_get_has_window (widget)) - { - if (gtk_widget_get_realized (widget)) - gdk_window_move_resize (gtk_widget_get_window (widget), - allocation->x, - allocation->y, - allocation->width, - allocation->height); - } - - for (GList *children = priv->children; children; children = children->next) - { - GtkFixedChild *child = children->data; - - if (!gtk_widget_get_visible (child->widget)) - continue; - - GtkRequisition child_requisition; - gtk_widget_get_preferred_size (child->widget, &child_requisition, NULL); - - GtkAllocation child_allocation; - child_allocation.x = child->x; - child_allocation.y = child->y; - - if (!gtk_widget_get_has_window (widget)) - { - child_allocation.x += allocation->x; - child_allocation.y += allocation->y; - } - - child_allocation.width = child_requisition.width; - child_allocation.height = child_requisition.height; - - struct xwidget_view *xv - = g_object_get_data (G_OBJECT (child->widget), XG_XWIDGET_VIEW); - if (xv) - { - child_allocation.width = xv->clip_right; - child_allocation.height = xv->clip_bottom - xv->clip_top; - } - - gtk_widget_size_allocate (child->widget, &child_allocation); - } -} - -#endif /* HAVE_XWIDGETS */ - static void emacs_fixed_class_init (EmacsFixedClass *klass) { @@ -152,9 +71,6 @@ emacs_fixed_class_init (EmacsFixedClass *klass) widget_class->get_preferred_width = emacs_fixed_get_preferred_width; widget_class->get_preferred_height = emacs_fixed_get_preferred_height; -#ifdef HAVE_XWIDGETS - widget_class->size_allocate = emacs_fixed_gtk_widget_size_allocate; -#endif g_type_class_add_private (klass, sizeof (EmacsFixedPrivate)); } @@ -182,9 +98,15 @@ emacs_fixed_get_preferred_width (GtkWidget *widget, { EmacsFixed *fixed = EMACS_FIXED (widget); EmacsFixedPrivate *priv = fixed->priv; +#ifdef HAVE_PGTK + int w = priv->f->output_data.pgtk->size_hints.min_width; + if (minimum) *minimum = w; + if (natural) *natural = priv->f->output_data.pgtk->preferred_width; +#else int w = priv->f->output_data.x->size_hints.min_width; if (minimum) *minimum = w; if (natural) *natural = w; +#endif } static void @@ -194,12 +116,20 @@ emacs_fixed_get_preferred_height (GtkWidget *widget, { EmacsFixed *fixed = EMACS_FIXED (widget); EmacsFixedPrivate *priv = fixed->priv; +#ifdef HAVE_PGTK + int h = priv->f->output_data.pgtk->size_hints.min_height; + if (minimum) *minimum = h; + if (natural) *natural = priv->f->output_data.pgtk->preferred_height; +#else int h = priv->f->output_data.x->size_hints.min_height; if (minimum) *minimum = h; if (natural) *natural = h; +#endif } +#ifndef HAVE_PGTK + /* Override the X function so we can intercept Gtk+ 3 calls. Use our values for min_width/height so that KDE don't freak out (Bug#8919), and so users can resize our frames as they wish. */ @@ -234,10 +164,33 @@ XSetWMSizeHints (Display *d, if ((hints->flags & PMinSize) && f) { - int w = f->output_data.x->size_hints.min_width; - int h = f->output_data.x->size_hints.min_height; - data[5] = w; - data[6] = h; + /* Overriding the size hints with our own values of min_width + and min_height used to work, but these days just results in + frames resizing unpredictably and emitting GTK warnings while + Emacs fights with GTK over the size of the frame. So instead + of doing that, just respect the hints set by GTK, but make + sure they are an integer multiple of the resize increments so + that bug#8919 stays fixed. */ + + /* int w = f->output_data.x->size_hints.min_width; + int h = f->output_data.x->size_hints.min_height; + + data[5] = w; + data[6] = h; */ + + /* Make sure min_width and min_height are multiples of width_inc + and height_inc. */ + + if (hints->flags & PResizeInc) + { + /* Some versions of GTK set PResizeInc even if the + increments are at their initial values. */ + + if (hints->width_inc && data[5] % hints->width_inc) + data[5] += (hints->width_inc - (data[5] % hints->width_inc)); + if (hints->height_inc && data[6] % hints->height_inc) + data[6] += (hints->height_inc - (data[6] % hints->height_inc)); + } } XChangeProperty (d, w, prop, XA_WM_SIZE_HINTS, 32, PropModeReplace, @@ -253,3 +206,5 @@ XSetWMNormalHints (Display *d, Window w, XSizeHints *hints) { XSetWMSizeHints (d, w, hints, XA_WM_NORMAL_HINTS); } + +#endif diff --git a/src/emacsgtkfixed.h b/src/emacsgtkfixed.h index b58d4fcc3e8..af5e22e6f4d 100644 --- a/src/emacsgtkfixed.h +++ b/src/emacsgtkfixed.h @@ -27,6 +27,11 @@ struct frame; G_BEGIN_DECLS +#ifdef HAVE_PGTK +#define EMACS_TYPE_FIXED (emacs_fixed_get_type ()) +#define EMACS_IS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), EMACS_TYPE_FIXED)) +#endif + struct frame; typedef struct _EmacsFixedPrivate EmacsFixedPrivate; @@ -44,6 +49,10 @@ struct _EmacsFixedClass GtkFixedClass parent_class; }; +#ifdef HAVE_PGTK +extern GType emacs_fixed_get_type (void); +#endif + extern GtkWidget *emacs_fixed_new (struct frame *f); G_END_DECLS diff --git a/src/eval.c b/src/eval.c index d002e81da1d..a1cebcd0257 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 @@ -64,7 +65,7 @@ union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE; union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); -static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, ptrdiff_t); +static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, specpdl_ref); static Lisp_Object lambda_arity (Lisp_Object); static Lisp_Object @@ -103,13 +104,6 @@ specpdl_where (union specbinding *pdl) } static Lisp_Object -specpdl_saved_value (union specbinding *pdl) -{ - eassert (pdl->kind >= SPECPDL_LET); - return pdl->let.saved_value; -} - -static Lisp_Object specpdl_arg (union specbinding *pdl) { eassert (pdl->kind == SPECPDL_UNWIND); @@ -137,13 +131,6 @@ backtrace_args (union specbinding *pdl) return pdl->bt.args; } -static bool -backtrace_debug_on_exit (union specbinding *pdl) -{ - eassert (pdl->kind == SPECPDL_BACKTRACE); - return pdl->bt.debug_on_exit; -} - /* Functions to modify slots of backtrace records. */ static void @@ -236,8 +223,8 @@ init_eval_once_for_pdumper (void) { enum { size = 50 }; union specbinding *pdlvec = malloc ((size + 1) * sizeof *specpdl); - specpdl_size = size; specpdl = specpdl_ptr = pdlvec + 1; + specpdl_end = specpdl + size; } void @@ -280,19 +267,18 @@ restore_stack_limits (Lisp_Object data) integer_to_intmax (XCDR (data), &max_lisp_eval_depth); } -static void grow_specpdl (void); - /* Call the Lisp debugger, giving it argument ARG. */ Lisp_Object call_debugger (Lisp_Object arg) { bool debug_while_redisplaying; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; intmax_t old_depth = max_lisp_eval_depth; /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */ - intmax_t old_max = max (max_specpdl_size, count); + ptrdiff_t counti = specpdl_ref_to_count (count); + intmax_t old_max = max (max_specpdl_size, counti); /* The previous value of 40 is too small now that the debugger prints using cl-prin1 instead of prin1. Printing lists nested 8 @@ -302,9 +288,9 @@ call_debugger (Lisp_Object arg) /* While debugging Bug#16603, previous value of 100 was found too small to avoid specpdl overflow in the debugger itself. */ - max_ensure_room (&max_specpdl_size, count, 200); + max_ensure_room (&max_specpdl_size, counti, 200); - if (old_max == count) + if (old_max == counti) { /* We can enter the debugger due to specpdl overflow (Bug#16603). */ specpdl_ptr--; @@ -353,11 +339,11 @@ call_debugger (Lisp_Object arg) return unbind_to (count, val); } -static void -do_debug_on_call (Lisp_Object code, ptrdiff_t count) +void +do_debug_on_call (Lisp_Object code, specpdl_ref count) { debug_on_next_call = 0; - set_backtrace_debug_on_exit (specpdl + count, true); + set_backtrace_debug_on_exit (specpdl_ref_to_ptr (count), true); call_debugger (list1 (code)); } @@ -573,6 +559,10 @@ usage: (function ARG) */) { /* Handle the special (:documentation <form>) to build the docstring dynamically. */ Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp))); + if (SYMBOLP (docstring) && !NILP (docstring)) + /* Hack for OClosures: Allow the docstring to be a symbol + * (the OClosure's type). */ + docstring = Fsymbol_name (docstring); CHECK_STRING (docstring); cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr)))); } @@ -676,23 +666,7 @@ default_toplevel_binding (Lisp_Object symbol) binding = pdl; break; - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_EXCURSION: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - case SPECPDL_LET_LOCAL: - break; - - default: - emacs_abort (); + default: break; } } return binding; @@ -719,23 +693,7 @@ lexbound_p (Lisp_Object symbol) } break; - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_EXCURSION: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - case SPECPDL_LET_LOCAL: - break; - - default: - emacs_abort (); + default: break; } } return false; @@ -935,7 +893,7 @@ usage: (let* VARLIST BODY...) */) (Lisp_Object args) { Lisp_Object var, val, elt, lexenv; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); lexenv = Vinternal_interpreter_environment; @@ -995,7 +953,7 @@ usage: (let VARLIST BODY...) */) { Lisp_Object *temps, tem, lexenv; Lisp_Object elt; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t argnum; USE_SAFE_ALLOCA; @@ -1075,6 +1033,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) +{ + specpdl_ref 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. @@ -1238,6 +1237,7 @@ unwind_to_catch (struct handler *catch, enum nonlocal_exit type, eassert (handlerlist == catch); lisp_eval_depth = catch->f_lisp_eval_depth; + set_act_rec (current_thread, catch->act_rec); sys_longjmp (catch->jmp, 1); } @@ -1271,7 +1271,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */) (Lisp_Object args) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect (prog_ignore, XCDR (args)); val = eval_sub (XCAR (args)); @@ -1395,7 +1395,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, /* Bind HANDLER_VAR to VAL while evaluating HANDLER_BODY. The unbind_to undoes just this binding; whoever longjumped to us unwound the stack to C->pdlcount before throwing. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (handler_var, val); return unbind_to (count, Fprogn (handler_body)); } @@ -1416,7 +1416,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, handler_var = Qinternal_interpreter_environment; } - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (handler_var, result); return unbind_to (count, Fprogn (success_handler)); } @@ -1505,90 +1505,6 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object), } } -/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3 as - its arguments. */ - -Lisp_Object -internal_condition_case_3 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object, - Lisp_Object), - Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, - Lisp_Object handlers, - Lisp_Object (*hfun) (Lisp_Object)) -{ - struct handler *c = push_handler (handlers, CONDITION_CASE); - if (sys_setjmp (c->jmp)) - { - Lisp_Object val = handlerlist->val; - clobbered_eassert (handlerlist == c); - handlerlist = handlerlist->next; - return hfun (val); - } - else - { - Lisp_Object val = bfun (arg1, arg2, arg3); - eassert (handlerlist == c); - handlerlist = c->next; - return val; - } -} - -/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3, ARG4 as - its arguments. */ - -Lisp_Object -internal_condition_case_4 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object), - Lisp_Object arg1, Lisp_Object arg2, - Lisp_Object arg3, Lisp_Object arg4, - Lisp_Object handlers, - Lisp_Object (*hfun) (Lisp_Object)) -{ - struct handler *c = push_handler (handlers, CONDITION_CASE); - if (sys_setjmp (c->jmp)) - { - Lisp_Object val = handlerlist->val; - clobbered_eassert (handlerlist == c); - handlerlist = handlerlist->next; - return hfun (val); - } - else - { - Lisp_Object val = bfun (arg1, arg2, arg3, arg4); - eassert (handlerlist == c); - handlerlist = c->next; - return val; - } -} - -/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3, - ARG4, ARG5 as its arguments. */ - -Lisp_Object -internal_condition_case_5 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object, - Lisp_Object), - Lisp_Object arg1, Lisp_Object arg2, - Lisp_Object arg3, Lisp_Object arg4, - Lisp_Object arg5, Lisp_Object handlers, - Lisp_Object (*hfun) (Lisp_Object)) -{ - struct handler *c = push_handler (handlers, CONDITION_CASE); - if (sys_setjmp (c->jmp)) - { - Lisp_Object val = handlerlist->val; - clobbered_eassert (handlerlist == c); - handlerlist = handlerlist->next; - return hfun (val); - } - else - { - Lisp_Object val = bfun (arg1, arg2, arg3, arg4, arg5); - eassert (handlerlist == c); - handlerlist = c->next; - return val; - } -} - /* Like internal_condition_case but call BFUN with NARGS as first, and ARGS as second argument. */ @@ -1678,6 +1594,7 @@ push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype) c->next = handlerlist; c->f_lisp_eval_depth = lisp_eval_depth; c->pdlcount = SPECPDL_INDEX (); + c->act_rec = get_act_rec (current_thread); c->poll_suppress_count = poll_suppress_count; c->interrupt_input_blocked = interrupt_input_blocked; handlerlist = c; @@ -1702,21 +1619,8 @@ process_quit_flag (void) quit (); } -/* Check quit-flag and quit if it is non-nil. Typing C-g does not - directly cause a quit; it only sets Vquit_flag. So the program - needs to call maybe_quit at times when it is safe to quit. Every - loop that might run for a long time or might not exit ought to call - maybe_quit at least once, at a safe place. Unless that is - impossible, of course. But it is very desirable to avoid creating - loops where maybe_quit is impossible. - - If quit-flag is set to `kill-emacs' the SIGINT handler has received - a request to exit Emacs when it is safe to do. - - When not quitting, process any pending signals. */ - void -maybe_quit (void) +probably_quit (void) { if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) process_quit_flag (); @@ -1789,11 +1693,12 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) && ! NILP (error_symbol) /* Don't try to call a lisp function if we've already overflowed the specpdl stack. */ - && specpdl_ptr < specpdl + specpdl_size) + && specpdl_ptr < specpdl_end) { /* Edebug takes care of restoring these variables when it exits. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); - max_ensure_room (&max_specpdl_size, SPECPDL_INDEX (), 40); + ptrdiff_t counti = specpdl_ref_to_count (SPECPDL_INDEX ()); + max_ensure_room (&max_specpdl_size, counti, 40); call2 (Vsignal_hook_function, error_symbol, data); } @@ -1851,18 +1756,20 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) } /* If we're in batch mode, print a backtrace unconditionally to help - with debugging. Make sure to use `debug' unconditionally to not - interfere with ERT or other packages that install custom - debuggers. Don't try to call the debugger while dumping or - bootstrapping, it wouldn't work anyway. */ + with debugging. Make sure to use `debug-early' unconditionally + to not interfere with ERT or other packages that install custom + debuggers. */ if (!debugger_called && !NILP (error_symbol) && (NILP (clause) || EQ (h->tag_or_ch, Qerror)) && noninteractive && backtrace_on_error_noninteractive - && !will_dump_p () && !will_bootstrap_p () - && NILP (Vinhibit_debugger)) + && NILP (Vinhibit_debugger) + && !NILP (Ffboundp (Qdebug_early))) { - ptrdiff_t count = SPECPDL_INDEX (); - specbind (Qdebugger, Qdebug); + max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); + specpdl_ref count = SPECPDL_INDEX (); + ptrdiff_t counti = specpdl_ref_to_count (count); + max_ensure_room (&max_specpdl_size, counti, 200); + specbind (Qdebugger, Qdebug_early); call_debugger (list2 (Qerror, Fcons (error_symbol, data))); unbind_to (count, Qnil); } @@ -2225,28 +2132,50 @@ this does nothing and returns nil. */) Qnil); } -void +static void un_autoload (Lisp_Object oldqueue) { - Lisp_Object queue, first, second; - /* Queue to unwind is current value of Vautoload_queue. oldqueue is the shadowed value to leave in Vautoload_queue. */ - queue = Vautoload_queue; + Lisp_Object queue = Vautoload_queue; Vautoload_queue = oldqueue; while (CONSP (queue)) { - first = XCAR (queue); - second = Fcdr (first); - first = Fcar (first); - if (EQ (first, make_fixnum (0))) - Vfeatures = second; + Lisp_Object first = XCAR (queue); + if (CONSP (first) && EQ (XCAR (first), make_fixnum (0))) + Vfeatures = XCDR (first); else - Ffset (first, second); + Ffset (first, Fcar (Fcdr (Fget (first, Qfunction_history)))); queue = XCDR (queue); } } +Lisp_Object +load_with_autoload_queue + (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, + Lisp_Object nosuffix, Lisp_Object must_suffix) +{ + specpdl_ref count = SPECPDL_INDEX (); + + /* If autoloading gets an error (which includes the error of failing + to define the function being called), we use Vautoload_queue + to undo function definitions and `provide' calls made by + the function. We do this in the specific case of autoloading + because autoloading is not an explicit request "load this file", + but rather a request to "call this function". + + The value saved here is to be restored into Vautoload_queue. */ + record_unwind_protect (un_autoload, Vautoload_queue); + Vautoload_queue = Qt; + Lisp_Object tem + = save_match_data_load (file, noerror, nomessage, nosuffix, must_suffix); + + /* Once loading finishes, don't undo it. */ + Vautoload_queue = Qt; + unbind_to (count, Qnil); + return tem; +} + /* Load an autoloaded function. FUNNAME is the symbol which is the function's name. FUNDEF is the autoload definition (a list). */ @@ -2259,8 +2188,6 @@ If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if it defines a macro. */) (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only) { - ptrdiff_t count = SPECPDL_INDEX (); - if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef))) return fundef; @@ -2277,26 +2204,12 @@ it defines a macro. */) CHECK_SYMBOL (funname); - /* If autoloading gets an error (which includes the error of failing - to define the function being called), we use Vautoload_queue - to undo function definitions and `provide' calls made by - the function. We do this in the specific case of autoloading - because autoloading is not an explicit request "load this file", - but rather a request to "call this function". - - The value saved here is to be restored into Vautoload_queue. */ - record_unwind_protect (un_autoload, Vautoload_queue); - Vautoload_queue = Qt; /* If `macro_only' is set and fundef isn't a macro, assume this autoload to be a "best-effort" (e.g. to try and find a compiler macro), so don't signal an error if autoloading fails. */ Lisp_Object ignore_errors = (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only; - save_match_data_load (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt); - - /* Once loading finishes, don't undo it. */ - Vautoload_queue = Qt; - unbind_to (count, Qnil); + load_with_autoload_queue (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt); if (NILP (funname) || !NILP (ignore_errors)) return Qnil; @@ -2321,62 +2234,33 @@ LEXICAL can also be an actual lexical environment, in the form of an alist mapping symbols to their value. */) (Lisp_Object form, Lisp_Object lexical) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinternal_interpreter_environment, CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt)); return unbind_to (count, eval_sub (form)); } -/* Grow the specpdl stack by one entry. - The caller should have already initialized the entry. - Signal an error on stack overflow. - - Make sure that there is always one unused entry past the top of the - stack, so that the just-initialized entry is safely unwound if - memory exhausted and an error is signaled here. Also, allocate a - never-used entry just before the bottom of the stack; sometimes its - address is taken. */ - -static void -grow_specpdl (void) +void +grow_specpdl_allocation (void) { - specpdl_ptr++; + eassert (specpdl_ptr == specpdl_end); - if (specpdl_ptr == specpdl + specpdl_size) + specpdl_ref count = SPECPDL_INDEX (); + ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); + union specbinding *pdlvec = specpdl - 1; + ptrdiff_t size = specpdl_end - specpdl; + ptrdiff_t pdlvecsize = size + 1; + if (max_size <= size) { - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); - union specbinding *pdlvec = specpdl - 1; - ptrdiff_t pdlvecsize = specpdl_size + 1; - if (max_size <= specpdl_size) - { - if (max_specpdl_size < 400) - max_size = max_specpdl_size = 400; - if (max_size <= specpdl_size) - signal_error ("Variable binding depth exceeds max-specpdl-size", - Qnil); - } - pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); - specpdl = pdlvec + 1; - specpdl_size = pdlvecsize - 1; - specpdl_ptr = specpdl + count; + if (max_specpdl_size < 400) + max_size = max_specpdl_size = 400; + if (max_size <= size) + xsignal0 (Qexcessive_variable_binding); } -} - -ptrdiff_t -record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) -{ - ptrdiff_t count = SPECPDL_INDEX (); - - eassert (nargs >= UNEVALLED); - specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; - specpdl_ptr->bt.debug_on_exit = false; - specpdl_ptr->bt.function = function; - current_thread->stack_top = specpdl_ptr->bt.args = args; - specpdl_ptr->bt.nargs = nargs; - grow_specpdl (); - - return count; + pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); + specpdl = pdlvec + 1; + specpdl_end = specpdl + pdlvecsize - 1; + specpdl_ptr = specpdl_ref_to_ptr (count); } /* Eval a sub-expression of the current expression (i.e. in the same @@ -2408,7 +2292,7 @@ eval_sub (Lisp_Object form) if (max_lisp_eval_depth < 100) max_lisp_eval_depth = 100; if (lisp_eval_depth > max_lisp_eval_depth) - error ("Lisp nesting exceeds `max-lisp-eval-depth'"); + xsignal0 (Qexcessive_lisp_nesting); } Lisp_Object original_fun = XCAR (form); @@ -2416,7 +2300,7 @@ eval_sub (Lisp_Object form) CHECK_LIST (original_args); /* This also protects them from gc. */ - ptrdiff_t count + specpdl_ref count = record_in_backtrace (original_fun, &original_args, UNEVALLED); if (debug_on_next_call) @@ -2465,13 +2349,13 @@ eval_sub (Lisp_Object form) vals[argnum++] = eval_sub (arg); } - set_backtrace_args (specpdl + count, vals, argnum); + set_backtrace_args (specpdl_ref_to_ptr (count), vals, argnum); val = XSUBR (fun)->function.aMANY (argnum, vals); lisp_eval_depth--; /* Do the debug-on-exit now, while VALS still exists. */ - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) val = call_debugger (list2 (Qexit, val)); SAFE_FREE (); specpdl_ptr--; @@ -2487,7 +2371,7 @@ eval_sub (Lisp_Object form) args_left = Fcdr (args_left); } - set_backtrace_args (specpdl + count, argvals, numargs); + set_backtrace_args (specpdl_ref_to_ptr (count), argvals, numargs); switch (i) { @@ -2559,13 +2443,26 @@ eval_sub (Lisp_Object form) } if (EQ (funcar, Qmacro)) { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); Lisp_Object exp; /* Bind lexical-binding during expansion of the macro, so the macro can know reliably if the code it outputs will be interpreted using lexical-binding or not. */ specbind (Qlexical_binding, NILP (Vinternal_interpreter_environment) ? Qnil : Qt); + + /* Make the macro aware of any defvar declarations in scope. */ + Lisp_Object dynvars = Vmacroexp__dynvars; + for (Lisp_Object p = Vinternal_interpreter_environment; + !NILP (p); p = XCDR(p)) + { + Lisp_Object e = XCAR (p); + if (SYMBOLP (e)) + dynvars = Fcons(e, dynvars); + } + if (!EQ (dynvars, Vmacroexp__dynvars)) + specbind (Qmacroexp__dynvars, dynvars); + exp = apply1 (Fcdr (fun), original_args); exp = unbind_to (count1, exp); val = eval_sub (exp); @@ -2578,7 +2475,7 @@ eval_sub (Lisp_Object form) } lisp_eval_depth--; - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; @@ -2869,76 +2766,6 @@ apply1 (Lisp_Object fn, Lisp_Object arg) return NILP (arg) ? Ffuncall (1, &fn) : CALLN (Fapply, fn, arg); } -/* Call function fn on no arguments. */ -Lisp_Object -call0 (Lisp_Object fn) -{ - return Ffuncall (1, &fn); -} - -/* Call function fn with 1 argument arg1. */ -Lisp_Object -call1 (Lisp_Object fn, Lisp_Object arg1) -{ - return CALLN (Ffuncall, fn, arg1); -} - -/* Call function fn with 2 arguments arg1, arg2. */ -Lisp_Object -call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) -{ - return CALLN (Ffuncall, fn, arg1, arg2); -} - -/* Call function fn with 3 arguments arg1, arg2, arg3. */ -Lisp_Object -call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3); -} - -/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */ -Lisp_Object -call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, - Lisp_Object arg4) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4); -} - -/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */ -Lisp_Object -call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, - Lisp_Object arg4, Lisp_Object arg5) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5); -} - -/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */ -Lisp_Object -call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, - Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6); -} - -/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */ -Lisp_Object -call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, - Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7); -} - -/* Call function fn with 8 arguments arg1, arg2, arg3, arg4, arg5, - arg6, arg7, arg8. */ -Lisp_Object -call8 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, - Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7, - Lisp_Object arg8) -{ - return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -} - DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, doc: /* Return t if OBJECT is a function. */) (Lisp_Object object) @@ -2979,74 +2806,74 @@ FUNCTIONP (Lisp_Object object) return false; } -DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, - doc: /* Call first argument as a function, passing remaining arguments to it. -Return the value that function returns. -Thus, (funcall \\='cons \\='x \\='y) returns (x . y). -usage: (funcall FUNCTION &rest ARGUMENTS) */) - (ptrdiff_t nargs, Lisp_Object *args) +Lisp_Object +funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args) { - Lisp_Object fun, original_fun; - Lisp_Object funcar; - ptrdiff_t numargs = nargs - 1; - Lisp_Object val; - ptrdiff_t count; - - maybe_quit (); - - if (++lisp_eval_depth > max_lisp_eval_depth) - { - if (max_lisp_eval_depth < 100) - max_lisp_eval_depth = 100; - if (lisp_eval_depth > max_lisp_eval_depth) - error ("Lisp nesting exceeds `max-lisp-eval-depth'"); - } - - count = record_in_backtrace (args[0], &args[1], nargs - 1); - - maybe_gc (); - - if (debug_on_next_call) - do_debug_on_call (Qlambda, count); - - original_fun = args[0]; - + Lisp_Object original_fun = fun; retry: - - /* Optimize for no indirection. */ - fun = original_fun; if (SYMBOLP (fun) && !NILP (fun) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) fun = indirect_function (fun); if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) - val = funcall_subr (XSUBR (fun), numargs, args + 1); + return funcall_subr (XSUBR (fun), numargs, args); else if (COMPILEDP (fun) || SUBR_NATIVE_COMPILED_DYNP (fun) || MODULE_FUNCTIONP (fun)) - val = funcall_lambda (fun, numargs, args + 1); + return funcall_lambda (fun, numargs, args); else { if (NILP (fun)) xsignal1 (Qvoid_function, original_fun); if (!CONSP (fun)) xsignal1 (Qinvalid_function, original_fun); - funcar = XCAR (fun); + Lisp_Object funcar = XCAR (fun); if (!SYMBOLP (funcar)) xsignal1 (Qinvalid_function, original_fun); if (EQ (funcar, Qlambda) || EQ (funcar, Qclosure)) - val = funcall_lambda (fun, numargs, args + 1); + return funcall_lambda (fun, numargs, args); else if (EQ (funcar, Qautoload)) { Fautoload_do_load (fun, original_fun, Qnil); + fun = original_fun; goto retry; } else xsignal1 (Qinvalid_function, original_fun); } +} + +DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, + doc: /* Call first argument as a function, passing remaining arguments to it. +Return the value that function returns. +Thus, (funcall \\='cons \\='x \\='y) returns (x . y). +usage: (funcall FUNCTION &rest ARGUMENTS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + specpdl_ref count; + + maybe_quit (); + + if (++lisp_eval_depth > max_lisp_eval_depth) + { + if (max_lisp_eval_depth < 100) + max_lisp_eval_depth = 100; + if (lisp_eval_depth > max_lisp_eval_depth) + xsignal0 (Qexcessive_lisp_nesting); + } + + count = record_in_backtrace (args[0], &args[1], nargs - 1); + + maybe_gc (); + + if (debug_on_next_call) + do_debug_on_call (Qlambda, count); + + Lisp_Object val = funcall_general (args[0], nargs - 1, args + 1); + lisp_eval_depth--; - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; return val; @@ -3059,99 +2886,82 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) { - if (numargs < subr->min_args - || (subr->max_args >= 0 && subr->max_args < numargs)) + eassume (numargs >= 0); + if (numargs >= subr->min_args) { - Lisp_Object fun; - XSETSUBR (fun, subr); - xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); - } + /* Conforming call to finite-arity subr. */ + if (numargs <= subr->max_args) + { + Lisp_Object argbuf[8]; + Lisp_Object *a; + if (numargs < subr->max_args) + { + eassume (subr->max_args <= ARRAYELTS (argbuf)); + a = argbuf; + memcpy (a, args, numargs * word_size); + memclear (a + numargs, (subr->max_args - numargs) * word_size); + } + else + a = args; + switch (subr->max_args) + { + case 0: + return subr->function.a0 (); + case 1: + return subr->function.a1 (a[0]); + case 2: + return subr->function.a2 (a[0], a[1]); + case 3: + return subr->function.a3 (a[0], a[1], a[2]); + case 4: + return subr->function.a4 (a[0], a[1], a[2], a[3]); + case 5: + return subr->function.a5 (a[0], a[1], a[2], a[3], a[4]); + case 6: + return subr->function.a6 (a[0], a[1], a[2], a[3], a[4], a[5]); + case 7: + return subr->function.a7 (a[0], a[1], a[2], a[3], a[4], a[5], + a[6]); + case 8: + return subr->function.a8 (a[0], a[1], a[2], a[3], a[4], a[5], + a[6], a[7]); + default: + /* If a subr takes more than 8 arguments without using MANY + or UNEVALLED, we need to extend this function to support it. + Until this is done, there is no way to call the function. */ + emacs_abort (); + } + } - else if (subr->max_args == UNEVALLED) - { - Lisp_Object fun; - XSETSUBR (fun, subr); - xsignal1 (Qinvalid_function, fun); + /* Call to n-adic subr. */ + if (subr->max_args == MANY) + return subr->function.aMANY (numargs, args); } - else if (subr->max_args == MANY) - return (subr->function.aMANY) (numargs, args); + /* Anything else is an error. */ + Lisp_Object fun; + XSETSUBR (fun, subr); + if (subr->max_args == UNEVALLED) + xsignal1 (Qinvalid_function, fun); else - { - Lisp_Object internal_argbuf[8]; - Lisp_Object *internal_args; - if (subr->max_args > numargs) - { - eassert (subr->max_args <= ARRAYELTS (internal_argbuf)); - internal_args = internal_argbuf; - memcpy (internal_args, args, numargs * word_size); - memclear (internal_args + numargs, - (subr->max_args - numargs) * word_size); - } - else - internal_args = args; - switch (subr->max_args) - { - case 0: - return (subr->function.a0 ()); - case 1: - return (subr->function.a1 (internal_args[0])); - case 2: - return (subr->function.a2 - (internal_args[0], internal_args[1])); - case 3: - return (subr->function.a3 - (internal_args[0], internal_args[1], internal_args[2])); - case 4: - return (subr->function.a4 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3])); - case 5: - return (subr->function.a5 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4])); - case 6: - return (subr->function.a6 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5])); - case 7: - return (subr->function.a7 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5], - internal_args[6])); - case 8: - return (subr->function.a8 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5], - internal_args[6], internal_args[7])); - - default: - - /* If a subr takes more than 8 arguments without using MANY - or UNEVALLED, we need to extend this function to support it. - Until this is done, there is no way to call the function. */ - emacs_abort (); - } - } + xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); } /* Call the compiled Lisp function FUN. If we have not yet read FUN's bytecode string and constants vector, fetch them from the file first. */ static Lisp_Object -fetch_and_exec_byte_code (Lisp_Object fun, Lisp_Object syms_left, +fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, ptrdiff_t nargs, Lisp_Object *args) { if (CONSP (AREF (fun, COMPILED_BYTECODE))) Ffetch_bytecode (fun); - return exec_byte_code (AREF (fun, COMPILED_BYTECODE), - AREF (fun, COMPILED_CONSTANTS), - AREF (fun, COMPILED_STACK_DEPTH), - syms_left, nargs, args); + + return exec_byte_code (fun, args_template, nargs, args); } static Lisp_Object -apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) +apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count) { Lisp_Object *arg_vector; Lisp_Object tem; @@ -3168,12 +2978,12 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) arg_vector[i] = tem; } - set_backtrace_args (specpdl + count, arg_vector, numargs); + set_backtrace_args (specpdl_ref_to_ptr (count), arg_vector, numargs); tem = funcall_lambda (fun, numargs, arg_vector); lisp_eval_depth--; /* Do the debug-on-exit now, while arg_vector still exists. */ - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) tem = call_debugger (list2 (Qexit, tem)); SAFE_FREE (); specpdl_ptr--; @@ -3190,7 +3000,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, register Lisp_Object *arg_vector) { Lisp_Object val, syms_left, next, lexenv; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t i; bool optional, rest; @@ -3215,18 +3025,15 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, else if (COMPILEDP (fun)) { syms_left = AREF (fun, COMPILED_ARGLIST); + /* Bytecode objects using lexical binding have an integral + ARGLIST slot value: pass the arguments to the byte-code + engine directly. */ if (FIXNUMP (syms_left)) - /* A byte-code object with an integer args template means we - shouldn't bind any arguments, instead just call the byte-code - interpreter directly; it will push arguments as necessary. - - Byte-code objects with a nil args template (the default) - have dynamically-bound arguments, and use the - argument-binding code below instead (as do all interpreted - functions, even lexically bound ones). */ - { - return fetch_and_exec_byte_code (fun, syms_left, nargs, arg_vector); - } + return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left), + nargs, arg_vector); + /* Otherwise the bytecode object uses dynamic binding and the + ARGLIST slot contains a standard formal argument list whose + variables are bound dynamically below. */ lexenv = Qnil; } #ifdef HAVE_MODULES @@ -3311,7 +3118,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, val = XSUBR (fun)->function.a0 (); } else - val = fetch_and_exec_byte_code (fun, Qnil, 0, NULL); + val = fetch_and_exec_byte_code (fun, 0, 0, NULL); return unbind_to (count, val); } @@ -3462,6 +3269,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, bytecode = Fstring_as_unibyte (bytecode); } + pin_string (bytecode); ASET (object, COMPILED_BYTECODE, bytecode); ASET (object, COMPILED_CONSTANTS, XCDR (tem)); } @@ -3552,9 +3360,6 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.kind = SPECPDL_LET; specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = SYMBOL_VAL (sym); - specpdl_ptr->let.saved_value = Qnil; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); break; case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED: @@ -3564,7 +3369,6 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = ovalue; specpdl_ptr->let.where = Fcurrent_buffer (); - specpdl_ptr->let.saved_value = Qnil; eassert (sym->u.s.redirect != SYMBOL_LOCALIZED || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); @@ -3582,22 +3386,17 @@ specbind (Lisp_Object symbol, Lisp_Object value) having their own value. This is consistent with what happens with other buffer-local variables. */ if (NILP (Flocal_variable_p (symbol, Qnil))) - { - specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); - return; - } + specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; } else specpdl_ptr->let.kind = SPECPDL_LET; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); break; } default: emacs_abort (); } + grow_specpdl (); + do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); } /* Push unwind-protect entries of various types. */ @@ -3627,6 +3426,20 @@ record_unwind_protect_ptr (void (*function) (void *), void *arg) specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR; specpdl_ptr->unwind_ptr.func = function; specpdl_ptr->unwind_ptr.arg = arg; + specpdl_ptr->unwind_ptr.mark = NULL; + grow_specpdl (); +} + +/* Like `record_unwind_protect_ptr', but also specifies a function + for GC-marking Lisp objects only reachable through ARG. */ +void +record_unwind_protect_ptr_mark (void (*function) (void *), void *arg, + void (*mark) (void *)) +{ + specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR; + specpdl_ptr->unwind_ptr.func = function; + specpdl_ptr->unwind_ptr.arg = arg; + specpdl_ptr->unwind_ptr.mark = mark; grow_specpdl (); } @@ -3670,27 +3483,10 @@ record_unwind_protect_module (enum specbind_tag kind, void *ptr) specpdl_ptr->kind = kind; specpdl_ptr->unwind_ptr.func = NULL; specpdl_ptr->unwind_ptr.arg = ptr; + specpdl_ptr->unwind_ptr.mark = NULL; grow_specpdl (); } -void -rebind_for_thread_switch (void) -{ - union specbinding *bind; - - for (bind = specpdl; bind != specpdl_ptr; ++bind) - { - if (bind->kind >= SPECPDL_LET) - { - Lisp_Object value = specpdl_saved_value (bind); - Lisp_Object sym = specpdl_symbol (bind); - bind->let.saved_value = Qnil; - do_specbind (XSYMBOL (sym), bind, value, - SET_INTERNAL_THREAD_SWITCH); - } - } -} - static void do_one_unbind (union specbinding *this_binding, bool unwinding, enum Set_Internal_Bind bindflag) @@ -3722,6 +3518,7 @@ do_one_unbind (union specbinding *this_binding, bool unwinding, this_binding->unwind_excursion.window); break; case SPECPDL_BACKTRACE: + case SPECPDL_NOP: break; #ifdef HAVE_MODULES case SPECPDL_MODULE_RUNTIME: @@ -3786,9 +3583,9 @@ record_unwind_protect_nothing (void) It need not be at the top of the stack. */ void -clear_unwind_protect (ptrdiff_t count) +clear_unwind_protect (specpdl_ref count) { - union specbinding *p = specpdl + count; + union specbinding *p = specpdl_ref_to_ptr (count); p->unwind_void.kind = SPECPDL_UNWIND_VOID; p->unwind_void.func = do_nothing; } @@ -3798,10 +3595,10 @@ clear_unwind_protect (ptrdiff_t count) previous value without invoking it. */ void -set_unwind_protect (ptrdiff_t count, void (*func) (Lisp_Object), +set_unwind_protect (specpdl_ref count, void (*func) (Lisp_Object), Lisp_Object arg) { - union specbinding *p = specpdl + count; + union specbinding *p = specpdl_ref_to_ptr (count); p->unwind.kind = SPECPDL_UNWIND; p->unwind.func = func; p->unwind.arg = arg; @@ -3809,25 +3606,26 @@ set_unwind_protect (ptrdiff_t count, void (*func) (Lisp_Object), } void -set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg) +set_unwind_protect_ptr (specpdl_ref count, void (*func) (void *), void *arg) { - union specbinding *p = specpdl + count; + union specbinding *p = specpdl_ref_to_ptr (count); p->unwind_ptr.kind = SPECPDL_UNWIND_PTR; p->unwind_ptr.func = func; p->unwind_ptr.arg = arg; + p->unwind_ptr.mark = NULL; } /* Pop and execute entries from the unwind-protect stack until the depth COUNT is reached. Return VALUE. */ Lisp_Object -unbind_to (ptrdiff_t count, Lisp_Object value) +unbind_to (specpdl_ref count, Lisp_Object value) { Lisp_Object quitf = Vquit_flag; Vquit_flag = Qnil; - while (specpdl_ptr != specpdl + count) + while (specpdl_ptr != specpdl_ref_to_ptr (count)) { /* Copy the binding, and decrement specpdl_ptr, before we do the work to unbind it. We decrement first @@ -3847,22 +3645,6 @@ unbind_to (ptrdiff_t count, Lisp_Object value) return value; } -void -unbind_for_thread_switch (struct thread_state *thr) -{ - union specbinding *bind; - - for (bind = thr->m_specpdl_ptr; bind > thr->m_specpdl;) - { - if ((--bind)->kind >= SPECPDL_LET) - { - Lisp_Object sym = specpdl_symbol (bind); - bind->let.saved_value = find_symbol_value (sym); - do_one_unbind (bind, false, SET_INTERNAL_THREAD_SWITCH); - } - } -} - DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0, doc: /* Return non-nil if SYMBOL's global binding has been declared special. A special variable is one that will be bound dynamically, even in a @@ -4018,11 +3800,13 @@ or a lambda expression for macro calls. */) value and the old value stored in the specpdl), kind of like the inplace pointer-reversal trick. As it turns out, the rewind does the same as the unwind, except it starts from the other end of the specpdl stack, so we use - the same function for both unwind and rewind. */ -static void -backtrace_eval_unrewind (int distance) + the same function for both unwind and rewind. + This same code is used when switching threads, except in that case + we unwind/rewind the whole specpdl of the threads. */ +void +specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only) { - union specbinding *tmp = specpdl_ptr; + union specbinding *tmp = pdl; int step = -1; if (distance < 0) { /* It's a rewind rather than unwind. */ @@ -4040,6 +3824,8 @@ backtrace_eval_unrewind (int distance) unwind_protect, but the problem is that we don't know how to rewind them afterwards. */ case SPECPDL_UNWIND: + if (vars_only) + break; if (tmp->unwind.func == set_buffer_if_live) { Lisp_Object oldarg = tmp->unwind.arg; @@ -4048,6 +3834,8 @@ backtrace_eval_unrewind (int distance) } break; case SPECPDL_UNWIND_EXCURSION: + if (vars_only) + break; { Lisp_Object marker = tmp->unwind_excursion.marker; Lisp_Object window = tmp->unwind_excursion.window; @@ -4055,17 +3843,6 @@ backtrace_eval_unrewind (int distance) save_excursion_restore (marker, window); } break; - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - break; case SPECPDL_LET: { /* If variable has a trivial value (no forwarding), we can just set it. No need to check for constant symbols here, @@ -4088,7 +3865,7 @@ backtrace_eval_unrewind (int distance) Lisp_Object sym = specpdl_symbol (tmp); Lisp_Object old_value = specpdl_old_value (tmp); set_specpdl_old_value (tmp, default_value (sym)); - Fset_default (sym, old_value); + set_default_internal (sym, old_value, SET_INTERNAL_THREAD_SWITCH); } break; case SPECPDL_LET_LOCAL: @@ -4104,21 +3881,37 @@ backtrace_eval_unrewind (int distance) { set_specpdl_old_value (tmp, buffer_local_value (symbol, where)); - set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND); + set_internal (symbol, old_value, where, + SET_INTERNAL_THREAD_SWITCH); } + else + /* If the var is not local any more, it can't be undone nor + redone, so just zap it. + This is important in case the buffer re-gains a local value + before we unrewind again, in which case we'd risk applying + this entry in the wrong direction. */ + tmp->kind = SPECPDL_NOP; } break; + + default: break; } } } +static void +backtrace_eval_unrewind (int distance) +{ + specpdl_unrewind (specpdl_ptr, distance, false); +} + DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL, doc: /* Evaluate EXP in the context of some activation frame. NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */) (Lisp_Object exp, Lisp_Object nframes, Lisp_Object base) { union specbinding *pdl = get_backtrace_frame (nframes, base); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t distance = specpdl_ptr - pdl; eassert (distance >= 0); @@ -4192,22 +3985,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. } break; - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_EXCURSION: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - break; - - default: - emacs_abort (); + default: break; } } } @@ -4265,15 +4043,22 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) case SPECPDL_LET: mark_object (specpdl_symbol (pdl)); mark_object (specpdl_old_value (pdl)); - mark_object (specpdl_saved_value (pdl)); break; case SPECPDL_UNWIND_PTR: + if (pdl->unwind_ptr.mark) + pdl->unwind_ptr.mark (pdl->unwind_ptr.arg); + break; + case SPECPDL_UNWIND_INT: case SPECPDL_UNWIND_INTMAX: case SPECPDL_UNWIND_VOID: + case SPECPDL_NOP: break; + /* While other loops that scan the specpdl use "default: break;" + for simplicity, here we explicitly list all cases and abort + if we find an unexpected value, as a sanity check. */ default: emacs_abort (); } @@ -4367,6 +4152,7 @@ before making `inhibit-quit' nil. */); DEFSYM (Qclosure, "closure"); DEFSYM (QCdocumentation, ":documentation"); DEFSYM (Qdebug, "debug"); + DEFSYM (Qdebug_early, "debug-early"); DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, doc: /* Non-nil means never enter the debugger. @@ -4421,7 +4207,7 @@ If due to frame exit, args are `exit' and the value being returned; If due to error, args are `error' and a list of the args to `signal'. If due to `apply' or `funcall' entry, one arg, `lambda'. If due to `eval' entry, one arg, t. */); - Vdebugger = Qnil; + Vdebugger = Qdebug_early; DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function, doc: /* If non-nil, this is a function for `signal' to call. @@ -4511,6 +4297,7 @@ alist of active lexical bindings. */); defsubr (&Slet); defsubr (&SletX); defsubr (&Swhile); + defsubr (&Sfuncall_with_delayed_message); defsubr (&Smacroexpand); defsubr (&Scatch); defsubr (&Sthrow); @@ -4539,5 +4326,6 @@ alist of active lexical bindings. */); defsubr (&Sbacktrace_eval); defsubr (&Sbacktrace__locals); defsubr (&Sspecial_variable_p); + DEFSYM (Qfunctionp, "functionp"); defsubr (&Sfunctionp); } diff --git a/src/fileio.c b/src/fileio.c index 7d392e0de73..c418036fc6e 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -195,7 +195,11 @@ get_file_errno_data (char const *string, Lisp_Object name, int errorno) if (errorno == EEXIST) return Fcons (Qfile_already_exists, errdata); else - return Fcons (errorno == ENOENT ? Qfile_missing : Qfile_error, + return Fcons (errorno == ENOENT + ? Qfile_missing + : (errorno == EACCES + ? Qpermission_denied + : Qfile_error), Fcons (build_string (string), errdata)); } @@ -710,14 +714,14 @@ This function does not grok magic file names. */) bool failed = fd < 0; if (!failed) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_int (close_file_unwind, fd); val = DECODE_FILE (val); if (STRINGP (text) && SBYTES (text) != 0) write_region (text, Qnil, val, Qnil, Qnil, Qnil, Qnil, fd); failed = NILP (dir_flag) && emacs_close (fd) != 0; /* Discard the unwind protect. */ - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl_ref_to_ptr (count); } if (failed) { @@ -2161,7 +2165,7 @@ permissions. */) Lisp_Object preserve_permissions) { Lisp_Object handler; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object encoded_file, encoded_newname; #if HAVE_LIBSELINUX char *con; @@ -2412,7 +2416,7 @@ permissions. */) #endif /* not WINDOWSNT */ /* Discard the unwind protects. */ - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl_ref_to_ptr (count); return Qnil; } @@ -2501,6 +2505,8 @@ With a prefix argument, TRASH is nil. */) return Qnil; } +#if defined HAVE_NATIVE_COMP && defined WINDOWSNT + static Lisp_Object internal_delete_file_1 (Lisp_Object ignore) { @@ -2519,6 +2525,8 @@ internal_delete_file (Lisp_Object filename) Qt, internal_delete_file_1); return NILP (tem); } + +#endif /* Return -1 if FILE is a case-insensitive file name, 0 if not, and a positive errno value if the result cannot be determined. */ @@ -2714,7 +2722,7 @@ This is what happens in interactive use with M-x. */) Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt); } - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qdelete_by_moving_to_trash, Qnil); if (dirp) call2 (Qdelete_directory, file, Qt); @@ -3833,7 +3841,7 @@ restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted, Lisp_Object oldpos = XCDR (car); if (MARKERP (marker) && FIXNUMP (oldpos) && XFIXNUM (oldpos) > same_at_start - && XFIXNUM (oldpos) < same_at_end) + && XFIXNUM (oldpos) <= same_at_end) { ptrdiff_t oldsize = same_at_end - same_at_start; ptrdiff_t newsize = inserted; @@ -3899,7 +3907,7 @@ by calling `format-decode', which see. */) ptrdiff_t how_much; off_t beg_offset, end_offset; int unprocessed; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object handler, val, insval, orig_filename, old_undo; Lisp_Object p; ptrdiff_t total = 0; @@ -3918,7 +3926,6 @@ by calling `format-decode', which see. */) && BEG == Z); Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark; bool we_locked_file = false; - ptrdiff_t fd_index; Lisp_Object window_markers = Qnil; /* same_at_start and same_at_end count bytes, because file access counts bytes and BEG and END count bytes. */ @@ -3980,7 +3987,7 @@ by calling `format-decode', which see. */) goto notfound; } - fd_index = SPECPDL_INDEX (); + specpdl_ref fd_index = SPECPDL_INDEX (); record_unwind_protect_int (close_file_unwind, fd); /* Replacement should preserve point as it preserves markers. */ @@ -4323,7 +4330,7 @@ by calling `format-decode', which see. */) if (! giveup_match_end) { ptrdiff_t temp; - ptrdiff_t this_count = SPECPDL_INDEX (); + specpdl_ref this_count = SPECPDL_INDEX (); /* We win! We can handle REPLACE the optimized way. */ @@ -4394,7 +4401,7 @@ by calling `format-decode', which see. */) unsigned char *decoded; ptrdiff_t temp; ptrdiff_t this = 0; - ptrdiff_t this_count = SPECPDL_INDEX (); + specpdl_ref this_count = SPECPDL_INDEX (); bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); Lisp_Object conversion_buffer; @@ -4700,7 +4707,7 @@ by calling `format-decode', which see. */) = Fcons (multibyte, Fcons (BVAR (current_buffer, undo_list), Fcurrent_buffer ())); - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); bset_enable_multibyte_characters (current_buffer, Qnil); bset_undo_list (current_buffer, Qt); @@ -4851,7 +4858,7 @@ by calling `format-decode', which see. */) if (inserted > 0) { /* Don't run point motion or modification hooks when decoding. */ - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); ptrdiff_t old_inserted = inserted; specbind (Qinhibit_point_motion_hooks, Qt); specbind (Qinhibit_modification_hooks, Qt); @@ -5182,8 +5189,8 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, const char *fn; struct stat st; struct timespec modtime; - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t count1 UNINIT; + specpdl_ref count = SPECPDL_INDEX (); + specpdl_ref count1 UNINIT; Lisp_Object handler; Lisp_Object visit_file; Lisp_Object annotations; @@ -5386,7 +5393,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, ok = 0, save_errno = errno; /* Discard the unwind protect for close_file_unwind. */ - specpdl_ptr = specpdl + count1; + specpdl_ptr = specpdl_ref_to_ptr (count1); } /* Some file systems have a bug where st_mtime is not updated @@ -5516,7 +5523,10 @@ DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, doc: /* Return t if (car A) is numerically less than (car B). */) (Lisp_Object a, Lisp_Object b) { - return arithcompare (Fcar (a), Fcar (b), ARITH_LESS); + Lisp_Object ca = Fcar (a), cb = Fcar (b); + if (FIXNUMP (ca) && FIXNUMP (cb)) + return XFIXNUM (ca) < XFIXNUM (cb) ? Qt : Qnil; + return arithcompare (ca, cb, ARITH_LESS); } /* Build the complete list of annotations appropriate for writing out @@ -5965,12 +5975,13 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) int do_handled_files; Lisp_Object oquit; FILE *stream = NULL; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); bool orig_minibuffer_auto_raise = minibuffer_auto_raise; bool old_message_p = 0; struct auto_save_unwind auto_save_unwind; - intmax_t sum = INT_ADD_WRAPV (specpdl_size, 40, &sum) ? INTMAX_MAX : sum; + intmax_t sum = INT_ADD_WRAPV (specpdl_end - specpdl, 40, &sum) + ? INTMAX_MAX : sum; if (max_specpdl_size < sum) max_specpdl_size = sum; @@ -6194,7 +6205,7 @@ before any other event (mouse or keypress) is handled. */) (void) { #if (defined USE_GTK || defined USE_MOTIF \ - || defined HAVE_NS || defined HAVE_NTGUI) + || defined HAVE_NS || defined HAVE_NTGUI || defined HAVE_HAIKU) if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) && use_dialog_box && use_file_dialog @@ -6380,6 +6391,7 @@ syms_of_fileio (void) DEFSYM (Qfile_already_exists, "file-already-exists"); DEFSYM (Qfile_date_error, "file-date-error"); DEFSYM (Qfile_missing, "file-missing"); + DEFSYM (Qpermission_denied, "permission-denied"); DEFSYM (Qfile_notify_error, "file-notify-error"); DEFSYM (Qremote_file_error, "remote-file-error"); DEFSYM (Qexcl, "excl"); @@ -6438,6 +6450,11 @@ behaves as if file names were encoded in `utf-8'. */); Fput (Qfile_missing, Qerror_message, build_pure_c_string ("File is missing")); + Fput (Qpermission_denied, Qerror_conditions, + Fpurecopy (list3 (Qpermission_denied, Qfile_error, Qerror))); + Fput (Qpermission_denied, Qerror_message, + build_pure_c_string ("Cannot access file or directory")); + Fput (Qfile_notify_error, Qerror_conditions, Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror))); Fput (Qfile_notify_error, Qerror_message, diff --git a/src/filelock.c b/src/filelock.c index e1e2cc1b23e..4fdad8d8560 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -65,7 +65,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #define BOOT_TIME_FILE "/var/run/random-seed" #endif -#if !defined WTMP_FILE && !defined WINDOWSNT +#if !defined WTMP_FILE && !defined WINDOWSNT && defined BOOT_TIME #define WTMP_FILE "/var/log/wtmp" #endif @@ -490,15 +490,29 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1]) return nbytes; } +/* True if errno values are negative. Although the C standard + requires them to be positive, they are negative in Haiku. */ +enum { NEGATIVE_ERRNO = EDOM < 0 }; + +/* Nonzero values that are not errno values. */ +enum + { + /* Another process on this machine owns it. */ + ANOTHER_OWNS_IT = NEGATIVE_ERRNO ? 1 : -1, + + /* This Emacs process owns it. */ + I_OWN_IT = 2 * ANOTHER_OWNS_IT + }; + /* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete, - -1 if another process owns it (and set OWNER (if non-null) to info), - -2 if the current process owns it, + ANOTHER_OWNS_IT if another process owns it + (and set OWNER (if non-null) to info), + I_OWN_IT if the current process owns it, or an errno value if something is wrong with the locking mechanism. */ static int current_lock_owner (lock_info_type *owner, char *lfname) { - int ret; lock_info_type local_owner; ptrdiff_t lfinfolen; intmax_t pid, boot_time; @@ -564,20 +578,25 @@ current_lock_owner (lock_info_type *owner, char *lfname) if (lfinfo_end != owner->user + lfinfolen) return EINVAL; - /* On current host? */ Lisp_Object system_name = Fsystem_name (); + /* If `system-name' returns nil, that means we're in a + --no-build-details Emacs, and the name part of the link (e.g., + .#test.txt -> larsi@.118961:1646577954) is an empty string. */ + if (NILP (system_name)) + system_name = build_string (""); + /* On current host? */ if (STRINGP (system_name) && dot - (at + 1) == SBYTES (system_name) && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0) { if (pid == getpid ()) - ret = -2; /* We own it. */ + return I_OWN_IT; else if (0 < pid && pid <= TYPE_MAXIMUM (pid_t) && (kill (pid, 0) >= 0 || errno == EPERM) && (boot_time == 0 || (boot_time <= TYPE_MAXIMUM (time_t) && within_one_second (boot_time, get_boot_time ())))) - ret = -1; /* An existing process on this machine owns it. */ + return ANOTHER_OWNS_IT; /* The owner process is dead or has a strange pid, so try to zap the lockfile. */ else @@ -586,18 +605,16 @@ current_lock_owner (lock_info_type *owner, char *lfname) else { /* If we wanted to support the check for stale locks on remote machines, here's where we'd do it. */ - ret = -1; + return ANOTHER_OWNS_IT; } - - return ret; } /* Lock the lock named LFNAME if possible. Return 0 in that case. - Return negative if some other process owns the lock, and info about + Return ANOTHER_OWNS_IT if some other process owns the lock, and info about that process in CLASHER. - Return positive errno value if cannot lock for any other reason. */ + Return errno value if cannot lock for any other reason. */ static int lock_if_free (lock_info_type *clasher, char *lfname) @@ -606,14 +623,14 @@ lock_if_free (lock_info_type *clasher, char *lfname) while ((err = lock_file_1 (lfname, 0)) == EEXIST) { err = current_lock_owner (clasher, lfname); + + /* Return if we locked it, or another process owns it, or it is + a strange error. */ if (err != 0) - { - if (err < 0) - return -2 - err; /* We locked it, or someone else has it. */ - break; /* current_lock_owner returned strange error. */ - } + return err == I_OWN_IT ? 0 : err; - /* We deleted a stale lock; try again to lock the file. */ + /* We deleted a stale lock or some other process deleted the lock; + try again to lock the file. */ } return err; @@ -670,7 +687,7 @@ lock_file (Lisp_Object fn) if (!NILP (subject_buf) && NILP (Fverify_visited_file_modtime (subject_buf)) && !NILP (Ffile_exists_p (fn)) - && !(lfname && current_lock_owner (NULL, lfname) == -2)) + && !(lfname && (current_lock_owner (NULL, lfname) == I_OWN_IT))) call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); /* Don't do locking if the user has opted out. */ @@ -678,7 +695,7 @@ lock_file (Lisp_Object fn) { /* Try to lock the lock. FIXME: This ignores errors when lock_if_free returns a positive errno value. */ - if (lock_if_free (&lock_info, lfname) < 0) + if (lock_if_free (&lock_info, lfname) == ANOTHER_OWNS_IT) { /* Someone else has the lock. Consider breaking it. */ Lisp_Object attack; @@ -710,9 +727,9 @@ unlock_file (Lisp_Object fn) lfname = SSDATA (ENCODE_FILE (lock_filename)); int err = current_lock_owner (0, lfname); - if (err == -2 && unlink (lfname) != 0 && errno != ENOENT) - err = errno; - if (0 < err) + if (! (err == 0 || err == ANOTHER_OWNS_IT + || (err == I_OWN_IT + && (unlink (lfname) == 0 || (err = errno) == ENOENT)))) report_file_errno ("Unlocking file", fn, err); return Qnil; @@ -862,8 +879,10 @@ t if it is locked by you, else a string saying which user has locked it. */) owner = current_lock_owner (&locker, lfname); switch (owner) { - case -2: ret = Qt; break; - case -1: ret = make_string (locker.user, locker.at - locker.user); break; + case I_OWN_IT: ret = Qt; break; + case ANOTHER_OWNS_IT: + ret = make_string (locker.user, locker.at - locker.user); + break; case 0: ret = Qnil; break; default: report_file_errno ("Testing file lock", filename, owner); } diff --git a/src/floatfns.c b/src/floatfns.c index 22376846c94..f2b3b13acd8 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -347,6 +347,21 @@ int double_integer_scale (double d) { int exponent = ilogb (d); +#ifdef HAIKU + /* On Haiku, the values returned by ilogb are nonsensical when + confronted with tiny numbers, inf, or NaN, which breaks the trick + used by code on other platforms, so we have to test for each case + manually, and return the appropriate value. */ + if (exponent == FP_ILOGB0) + { + if (isnan (d)) + return (DBL_MANT_DIG - DBL_MIN_EXP) + 2; + if (isinf (d)) + return (DBL_MANT_DIG - DBL_MIN_EXP) + 1; + + return (DBL_MANT_DIG - DBL_MIN_EXP); + } +#endif return (DBL_MIN_EXP - 1 <= exponent && exponent < INT_MAX ? DBL_MANT_DIG - 1 - exponent : (DBL_MANT_DIG - DBL_MIN_EXP diff --git a/src/fns.c b/src/fns.c index 65dc3b61f2b..4673fde28c7 100644 --- a/src/fns.c +++ b/src/fns.c @@ -39,9 +39,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "puresize.h" #include "gnutls.h" -static void sort_vector_copy (Lisp_Object pred, ptrdiff_t len, - Lisp_Object src[restrict VLA_ELEMS (len)], - Lisp_Object dest[restrict VLA_ELEMS (len)]); enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; static bool internal_equal (Lisp_Object, Lisp_Object, enum equal_kind, int, Lisp_Object); @@ -55,49 +52,24 @@ DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, return argument; } +/* Return a random Lisp fixnum I in the range 0 <= I < LIM, + where LIM is taken from a positive fixnum. */ static Lisp_Object -ccall2 (Lisp_Object (f) (ptrdiff_t nargs, Lisp_Object *args), - Lisp_Object arg1, Lisp_Object arg2) +get_random_fixnum (EMACS_INT lim) { - Lisp_Object args[2] = {arg1, arg2}; - return f (2, args); -} - -static Lisp_Object -get_random_bignum (Lisp_Object limit) -{ - /* This is a naive transcription into bignums of the fixnum algorithm. - I'd be quite surprised if that's anywhere near the best algorithm - for it. */ - while (true) + /* Return the remainder of a random integer R (in range 0..INTMASK) + divided by LIM, except reject the rare case where R is so close + to INTMASK that the remainder isn't random. */ + EMACS_INT difflim = INTMASK - lim + 1, diff, remainder; + do { - Lisp_Object val = make_fixnum (0); - Lisp_Object lim = limit; - int bits = 0; - int bitsperiteration = FIXNUM_BITS - 1; - do - { - /* Shift by one so it is a valid positive fixnum. */ - EMACS_INT rand = get_random () >> 1; - Lisp_Object lrand = make_fixnum (rand); - bits += bitsperiteration; - val = ccall2 (Flogior, - Fash (val, make_fixnum (bitsperiteration)), - lrand); - lim = Fash (lim, make_fixnum (- bitsperiteration)); - } - while (!EQ (lim, make_fixnum (0))); - /* Return the remainder, except reject the rare case where - get_random returns a number so close to INTMASK that the - remainder isn't random. */ - Lisp_Object remainder = Frem (val, limit); - if (!NILP (ccall2 (Fleq, - ccall2 (Fminus, val, remainder), - ccall2 (Fminus, - Fash (make_fixnum (1), make_fixnum (bits)), - limit)))) - return remainder; + EMACS_INT r = get_random (); + remainder = r % lim; + diff = r - remainder; } + while (difflim < diff); + + return make_fixnum (remainder); } DEFUN ("random", Frandom, Srandom, 0, 1, 0, @@ -111,32 +83,26 @@ With a string argument, set the seed based on the string's contents. See Info node `(elisp)Random Numbers' for more details. */) (Lisp_Object limit) { - EMACS_INT val; - if (EQ (limit, Qt)) init_random (); else if (STRINGP (limit)) seed_random (SSDATA (limit), SBYTES (limit)); - if (BIGNUMP (limit)) + else if (FIXNUMP (limit)) { - if (0 > mpz_sgn (*xbignum_val (limit))) - xsignal2 (Qwrong_type_argument, Qnatnump, limit); - return get_random_bignum (limit); + EMACS_INT lim = XFIXNUM (limit); + if (lim <= 0) + xsignal1 (Qargs_out_of_range, limit); + return get_random_fixnum (lim); + } + else if (BIGNUMP (limit)) + { + struct Lisp_Bignum *lim = XBIGNUM (limit); + if (mpz_sgn (*bignum_val (lim)) <= 0) + xsignal1 (Qargs_out_of_range, limit); + return get_random_bignum (lim); } - val = get_random (); - if (FIXNUMP (limit) && 0 < XFIXNUM (limit)) - while (true) - { - /* Return the remainder, except reject the rare case where - get_random returns a number so close to INTMASK that the - remainder isn't random. */ - EMACS_INT remainder = val % XFIXNUM (limit); - if (val - remainder <= INTMASK - XFIXNUM (limit) + 1) - return make_fixnum (remainder); - val = get_random (); - } - return make_ufixnum (val); + return make_ufixnum (get_random ()); } /* Random data-structure functions. */ @@ -475,15 +441,24 @@ Symbols are also allowed; their print names are used instead. */) { if (SYMBOLP (string1)) string1 = SYMBOL_NAME (string1); + else + CHECK_STRING (string1); if (SYMBOLP (string2)) string2 = SYMBOL_NAME (string2); - CHECK_STRING (string1); - CHECK_STRING (string2); + else + CHECK_STRING (string2); + + ptrdiff_t n = min (SCHARS (string1), SCHARS (string2)); + if (!STRING_MULTIBYTE (string1) && !STRING_MULTIBYTE (string2)) + { + /* Both arguments are unibyte (hot path). */ + int d = memcmp (SSDATA (string1), SSDATA (string2), n); + return d < 0 || (d == 0 && n < SCHARS (string2)) ? Qt : Qnil; + } ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0, i2_byte = 0; - ptrdiff_t end = min (SCHARS (string1), SCHARS (string2)); - while (i1 < end) + while (i1 < n) { /* When we find a mismatch, we must compare the characters, not just the bytes. */ @@ -516,37 +491,9 @@ Symbols are also allowed; their print names are used instead. */) string2 = SYMBOL_NAME (string2); CHECK_STRING (string1); CHECK_STRING (string2); - return string_version_cmp (string1, string2) < 0 ? Qt : Qnil; -} - -/* Return negative, 0, positive if STRING1 is <, =, > STRING2 as per - string-version-lessp. */ -int -string_version_cmp (Lisp_Object string1, Lisp_Object string2) -{ - char *p1 = SSDATA (string1); - char *p2 = SSDATA (string2); - char *lim1 = p1 + SBYTES (string1); - char *lim2 = p2 + SBYTES (string2); - int cmp; - - while ((cmp = filevercmp (p1, p2)) == 0) - { - /* If the strings are identical through their first null bytes, - skip past identical prefixes and try again. */ - ptrdiff_t size = strlen (p1) + 1; - eassert (size == strlen (p2) + 1); - p1 += size; - p2 += size; - bool more1 = p1 <= lim1; - bool more2 = p2 <= lim2; - if (!more1) - return more2; - if (!more2) - return -1; - } - - return cmp; + int cmp = filenvercmp (SSDATA (string1), SBYTES (string1), + SSDATA (string2), SBYTES (string2)); + return cmp < 0 ? Qt : Qnil; } DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 4, 0, @@ -643,18 +590,19 @@ Do NOT use this function to compare file names for equality. */) } static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args, - enum Lisp_Type target_type, bool last_special); + Lisp_Object last_tail, bool vector_target); +static Lisp_Object concat_strings (ptrdiff_t nargs, Lisp_Object *args); Lisp_Object concat2 (Lisp_Object s1, Lisp_Object s2) { - return concat (2, ((Lisp_Object []) {s1, s2}), Lisp_String, 0); + return concat_strings (2, ((Lisp_Object []) {s1, s2})); } Lisp_Object concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3) { - return concat (3, ((Lisp_Object []) {s1, s2, s3}), Lisp_String, 0); + return concat_strings (3, ((Lisp_Object []) {s1, s2, s3})); } DEFUN ("append", Fappend, Sappend, 0, MANY, 0, @@ -665,7 +613,9 @@ The last argument is not copied, just used as the tail of the new list. usage: (append &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { - return concat (nargs, args, Lisp_Cons, 1); + if (nargs == 0) + return Qnil; + return concat (nargs - 1, args, args[nargs - 1], false); } DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0, @@ -678,7 +628,7 @@ to be `eq'. usage: (concat &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { - return concat (nargs, args, Lisp_String, 0); + return concat_strings (nargs, args); } DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0, @@ -688,7 +638,7 @@ Each argument may be a list, vector or string. usage: (vconcat &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { - return concat (nargs, args, Lisp_Vectorlike, 0); + return concat (nargs, args, Qnil, true); } @@ -702,16 +652,48 @@ the same empty object instead of its copy. */) { if (NILP (arg)) return arg; - if (RECORDP (arg)) + if (CONSP (arg)) { - return Frecord (PVSIZE (arg), XVECTOR (arg)->contents); + Lisp_Object val = Fcons (XCAR (arg), Qnil); + Lisp_Object prev = val; + Lisp_Object tail = XCDR (arg); + FOR_EACH_TAIL (tail) + { + Lisp_Object c = Fcons (XCAR (tail), Qnil); + XSETCDR (prev, c); + prev = c; + } + CHECK_LIST_END (tail, tail); + return val; } - if (CHAR_TABLE_P (arg)) + if (STRINGP (arg)) { - return copy_char_table (arg); + ptrdiff_t bytes = SBYTES (arg); + ptrdiff_t chars = SCHARS (arg); + Lisp_Object val = STRING_MULTIBYTE (arg) + ? make_uninit_multibyte_string (chars, bytes) + : make_uninit_string (bytes); + memcpy (SDATA (val), SDATA (arg), bytes); + INTERVAL ivs = string_intervals (arg); + if (ivs) + { + INTERVAL copy = copy_intervals (ivs, 0, chars); + set_interval_object (copy, val); + set_string_intervals (val, copy); + } + return val; } + if (VECTORP (arg)) + return Fvector (ASIZE (arg), XVECTOR (arg)->contents); + + if (RECORDP (arg)) + return Frecord (PVSIZE (arg), XVECTOR (arg)->contents); + + if (CHAR_TABLE_P (arg)) + return copy_char_table (arg); + if (BOOL_VECTOR_P (arg)) { EMACS_INT nbits = bool_vector_size (arg); @@ -721,13 +703,10 @@ the same empty object instead of its copy. */) return val; } - if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg)) - wrong_type_argument (Qsequencep, arg); - - return concat (1, &arg, XTYPE (arg), 0); + wrong_type_argument (Qsequencep, arg); } -/* This structure holds information of an argument of `concat' that is +/* This structure holds information of an argument of `concat_strings' that is a string and has text properties to be copied. */ struct textprop_rec { @@ -737,278 +716,308 @@ struct textprop_rec }; static Lisp_Object -concat (ptrdiff_t nargs, Lisp_Object *args, - enum Lisp_Type target_type, bool last_special) +concat_strings (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object val; - Lisp_Object tail; - Lisp_Object this; - ptrdiff_t toindex; - ptrdiff_t toindex_byte = 0; - EMACS_INT result_len; - EMACS_INT result_len_byte; - ptrdiff_t argnum; - Lisp_Object last_tail; - Lisp_Object prev; - bool some_multibyte; - /* When we make a multibyte string, we can't copy text properties - while concatenating each string because the length of resulting - string can't be decided until we finish the whole concatenation. - So, we record strings that have text properties to be copied - here, and copy the text properties after the concatenation. */ - struct textprop_rec *textprops = NULL; - /* Number of elements in textprops. */ - ptrdiff_t num_textprops = 0; USE_SAFE_ALLOCA; - tail = Qnil; - - /* In append, the last arg isn't treated like the others */ - if (last_special && nargs > 0) - { - nargs--; - last_tail = args[nargs]; - } - else - last_tail = Qnil; - - /* Check each argument. */ - for (argnum = 0; argnum < nargs; argnum++) - { - this = args[argnum]; - if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this) - || COMPILEDP (this) || BOOL_VECTOR_P (this))) - wrong_type_argument (Qsequencep, this); - } - - /* Compute total length in chars of arguments in RESULT_LEN. - If desired output is a string, also compute length in bytes - in RESULT_LEN_BYTE, and determine in SOME_MULTIBYTE + /* Check types and compute total length in chars of arguments in RESULT_LEN, + length in bytes in RESULT_LEN_BYTE, and determine in DEST_MULTIBYTE whether the result should be a multibyte string. */ - result_len_byte = 0; - result_len = 0; - some_multibyte = 0; - for (argnum = 0; argnum < nargs; argnum++) + EMACS_INT result_len = 0; + EMACS_INT result_len_byte = 0; + bool dest_multibyte = false; + bool some_unibyte = false; + for (ptrdiff_t i = 0; i < nargs; i++) { + Lisp_Object arg = args[i]; EMACS_INT len; - this = args[argnum]; - len = XFIXNAT (Flength (this)); - if (target_type == Lisp_String) - { - /* We must count the number of bytes needed in the string - as well as the number of characters. */ - ptrdiff_t i; - Lisp_Object ch; - int c; - ptrdiff_t this_len_byte; - if (VECTORP (this) || COMPILEDP (this)) - for (i = 0; i < len; i++) - { - ch = AREF (this, i); - CHECK_CHARACTER (ch); - c = XFIXNAT (ch); - this_len_byte = CHAR_BYTES (c); - if (STRING_BYTES_BOUND - result_len_byte < this_len_byte) - string_overflow (); - result_len_byte += this_len_byte; - if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c)) - some_multibyte = 1; - } - else if (BOOL_VECTOR_P (this) && bool_vector_size (this) > 0) - wrong_type_argument (Qintegerp, Faref (this, make_fixnum (0))); - else if (CONSP (this)) - for (; CONSP (this); this = XCDR (this)) - { - ch = XCAR (this); - CHECK_CHARACTER (ch); - c = XFIXNAT (ch); - this_len_byte = CHAR_BYTES (c); - if (STRING_BYTES_BOUND - result_len_byte < this_len_byte) - string_overflow (); - result_len_byte += this_len_byte; - if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c)) - some_multibyte = 1; - } - else if (STRINGP (this)) + /* We must count the number of bytes needed in the string + as well as the number of characters. */ + + if (STRINGP (arg)) + { + ptrdiff_t arg_len_byte = SBYTES (arg); + len = SCHARS (arg); + if (STRING_MULTIBYTE (arg)) + dest_multibyte = true; + else + some_unibyte = true; + if (STRING_BYTES_BOUND - result_len_byte < arg_len_byte) + string_overflow (); + result_len_byte += arg_len_byte; + } + else if (VECTORP (arg)) + { + len = ASIZE (arg); + ptrdiff_t arg_len_byte = 0; + for (ptrdiff_t j = 0; j < len; j++) { - if (STRING_MULTIBYTE (this)) - { - some_multibyte = 1; - this_len_byte = SBYTES (this); - } - else - this_len_byte = count_size_as_multibyte (SDATA (this), - SCHARS (this)); - if (STRING_BYTES_BOUND - result_len_byte < this_len_byte) - string_overflow (); - result_len_byte += this_len_byte; + Lisp_Object ch = AREF (arg, j); + CHECK_CHARACTER (ch); + int c = XFIXNAT (ch); + arg_len_byte += CHAR_BYTES (c); + if (!ASCII_CHAR_P (c) && !CHAR_BYTE8_P (c)) + dest_multibyte = true; + } + if (STRING_BYTES_BOUND - result_len_byte < arg_len_byte) + string_overflow (); + result_len_byte += arg_len_byte; + } + else if (NILP (arg)) + continue; + else if (CONSP (arg)) + { + len = XFIXNAT (Flength (arg)); + ptrdiff_t arg_len_byte = 0; + for (; CONSP (arg); arg = XCDR (arg)) + { + Lisp_Object ch = XCAR (arg); + CHECK_CHARACTER (ch); + int c = XFIXNAT (ch); + arg_len_byte += CHAR_BYTES (c); + if (!ASCII_CHAR_P (c) && !CHAR_BYTE8_P (c)) + dest_multibyte = true; } + if (STRING_BYTES_BOUND - result_len_byte < arg_len_byte) + string_overflow (); + result_len_byte += arg_len_byte; } + else + wrong_type_argument (Qsequencep, arg); result_len += len; if (MOST_POSITIVE_FIXNUM < result_len) memory_full (SIZE_MAX); } - if (! some_multibyte) + if (dest_multibyte && some_unibyte) + { + /* Non-ASCII characters in unibyte strings take two bytes when + converted to multibyte -- count them and adjust the total. */ + for (ptrdiff_t i = 0; i < nargs; i++) + { + Lisp_Object arg = args[i]; + if (STRINGP (arg) && !STRING_MULTIBYTE (arg)) + { + ptrdiff_t bytes = SCHARS (arg); + const unsigned char *s = SDATA (arg); + ptrdiff_t nonascii = 0; + for (ptrdiff_t j = 0; j < bytes; j++) + nonascii += s[j] >> 7; + if (STRING_BYTES_BOUND - result_len_byte < nonascii) + string_overflow (); + result_len_byte += nonascii; + } + } + } + + if (!dest_multibyte) result_len_byte = result_len; /* Create the output object. */ - if (target_type == Lisp_Cons) - val = Fmake_list (make_fixnum (result_len), Qnil); - else if (target_type == Lisp_Vectorlike) - val = make_nil_vector (result_len); - else if (some_multibyte) - val = make_uninit_multibyte_string (result_len, result_len_byte); - else - val = make_uninit_string (result_len); - - /* In `append', if all but last arg are nil, return last arg. */ - if (target_type == Lisp_Cons && NILP (val)) - return last_tail; + Lisp_Object result = dest_multibyte + ? make_uninit_multibyte_string (result_len, result_len_byte) + : make_uninit_string (result_len); /* Copy the contents of the args into the result. */ - if (CONSP (val)) - tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */ - else - toindex = 0, toindex_byte = 0; + ptrdiff_t toindex = 0; + ptrdiff_t toindex_byte = 0; - prev = Qnil; - if (STRINGP (val)) - SAFE_NALLOCA (textprops, 1, nargs); + /* When we make a multibyte string, we can't copy text properties + while concatenating each string because the length of resulting + string can't be decided until we finish the whole concatenation. + So, we record strings that have text properties to be copied + here, and copy the text properties after the concatenation. */ + struct textprop_rec *textprops; + /* Number of elements in textprops. */ + ptrdiff_t num_textprops = 0; + SAFE_NALLOCA (textprops, 1, nargs); - for (argnum = 0; argnum < nargs; argnum++) + for (ptrdiff_t i = 0; i < nargs; i++) { - Lisp_Object thislen; - ptrdiff_t thisleni = 0; - ptrdiff_t thisindex = 0; - ptrdiff_t thisindex_byte = 0; - - this = args[argnum]; - if (!CONSP (this)) - thislen = Flength (this), thisleni = XFIXNUM (thislen); - - /* Between strings of the same kind, copy fast. */ - if (STRINGP (this) && STRINGP (val) - && STRING_MULTIBYTE (this) == some_multibyte) + Lisp_Object arg = args[i]; + if (STRINGP (arg)) { - ptrdiff_t thislen_byte = SBYTES (this); - - memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this)); - if (string_intervals (this)) + if (string_intervals (arg)) { - textprops[num_textprops].argnum = argnum; + textprops[num_textprops].argnum = i; textprops[num_textprops].from = 0; - textprops[num_textprops++].to = toindex; + textprops[num_textprops].to = toindex; + num_textprops++; + } + ptrdiff_t nchars = SCHARS (arg); + if (STRING_MULTIBYTE (arg) == dest_multibyte) + { + /* Between strings of the same kind, copy fast. */ + ptrdiff_t arg_len_byte = SBYTES (arg); + memcpy (SDATA (result) + toindex_byte, SDATA (arg), arg_len_byte); + toindex_byte += arg_len_byte; + } + else + { + /* Copy a single-byte string to a multibyte string. */ + toindex_byte += copy_text (SDATA (arg), + SDATA (result) + toindex_byte, + nchars, 0, 1); } - toindex_byte += thislen_byte; - toindex += thisleni; + toindex += nchars; } - /* Copy a single-byte string to a multibyte string. */ - else if (STRINGP (this) && STRINGP (val)) + else if (VECTORP (arg)) { - if (string_intervals (this)) + ptrdiff_t len = ASIZE (arg); + for (ptrdiff_t j = 0; j < len; j++) { - textprops[num_textprops].argnum = argnum; - textprops[num_textprops].from = 0; - textprops[num_textprops++].to = toindex; + int c = XFIXNAT (AREF (arg, j)); + if (dest_multibyte) + toindex_byte += CHAR_STRING (c, SDATA (result) + toindex_byte); + else + SSET (result, toindex_byte++, c); + toindex++; } - toindex_byte += copy_text (SDATA (this), - SDATA (val) + toindex_byte, - SCHARS (this), 0, 1); - toindex += thisleni; } else - /* Copy element by element. */ - while (1) + for (Lisp_Object tail = arg; !NILP (tail); tail = XCDR (tail)) { - register Lisp_Object elt; - - /* Fetch next element of `this' arg into `elt', or break if - `this' is exhausted. */ - if (NILP (this)) break; - if (CONSP (this)) - elt = XCAR (this), this = XCDR (this); - else if (thisindex >= thisleni) - break; - else if (STRINGP (this)) - { - int c; - if (STRING_MULTIBYTE (this)) - c = fetch_string_char_advance_no_check (this, &thisindex, - &thisindex_byte); - else - { - c = SREF (this, thisindex); thisindex++; - if (some_multibyte && !ASCII_CHAR_P (c)) - c = BYTE8_TO_CHAR (c); - } - XSETFASTINT (elt, c); - } - else if (BOOL_VECTOR_P (this)) - { - elt = bool_vector_ref (this, thisindex); - thisindex++; - } + int c = XFIXNAT (XCAR (tail)); + if (dest_multibyte) + toindex_byte += CHAR_STRING (c, SDATA (result) + toindex_byte); else - { - elt = AREF (this, thisindex); - thisindex++; - } - - /* Store this element into the result. */ - if (toindex < 0) - { - XSETCAR (tail, elt); - prev = tail; - tail = XCDR (tail); - } - else if (VECTORP (val)) - { - ASET (val, toindex, elt); - toindex++; - } - else - { - int c; - CHECK_CHARACTER (elt); - c = XFIXNAT (elt); - if (some_multibyte) - toindex_byte += CHAR_STRING (c, SDATA (val) + toindex_byte); - else - SSET (val, toindex_byte++, c); - toindex++; - } + SSET (result, toindex_byte++, c); + toindex++; } } - if (!NILP (prev)) - XSETCDR (prev, last_tail); if (num_textprops > 0) { - Lisp_Object props; ptrdiff_t last_to_end = -1; - - for (argnum = 0; argnum < num_textprops; argnum++) + for (ptrdiff_t i = 0; i < num_textprops; i++) { - this = args[textprops[argnum].argnum]; - props = text_property_list (this, - make_fixnum (0), - make_fixnum (SCHARS (this)), - Qnil); + Lisp_Object arg = args[textprops[i].argnum]; + Lisp_Object props = text_property_list (arg, + make_fixnum (0), + make_fixnum (SCHARS (arg)), + Qnil); /* If successive arguments have properties, be sure that the value of `composition' property be the copy. */ - if (last_to_end == textprops[argnum].to) + if (last_to_end == textprops[i].to) make_composition_value_copy (props); - add_text_properties_from_list (val, props, - make_fixnum (textprops[argnum].to)); - last_to_end = textprops[argnum].to + SCHARS (this); + add_text_properties_from_list (result, props, + make_fixnum (textprops[i].to)); + last_to_end = textprops[i].to + SCHARS (arg); } } SAFE_FREE (); - return val; + return result; +} + +/* Concatenate sequences into a list or vector. */ + +Lisp_Object +concat (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object last_tail, + bool vector_target) +{ + /* Check argument types and compute total length of arguments. */ + EMACS_INT result_len = 0; + for (ptrdiff_t i = 0; i < nargs; i++) + { + Lisp_Object arg = args[i]; + if (!(CONSP (arg) || NILP (arg) || VECTORP (arg) || STRINGP (arg) + || COMPILEDP (arg) || BOOL_VECTOR_P (arg))) + wrong_type_argument (Qsequencep, arg); + EMACS_INT len = XFIXNAT (Flength (arg)); + result_len += len; + if (MOST_POSITIVE_FIXNUM < result_len) + memory_full (SIZE_MAX); + } + + /* When the target is a list, return the tail directly if all other + arguments are empty. */ + if (!vector_target && result_len == 0) + return last_tail; + + /* Create the output object. */ + Lisp_Object result = vector_target + ? make_nil_vector (result_len) + : Fmake_list (make_fixnum (result_len), Qnil); + + /* Copy the contents of the args into the result. */ + Lisp_Object tail = Qnil; + ptrdiff_t toindex = 0; + if (CONSP (result)) + { + tail = result; + toindex = -1; /* -1 in toindex is flag we are making a list */ + } + + Lisp_Object prev = Qnil; + + for (ptrdiff_t i = 0; i < nargs; i++) + { + ptrdiff_t arglen = 0; + ptrdiff_t argindex = 0; + ptrdiff_t argindex_byte = 0; + + Lisp_Object arg = args[i]; + if (!CONSP (arg)) + arglen = XFIXNUM (Flength (arg)); + + /* Copy element by element. */ + while (1) + { + /* Fetch next element of `arg' arg into `elt', or break if + `arg' is exhausted. */ + Lisp_Object elt; + if (CONSP (arg)) + { + elt = XCAR (arg); + arg = XCDR (arg); + } + else if (NILP (arg) || argindex >= arglen) + break; + else if (STRINGP (arg)) + { + int c; + if (STRING_MULTIBYTE (arg)) + c = fetch_string_char_advance_no_check (arg, &argindex, + &argindex_byte); + else + { + c = SREF (arg, argindex); + argindex++; + } + XSETFASTINT (elt, c); + } + else if (BOOL_VECTOR_P (arg)) + { + elt = bool_vector_ref (arg, argindex); + argindex++; + } + else + { + elt = AREF (arg, argindex); + argindex++; + } + + /* Store this element into the result. */ + if (toindex < 0) + { + XSETCAR (tail, elt); + prev = tail; + tail = XCDR (tail); + } + else + { + ASET (result, toindex, elt); + toindex++; + } + } + } + if (!NILP (prev)) + XSETCDR (prev, last_tail); + + return result; } static Lisp_Object string_char_byte_cache_string; @@ -1380,7 +1389,7 @@ Elements of ALIST that are not conses are also shared. */) { if (NILP (alist)) return alist; - alist = concat (1, &alist, Lisp_Cons, false); + alist = Fcopy_sequence (alist); for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem)) { Lisp_Object car = XCAR (tem); @@ -2104,8 +2113,11 @@ See also the function `nreverse', which is used more often. */) return new; } -/* Sort LIST using PREDICATE, preserving original order of elements - considered as equal. */ + +/* Stably sort LIST ordered by PREDICATE using the TIMSORT + algorithm. This converts the list to a vector, sorts the vector, + and returns the result converted back to a list. The input list is + destructively reused to hold the sorted result. */ static Lisp_Object sort_list (Lisp_Object list, Lisp_Object predicate) @@ -2113,112 +2125,43 @@ sort_list (Lisp_Object list, Lisp_Object predicate) ptrdiff_t length = list_length (list); if (length < 2) return list; - - Lisp_Object tem = Fnthcdr (make_fixnum (length / 2 - 1), list); - Lisp_Object back = Fcdr (tem); - Fsetcdr (tem, Qnil); - - return merge (Fsort (list, predicate), Fsort (back, predicate), predicate); -} - -/* Using PRED to compare, return whether A and B are in order. - Compare stably when A appeared before B in the input. */ -static bool -inorder (Lisp_Object pred, Lisp_Object a, Lisp_Object b) -{ - return NILP (call2 (pred, b, a)); -} - -/* Using PRED to compare, merge from ALEN-length A and BLEN-length B - into DEST. Argument arrays must be nonempty and must not overlap, - except that B might be the last part of DEST. */ -static void -merge_vectors (Lisp_Object pred, - ptrdiff_t alen, Lisp_Object const a[restrict VLA_ELEMS (alen)], - ptrdiff_t blen, Lisp_Object const b[VLA_ELEMS (blen)], - Lisp_Object dest[VLA_ELEMS (alen + blen)]) -{ - eassume (0 < alen && 0 < blen); - Lisp_Object const *alim = a + alen; - Lisp_Object const *blim = b + blen; - - while (true) + else { - if (inorder (pred, a[0], b[0])) + Lisp_Object *result; + USE_SAFE_ALLOCA; + SAFE_ALLOCA_LISP (result, length); + Lisp_Object tail = list; + for (ptrdiff_t i = 0; i < length; i++) { - *dest++ = *a++; - if (a == alim) - { - if (dest != b) - memcpy (dest, b, (blim - b) * sizeof *dest); - return; - } + result[i] = Fcar (tail); + tail = XCDR (tail); } - else + tim_sort (predicate, result, length); + + ptrdiff_t i = 0; + tail = list; + while (CONSP (tail)) { - *dest++ = *b++; - if (b == blim) - { - memcpy (dest, a, (alim - a) * sizeof *dest); - return; - } + XSETCAR (tail, result[i]); + tail = XCDR (tail); + i++; } + SAFE_FREE (); + return list; } } -/* Using PRED to compare, sort LEN-length VEC in place, using TMP for - temporary storage. LEN must be at least 2. */ -static void -sort_vector_inplace (Lisp_Object pred, ptrdiff_t len, - Lisp_Object vec[restrict VLA_ELEMS (len)], - Lisp_Object tmp[restrict VLA_ELEMS (len >> 1)]) -{ - eassume (2 <= len); - ptrdiff_t halflen = len >> 1; - sort_vector_copy (pred, halflen, vec, tmp); - if (1 < len - halflen) - sort_vector_inplace (pred, len - halflen, vec + halflen, vec); - merge_vectors (pred, halflen, tmp, len - halflen, vec + halflen, vec); -} - -/* Using PRED to compare, sort from LEN-length SRC into DST. - Len must be positive. */ -static void -sort_vector_copy (Lisp_Object pred, ptrdiff_t len, - Lisp_Object src[restrict VLA_ELEMS (len)], - Lisp_Object dest[restrict VLA_ELEMS (len)]) -{ - eassume (0 < len); - ptrdiff_t halflen = len >> 1; - if (halflen < 1) - dest[0] = src[0]; - else - { - if (1 < halflen) - sort_vector_inplace (pred, halflen, src, dest); - if (1 < len - halflen) - sort_vector_inplace (pred, len - halflen, src + halflen, dest); - merge_vectors (pred, halflen, src, len - halflen, src + halflen, dest); - } -} - -/* Sort VECTOR in place using PREDICATE, preserving original order of - elements considered as equal. */ +/* Stably sort VECTOR ordered by PREDICATE using the TIMSORT + algorithm. */ static void sort_vector (Lisp_Object vector, Lisp_Object predicate) { - ptrdiff_t len = ASIZE (vector); - if (len < 2) + ptrdiff_t length = ASIZE (vector); + if (length < 2) return; - ptrdiff_t halflen = len >> 1; - Lisp_Object *tmp; - USE_SAFE_ALLOCA; - SAFE_ALLOCA_LISP (tmp, halflen); - for (ptrdiff_t i = 0; i < halflen; i++) - tmp[i] = make_fixnum (0); - sort_vector_inplace (predicate, len, XVECTOR (vector)->contents, tmp); - SAFE_FREE (); + + tim_sort (predicate, XVECTOR (vector)->contents, length); } DEFUN ("sort", Fsort, Ssort, 2, 2, 0, @@ -2264,7 +2207,7 @@ merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred) } Lisp_Object tem; - if (inorder (pred, Fcar (l1), Fcar (l2))) + if (!NILP (call2 (pred, Fcar (l1), Fcar (l2)))) { tem = l1; l1 = Fcdr (l1); @@ -2569,6 +2512,13 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, } } + /* A symbol with position compares the contained symbol, and is + `equal' to the corresponding ordinary symbol. */ + if (SYMBOL_WITH_POS_P (o1)) + o1 = SYMBOL_WITH_POS_SYM (o1); + if (SYMBOL_WITH_POS_P (o2)) + o2 = SYMBOL_WITH_POS_SYM (o2); + if (EQ (o1, o2)) return true; if (XTYPE (o1) != XTYPE (o2)) @@ -2855,12 +2805,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. */) @@ -2961,6 +2915,9 @@ 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. +If the `use-short-answers' variable is non-nil, instead of asking for +\"yes\" or \"no\", this function will ask for \"y\" or \"n\". + If dialog boxes are supported, a dialog box will be used if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) (Lisp_Object prompt) @@ -2987,7 +2944,7 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) AUTO_STRING (yes_or_no, "(yes or no) "); prompt = CALLN (Fconcat, prompt, yes_or_no); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qenable_recursive_minibuffers, Qt); while (1) @@ -3149,7 +3106,7 @@ FILENAME are suppressed. */) if (NILP (tem)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); int nesting = 0; /* This is to make sure that loadup.el gives a clear picture @@ -3176,12 +3133,8 @@ FILENAME are suppressed. */) record_unwind_protect (require_unwind, require_nesting_list); require_nesting_list = Fcons (feature, require_nesting_list); - /* Value saved here is to be restored into Vautoload_queue */ - record_unwind_protect (un_autoload, Vautoload_queue); - Vautoload_queue = Qt; - /* Load the file. */ - tem = save_match_data_load + tem = load_with_autoload_queue (NILP (filename) ? Fsymbol_name (feature) : filename, noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil)); @@ -3203,8 +3156,6 @@ FILENAME are suppressed. */) SDATA (tem3), tem2); } - /* Once loading finishes, don't undo it. */ - Vautoload_queue = Qt; feature = unbind_to (count, feature); } @@ -3649,7 +3600,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length, c = string_char_and_length ((unsigned char *) from + i, &bytes); if (CHAR_BYTE8_P (c)) c = CHAR_TO_BYTE8 (c); - else if (c >= 256) + else if (c >= 128) return -1; i += bytes; } @@ -3692,7 +3643,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length, c = string_char_and_length ((unsigned char *) from + i, &bytes); if (CHAR_BYTE8_P (c)) c = CHAR_TO_BYTE8 (c); - else if (c >= 256) + else if (c >= 128) return -1; i += bytes; } @@ -3717,7 +3668,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length, c = string_char_and_length ((unsigned char *) from + i, &bytes); if (CHAR_BYTE8_P (c)) c = CHAR_TO_BYTE8 (c); - else if (c >= 256) + else if (c >= 128) return -1; i += bytes; } @@ -4156,7 +4107,7 @@ hash_table_user_defined_call (ptrdiff_t nargs, Lisp_Object *args, { if (!h->mutable) return Ffuncall (nargs, args); - ptrdiff_t count = inhibit_garbage_collection (); + specpdl_ref count = inhibit_garbage_collection (); record_unwind_protect_ptr (restore_mutability, h); h->mutable = false; return unbind_to (count, Ffuncall (nargs, args)); @@ -4198,13 +4149,15 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, static Lisp_Object hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) { + if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) + key = SYMBOL_WITH_POS_SYM (key); return make_ufixnum (XHASH (key) ^ XTYPE (key)); } /* Ignore HT and return a hash code for KEY which uses 'equal' to compare keys. The hash code is at most INTMASK. */ -Lisp_Object +static Lisp_Object hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) { return make_ufixnum (sxhash (key)); @@ -4213,7 +4166,7 @@ hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) /* Ignore HT and return a hash code for KEY which uses 'eql' to compare keys. The hash code is at most INTMASK. */ -Lisp_Object +static Lisp_Object hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) { return (FLOATP (key) || BIGNUMP (key) ? hashfn_equal : hashfn_eq) (key, h); @@ -4475,7 +4428,8 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash) { ptrdiff_t start_of_bucket, i; - Lisp_Object hash_code = h->test.hashfn (key, h); + Lisp_Object hash_code; + hash_code = h->test.hashfn (key, h); if (hash) *hash = hash_code; @@ -4912,6 +4866,8 @@ sxhash_obj (Lisp_Object obj, int depth) hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth)); return SXHASH_REDUCE (hash); } + else if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS) + return sxhash_obj (XSYMBOL_WITH_POS (obj)->sym, depth + 1); else /* Others are 'equal' if they are 'eq', so take their address as hash. */ diff --git a/src/font.c b/src/font.c index 56a921da944..7e0219181c9 100644 --- a/src/font.c +++ b/src/font.c @@ -57,24 +57,28 @@ 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]; }; +/* The following tables should be in sync with 'custom-face-attributes'. */ + /* 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 @@ -1484,11 +1488,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") @@ -2750,11 +2763,36 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size) continue; } for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++) - if (FIXNUMP (AREF (spec, prop)) - && ! (FIXNUMP (AREF (entity, prop)) - && ((XFIXNUM (AREF (spec, prop)) >> 8) - == (XFIXNUM (AREF (entity, prop)) >> 8)))) - prop = FONT_SPEC_MAX; + { + if (FIXNUMP (AREF (spec, prop))) + { + if (!FIXNUMP (AREF (entity, prop))) + prop = FONT_SPEC_MAX; + else + { + int required = XFIXNUM (AREF (spec, prop)) >> 8; + int candidate = XFIXNUM (AREF (entity, prop)) >> 8; + + if (candidate != required +#ifdef HAVE_NTGUI + /* A kludge for w32 font search, where listing a + family returns only 4 standard weights: regular, + italic, bold, bold-italic. For other values one + must specify the font, not just the family in the + :family attribute of the face. But specifying + :family in the face attributes looks for regular + weight, so if we require exact match, the + non-regular font will be rejected. So we relax + the accuracy of the match here, and let + font_sort_entities find the best match. */ + && (prop != FONT_WEIGHT_INDEX + || eabs (candidate - required) > 100) +#endif + ) + prop = FONT_SPEC_MAX; + } + } + } if (prop < FONT_SPEC_MAX && size && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0) @@ -4988,6 +5026,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. @@ -5006,8 +5071,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) { @@ -5559,6 +5629,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 @@ -5677,7 +5748,11 @@ match. */); syms_of_xftfont (); #endif /* HAVE_XFT */ #endif /* not USE_CAIRO */ -#endif /* HAVE_X_WINDOWS */ +#else /* not HAVE_X_WINDOWS */ +#ifdef USE_CAIRO + syms_of_ftcrfont (); +#endif +#endif /* not HAVE_X_WINDOWS */ #else /* not HAVE_FREETYPE */ #ifdef HAVE_X_WINDOWS syms_of_xfont (); @@ -5689,6 +5764,9 @@ match. */); #ifdef HAVE_NTGUI syms_of_w32font (); #endif /* HAVE_NTGUI */ +#ifdef USE_BE_CAIRO + syms_of_ftcrfont (); +#endif #endif /* HAVE_WINDOW_SYSTEM */ } diff --git a/src/font.h b/src/font.h index 97e8c5b43ab..424616a4a1e 100644 --- a/src/font.h +++ b/src/font.h @@ -965,7 +965,7 @@ extern struct font_driver const nsfont_driver; extern void syms_of_nsfont (void); extern void syms_of_macfont (void); #endif /* HAVE_NS */ -#ifdef USE_CAIRO +#if defined (USE_CAIRO) || defined (USE_BE_CAIRO) extern struct font_driver const ftcrfont_driver; #ifdef HAVE_HARFBUZZ extern struct font_driver ftcrhbfont_driver; @@ -999,7 +999,7 @@ extern void font_deferred_log (const char *, Lisp_Object, Lisp_Object); INLINE bool font_data_structures_may_be_ill_formed (void) { -#ifdef USE_CAIRO +#if defined USE_CAIRO || defined USE_BE_CAIRO /* Although this works around Bug#20890, it is probably not the right thing to do. */ return gc_in_progress; diff --git a/src/frame.c b/src/frame.c index ccac18d23c2..93028aa8958 100644 --- a/src/frame.c +++ b/src/frame.c @@ -225,7 +225,9 @@ Value is: `x' for an Emacs frame that is really an X window, `w32' for an Emacs frame that is a window on MS-Windows display, `ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, - `pc' for a direct-write MS-DOS frame. + `pc' for a direct-write MS-DOS frame, + `pgtk' for an Emacs frame running on pure GTK. + `haiku' for an Emacs frame running in Haiku. See also `frame-live-p'. */) (Lisp_Object object) { @@ -244,6 +246,10 @@ See also `frame-live-p'. */) return Qpc; case output_ns: return Qns; + case output_pgtk: + return Qpgtk; + case output_haiku: + return Qhaiku; default: emacs_abort (); } @@ -271,6 +277,8 @@ The value is a symbol: `w32' for an Emacs frame that is a window on MS-Windows display, `ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, `pc' for a direct-write MS-DOS frame. + `pgtk' for an Emacs frame using pure GTK facilities. + `haiku' for an Emacs frame running in Haiku. FRAME defaults to the currently selected frame. @@ -327,7 +335,7 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size, * additionally limit the minimum frame height to a value large enough * to support menu bar, tab bar, mode line and echo area. */ -int +static int frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal, Lisp_Object ignore, Lisp_Object pixelwise) { @@ -1979,6 +1987,14 @@ delete_frame (Lisp_Object frame, Lisp_Object force) else error ("Attempt to delete the only frame"); } +#ifdef HAVE_X_WINDOWS + else if (x_dnd_in_progress && f == x_dnd_frame) + error ("Attempt to delete the drop source frame"); +#endif +#ifdef HAVE_HAIKU + else if (f == haiku_dnd_frame) + error ("Attempt to delete the drop source frame"); +#endif XSETFRAME (frame, f); @@ -2212,7 +2228,8 @@ delete_frame (Lisp_Object frame, Lisp_Object force) /* Since a similar behavior was observed on the Lucid and Motif builds (see Bug#5802, Bug#21509, Bug#23499, Bug#27816), we now don't delete the terminal for these builds either. */ - if (terminal->reference_count == 0 && terminal->type == output_x_window) + if (terminal->reference_count == 0 && + (terminal->type == output_x_window || terminal->type == output_pgtk)) terminal->reference_count = 1; #endif /* USE_X_TOOLKIT || USE_GTK */ if (terminal->reference_count == 0) @@ -2373,9 +2390,12 @@ delete_frame (Lisp_Object frame, Lisp_Object force) } DEFUN ("delete-frame", Fdelete_frame, Sdelete_frame, 0, 2, "", - doc: /* Delete FRAME, permanently eliminating it from use. + doc: /* Delete FRAME, eliminating it from use. FRAME must be a live frame and defaults to the selected one. +When `undelete-frame-mode' is enabled, the 16 most recently deleted +frames can be undeleted with `undelete-frame', which see. + A frame may not be deleted if its minibuffer serves as surrogate minibuffer for another frame. Normally, you may not delete a frame if all other frames are invisible, but if the second optional argument @@ -2493,9 +2513,12 @@ vertical offset, measured in units of the frame's default character size. If Emacs is running on a mouseless terminal or hasn't been programmed to read the mouse position, it returns the selected frame for FRAME and nil for X and Y. -If `mouse-position-function' is non-nil, `mouse-position' calls it, -passing the normal return value to that function as an argument, -and returns whatever that function returns. */) + +FRAME might be nil if `track-mouse' is set to `drag-source'. This +means there is no frame under the mouse. If `mouse-position-function' +is non-nil, `mouse-position' calls it, passing the normal return value +to that function as an argument, and returns whatever that function +returns. */) (void) { return mouse_position (true); @@ -2522,7 +2545,7 @@ mouse_position (bool call_mouse_position_function) &time_dummy); } - if (! NILP (x)) + if (! NILP (x) && f) { int col = XFIXNUM (x); int row = XFIXNUM (y); @@ -2530,7 +2553,10 @@ mouse_position (bool call_mouse_position_function) XSETINT (x, col); XSETINT (y, row); } - XSETFRAME (lispy_dummy, f); + if (f) + XSETFRAME (lispy_dummy, f); + else + lispy_dummy = Qnil; retval = Fcons (lispy_dummy, Fcons (x, y)); if (call_mouse_position_function && !NILP (Vmouse_position_function)) retval = call1 (Vmouse_position_function, retval); @@ -2543,9 +2569,11 @@ DEFUN ("mouse-pixel-position", Fmouse_pixel_position, The position is given in pixel units, where (0, 0) is the upper-left corner of the frame, X is the horizontal offset, and Y is the vertical offset. -If Emacs is running on a mouseless terminal or hasn't been programmed -to read the mouse position, it returns the selected frame for FRAME -and nil for X and Y. */) +FRAME might be nil if `track-mouse' is set to `drag-source'. This +means there is no frame under the mouse. If Emacs is running on a +mouseless terminal or hasn't been programmed to read the mouse +position, it returns the selected frame for FRAME and nil for X and +Y. */) (void) { struct frame *f; @@ -2566,7 +2594,11 @@ and nil for X and Y. */) &time_dummy); } - XSETFRAME (lispy_dummy, f); + if (f) + XSETFRAME (lispy_dummy, f); + else + lispy_dummy = Qnil; + retval = Fcons (lispy_dummy, Fcons (x, y)); if (!NILP (Vmouse_position_function)) retval = call1 (Vmouse_position_function, retval); @@ -3483,7 +3515,10 @@ DEFUN ("frame-native-width", Fframe_native_width, Sframe_native_width, 0, 1, 0, doc: /* Return FRAME's native width in pixels. For a terminal frame, the result really gives the width in characters. -If FRAME is omitted or nil, the selected frame is used. */) +If FRAME is omitted or nil, the selected frame is used. + +If you're interested only in the width of the text portion of the +frame, see `frame-text-width' instead. */) (Lisp_Object frame) { struct frame *f = decode_any_frame (frame); @@ -3507,6 +3542,9 @@ minibuffer or echo area), mode line, and header line. It does not include the tool bar or menu bar. With other graphical versions, it may also include the tool bar and the menu bar. +If you're interested only in the height of the text portion of the +frame, see `frame-text-height' instead. + For a text terminal, it includes the menu bar. In this case, the result is really in characters rather than pixels (i.e., is identical to `frame-height'). */) @@ -3895,6 +3933,10 @@ static const struct frame_parm_table frame_parms[] = {"z-group", SYMBOL_INDEX (Qz_group)}, {"override-redirect", SYMBOL_INDEX (Qoverride_redirect)}, {"no-special-glyphs", SYMBOL_INDEX (Qno_special_glyphs)}, + {"alpha-background", SYMBOL_INDEX (Qalpha_background)}, +#ifdef HAVE_X_WINDOWS + {"shaded", SYMBOL_INDEX (Qshaded)}, +#endif #ifdef NS_IMPL_COCOA {"ns-appearance", SYMBOL_INDEX (Qns_appearance)}, {"ns-transparent-titlebar", SYMBOL_INDEX (Qns_transparent_titlebar)}, @@ -5012,6 +5054,34 @@ gui_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } } +void +gui_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + double alpha = 1.0; + + if (NILP (arg)) + alpha = 1.0; + else if (FLOATP (arg)) + { + alpha = XFLOAT_DATA (arg); + if (! (0 <= alpha && alpha <= 1.0)) + args_out_of_range (make_float (0.0), make_float (1.0)); + } + else if (FIXNUMP (arg)) + { + EMACS_INT ialpha = XFIXNUM (arg); + if (! (0 <= ialpha && ialpha <= 100)) + args_out_of_range (make_fixnum (0), make_fixnum (100)); + alpha = ialpha / 100.0; + } + else + wrong_type_argument (Qnumberp, arg); + + f->alpha_background = alpha; + + recompute_basic_faces (f); + SET_FRAME_GARBAGED (f); +} /** * gui_set_no_special_glyphs: @@ -5028,8 +5098,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. */ @@ -5054,8 +5122,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. @@ -5897,7 +5963,7 @@ This function is for internal use only. */) #ifdef HAVE_WINDOW_SYSTEM -# if (defined USE_GTK || defined HAVE_NS || defined HAVE_XINERAMA \ +# if (defined USE_GTK || defined HAVE_PGTK || defined HAVE_NS || defined HAVE_XINERAMA \ || defined HAVE_XRANDR) void free_monitors (struct MonitorInfo *monitors, int n_monitors) @@ -5935,6 +6001,10 @@ make_monitor_attribute_list (struct MonitorInfo *monitors, attributes); attributes = Fcons (Fcons (Qframes, AREF (monitor_frames, i)), attributes); +#ifdef HAVE_PGTK + attributes = Fcons (Fcons (Qscale_factor, make_float (mi->scale_factor)), + attributes); +#endif attributes = Fcons (Fcons (Qmm_size, list2i (mi->mm_width, mi->mm_height)), attributes); @@ -6024,6 +6094,8 @@ syms_of_frame (void) DEFSYM (Qw32, "w32"); DEFSYM (Qpc, "pc"); DEFSYM (Qns, "ns"); + DEFSYM (Qpgtk, "pgtk"); + DEFSYM (Qhaiku, "haiku"); DEFSYM (Qvisible, "visible"); DEFSYM (Qbuffer_predicate, "buffer-predicate"); DEFSYM (Qbuffer_list, "buffer-list"); @@ -6041,11 +6113,15 @@ syms_of_frame (void) DEFSYM (Qfullheight, "fullheight"); DEFSYM (Qfullboth, "fullboth"); DEFSYM (Qmaximized, "maximized"); + DEFSYM (Qshaded, "shaded"); DEFSYM (Qx_resource_name, "x-resource-name"); DEFSYM (Qx_frame_parameter, "x-frame-parameter"); DEFSYM (Qworkarea, "workarea"); DEFSYM (Qmm_size, "mm-size"); +#ifdef HAVE_PGTK + DEFSYM (Qscale_factor, "scale-factor"); +#endif DEFSYM (Qframes, "frames"); DEFSYM (Qsource, "source"); @@ -6083,6 +6159,7 @@ syms_of_frame (void) #endif DEFSYM (Qalpha, "alpha"); + DEFSYM (Qalpha_background, "alpha-background"); DEFSYM (Qauto_lower, "auto-lower"); DEFSYM (Qauto_raise, "auto-raise"); DEFSYM (Qborder_color, "border-color"); @@ -6182,14 +6259,24 @@ You can also use a floating number between 0.0 and 1.0. */); doc: /* Alist of default values for frame creation. These may be set in your init file, like this: (setq default-frame-alist \\='((width . 80) (height . 55) (menu-bar-lines . 1))) + These override values given in window system configuration data, - including X Windows' defaults database. +including X Windows' defaults database. + +Note that many display-related modes (like `scroll-bar-mode' or +`menu-bar-mode') alter `default-frame-alist', so if you set this +variable directly, you may be overriding other settings +unintentionally. Instead it's often better to use +`modify-all-frames-parameters' or push new elements to the front of +this alist. + For values specific to the first Emacs frame, see `initial-frame-alist'. + For window-system specific values, see `window-system-default-frame-alist'. + For values specific to the separate minibuffer frame, see - `minibuffer-frame-alist'. -The `menu-bar-lines' element of the list controls whether new frames - have menu bars; `menu-bar-mode' works by altering this element. +`minibuffer-frame-alist'. + Setting this variable does not affect existing frames, only new ones. */); Vdefault_frame_alist = Qnil; @@ -6209,7 +6296,7 @@ Setting this variable does not affect existing frames, only new ones. */); DEFVAR_BOOL ("scroll-bar-adjust-thumb-portion", scroll_bar_adjust_thumb_portion_p, - doc: /* Adjust thumb for overscrolling for Gtk+ and MOTIF. + doc: /* Adjust scroll bars for overscrolling for Gtk+, Motif and Haiku. Non-nil means adjust the thumb in the scroll bar so it can be dragged downwards even if the end of the buffer is shown (i.e. overscrolling). Set to nil if you want the thumb to be at the bottom when the end of the buffer @@ -6455,6 +6542,14 @@ This variable is effective only with the X toolkit (and there only when Gtk+ tooltips are not used) and on Windows. */); tooltip_reuse_hidden_frame = false; + DEFVAR_BOOL ("use-system-tooltips", use_system_tooltips, + doc: /* Use the toolkit to display tooltips. +This option is only meaningful when Emacs is built with GTK+ or Haiku +windowing support, and results in tooltips that look like those +displayed by other GTK+ or Haiku programs, but will not be able to +display text properties inside tooltip text. */); + use_system_tooltips = true; + DEFVAR_LISP ("iconify-child-frame", iconify_child_frame, doc: /* How to handle iconification of child frames. This variable tells Emacs how to proceed when it is asked to iconify a @@ -6470,6 +6565,14 @@ making the child frame unresponsive to user actions, the default is to iconify the top level frame instead. */); iconify_child_frame = Qiconify_top_level; + DEFVAR_LISP ("frame-internal-parameters", frame_internal_parameters, + doc: /* Frame parameters specific to every frame. */); +#ifdef HAVE_X_WINDOWS + frame_internal_parameters = list4 (Qname, Qparent_id, Qwindow_id, Qouter_window_id); +#else + frame_internal_parameters = list3 (Qname, Qparent_id, Qwindow_id); +#endif + defsubr (&Sframep); defsubr (&Sframe_live_p); defsubr (&Swindow_system); diff --git a/src/frame.h b/src/frame.h index 0b8cdf62ded..4942e640d27 100644 --- a/src/frame.h +++ b/src/frame.h @@ -102,6 +102,10 @@ struct frame Lisp_Object parent_frame; #endif /* HAVE_WINDOW_SYSTEM */ + /* Last device to move over this frame. Any value that isn't a + string means the "Virtual core pointer". */ + Lisp_Object last_mouse_device; + /* The frame which should receive keystrokes that occur in this frame, or nil if they should go to the frame itself. This is usually nil, but if the frame is minibufferless, we can use this @@ -585,6 +589,8 @@ struct frame struct x_output *x; /* From xterm.h. */ struct w32_output *w32; /* From w32term.h. */ struct ns_output *ns; /* From nsterm.h. */ + struct pgtk_output *pgtk; /* From pgtkterm.h. */ + struct haiku_output *haiku; /* From haikuterm.h. */ } output_data; @@ -635,6 +641,9 @@ struct frame Negative values mean not to change alpha. */ double alpha[2]; + /* Background opacity */ + double alpha_background; + /* Exponent for gamma correction of colors. 1/(VIEWING_GAMMA * SCREEN_GAMMA) where viewing_gamma is 0.4545 and SCREEN_GAMMA is a frame parameter. 0 means don't do gamma correction. */ @@ -852,6 +861,16 @@ default_pixels_per_inch_y (void) #else #define FRAME_NS_P(f) ((f)->output_method == output_ns) #endif +#ifndef HAVE_PGTK +#define FRAME_PGTK_P(f) false +#else +#define FRAME_PGTK_P(f) ((f)->output_method == output_pgtk) +#endif +#ifndef HAVE_HAIKU +#define FRAME_HAIKU_P(f) false +#else +#define FRAME_HAIKU_P(f) ((f)->output_method == output_haiku) +#endif /* FRAME_WINDOW_P tests whether the frame is a graphical window system frame. */ @@ -864,6 +883,12 @@ default_pixels_per_inch_y (void) #ifdef HAVE_NS #define FRAME_WINDOW_P(f) FRAME_NS_P(f) #endif +#ifdef HAVE_PGTK +#define FRAME_WINDOW_P(f) FRAME_PGTK_P(f) +#endif +#ifdef HAVE_HAIKU +#define FRAME_WINDOW_P(f) FRAME_HAIKU_P (f) +#endif #ifndef FRAME_WINDOW_P #define FRAME_WINDOW_P(f) ((void) (f), false) #endif @@ -916,6 +941,8 @@ default_pixels_per_inch_y (void) /* Scale factor of frame F. */ #if defined HAVE_NS # define FRAME_SCALE_FACTOR(f) (FRAME_NS_P (f) ? ns_frame_scale_factor (f) : 1) +#elif defined HAVE_PGTK +# define FRAME_SCALE_FACTOR(f) (FRAME_PGTK_P (f) ? pgtk_frame_scale_factor (f) : 1) #else # define FRAME_SCALE_FACTOR(f) 1 #endif @@ -1315,8 +1342,6 @@ extern bool frame_inhibit_resize (struct frame *, bool, Lisp_Object); extern void adjust_frame_size (struct frame *, int, int, int, bool, Lisp_Object); extern Lisp_Object mouse_position (bool); -extern int frame_windows_min_size (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object); extern void frame_size_history_plain (struct frame *, Lisp_Object); extern void frame_size_history_extra (struct frame *, Lisp_Object, int, int, int, int, int, int); @@ -1649,6 +1674,7 @@ extern void gui_set_scroll_bar_height (struct frame *, Lisp_Object, Lisp_Object) extern long gui_figure_window_size (struct frame *, Lisp_Object, bool, bool); extern void gui_set_alpha (struct frame *, Lisp_Object, Lisp_Object); +extern void gui_set_alpha_background (struct frame *, Lisp_Object, Lisp_Object); extern void gui_set_no_special_glyphs (struct frame *, Lisp_Object, Lisp_Object); extern void validate_x_resource_name (void); @@ -1673,7 +1699,7 @@ extern const char *x_get_resource_string (const char *, const char *); extern void x_sync (struct frame *); #endif /* HAVE_X_WINDOWS */ -#ifndef HAVE_NS +#if !defined (HAVE_NS) && !defined (HAVE_PGTK) /* Set F's bitmap icon, if specified among F's parameters. */ @@ -1709,6 +1735,9 @@ struct MonitorInfo { Emacs_Rectangle geom, work; int mm_width, mm_height; char *name; +#ifdef HAVE_PGTK + double scale_factor; +#endif }; extern void free_monitors (struct MonitorInfo *monitors, int n_monitors); diff --git a/src/fringe.c b/src/fringe.c index 14148a67ab1..bf0b5fde761 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -30,6 +30,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "termhooks.h" #include "pdumper.h" +#ifdef HAVE_PGTK +# include "pgtkterm.h" +#endif + /* Fringe bitmaps are represented in three different ways: Logical bitmaps are used internally to denote things like @@ -969,7 +973,7 @@ update_window_fringes (struct window *w, bool keep_current_p) if (w->pseudo_window_p) return 0; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* This function could be called for redisplaying non-selected windows, in which case point has been temporarily moved to that @@ -1408,7 +1412,7 @@ If BITMAP overrides a standard fringe bitmap, the original bitmap is restored. On W32 and MAC (little endian), there's no need to do this. */ -#if defined (HAVE_X_WINDOWS) +#if defined (HAVE_X_WINDOWS) || defined (HAVE_PGTK) static const unsigned char swap_nibble[16] = { 0x0, 0x8, 0x4, 0xc, /* 0000 1000 0100 1100 */ 0x2, 0xa, 0x6, 0xe, /* 0010 1010 0110 1110 */ @@ -1471,6 +1475,25 @@ init_fringe_bitmap (int which, struct fringe_bitmap *fb, int once_p) #endif /* not USE_CAIRO */ #endif /* HAVE_X_WINDOWS */ +#if !defined(HAVE_X_WINDOWS) && defined (HAVE_PGTK) + unsigned short *bits = fb->bits; + int j; + + for (j = 0; j < fb->height; j++) + { + unsigned short b = *bits; +#ifdef WORDS_BIGENDIAN + *bits++ = (b << (16 - fb->width)); +#else + b = (unsigned short)((swap_nibble[b & 0xf] << 12) + | (swap_nibble[(b>>4) & 0xf] << 8) + | (swap_nibble[(b>>8) & 0xf] << 4) + | (swap_nibble[(b>>12) & 0xf])); + *bits++ = (b >> (16 - fb->width)); +#endif + } +#endif /* !HAVE_X_WINDOWS && HAVE_PGTK */ + #ifdef HAVE_NTGUI unsigned short *bits = fb->bits; int j; diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 39ea068556b..98a28af5f22 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -22,7 +22,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <cairo-ft.h> #include "lisp.h" +#ifdef HAVE_X_WINDOWS #include "xterm.h" +#elif HAVE_HAIKU +#include "haikuterm.h" +#include "haiku_support.h" +#include "termchar.h" +#else +#include "pgtkterm.h" +#endif #include "blockinput.h" #include "charset.h" #include "composite.h" @@ -30,6 +38,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "ftfont.h" #include "pdumper.h" +#ifdef USE_BE_CAIRO +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) +#endif + #define METRICS_NCOLS_PER_ROW (128) enum metrics_status @@ -155,6 +169,10 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) cairo_matrix_init_scale (&font_matrix, pixel_size, pixel_size); cairo_matrix_init_identity (&ctm); cairo_font_options_t *options = cairo_font_options_create (); +#ifdef USE_BE_CAIRO + if (be_use_subpixel_antialiasing ()) + cairo_font_options_set_antialias (options, CAIRO_ANTIALIAS_SUBPIXEL); +#endif cairo_scaled_font_t *scaled_font = cairo_scaled_font_create (font_face, &font_matrix, &ctm, options); cairo_font_face_destroy (font_face); @@ -504,22 +522,65 @@ ftcrfont_draw (struct glyph_string *s, int from, int to, int x, int y, bool with_background) { struct frame *f = s->f; - struct face *face = s->face; struct font_info *ftcrfont_info = (struct font_info *) s->font; cairo_t *cr; cairo_glyph_t *glyphs; int len = to - from; int i; +#ifdef USE_BE_CAIRO + unsigned long be_foreground, be_background; + + if (s->hl != DRAW_CURSOR) + { + be_foreground = s->face->foreground; + be_background = s->face->background; + } + else + haiku_merge_cursor_foreground (s, &be_foreground, + &be_background); +#endif block_input (); +#ifndef USE_BE_CAIRO +#ifdef HAVE_X_WINDOWS cr = x_begin_cr_clip (f, s->gc); +#else + cr = pgtk_begin_cr_clip (f); +#endif +#else + /* Presumably the draw lock is already held by + haiku_draw_glyph_string. */ + EmacsWindow_begin_cr_critical_section (FRAME_HAIKU_WINDOW (f)); + cr = haiku_begin_cr_clip (f, s); + if (!cr) + { + EmacsWindow_end_cr_critical_section (FRAME_HAIKU_WINDOW (f)); + unblock_input (); + return 0; + } + BView_cr_dump_clipping (FRAME_HAIKU_VIEW (f), cr); +#endif if (with_background) { - x_set_cr_source_with_gc_background (f, s->gc); - cairo_rectangle (cr, x, y - FONT_BASE (face->font), - s->width, FONT_HEIGHT (face->font)); +#ifndef USE_BE_CAIRO +#ifdef HAVE_X_WINDOWS + x_set_cr_source_with_gc_background (f, s->gc, s->hl != DRAW_CURSOR); +#else + pgtk_set_cr_source_with_color (f, s->xgcv.background, + s->hl != DRAW_CURSOR); +#endif +#else + uint32_t col = be_background; + + cairo_set_source_rgb (cr, RED_FROM_ULONG (col) / 255.0, + GREEN_FROM_ULONG (col) / 255.0, + BLUE_FROM_ULONG (col) / 255.0); +#endif + s->background_filled_p = 1; + cairo_rectangle (cr, x, y - FONT_BASE (s->font), + s->width, FONT_HEIGHT (s->font)); cairo_fill (cr); } @@ -533,13 +594,31 @@ ftcrfont_draw (struct glyph_string *s, glyphs[i].index, NULL)); } +#ifndef USE_BE_CAIRO +#ifdef HAVE_X_WINDOWS + x_set_cr_source_with_gc_foreground (f, s->gc, false); +#else + pgtk_set_cr_source_with_color (f, s->xgcv.foreground, false); +#endif +#else + uint32_t col = be_foreground; - x_set_cr_source_with_gc_foreground (f, s->gc); + cairo_set_source_rgb (cr, RED_FROM_ULONG (col) / 255.0, + GREEN_FROM_ULONG (col) / 255.0, + BLUE_FROM_ULONG (col) / 255.0); +#endif cairo_set_scaled_font (cr, ftcrfont_info->cr_scaled_font); cairo_show_glyphs (cr, glyphs, len); - +#ifndef USE_BE_CAIRO +#ifdef HAVE_X_WINDOWS x_end_cr_clip (f); - +#else + pgtk_end_cr_clip (f); +#endif +#else + haiku_end_cr_clip (cr); + EmacsWindow_end_cr_critical_section (FRAME_HAIKU_WINDOW (f)); +#endif unblock_input (); return len; diff --git a/src/ftfont.c b/src/ftfont.c index f457505fb3b..5797300d231 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -189,6 +189,24 @@ ftfont_pattern_entity (FcPattern *p, Lisp_Object extra) return Qnil; if (FcPatternGetInteger (p, FC_INDEX, 0, &idx) != FcResultMatch) return Qnil; +#ifdef FC_VARIABLE + /* This is a virtual/meta FcPattern for a variable weight font, from + which it is possible to extract an FcRange value specifying the + minimum and maximum weights available in this file. We don't + need to know that information explicitly, so skip it. We will be + called with an FcPattern for each actually available, non-virtual + weight. + + Fontconfig started generating virtual/meta patterns for variable + weight fonts in the same release that FC_VARIABLE was added, so + we conditionalize on that constant. This also ensures that + FcPatternGetRange is available. */ + FcRange *range; + if (FcPatternGetRange (p, FC_WEIGHT, 0, &range) == FcResultMatch + && FcPatternGetBool (p, FC_VARIABLE, 0, &b) == FcResultMatch + && b == FcTrue) + return Qnil; +#endif /* FC_VARIABLE */ file = (char *) str; key = Fcons (build_unibyte_string (file), make_fixnum (idx)); @@ -225,8 +243,6 @@ ftfont_pattern_entity (FcPattern *p, Lisp_Object extra) } if (FcPatternGetInteger (p, FC_WEIGHT, 0, &numeric) == FcResultMatch) { - if (numeric >= FC_WEIGHT_REGULAR && numeric < FC_WEIGHT_MEDIUM) - numeric = FC_WEIGHT_MEDIUM; FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX, make_fixnum (numeric)); } if (FcPatternGetInteger (p, FC_SLANT, 0, &numeric) == FcResultMatch) @@ -865,6 +881,9 @@ ftfont_list (struct frame *f, Lisp_Object spec) #if defined HAVE_XFT && defined FC_COLOR FC_COLOR, #endif +#ifdef FC_VARIABLE + FC_VARIABLE, +#endif /* FC_VARIABLE */ NULL); if (! objset) goto err; @@ -3110,6 +3129,10 @@ syms_of_ftfont (void) Fput (Qfreetype, Qfont_driver_superseded_by, Qfreetypehb); #endif /* HAVE_HARFBUZZ */ +#ifdef HAVE_HAIKU + DEFSYM (Qmono, "mono"); +#endif + /* Fontconfig's generic families and their aliases. */ DEFSYM (Qmonospace, "monospace"); DEFSYM (Qsans_serif, "sans-serif"); diff --git a/src/ftfont.h b/src/ftfont.h index f771dc159b0..cfab8d3154f 100644 --- a/src/ftfont.h +++ b/src/ftfont.h @@ -25,10 +25,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <ft2build.h> #include FT_FREETYPE_H #include FT_SIZES_H +#include FT_TRUETYPE_TABLES_H #ifdef FT_BDF_H # include FT_BDF_H #endif +#ifdef USE_BE_CAIRO +#include <cairo.h> +#endif + #ifdef HAVE_HARFBUZZ #include <hb.h> #include <hb-ft.h> @@ -62,7 +67,7 @@ struct font_info hb_font_t *hb_font; #endif /* HAVE_HARFBUZZ */ -#ifdef USE_CAIRO +#if defined (USE_CAIRO) || defined (USE_BE_CAIRO) cairo_scaled_font_t *cr_scaled_font; /* Scale factor from the bitmap strike metrics in 1/64 pixels, used as the hb_position_t value in HarfBuzz, to those in (scaled) diff --git a/src/gnutls.c b/src/gnutls.c index 3ec38370679..0e1e63e157a 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -616,6 +616,9 @@ gnutls_try_handshake (struct Lisp_Process *proc) gnutls_session_t state = proc->gnutls_state; int ret; bool non_blocking = proc->is_non_blocking_client; + /* Sleep for ten milliseconds when busy-looping in + gnutls_handshake. */ + struct timespec delay = { 0, 1000 * 1000 * 10 }; if (proc->gnutls_complete_negotiation_p) non_blocking = false; @@ -630,6 +633,7 @@ gnutls_try_handshake (struct Lisp_Process *proc) maybe_quit (); if (non_blocking && ret != GNUTLS_E_INTERRUPTED) break; + nanosleep (&delay, NULL); } proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED; @@ -1517,7 +1521,7 @@ returned as the :certificate entry. */) /* Initialize global GnuTLS state to defaults. Call 'gnutls-global-deinit' when GnuTLS usage is no longer needed. Return zero on success. */ -Lisp_Object +static Lisp_Object emacs_gnutls_global_init (void) { int ret = GNUTLS_E_SUCCESS; diff --git a/src/gnutls.h b/src/gnutls.h index 791e5340c2d..19d3d3f5bc6 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -90,7 +90,6 @@ extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err); extern int w32_gnutls_rnd (gnutls_rnd_level_t, void *, size_t); #endif extern Lisp_Object emacs_gnutls_deinit (Lisp_Object); -extern Lisp_Object emacs_gnutls_global_init (void); extern int gnutls_try_handshake (struct Lisp_Process *p); extern Lisp_Object gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist); diff --git a/src/gtkutil.c b/src/gtkutil.c index 45a78fc382f..718da171f49 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -17,13 +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/>. */ -/* FIXME: This code is problematic; it misuses GTK, so the GTK - developers don't think they should fix the resulting problems in GTK - itself. The right way to fix this is by rewriting the code in Emacs - to use GTK3 properly. As of 2020, there is a project to do this. - Talk with Yuuki Harano <masm+emacs@masm11.me> if you are interested - in doing substantial work on this. */ - #include <config.h> #ifdef USE_GTK @@ -37,7 +30,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "dispextern.h" #include "frame.h" #include "systime.h" +#ifndef HAVE_PGTK #include "xterm.h" +#define xp x +typedef struct x_output xp_output; +#else +#define xp pgtk +typedef struct pgtk_output xp_output; +#endif #include "blockinput.h" #include "window.h" #include "gtkutil.h" @@ -47,12 +47,18 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <gdk/gdkkeysyms.h> +#ifdef HAVE_XINPUT2 +#include <X11/extensions/XInput2.h> +#endif + #ifdef HAVE_XFT #include <X11/Xft/Xft.h> #endif #ifdef HAVE_GTK3 +#ifndef HAVE_PGTK #include <gtk/gtkx.h> +#endif #include "emacsgtkfixed.h" #endif @@ -70,6 +76,34 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #define XG_TEXT_OPEN GTK_STOCK_OPEN #endif +#ifdef HAVE_GTK3 +static void emacs_menu_bar_get_preferred_width (GtkWidget *, gint *, gint *); +static GType emacs_menu_bar_get_type (void); + +typedef struct _EmacsMenuBar +{ + GtkMenuBar parent; +} EmacsMenuBar; + +typedef struct _EmacsMenuBarClass +{ + GtkMenuBarClass parent; +} EmacsMenuBarClass; + +G_DEFINE_TYPE (EmacsMenuBar, emacs_menu_bar, GTK_TYPE_MENU_BAR) +#endif + +#ifndef HAVE_PGTK +static void xg_im_context_commit (GtkIMContext *, gchar *, gpointer); +static void xg_im_context_preedit_changed (GtkIMContext *, gpointer); +static void xg_im_context_preedit_end (GtkIMContext *, gpointer); +static bool xg_widget_key_press_event_cb (GtkWidget *, GdkEvent *, gpointer); +#endif + +#if GTK_CHECK_VERSION (3, 10, 0) +static void xg_widget_style_updated (GtkWidget *, gpointer); +#endif + #ifndef HAVE_GTK3 #ifdef HAVE_FREETYPE @@ -108,7 +142,46 @@ struct xg_frame_tb_info bool xg_gtk_initialized; /* Used to make sure xwidget calls are possible */ #endif -static GtkWidget * xg_get_widget_from_map (ptrdiff_t idx); +static GtkWidget *xg_get_widget_from_map (ptrdiff_t idx, Display *dpy); + + + +#ifdef HAVE_GTK3 +static void +emacs_menu_bar_init (EmacsMenuBar *menu_bar) +{ + return; +} + +static void +emacs_menu_bar_class_init (EmacsMenuBarClass *klass) +{ + GtkWidgetClass *widget_class; + + widget_class = GTK_WIDGET_CLASS (klass); + widget_class->get_preferred_width = emacs_menu_bar_get_preferred_width; +} + +static void +emacs_menu_bar_get_preferred_width (GtkWidget *widget, + gint *minimum, gint *natural) +{ + GtkWidgetClass *widget_class; + + widget_class = GTK_WIDGET_CLASS (emacs_menu_bar_parent_class); + widget_class->get_preferred_width (widget, minimum, natural); + + if (minimum) + *minimum = 0; +} + +static GtkWidget * +emacs_menu_bar_new (void) +{ + return GTK_WIDGET (g_object_new (emacs_menu_bar_get_type (), NULL)); +} + +#endif /*********************************************************************** @@ -127,6 +200,7 @@ static GdkDisplay *gdpy_def; static void xg_set_screen (GtkWidget *w, struct frame *f) { +#ifndef HAVE_PGTK if (FRAME_X_DISPLAY (f) != DEFAULT_GDK_DISPLAY ()) { GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f)); @@ -137,6 +211,17 @@ xg_set_screen (GtkWidget *w, struct frame *f) else gtk_window_set_screen (GTK_WINDOW (w), gscreen); } +#else + if (FRAME_X_DISPLAY (f) != DEFAULT_GDK_DISPLAY ()) + { + GdkScreen *gscreen = gdk_display_get_default_screen (FRAME_X_DISPLAY (f)); + + if (GTK_IS_MENU (w)) + gtk_menu_set_screen (GTK_MENU (w), gscreen); + else + gtk_window_set_screen (GTK_WINDOW (w), gscreen); + } +#endif } @@ -148,12 +233,20 @@ xg_set_screen (GtkWidget *w, struct frame *f) multiple displays. */ void +#ifndef HAVE_PGTK xg_display_open (char *display_name, Display **dpy) +#else +xg_display_open (char *display_name, GdkDisplay **dpy) +#endif { GdkDisplay *gdpy; unrequest_sigio (); /* See comment in x_display_ok, xterm.c. */ +#ifndef HAVE_PGTK gdpy = gdk_display_open (display_name); +#else + gdpy = gdk_display_open (strlen (display_name) == 0 ? NULL : display_name); +#endif request_sigio (); if (!gdpy_def && gdpy) { @@ -162,13 +255,18 @@ xg_display_open (char *display_name, Display **dpy) gdpy); } +#ifndef HAVE_PGTK *dpy = gdpy ? GDK_DISPLAY_XDISPLAY (gdpy) : NULL; +#else + *dpy = gdpy; +#endif } /* Scaling/HiDPI functions. */ static int xg_get_gdk_scale (void) { +#ifdef HAVE_GTK3 const char *sscale = getenv ("GDK_SCALE"); if (sscale) @@ -177,6 +275,7 @@ xg_get_gdk_scale (void) if (0 < scale) return min (scale, INT_MAX); } +#endif return 1; } @@ -184,6 +283,9 @@ xg_get_gdk_scale (void) int xg_get_scale (struct frame *f) { +#ifdef HAVE_PGTK + return 1; +#endif #ifdef HAVE_GTK3 if (FRAME_GTK_WIDGET (f)) return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f)); @@ -194,8 +296,13 @@ xg_get_scale (struct frame *f) /* Close display DPY. */ void +#ifndef HAVE_PGTK xg_display_close (Display *dpy) +#else +xg_display_close (GdkDisplay *gdpy) +#endif { +#ifndef HAVE_PGTK GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (dpy); /* If this is the default display, try to change it before closing. @@ -219,6 +326,31 @@ xg_display_close (Display *dpy) } gdk_display_close (gdpy); + +#else + + /* If this is the default display, try to change it before closing. + If there is no other display to use, gdpy_def is set to NULL, and + the next call to xg_display_open resets the default display. */ + if (gdk_display_get_default () == gdpy) + { + struct pgtk_display_info *dpyinfo; + GdkDisplay *gdpy_new = NULL; + + /* Find another display. */ + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) + if (dpyinfo->gdpy != gdpy) + { + gdpy_new = dpyinfo->gdpy; + gdk_display_manager_set_default_display (gdk_display_manager_get (), + gdpy_new); + break; + } + gdpy_def = gdpy_new; + } + + gdk_display_close (gdpy); +#endif } @@ -230,12 +362,19 @@ xg_display_close (Display *dpy) scroll bars on display DPY. */ GdkCursor * +#ifndef HAVE_PGTK xg_create_default_cursor (Display *dpy) +#else +xg_create_default_cursor (GdkDisplay *gdpy) +#endif { +#ifndef HAVE_PGTK GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (dpy); +#endif return gdk_cursor_new_for_display (gdpy, GDK_LEFT_PTR); } +#ifndef HAVE_PGTK /* Apply GMASK to GPIX and return a GdkPixbuf with an alpha channel. */ static GdkPixbuf * @@ -335,6 +474,8 @@ xg_get_pixbuf_from_surface (cairo_surface_t *surface) } #endif /* USE_CAIRO && !HAVE_GTK3 */ +#endif /* !HAVE_PGTK */ + static Lisp_Object file_for_image (Lisp_Object image) { @@ -605,8 +746,13 @@ xg_check_special_colors (struct frame *f, block_input (); { #ifdef HAVE_GTK3 +#ifndef HAVE_PGTK GtkStyleContext *gsty = gtk_widget_get_style_context (FRAME_GTK_OUTER_WIDGET (f)); +#else + GtkStyleContext *gsty + = gtk_widget_get_style_context (FRAME_WIDGET (f)); +#endif GdkRGBA col; char buf[sizeof "rgb://rrrr/gggg/bbbb"]; int state = GTK_STATE_FLAG_SELECTED|GTK_STATE_FLAG_FOCUSED; @@ -630,9 +776,14 @@ xg_check_special_colors (struct frame *f, r = col.red * 65535, g = col.green * 65535, b = col.blue * 65535; +#ifndef HAVE_PGTK sprintf (buf, "rgb:%04x/%04x/%04x", r, g, b); success_p = x_parse_color (f, buf, color) != 0; #else + sprintf (buf, "#%04x%04x%04x", r, g, b); + success_p = pgtk_parse_color (f, buf, color) != 0; +#endif +#else GtkStyle *gsty = gtk_widget_get_style (FRAME_GTK_WIDGET (f)); GdkColor *grgb = get_bg ? &gsty->bg[GTK_STATE_SELECTED] @@ -655,6 +806,9 @@ xg_check_special_colors (struct frame *f, /*********************************************************************** Tooltips ***********************************************************************/ + +#ifndef HAVE_PGTK + /* Gtk+ calls this callback when the parent of our tooltip dummy changes. We use that to pop down the tooltip. This happens if Gtk+ for some reason wants to change or hide the tooltip. */ @@ -665,7 +819,7 @@ hierarchy_ch_cb (GtkWidget *widget, gpointer user_data) { struct frame *f = user_data; - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; GtkWidget *top = gtk_widget_get_toplevel (x->ttip_lbl); if (! top || ! GTK_IS_WINDOW (top)) @@ -687,7 +841,7 @@ qttip_cb (GtkWidget *widget, gpointer user_data) { struct frame *f = user_data; - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; if (x->ttip_widget == NULL) { GtkWidget *p; @@ -734,7 +888,7 @@ xg_prepare_tooltip (struct frame *f, int *width, int *height) { - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; GtkWidget *widget; GdkWindow *gwin; GdkScreen *screen; @@ -785,13 +939,19 @@ xg_prepare_tooltip (struct frame *f, void xg_show_tooltip (struct frame *f, int root_x, int root_y) { - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; if (x->ttip_window) { block_input (); +#ifndef HAVE_PGTK gtk_window_move (x->ttip_window, root_x / xg_get_scale (f), root_y / xg_get_scale (f)); gtk_widget_show (GTK_WIDGET (x->ttip_window)); +#else + gtk_widget_show (GTK_WIDGET (x->ttip_window)); + gtk_window_move (x->ttip_window, root_x / xg_get_scale (f), + root_y / xg_get_scale (f)); +#endif unblock_input (); } } @@ -803,10 +963,9 @@ xg_show_tooltip (struct frame *f, int root_x, int root_y) bool xg_hide_tooltip (struct frame *f) { - if (f->output_data.x->ttip_window) + if (f->output_data.xp->ttip_window) { - GtkWindow *win = f->output_data.x->ttip_window; - + GtkWindow *win = f->output_data.xp->ttip_window; block_input (); gtk_widget_hide (GTK_WIDGET (win)); @@ -824,6 +983,30 @@ xg_hide_tooltip (struct frame *f) return FALSE; } +#else /* HAVE_PGTK */ + +void +xg_show_tooltip (struct frame *f, + Lisp_Object string) +{ + Lisp_Object encoded_string = ENCODE_UTF_8 (string); + gtk_widget_set_tooltip_text (FRAME_GTK_OUTER_WIDGET (f) + ? FRAME_GTK_OUTER_WIDGET (f) + : FRAME_GTK_WIDGET (f), + SSDATA (encoded_string)); +} + +bool +xg_hide_tooltip (struct frame *f) +{ + if (FRAME_GTK_OUTER_WIDGET (f)) + gtk_widget_set_tooltip_text (FRAME_GTK_OUTER_WIDGET (f), NULL); + gtk_widget_set_tooltip_text (FRAME_GTK_WIDGET (f), NULL); + return TRUE; +} + +#endif /* HAVE_PGTK */ + /*********************************************************************** General functions for creating widgets, resizing, events, e.t.c. @@ -839,6 +1022,27 @@ my_log_handler (const gchar *log_domain, GLogLevelFlags log_level, } #endif +#if defined HAVE_GTK3 && defined HAVE_XINPUT2 +bool +xg_is_menu_window (Display *dpy, Window wdesc) +{ + GtkWidget *gwdesc = xg_win_to_widget (dpy, wdesc); + + if (GTK_IS_WINDOW (gwdesc)) + { + GtkWidget *fw = gtk_bin_get_child (GTK_BIN (gwdesc)); + if (GTK_IS_MENU (fw)) + { + GtkWidget *parent + = gtk_menu_shell_get_parent_shell (GTK_MENU_SHELL (fw)); + return GTK_IS_MENU_BAR (parent); + } + } + + return false; +} +#endif + /* Make a geometry string and pass that to GTK. It seems this is the only way to get geometry position right if the user explicitly asked for a position when starting Emacs. @@ -954,8 +1158,23 @@ xg_frame_set_char_size (struct frame *f, int width, int height) bool was_visible = false; bool hide_child_frame; +#ifndef HAVE_PGTK gtk_window_get_size (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), &gwidth, &gheight); +#else + if (FRAME_GTK_OUTER_WIDGET (f)) + { + gtk_window_get_size (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + &gwidth, &gheight); + } + else + { + GtkAllocation alloc; + gtk_widget_get_allocation (FRAME_GTK_WIDGET (f), &alloc); + gwidth = alloc.width; + gheight = alloc.height; + } +#endif /* Do this before resize, as we don't know yet if we will be resized. */ FRAME_RIF (f)->clear_under_internal_border (f); @@ -975,32 +1194,83 @@ xg_frame_set_char_size (struct frame *f, int width, int height) remain unchanged but giving the frame back its normal size will be broken ... */ if (EQ (fullscreen, Qfullwidth) && width == FRAME_PIXEL_WIDTH (f)) +#ifndef HAVE_PGTK gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), gwidth, outer_height); +#else + if (FRAME_GTK_OUTER_WIDGET (f)) + { + gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + gwidth, outer_height); + } + else + { + gtk_widget_set_size_request (FRAME_GTK_WIDGET (f), + gwidth, outer_height); + } +#endif else if (EQ (fullscreen, Qfullheight) && height == FRAME_PIXEL_HEIGHT (f)) +#ifndef HAVE_PGTK gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), outer_width, gheight); +#else + if (FRAME_GTK_OUTER_WIDGET (f)) + { + gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + outer_width, gheight); + } + else + { + gtk_widget_set_size_request (FRAME_GTK_WIDGET (f), + outer_width, gheight); + } +#endif else if (FRAME_PARENT_FRAME (f) && FRAME_VISIBLE_P (f)) { was_visible = true; +#ifndef HAVE_PGTK hide_child_frame = EQ (x_gtk_resize_child_frames, Qhide); +#else + hide_child_frame = false; +#endif if (outer_width != gwidth || outer_height != gheight) { if (hide_child_frame) { block_input (); +#ifndef HAVE_PGTK gtk_widget_hide (FRAME_GTK_OUTER_WIDGET (f)); +#else + gtk_widget_hide (FRAME_WIDGET (f)); +#endif unblock_input (); } +#ifndef HAVE_PGTK gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), outer_width, outer_height); +#else + if (FRAME_GTK_OUTER_WIDGET (f)) + { + gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + outer_width, outer_height); + } + else + { + gtk_widget_set_size_request (FRAME_GTK_WIDGET (f), + outer_width, outer_height); + } +#endif if (hide_child_frame) { block_input (); +#ifndef HAVE_PGTK gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (f)); +#else + gtk_widget_show_all (FRAME_WIDGET (f)); +#endif unblock_input (); } @@ -1009,8 +1279,21 @@ xg_frame_set_char_size (struct frame *f, int width, int height) } else { +#ifndef HAVE_PGTK gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), outer_width, outer_height); +#else + if (FRAME_GTK_OUTER_WIDGET (f)) + { + gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + outer_width, outer_height); + } + else + { + gtk_widget_set_size_request (FRAME_GTK_WIDGET (f), + outer_width, outer_height); + } +#endif fullscreen = Qnil; } @@ -1035,7 +1318,9 @@ xg_frame_set_char_size (struct frame *f, int width, int height) /* Must call this to flush out events */ (void)gtk_events_pending (); gdk_flush (); +#ifndef HAVE_PGTK x_wait_for_event (f, ConfigureNotify); +#endif if (!NILP (fullscreen)) /* Try to restore fullscreen state. */ @@ -1068,11 +1353,12 @@ xg_height_or_width_changed (struct frame *f) gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), FRAME_TOTAL_PIXEL_WIDTH (f), FRAME_TOTAL_PIXEL_HEIGHT (f)); - f->output_data.x->hint_flags = 0; + f->output_data.xp->hint_flags = 0; x_wm_set_size_hint (f, 0, 0); } #endif +#ifndef HAVE_PGTK /* Convert an X Window WSESC on display DPY to its corresponding GtkWidget. Must be done like this, because GtkWidget:s can have "hidden" X Window that aren't accessible. @@ -1100,6 +1386,7 @@ xg_win_to_widget (Display *dpy, Window wdesc) unblock_input (); return gwdesc; } +#endif /* Set the background of widget W to PIXEL. */ @@ -1107,9 +1394,18 @@ static void xg_set_widget_bg (struct frame *f, GtkWidget *w, unsigned long pixel) { #ifdef HAVE_GTK3 - XColor xbg; + Emacs_Color xbg; xbg.pixel = pixel; +#ifndef HAVE_PGTK if (XQueryColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), &xbg)) +#else + xbg.red = (pixel >> 16) & 0xff; + xbg.green = (pixel >> 8) & 0xff; + xbg.blue = (pixel >> 0) & 0xff; + xbg.red |= xbg.red << 8; + xbg.green |= xbg.green << 8; + xbg.blue |= xbg.blue << 8; +#endif { const char format[] = "* { background-color: #%02x%02x%02x; }"; /* The format is always longer than the resulting string. */ @@ -1144,7 +1440,16 @@ style_changed_cb (GObject *go, struct input_event event; GdkDisplay *gdpy = user_data; const char *display_name = gdk_display_get_name (gdpy); +#ifndef HAVE_PGTK Display *dpy = GDK_DISPLAY_XDISPLAY (gdpy); +#else + GdkDisplay *dpy = gdpy; +#endif + +#ifndef HAVE_PGTK + if (display_name == NULL) + display_name = ""; +#endif EVENT_INIT (event); event.kind = CONFIG_CHANGED_EVENT; @@ -1165,7 +1470,11 @@ style_changed_cb (GObject *go, { struct frame *f = XFRAME (frame); if (FRAME_LIVE_P (f) +#ifndef HAVE_PGTK && FRAME_X_P (f) +#else + && FRAME_PGTK_P (f) +#endif && FRAME_X_DISPLAY (f) == dpy) { FRAME_TERMINAL (f)->set_scroll_bar_default_width_hook (f); @@ -1179,6 +1488,7 @@ style_changed_cb (GObject *go, /* Called when a delete-event occurs on WIDGET. */ +#ifndef HAVE_PGTK static gboolean delete_cb (GtkWidget *widget, GdkEvent *event, @@ -1186,6 +1496,7 @@ delete_cb (GtkWidget *widget, { return TRUE; } +#endif /* Create and set up the GTK widgets for frame F. Return true if creation succeeded. */ @@ -1199,17 +1510,36 @@ xg_create_frame_widgets (struct frame *f) #ifndef HAVE_GTK3 GtkRcStyle *style; #endif +#ifndef HAVE_PGTK + GtkIMContext *imc; +#endif + GtkWindowType type = GTK_WINDOW_TOPLEVEL; char *title = 0; block_input (); +#ifndef HAVE_PGTK /* gtk_plug not found. */ if (FRAME_X_EMBEDDED_P (f)) { GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f)); - wtop = gtk_plug_new_for_display (gdpy, f->output_data.x->parent_desc); + wtop = gtk_plug_new_for_display (gdpy, f->output_data.xp->parent_desc); } else - wtop = gtk_window_new (GTK_WINDOW_TOPLEVEL); + wtop = gtk_window_new (type); +#else + if (f->tooltip) + { + type = GTK_WINDOW_POPUP; + } + wtop = gtk_window_new (type); + gtk_widget_add_events (wtop, GDK_ALL_EVENTS_MASK); +#endif + + gtk_widget_set_app_paintable (wtop, f->alpha_background != 1.0); +#if GTK_CHECK_VERSION (3, 10, 0) + g_signal_connect (G_OBJECT (wtop), "style-updated", + G_CALLBACK (xg_widget_style_updated), f); +#endif /* gtk_window_set_has_resize_grip is a Gtk+ 3.0 function but Ubuntu has backported it to Gtk+ 2.0 and they add the resize grip for @@ -1266,8 +1596,8 @@ xg_create_frame_widgets (struct frame *f) FRAME_GTK_OUTER_WIDGET (f) = wtop; FRAME_GTK_WIDGET (f) = wfixed; - f->output_data.x->vbox_widget = wvbox; - f->output_data.x->hbox_widget = whbox; + f->output_data.xp->vbox_widget = wvbox; + f->output_data.xp->hbox_widget = whbox; gtk_widget_set_has_window (wfixed, TRUE); @@ -1282,11 +1612,11 @@ xg_create_frame_widgets (struct frame *f) with regular X drawing primitives, so from a GTK/GDK point of view, the widget is totally blank. When an expose comes, this will make the widget blank, and then Emacs redraws it. This flickers - a lot, so we turn off double buffering. - FIXME: gtk_widget_set_double_buffered is deprecated and might stop - working in the future. We need to migrate away from combining - X and GTK+ drawing to a pure GTK+ build. */ + a lot, so we turn off double buffering. */ + +#ifndef HAVE_PGTK gtk_widget_set_double_buffered (wfixed, FALSE); +#endif #if ! GTK_CHECK_VERSION (3, 22, 0) gtk_window_set_wmclass (GTK_WINDOW (wtop), @@ -1294,10 +1624,12 @@ xg_create_frame_widgets (struct frame *f) SSDATA (Vx_resource_class)); #endif +#ifndef HAVE_PGTK /* Add callback to do nothing on WM_DELETE_WINDOW. The default in GTK is to destroy the widget. We want Emacs to do that instead. */ g_signal_connect (G_OBJECT (wtop), "delete-event", G_CALLBACK (delete_cb), f); +#endif /* Convert our geometry parameters into a geometry string and specify it. @@ -1308,7 +1640,9 @@ xg_create_frame_widgets (struct frame *f) gtk_widget_add_events (wfixed, GDK_POINTER_MOTION_MASK +#ifndef HAVE_PGTK | GDK_EXPOSURE_MASK +#endif | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK | GDK_KEY_PRESS_MASK @@ -1316,13 +1650,34 @@ xg_create_frame_widgets (struct frame *f) | GDK_LEAVE_NOTIFY_MASK | GDK_FOCUS_CHANGE_MASK | GDK_STRUCTURE_MASK +#ifdef HAVE_PGTK + | GDK_SCROLL_MASK + | GDK_SMOOTH_SCROLL_MASK +#endif | GDK_VISIBILITY_NOTIFY_MASK); + GdkScreen *screen = gtk_widget_get_screen (wtop); + +#if !defined HAVE_PGTK + GdkVisual *visual = gdk_x11_screen_lookup_visual (screen, + XVisualIDFromVisual (FRAME_X_VISUAL (f))); + + if (!visual) + emacs_abort (); +#else + GdkVisual *visual = gdk_screen_get_rgba_visual (screen); +#endif + + gtk_widget_set_visual (wtop, visual); + gtk_widget_set_visual (wfixed, visual); + +#ifndef HAVE_PGTK /* Must realize the windows so the X window gets created. It is used by callers of this function. */ gtk_widget_realize (wfixed); FRAME_X_WINDOW (f) = GTK_WIDGET_TO_X_WIN (wfixed); initial_set_up_x_back_buffer (f); +#endif /* Since GTK clears its window by filling with the background color, we must keep X and GTK background in sync. */ @@ -1337,8 +1692,12 @@ xg_create_frame_widgets (struct frame *f) /* Must use g_strdup because gtk_widget_modify_style does g_free. */ style->bg_pixmap_name[GTK_STATE_NORMAL] = g_strdup ("<none>"); gtk_widget_modify_style (wfixed, style); + gtk_widget_set_can_focus (wfixed, TRUE); #else gtk_widget_set_can_focus (wfixed, TRUE); +#ifdef HAVE_PGTK + gtk_widget_grab_focus (wfixed); +#endif gtk_window_set_resizable (GTK_WINDOW (wtop), TRUE); #endif @@ -1351,14 +1710,31 @@ xg_create_frame_widgets (struct frame *f) } /* Steal a tool tip window we can move ourselves. */ - f->output_data.x->ttip_widget = 0; - f->output_data.x->ttip_lbl = 0; - f->output_data.x->ttip_window = 0; + f->output_data.xp->ttip_widget = 0; + f->output_data.xp->ttip_lbl = 0; + f->output_data.xp->ttip_window = 0; +#ifndef HAVE_PGTK gtk_widget_set_tooltip_text (wtop, "Dummy text"); g_signal_connect (wtop, "query-tooltip", G_CALLBACK (qttip_cb), f); + imc = gtk_im_multicontext_new (); + g_object_ref (imc); + gtk_im_context_set_use_preedit (imc, TRUE); + + g_signal_connect (G_OBJECT (imc), "commit", + G_CALLBACK (xg_im_context_commit), f); + g_signal_connect (G_OBJECT (imc), "preedit-changed", + G_CALLBACK (xg_im_context_preedit_changed), NULL); + g_signal_connect (G_OBJECT (imc), "preedit-end", + G_CALLBACK (xg_im_context_preedit_end), NULL); + FRAME_X_OUTPUT (f)->im_context = imc; + + g_signal_connect (G_OBJECT (wfixed), "key-press-event", + G_CALLBACK (xg_widget_key_press_event_cb), + NULL); +#endif + { - GdkScreen *screen = gtk_widget_get_screen (wtop); GtkSettings *gs = gtk_settings_get_for_screen (screen); /* Only connect this signal once per screen. */ if (! g_signal_handler_find (G_OBJECT (gs), @@ -1378,12 +1754,114 @@ xg_create_frame_widgets (struct frame *f) return 1; } +#ifdef HAVE_PGTK +void +xg_create_frame_outer_widgets (struct frame *f) +{ + GtkWidget *wtop; + GtkWidget *wvbox, *whbox; + GtkWindowType type = GTK_WINDOW_TOPLEVEL; + char *title = 0; + + block_input (); + + wtop = gtk_window_new (type); + gtk_widget_add_events (wtop, GDK_ALL_EVENTS_MASK); + + xg_set_screen (wtop, f); + + wvbox = gtk_box_new (GTK_ORIENTATION_VERTICAL, 0); + whbox = gtk_box_new (GTK_ORIENTATION_HORIZONTAL, 0); + gtk_box_set_homogeneous (GTK_BOX (wvbox), FALSE); + gtk_box_set_homogeneous (GTK_BOX (whbox), FALSE); + + /* Use same names as the Xt port does. I.e. Emacs.pane.emacs by default */ + gtk_widget_set_name (wtop, EMACS_CLASS); + gtk_widget_set_name (wvbox, "pane"); + + /* If this frame has a title or name, set it in the title bar. */ + if (! NILP (f->title)) + title = SSDATA (ENCODE_UTF_8 (f->title)); + else if (! NILP (f->name)) + title = SSDATA (ENCODE_UTF_8 (f->name)); + + if (title) + gtk_window_set_title (GTK_WINDOW (wtop), title); + + if (FRAME_UNDECORATED (f)) + { + gtk_window_set_decorated (GTK_WINDOW (wtop), FALSE); + store_frame_param (f, Qundecorated, Qt); + } + + FRAME_GTK_OUTER_WIDGET (f) = wtop; + f->output_data.xp->vbox_widget = wvbox; + f->output_data.xp->hbox_widget = whbox; + + gtk_container_add (GTK_CONTAINER (wtop), wvbox); + gtk_box_pack_start (GTK_BOX (wvbox), whbox, TRUE, TRUE, 0); + + if (FRAME_EXTERNAL_TOOL_BAR (f)) + update_frame_tool_bar (f); + +#if ! GTK_CHECK_VERSION (3, 22, 0) + gtk_window_set_wmclass (GTK_WINDOW (wtop), + SSDATA (Vx_resource_name), + SSDATA (Vx_resource_class)); +#endif + + /* Convert our geometry parameters into a geometry string + and specify it. + GTK will itself handle calculating the real position this way. */ + xg_set_geometry (f); + f->win_gravity + = gtk_window_get_gravity (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); + + gtk_window_set_resizable (GTK_WINDOW (wtop), TRUE); + + if (FRAME_OVERRIDE_REDIRECT (f)) + { + GdkWindow *gwin = gtk_widget_get_window (wtop); + + if (gwin) + gdk_window_set_override_redirect (gwin, TRUE); + } + + /* Steal a tool tip window we can move ourselves. */ + f->output_data.xp->ttip_widget = 0; + f->output_data.xp->ttip_lbl = 0; + f->output_data.xp->ttip_window = 0; +#ifndef HAVE_PGTK + gtk_widget_set_tooltip_text (wtop, "Dummy text"); + g_signal_connect (wtop, "query-tooltip", G_CALLBACK (qttip_cb), f); +#endif + + { + GdkScreen *screen = gtk_widget_get_screen (wtop); + GtkSettings *gs = gtk_settings_get_for_screen (screen); + /* Only connect this signal once per screen. */ + if (! g_signal_handler_find (G_OBJECT (gs), + G_SIGNAL_MATCH_FUNC, + 0, 0, 0, + (gpointer) G_CALLBACK (style_changed_cb), + 0)) + { + g_signal_connect (G_OBJECT (gs), "notify::gtk-theme-name", + G_CALLBACK (style_changed_cb), + gdk_screen_get_display (screen)); + } + } + + unblock_input (); +} +#endif + void xg_free_frame_widgets (struct frame *f) { if (FRAME_GTK_OUTER_WIDGET (f)) { - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; struct xg_frame_tb_info *tbinfo = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), TB_INFO_KEY); @@ -1391,10 +1869,15 @@ xg_free_frame_widgets (struct frame *f) xfree (tbinfo); /* x_free_frame_resources should have taken care of it */ +#ifndef HAVE_PGTK eassert (!FRAME_X_DOUBLE_BUFFERED_P (f)); + g_object_unref (FRAME_X_OUTPUT (f)->im_context); +#endif gtk_widget_destroy (FRAME_GTK_OUTER_WIDGET (f)); FRAME_X_WINDOW (f) = 0; /* Set to avoid XDestroyWindow in xterm.c */ +#ifndef HAVE_PGTK FRAME_X_RAW_DRAWABLE (f) = 0; +#endif FRAME_GTK_OUTER_WIDGET (f) = 0; if (x->ttip_widget) { @@ -1436,9 +1919,12 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) XSETFRAME (frame, f); fs_state = Fframe_parameter (frame, Qfullscreen); - if ((EQ (fs_state, Qmaximized) || EQ (fs_state, Qfullboth)) && - (x_wm_supports (f, FRAME_DISPLAY_INFO (f)->Xatom_net_wm_state) || - x_wm_supports (f, FRAME_DISPLAY_INFO (f)->Xatom_net_wm_state_fullscreen))) + if ((EQ (fs_state, Qmaximized) || EQ (fs_state, Qfullboth)) +#ifndef HAVE_PGTK + && (x_wm_supports (f, FRAME_DISPLAY_INFO (f)->Xatom_net_wm_state) || + x_wm_supports (f, FRAME_DISPLAY_INFO (f)->Xatom_net_wm_state_fullscreen)) +#endif + ) { /* Don't set hints when maximized or fullscreen. Apparently KWin and Gtk3 don't get along and the frame shrinks (!). @@ -1449,14 +1935,14 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) if (flags) { memset (&size_hints, 0, sizeof (size_hints)); - f->output_data.x->size_hints = size_hints; - f->output_data.x->hint_flags = hint_flags; + f->output_data.xp->size_hints = size_hints; + f->output_data.xp->hint_flags = hint_flags; } else flags = f->size_hint_flags; - size_hints = f->output_data.x->size_hints; - hint_flags = f->output_data.x->hint_flags; + size_hints = f->output_data.xp->size_hints; + hint_flags = f->output_data.xp->hint_flags; hint_flags |= GDK_HINT_RESIZE_INC | GDK_HINT_MIN_SIZE; size_hints.width_inc = frame_resize_pixelwise ? 1 : FRAME_COLUMN_WIDTH (f); @@ -1500,12 +1986,12 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) else if (win_gravity == StaticGravity) size_hints.win_gravity = GDK_GRAVITY_STATIC; - if (x_gtk_use_window_move) - { - if (flags & PPosition) hint_flags |= GDK_HINT_POS; - if (flags & USPosition) hint_flags |= GDK_HINT_USER_POS; - if (flags & USSize) hint_flags |= GDK_HINT_USER_SIZE; - } + if (flags & PPosition) + hint_flags |= GDK_HINT_POS; + if (flags & USPosition) + hint_flags |= GDK_HINT_USER_POS; + if (flags & USSize) + hint_flags |= GDK_HINT_USER_SIZE; if (user_position) { @@ -1518,16 +2004,16 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) size_hints.width_inc /= scale; size_hints.height_inc /= scale; - if (hint_flags != f->output_data.x->hint_flags + if (hint_flags != f->output_data.xp->hint_flags || memcmp (&size_hints, - &f->output_data.x->size_hints, + &f->output_data.xp->size_hints, sizeof (size_hints)) != 0) { block_input (); gtk_window_set_geometry_hints (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), NULL, &size_hints, hint_flags); - f->output_data.x->size_hints = size_hints; - f->output_data.x->hint_flags = hint_flags; + f->output_data.xp->size_hints = size_hints; + f->output_data.xp->hint_flags = hint_flags; unblock_input (); } } @@ -1552,8 +2038,8 @@ xg_set_background_color (struct frame *f, unsigned long bg) !NILP (bar); bar = XSCROLL_BAR (bar)->next) { - GtkWidget *scrollbar = - xg_get_widget_from_map (XSCROLL_BAR (bar)->x_window); + GtkWidget *scrollbar = xg_get_widget_from_map (XSCROLL_BAR (bar)->x_window, + FRAME_X_DISPLAY (f)); GtkWidget *webox = gtk_widget_get_parent (scrollbar); xg_set_widget_bg (f, webox, FRAME_BACKGROUND_PIXEL (f)); } @@ -1567,6 +2053,10 @@ xg_set_background_color (struct frame *f, unsigned long bg) void xg_set_undecorated (struct frame *f, Lisp_Object undecorated) { +#ifdef HAVE_PGTK + if (!FRAME_GTK_OUTER_WIDGET (f)) + return; +#endif if (FRAME_GTK_WIDGET (f)) { block_input (); @@ -1593,7 +2083,11 @@ xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) XSETFRAME (frame2, f2); gdk_window_restack (gwin1, gwin2, above_flag); +#ifndef HAVE_PGTK x_sync (f1); +#else + gdk_flush (); +#endif } unblock_input (); } @@ -1604,10 +2098,17 @@ void xg_set_skip_taskbar (struct frame *f, Lisp_Object skip_taskbar) { block_input (); +#ifndef HAVE_PGTK if (FRAME_GTK_WIDGET (f)) gdk_window_set_skip_taskbar_hint (gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)), NILP (skip_taskbar) ? FALSE : TRUE); +#else + if (FRAME_GTK_OUTER_WIDGET (f)) + gdk_window_set_skip_taskbar_hint + (gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)), + NILP (skip_taskbar) ? FALSE : TRUE); +#endif unblock_input (); } @@ -1616,6 +2117,10 @@ xg_set_skip_taskbar (struct frame *f, Lisp_Object skip_taskbar) void xg_set_no_focus_on_map (struct frame *f, Lisp_Object no_focus_on_map) { +#ifdef HAVE_PGTK + if (!FRAME_GTK_OUTER_WIDGET (f)) + return; +#endif block_input (); if (FRAME_GTK_WIDGET (f)) { @@ -1631,12 +2136,19 @@ xg_set_no_focus_on_map (struct frame *f, Lisp_Object no_focus_on_map) void xg_set_no_accept_focus (struct frame *f, Lisp_Object no_accept_focus) { + gboolean g_no_accept_focus = NILP (no_accept_focus) ? TRUE : FALSE; +#ifdef HAVE_PGTK + if (!FRAME_GTK_OUTER_WIDGET (f)) + { + if (FRAME_WIDGET (f)) + gtk_widget_set_can_focus (FRAME_WIDGET (f), g_no_accept_focus); + return; + } +#endif block_input (); if (FRAME_GTK_WIDGET (f)) { GtkWindow *gwin = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)); - gboolean g_no_accept_focus = NILP (no_accept_focus) ? TRUE : FALSE; - gtk_window_set_accept_focus (gwin, g_no_accept_focus); } unblock_input (); @@ -1657,18 +2169,24 @@ xg_set_override_redirect (struct frame *f, Lisp_Object override_redirect) unblock_input (); } +#ifndef HAVE_PGTK /* Set the frame icon to ICON_PIXMAP/MASK. This must be done with GTK functions so GTK does not overwrite the icon. */ void xg_set_frame_icon (struct frame *f, Pixmap icon_pixmap, Pixmap icon_mask) { +#ifdef HAVE_PGTK + if (!FRAME_GTK_OUTER_WIDGET (f)) + return; +#endif GdkPixbuf *gp = xg_get_pixbuf_from_pix_and_mask (f, icon_pixmap, icon_mask); if (gp) gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), gp); } +#endif @@ -1919,7 +2437,7 @@ xg_maybe_add_timer (gpointer data) static int xg_dialog_run (struct frame *f, GtkWidget *w) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct xg_dialog_data dd; xg_set_screen (w, f); @@ -2205,6 +2723,11 @@ xg_get_file_name (struct frame *f, int filesel_done = 0; xg_get_file_func func; +#ifdef HAVE_PGTK + if (!FRAME_GTK_OUTER_WIDGET (f)) + error ("Can't open dialog from child frames"); +#endif + #ifdef HAVE_GTK_FILE_SELECTION_NEW if (xg_uses_old_file_dialog ()) @@ -2237,20 +2760,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 */ @@ -2288,6 +2825,11 @@ xg_get_font (struct frame *f, const char *default_name) int done = 0; Lisp_Object font = Qnil; +#ifdef HAVE_PGTK + if (!FRAME_GTK_OUTER_WIDGET (f)) + error ("Can't open dialog from child frames"); +#endif + w = gtk_font_chooser_dialog_new ("Pick a font", GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); @@ -2341,8 +2883,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); @@ -2485,7 +3027,7 @@ xg_mark_data (void) { struct frame *f = XFRAME (frame); - if (FRAME_X_P (f) && FRAME_GTK_OUTER_WIDGET (f)) + if ((FRAME_X_P (f) || FRAME_PGTK_P (f)) && FRAME_GTK_OUTER_WIDGET (f)) { struct xg_frame_tb_info *tbinfo = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), @@ -2497,6 +3039,16 @@ xg_mark_data (void) } } } + +#ifndef HAVE_PGTK + if (xg_pending_quit_event.kind != NO_EVENT) + { + eassert (xg_pending_quit_event.kind == ASCII_KEYSTROKE_EVENT); + + mark_object (xg_pending_quit_event.frame_or_window); + mark_object (xg_pending_quit_event.arg); + } +#endif } /* Callback called when a menu item is destroyed. Used to free data. @@ -2649,6 +3201,11 @@ make_menu_item (const char *utf8_label, if (wtoadd) gtk_container_add (GTK_CONTAINER (w), wtoadd); if (! item->enabled) gtk_widget_set_sensitive (w, FALSE); +#ifdef HAVE_PGTK + if (!NILP (item->help)) + gtk_widget_set_tooltip_text (w, SSDATA (item->help)); +#endif + return w; } @@ -2715,6 +3272,25 @@ xg_create_one_menuitem (widget_value *item, return w; } +#ifdef HAVE_PGTK +static gboolean +menu_bar_button_pressed_cb (GtkWidget *widget, GdkEvent *event, + gpointer user_data) +{ + struct frame *f = user_data; + + if (event->button.button < 4 + && event->button.window != gtk_widget_get_window (widget) + && !popup_activated ()) + { + pgtk_menu_set_in_use (true); + set_frame_menubar (f, true); + } + + return false; +} +#endif + /* Create a full menu tree specified by DATA. F is the frame the created menu belongs to. SELECT_CB is the callback to use when a menu item is selected. @@ -2771,7 +3347,16 @@ create_menus (widget_value *data, } else { +#ifndef HAVE_GTK3 wmenu = gtk_menu_bar_new (); +#else + wmenu = emacs_menu_bar_new (); +#endif + +#ifdef HAVE_PGTK + g_signal_connect (G_OBJECT (wmenu), "button-press-event", + G_CALLBACK (menu_bar_button_pressed_cb), f); +#endif /* Set width of menu bar to a small value so it doesn't enlarge a small initial frame size. The width will be set to the width of the frame later on when it is added to a container. @@ -2788,9 +3373,15 @@ create_menus (widget_value *data, if (name) gtk_widget_set_name (wmenu, name); +#ifndef HAVE_PGTK if (deactivate_cb) g_signal_connect (G_OBJECT (wmenu), "selection-done", deactivate_cb, 0); +#else + if (deactivate_cb) + g_signal_connect (G_OBJECT (wmenu), + "deactivate", deactivate_cb, 0); +#endif } for (item = data; item; item = item->next) @@ -3512,8 +4103,9 @@ menubar_map_cb (GtkWidget *w, gpointer user_data) void xg_update_frame_menubar (struct frame *f) { - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; GtkRequisition req; + int scale = xg_get_scale (f); if (!x->menubar_widget || gtk_widget_get_mapped (x->menubar_widget)) return; @@ -3531,9 +4123,21 @@ xg_update_frame_menubar (struct frame *f) gtk_widget_show_all (x->menubar_widget); gtk_widget_get_preferred_size (x->menubar_widget, NULL, &req); req.height *= xg_get_scale (f); - if (FRAME_MENUBAR_HEIGHT (f) != req.height) + +#if !defined HAVE_PGTK && defined HAVE_GTK3 + if (FRAME_DISPLAY_INFO (f)->n_planes == 32) { - FRAME_MENUBAR_HEIGHT (f) = req.height; + GdkScreen *screen = gtk_widget_get_screen (x->menubar_widget); + GdkVisual *visual = gdk_screen_get_system_visual (screen); + + gtk_widget_realize (x->menubar_widget); + gtk_widget_set_visual (x->menubar_widget, visual); + } +#endif + + if (FRAME_MENUBAR_HEIGHT (f) != (req.height * scale)) + { + FRAME_MENUBAR_HEIGHT (f) = req.height * scale; adjust_frame_size (f, -1, -1, 2, 0, Qmenu_bar_lines); } unblock_input (); @@ -3545,7 +4149,7 @@ xg_update_frame_menubar (struct frame *f) void free_frame_menubar (struct frame *f) { - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; if (x->menubar_widget) { @@ -3561,6 +4165,7 @@ free_frame_menubar (struct frame *f) } } +#ifndef HAVE_PGTK bool xg_event_is_for_menubar (struct frame *f, const XEvent *event) { @@ -3575,6 +4180,18 @@ xg_event_is_for_menubar (struct frame *f, const XEvent *event) if (! x->menubar_widget) return 0; +#ifdef HAVE_XINPUT2 + XIDeviceEvent *xev = (XIDeviceEvent *) event->xcookie.data; + if (event->type == GenericEvent) /* XI_ButtonPress or XI_ButtonRelease or a touch event. */ + { + if (! (xev->event_x >= 0 + && xev->event_x < FRAME_PIXEL_WIDTH (f) + && xev->event_y >= 0 + && xev->event_y < FRAME_MENUBAR_HEIGHT (f))) + return 0; + } + else +#endif if (! (event->xbutton.x >= 0 && event->xbutton.x < FRAME_PIXEL_WIDTH (f) && event->xbutton.y >= 0 @@ -3583,7 +4200,12 @@ xg_event_is_for_menubar (struct frame *f, const XEvent *event) return 0; gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f)); - gw = gdk_x11_window_lookup_for_display (gdpy, event->xbutton.window); +#ifdef HAVE_XINPUT2 + if (event->type == GenericEvent) + gw = gdk_x11_window_lookup_for_display (gdpy, xev->event); + else +#endif + gw = gdk_x11_window_lookup_for_display (gdpy, event->xbutton.window); if (! gw) return 0; gevent.any.window = gw; gevent.any.type = GDK_NOTHING; @@ -3597,8 +4219,21 @@ xg_event_is_for_menubar (struct frame *f, const XEvent *event) list = gtk_container_get_children (GTK_CONTAINER (x->menubar_widget)); if (! list) return 0; int scale = xg_get_scale (f); - rec.x = event->xbutton.x / scale; - rec.y = event->xbutton.y / scale; +#ifdef HAVE_XINPUT2 + if (event->type == GenericEvent) + { + rec.x = xev->event_x / scale; + rec.y = xev->event_y / scale; + } + else + { +#endif + rec.x = event->xbutton.x / scale; + rec.y = event->xbutton.y / scale; +#ifdef HAVE_XINPUT2 + } +#endif + rec.width = 1; rec.height = 1; @@ -3611,6 +4246,7 @@ xg_event_is_for_menubar (struct frame *f, const XEvent *event) g_list_free (list); return iter != 0; } +#endif @@ -3628,6 +4264,8 @@ bool xg_ignore_gtk_scrollbar; static int scroll_bar_width_for_theme; static int scroll_bar_height_for_theme; +#if defined HAVE_PGTK || !defined HAVE_GTK3 + /* Xlib's `Window' fits in 32 bits. But we want to store pointers, and they may be larger than 32 bits. Keep a mapping from integer index to widget pointers to get around the 32 bit limitation. */ @@ -3699,7 +4337,7 @@ xg_remove_widget_from_map (ptrdiff_t idx) /* Get the widget pointer at IDX from id_to_widget. */ static GtkWidget * -xg_get_widget_from_map (ptrdiff_t idx) +xg_get_widget_from_map (ptrdiff_t idx, Display *dpy) { if (idx < id_to_widget.max_size && id_to_widget.widgets[idx] != 0) return id_to_widget.widgets[idx]; @@ -3707,6 +4345,42 @@ xg_get_widget_from_map (ptrdiff_t idx) return 0; } +#else +static void +find_scrollbar_cb (GtkWidget *widget, gpointer user_data) +{ + GtkWidget **scroll_bar = user_data; + + if (GTK_IS_SCROLLBAR (widget)) + *scroll_bar = widget; +} + +static GtkWidget * +xg_get_widget_from_map (ptrdiff_t window, Display *dpy) +{ + GtkWidget *gwdesc, *scroll_bar = NULL; + GdkWindow *gdkwin; + + gdkwin = gdk_x11_window_lookup_for_display (gdk_x11_lookup_xdisplay (dpy), + (Window) window); + if (gdkwin) + { + GdkEvent event; + event.any.window = gdkwin; + event.any.type = GDK_NOTHING; + gwdesc = gtk_get_event_widget (&event); + + if (gwdesc && GTK_IS_EVENT_BOX (gwdesc)) + gtk_container_forall (GTK_CONTAINER (gwdesc), + find_scrollbar_cb, &scroll_bar); + } + else + return NULL; + + return scroll_bar; +} +#endif + static void update_theme_scrollbar_width (void) { @@ -3766,6 +4440,7 @@ xg_get_default_scrollbar_height (struct frame *f) return scroll_bar_width_for_theme * xg_get_scale (f); } +#ifndef HAVE_GTK3 /* Return the scrollbar id for X Window WID on display DPY. Return -1 if WID not in id_to_widget. */ @@ -3786,17 +4461,46 @@ xg_get_scroll_id_for_window (Display *dpy, Window wid) return -1; } +#endif /* Callback invoked when scroll bar WIDGET is destroyed. DATA is the index into id_to_widget for WIDGET. We free pointer to last scroll bar values here and remove the index. */ +#if !defined HAVE_GTK3 || defined HAVE_PGTK static void xg_gtk_scroll_destroy (GtkWidget *widget, gpointer data) { intptr_t id = (intptr_t) data; xg_remove_widget_from_map (id); } +#endif + +#if defined HAVE_GTK3 && !defined HAVE_PGTK +static void +xg_scroll_bar_size_allocate_cb (GtkWidget *widget, + GdkRectangle *allocation, + gpointer user_data) +{ + GdkEvent *event = gtk_get_current_event (); + GdkEvent dummy; + + if (event && event->any.type == GDK_CONFIGURE) + x_scroll_bar_configure (event); + else + { + /* These are the only fields used by x_scroll_bar_configure. */ + dummy.configure.send_event = FALSE; + dummy.configure.x = allocation->x; + dummy.configure.y = allocation->y; + dummy.configure.width = allocation->width; + dummy.configure.height = allocation->height; + dummy.configure.window = gtk_widget_get_window (widget); + + x_scroll_bar_configure (&dummy); + } +} +#endif static void xg_finish_scroll_bar_creation (struct frame *f, @@ -3807,19 +4511,32 @@ xg_finish_scroll_bar_creation (struct frame *f, const char *scroll_bar_name) { GtkWidget *webox = gtk_event_box_new (); +#ifdef HAVE_GTK3 + GtkCssProvider *foreground_provider; + GtkCssProvider *background_provider; +#endif gtk_widget_set_name (wscroll, scroll_bar_name); #ifndef HAVE_GTK3 gtk_range_set_update_policy (GTK_RANGE (wscroll), GTK_UPDATE_CONTINUOUS); #endif - g_object_set_data (G_OBJECT (wscroll), XG_FRAME_DATA, (gpointer)f); + g_object_set_data (G_OBJECT (wscroll), XG_FRAME_DATA, (gpointer) f); +#if defined HAVE_GTK3 && !defined HAVE_PGTK + g_signal_connect (G_OBJECT (webox), "size-allocate", + G_CALLBACK (xg_scroll_bar_size_allocate_cb), + NULL); +#endif + +#if defined HAVE_PGTK || !defined HAVE_GTK3 ptrdiff_t scroll_id = xg_store_widget_in_map (wscroll); g_signal_connect (G_OBJECT (wscroll), "destroy", G_CALLBACK (xg_gtk_scroll_destroy), (gpointer) scroll_id); +#endif + g_signal_connect (G_OBJECT (wscroll), "change-value", scroll_callback, @@ -3835,7 +4552,7 @@ xg_finish_scroll_bar_creation (struct frame *f, also, which causes flicker. Put an event box between the edit widget and the scroll bar, so the scroll bar instead draws itself on the event box window. */ - gtk_fixed_put (GTK_FIXED (f->output_data.x->edit_widget), webox, -1, -1); + gtk_fixed_put (GTK_FIXED (f->output_data.xp->edit_widget), webox, -1, -1); gtk_container_add (GTK_CONTAINER (webox), wscroll); xg_set_widget_bg (f, webox, FRAME_BACKGROUND_PIXEL (f)); @@ -3845,12 +4562,37 @@ xg_finish_scroll_bar_creation (struct frame *f, real X window, it and its scroll-bar child try to draw on the Emacs main window, which we draw over using Xlib. */ gtk_widget_realize (webox); +#ifdef HAVE_PGTK + gtk_widget_show_all (webox); +#elif defined HAVE_GTK3 + bar->x_window = GTK_WIDGET_TO_X_WIN (webox); + gtk_widget_show_all (webox); +#else GTK_WIDGET_TO_X_WIN (webox); +#endif /* Set the cursor to an arrow. */ xg_set_cursor (webox, FRAME_DISPLAY_INFO (f)->xg_cursor); +#ifdef HAVE_GTK3 + GtkStyleContext *ctxt = gtk_widget_get_style_context (wscroll); + foreground_provider = FRAME_OUTPUT_DATA (f)->scrollbar_foreground_css_provider; + background_provider = FRAME_OUTPUT_DATA (f)->scrollbar_background_css_provider; + + gtk_style_context_add_provider (ctxt, GTK_STYLE_PROVIDER (foreground_provider), + GTK_STYLE_PROVIDER_PRIORITY_USER); + gtk_style_context_add_provider (ctxt, GTK_STYLE_PROVIDER (background_provider), + GTK_STYLE_PROVIDER_PRIORITY_USER); + +#ifndef HAVE_PGTK + gtk_widget_add_events (webox, GDK_STRUCTURE_MASK); + gtk_widget_set_double_buffered (wscroll, FALSE); +#endif +#endif + +#if defined HAVE_PGTK || !defined HAVE_GTK3 bar->x_window = scroll_id; +#endif } /* Create a scroll bar widget for frame F. Store the scroll bar @@ -3924,7 +4666,8 @@ xg_create_horizontal_scroll_bar (struct frame *f, void xg_remove_scroll_bar (struct frame *f, ptrdiff_t scrollbar_id) { - GtkWidget *w = xg_get_widget_from_map (scrollbar_id); + GtkWidget *w = xg_get_widget_from_map (scrollbar_id, + FRAME_X_DISPLAY (f)); if (w) { GtkWidget *wparent = gtk_widget_get_parent (w); @@ -3947,11 +4690,15 @@ xg_update_scrollbar_pos (struct frame *f, int width, int height) { - GtkWidget *wscroll = xg_get_widget_from_map (scrollbar_id); + GtkWidget *wscroll = xg_get_widget_from_map (scrollbar_id, + FRAME_X_DISPLAY (f)); if (wscroll) { - GtkWidget *wfixed = f->output_data.x->edit_widget; + GtkWidget *wfixed = f->output_data.xp->edit_widget; GtkWidget *wparent = gtk_widget_get_parent (wscroll); +#if !defined HAVE_PGTK && defined HAVE_GTK3 + GdkWindow *wdesc = gtk_widget_get_window (wparent); +#endif gint msl; int scale = xg_get_scale (f); @@ -3984,29 +4731,53 @@ xg_update_scrollbar_pos (struct frame *f, { gtk_widget_show_all (wparent); gtk_widget_set_size_request (wscroll, width, height); + +#if !defined HAVE_PGTK && defined HAVE_GTK3 + if (wdesc) + { + gdk_window_move_resize (wdesc, left, top, width, height); +#if GTK_CHECK_VERSION (3, 20, 0) + gtk_widget_queue_allocate (wparent); +#endif + } +#endif } + if (oldx != -1 && oldw > 0 && oldh > 0) { /* Clear under old scroll bar position. */ oldw += (scale - 1) * oldw; oldx -= (scale - 1) * oldw; +#ifndef HAVE_PGTK x_clear_area (f, oldx, oldy, oldw, oldh); +#else + pgtk_clear_area (f, oldx, oldy, oldw, oldh); +#endif } if (!hidden) { - GtkWidget *scrollbar = xg_get_widget_from_map (scrollbar_id); + GtkWidget *scrollbar = xg_get_widget_from_map (scrollbar_id, + FRAME_X_DISPLAY (f)); GtkWidget *webox = gtk_widget_get_parent (scrollbar); +#ifndef HAVE_PGTK /* Don't obscure any child frames. */ XLowerWindow (FRAME_X_DISPLAY (f), GTK_WIDGET_TO_X_WIN (webox)); +#else + gdk_window_lower (gtk_widget_get_window (webox)); +#endif } /* GTK does not redraw until the main loop is entered again, but if there are no X events pending we will not enter it. So we sync here to get some events. */ +#ifndef HAVE_PGTK x_sync (f); +#else + gdk_flush (); +#endif SET_FRAME_GARBAGED (f); cancel_mouse_face (f); } @@ -4026,13 +4797,16 @@ xg_update_horizontal_scrollbar_pos (struct frame *f, int width, int height) { - - GtkWidget *wscroll = xg_get_widget_from_map (scrollbar_id); + GtkWidget *wscroll = xg_get_widget_from_map (scrollbar_id, + FRAME_X_DISPLAY (f)); if (wscroll) { - GtkWidget *wfixed = f->output_data.x->edit_widget; + GtkWidget *wfixed = f->output_data.xp->edit_widget; GtkWidget *wparent = gtk_widget_get_parent (wscroll); +#if !defined HAVE_PGTK && defined HAVE_GTK3 + GdkWindow *wdesc = gtk_widget_get_window (wparent); +#endif gint msl; int scale = xg_get_scale (f); @@ -4064,10 +4838,24 @@ xg_update_horizontal_scrollbar_pos (struct frame *f, { gtk_widget_show_all (wparent); gtk_widget_set_size_request (wscroll, width, height); + +#if !defined HAVE_PGTK && defined HAVE_GTK3 + if (wdesc) + { + gdk_window_move_resize (wdesc, left, top, width, height); +#if GTK_CHECK_VERSION (3, 20, 0) + gtk_widget_queue_allocate (wparent); +#endif + } +#endif } if (oldx != -1 && oldw > 0 && oldh > 0) /* Clear under old scroll bar position. */ +#ifndef HAVE_PGTK x_clear_area (f, oldx, oldy, oldw, oldh); +#else + pgtk_clear_area (f, oldx, oldy, oldw, oldh); +#endif /* GTK does not redraw until the main loop is entered again, but if there are no X events pending we will not enter it. So we sync @@ -4075,14 +4863,22 @@ xg_update_horizontal_scrollbar_pos (struct frame *f, { GtkWidget *scrollbar = - xg_get_widget_from_map (scrollbar_id); + xg_get_widget_from_map (scrollbar_id, FRAME_X_DISPLAY (f)); GtkWidget *webox = gtk_widget_get_parent (scrollbar); +#ifndef HAVE_PGTK /* Don't obscure any child frames. */ XLowerWindow (FRAME_X_DISPLAY (f), GTK_WIDGET_TO_X_WIN (webox)); +#else + gdk_window_lower (gtk_widget_get_window (webox)); +#endif } +#ifndef HAVE_PGTK x_sync (f); +#else + gdk_flush (); +#endif SET_FRAME_GARBAGED (f); cancel_mouse_face (f); } @@ -4107,9 +4903,10 @@ xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int position, int whole) { - GtkWidget *wscroll = xg_get_widget_from_map (bar->x_window); - struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); + GtkWidget *wscroll = xg_get_widget_from_map (bar->x_window, + FRAME_X_DISPLAY (f)); + if (wscroll && bar->dragging == -1) { @@ -4194,7 +4991,9 @@ xg_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int position, int whole) { - GtkWidget *wscroll = xg_get_widget_from_map (bar->x_window); + struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); + GtkWidget *wscroll = xg_get_widget_from_map (bar->x_window, + FRAME_X_DISPLAY (f)); if (wscroll && bar->dragging == -1) { @@ -4226,14 +5025,38 @@ xg_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, frame. This function does additional checks. */ bool -xg_event_is_for_scrollbar (struct frame *f, const XEvent *event) +xg_event_is_for_scrollbar (struct frame *f, const EVENT *event, + bool for_valuator) { bool retval = 0; - if (f && event->type == ButtonPress && event->xbutton.button < 4) +#ifdef HAVE_XINPUT2 + XIDeviceEvent *xev = (XIDeviceEvent *) event->xcookie.data; + if (f && ((FRAME_DISPLAY_INFO (f)->supports_xi2 + && event->type == GenericEvent + && (event->xgeneric.extension + == FRAME_DISPLAY_INFO (f)->xi2_opcode) + && (event->xgeneric.evtype == XI_ButtonPress + && xev->detail < 4)) + || (event->type == ButtonPress + && event->xbutton.button < 4) + || for_valuator)) +#else + if (f +#ifndef HAVE_PGTK + && event->type == ButtonPress && event->xbutton.button < 4 +#else + && event->type == GDK_BUTTON_PRESS && event->button.button < 4 +#endif + ) +#endif /* HAVE_XINPUT2 */ { /* Check if press occurred outside the edit widget. */ +#ifndef HAVE_PGTK GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f)); +#else + GdkDisplay *gdpy = FRAME_X_DISPLAY (f); +#endif GdkWindow *gwin; #ifdef HAVE_GTK3 #if GTK_CHECK_VERSION (3, 20, 0) @@ -4247,11 +5070,30 @@ xg_event_is_for_scrollbar (struct frame *f, const XEvent *event) #else gwin = gdk_display_get_window_at_pointer (gdpy, NULL, NULL); #endif - retval = gwin != gtk_widget_get_window (f->output_data.x->edit_widget); + retval = gwin != gtk_widget_get_window (f->output_data.xp->edit_widget); } +#ifdef HAVE_XINPUT2 + else if (f && ((FRAME_DISPLAY_INFO (f)->supports_xi2 + && event->type == GenericEvent + && (event->xgeneric.extension + == FRAME_DISPLAY_INFO (f)->xi2_opcode) + && ((event->xgeneric.evtype == XI_ButtonRelease + && xev->detail < 4) + || (event->xgeneric.evtype == XI_Motion))) + || ((event->type == ButtonRelease + && event->xbutton.button < 4) + || event->type == MotionNotify))) +#else else if (f +#ifndef HAVE_PGTK && ((event->type == ButtonRelease && event->xbutton.button < 4) - || event->type == MotionNotify)) + || event->type == MotionNotify) +#else + && ((event->type == GDK_BUTTON_RELEASE && event->button.button < 4) + || event->type == GDK_MOTION_NOTIFY) +#endif + ) +#endif /* HAVE_XINPUT2 */ { /* If we are releasing or moving the scroll bar, it has the grab. */ GtkWidget *w = gtk_grab_get_current (); @@ -4329,7 +5171,11 @@ draw_page (GtkPrintOperation *operation, GtkPrintContext *context, struct frame *f = XFRAME (Fnth (make_fixnum (page_nr), frames)); cairo_t *cr = gtk_print_context_get_cairo_context (context); +#ifndef HAVE_PGTK x_cr_draw_frame (cr, f); +#else + pgtk_cr_draw_frame (cr, f); +#endif } void @@ -4430,7 +5276,11 @@ xg_tool_bar_callback (GtkWidget *w, gpointer client_data) /* Convert between the modifier bits GDK uses and the modifier bits Emacs uses. This assumes GDK and X masks are the same, which they are when this is written. */ +#ifndef HAVE_PGTK event.modifiers = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), mod); +#else + event.modifiers = pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), mod); +#endif kbd_buffer_store_event (&event); /* Return focus to the frame after we have clicked on a detached @@ -4527,7 +5377,7 @@ xg_tool_bar_item_expose_callback (GtkWidget *w, static void xg_pack_tool_bar (struct frame *f, Lisp_Object pos) { - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; bool into_hbox = EQ (pos, Qleft) || EQ (pos, Qright); GtkWidget *top_widget = x->toolbar_widget; @@ -4583,7 +5433,7 @@ tb_size_cb (GtkWidget *widget, static void xg_create_tool_bar (struct frame *f) { - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; #ifdef HAVE_GTK3 GtkStyleContext *gsty; #endif @@ -4822,10 +5672,11 @@ xg_tool_item_stale_p (GtkWidget *wbutton, const char *stock_name, static bool xg_update_tool_bar_sizes (struct frame *f) { - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; GtkRequisition req; int nl = 0, nr = 0, nt = 0, nb = 0; GtkWidget *top_widget = x->toolbar_widget; + int scale = xg_get_scale (f); gtk_widget_get_preferred_size (GTK_WIDGET (top_widget), NULL, &req); if (x->toolbar_in_hbox) @@ -4834,8 +5685,10 @@ xg_update_tool_bar_sizes (struct frame *f) gtk_container_child_get (GTK_CONTAINER (x->hbox_widget), top_widget, "position", &pos, NULL); - if (pos == 0) nl = req.width; - else nr = req.width; + if (pos == 0) + nl = req.width * scale; + else + nr = req.width * scale; } else { @@ -4843,8 +5696,10 @@ xg_update_tool_bar_sizes (struct frame *f) gtk_container_child_get (GTK_CONTAINER (x->vbox_widget), top_widget, "position", &pos, NULL); - if (pos == 0 || (pos == 1 && x->menubar_widget)) nt = req.height; - else nb = req.height; + if (pos == 0 || (pos == 1 && x->menubar_widget)) + nt = req.height * scale; + else + nb = req.height * scale; } if (nl != FRAME_TOOLBAR_LEFT_WIDTH (f) @@ -4908,7 +5763,7 @@ void update_frame_tool_bar (struct frame *f) { int i, j; - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; int hmargin = 0, vmargin = 0; GtkToolbar *wtoolbar; GtkToolItem *ti; @@ -4923,6 +5778,11 @@ update_frame_tool_bar (struct frame *f) if (! FRAME_GTK_WIDGET (f)) return; +#ifdef HAVE_PGTK + if (! FRAME_GTK_OUTER_WIDGET (f)) + return; +#endif + block_input (); if (RANGED_FIXNUMP (1, Vtool_bar_button_margin, INT_MAX)) @@ -5218,7 +6078,7 @@ update_frame_tool_bar (struct frame *f) void free_frame_tool_bar (struct frame *f) { - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; if (x->toolbar_widget) { @@ -5263,7 +6123,7 @@ free_frame_tool_bar (struct frame *f) void xg_change_toolbar_position (struct frame *f, Lisp_Object pos) { - struct x_output *x = f->output_data.x; + xp_output *x = f->output_data.xp; GtkWidget *top_widget = x->toolbar_widget; if (! x->toolbar_widget || ! top_widget) @@ -5312,8 +6172,10 @@ xg_initialize (void) xg_menu_cb_list.prev = xg_menu_cb_list.next = xg_menu_item_cb_list.prev = xg_menu_item_cb_list.next = 0; +#if defined HAVE_PGTK || !defined HAVE_GTK3 id_to_widget.max_size = id_to_widget.used = 0; id_to_widget.widgets = 0; +#endif settings = gtk_settings_get_for_screen (gdk_display_get_default_screen (gdk_display_get_default ())); @@ -5361,4 +6223,440 @@ xg_initialize (void) #endif } +#ifndef HAVE_PGTK +static void +xg_add_virtual_mods (struct x_display_info *dpyinfo, GdkEventKey *key) +{ + guint modifiers = key->state; + + if (modifiers & dpyinfo->meta_mod_mask) + { + /* GDK always assumes Mod1 is alt, but that's no reason for + us to make that mistake as well. */ + if (!dpyinfo->alt_mod_mask) + key->state |= GDK_MOD1_MASK; + else + key->state |= GDK_META_MASK; + } + + if (modifiers & dpyinfo->alt_mod_mask) + key->state |= GDK_MOD1_MASK; + if (modifiers & dpyinfo->super_mod_mask) + key->state |= GDK_SUPER_MASK; + if (modifiers & dpyinfo->hyper_mod_mask) + key->state |= GDK_HYPER_MASK; +} + +static unsigned int +xg_virtual_mods_to_x (struct x_display_info *dpyinfo, guint virtual) +{ + unsigned int modifiers = virtual & ~(GDK_SUPER_MASK + | GDK_META_MASK + | GDK_HYPER_MASK + | GDK_MOD2_MASK + | GDK_MOD3_MASK + | GDK_MOD4_MASK + | GDK_MOD5_MASK); + + if (virtual & GDK_META_MASK) + modifiers |= dpyinfo->meta_mod_mask; + if (virtual & GDK_SUPER_MASK) + modifiers |= dpyinfo->super_mod_mask; + if (virtual & GDK_HYPER_MASK) + modifiers |= dpyinfo->hyper_mod_mask; + + return modifiers; +} + +static void +xg_im_context_commit (GtkIMContext *imc, gchar *str, + gpointer user_data) +{ + struct frame *f = user_data; + struct input_event ie; +#ifdef HAVE_XINPUT2 + struct xi_device_t *source; + struct x_display_info *dpyinfo; +#endif + + EVENT_INIT (ie); + /* This used to use g_utf8_to_ucs4_fast, which led to bad results + when STR wasn't actually a UTF-8 string, which some input method + modules commit. */ + + ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + ie.arg = decode_string_utf_8 (Qnil, str, strlen (str), + Qnil, false, Qnil, Qnil); + + /* STR is invalid and not really encoded in UTF-8. */ + if (NILP (ie.arg)) + ie.arg = build_unibyte_string (str); + + Fput_text_property (make_fixnum (0), + make_fixnum (SCHARS (ie.arg)), + Qcoding, Qt, ie.arg); + +#ifdef HAVE_XINPUT2 + dpyinfo = FRAME_DISPLAY_INFO (f); + + /* There is no timestamp associated with commit events, so use the + device that sent the last event to be filtered. */ + if (dpyinfo->pending_keystroke_time) + { + dpyinfo->pending_keystroke_time = 0; + source = xi_device_from_id (dpyinfo, + dpyinfo->pending_keystroke_source); + + if (source) + ie.device = source->name; + } +#endif + + XSETFRAME (ie.frame_or_window, f); + ie.modifiers = 0; + ie.timestamp = 0; + + kbd_buffer_store_event (&ie); +} + +static void +xg_im_context_preedit_changed (GtkIMContext *imc, gpointer user_data) +{ + PangoAttrList *list; + gchar *str; + gint cursor; + struct input_event inev; + + gtk_im_context_get_preedit_string (imc, &str, &list, &cursor); + + EVENT_INIT (inev); + inev.kind = PREEDIT_TEXT_EVENT; + inev.arg = build_string_from_utf8 (str); + + if (SCHARS (inev.arg)) + Fput_text_property (make_fixnum (min (SCHARS (inev.arg) - 1, + max (0, cursor))), + make_fixnum (min (SCHARS (inev.arg), + max (0, cursor) + 1)), + Qcursor, Qt, inev.arg); + + kbd_buffer_store_event (&inev); + + g_free (str); + pango_attr_list_unref (list); +} + +static void +xg_im_context_preedit_end (GtkIMContext *imc, gpointer user_data) +{ + struct input_event inev; + + EVENT_INIT (inev); + inev.kind = PREEDIT_TEXT_EVENT; + inev.arg = Qnil; + kbd_buffer_store_event (&inev); +} + +static bool +xg_widget_key_press_event_cb (GtkWidget *widget, GdkEvent *event, + gpointer user_data) +{ + Lisp_Object tail, tem; + struct frame *f = NULL; + union buffered_input_event inev; + guint keysym = event->key.keyval; + unsigned int xstate; + gunichar uc; +#ifdef HAVE_XINPUT2 + Time pending_keystroke_time; + struct xi_device_t *source; +#endif + + FOR_EACH_FRAME (tail, tem) + { + if (FRAME_X_P (XFRAME (tem)) + && (FRAME_GTK_WIDGET (XFRAME (tem)) == widget)) + { + f = XFRAME (tem); + break; + } + } + + if (!f) + return true; + +#ifdef HAVE_XINPUT2 + pending_keystroke_time + = FRAME_DISPLAY_INFO (f)->pending_keystroke_time; + + if (event->key.time >= pending_keystroke_time) + FRAME_DISPLAY_INFO (f)->pending_keystroke_time = 0; +#endif + + if (!x_gtk_use_native_input + && !FRAME_DISPLAY_INFO (f)->prefer_native_input) + return true; + + EVENT_INIT (inev.ie); + XSETFRAME (inev.ie.frame_or_window, f); + + xstate = xg_virtual_mods_to_x (FRAME_DISPLAY_INFO (f), + event->key.state); + + inev.ie.modifiers + |= x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), xstate); + inev.ie.timestamp = event->key.time; + +#ifdef HAVE_XINPUT2 + if (event->key.time == pending_keystroke_time) + { + source = xi_device_from_id (FRAME_DISPLAY_INFO (f), + FRAME_DISPLAY_INFO (f)->pending_keystroke_source); + + if (source) + inev.ie.device = source->name; + } +#endif + + if (event->key.is_modifier) + goto done; + +#ifndef HAVE_GTK3 + /* FIXME: event->key.is_modifier is not accurate on GTK 2. */ + + if (keysym >= GDK_KEY_Shift_L && keysym <= GDK_KEY_Hyper_R) + goto done; +#endif + + /* First deal with keysyms which have defined + translations to characters. */ + if (keysym >= 32 && keysym < 128) + /* Avoid explicitly decoding each ASCII character. */ + { + inev.ie.kind = ASCII_KEYSTROKE_EVENT; + inev.ie.code = keysym; + goto done; + } + + /* Keysyms directly mapped to Unicode characters. */ + if (keysym >= 0x01000000 && keysym <= 0x0110FFFF) + { + if (keysym < 0x01000080) + inev.ie.kind = ASCII_KEYSTROKE_EVENT; + else + inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + inev.ie.code = keysym & 0xFFFFFF; + goto done; + } + + /* Random non-modifier sorts of keysyms. */ + if (((keysym >= GDK_KEY_BackSpace && keysym <= GDK_KEY_Escape) + || keysym == GDK_KEY_Delete +#ifdef GDK_KEY_ISO_Left_Tab + || (keysym >= GDK_KEY_ISO_Left_Tab && keysym <= GDK_KEY_ISO_Enter) +#endif + || IsCursorKey (keysym) /* 0xff50 <= x < 0xff60 */ + || IsMiscFunctionKey (keysym) /* 0xff60 <= x < VARIES */ +#ifdef GDK_KEY_dead_circumflex + || keysym == GDK_KEY_dead_circumflex +#endif +#ifdef GDK_KEY_dead_grave + || keysym == GDK_KEY_dead_grave +#endif +#ifdef GDK_KEY_dead_tilde + || keysym == GDK_KEY_dead_tilde +#endif +#ifdef GDK_KEY_dead_diaeresis + || keysym == GDK_KEY_dead_diaeresis +#endif +#ifdef GDK_KEY_dead_macron + || keysym == GDK_KEY_dead_macron +#endif +#ifdef GDK_KEY_dead_degree + || keysym == GDK_KEY_dead_degree +#endif +#ifdef GDK_KEY_dead_acute + || keysym == GDK_KEY_dead_acute +#endif +#ifdef GDK_KEY_dead_cedilla + || keysym == GDK_KEY_dead_cedilla +#endif +#ifdef GDK_KEY_dead_breve + || keysym == GDK_KEY_dead_breve +#endif +#ifdef GDK_KEY_dead_ogonek + || keysym == GDK_KEY_dead_ogonek +#endif +#ifdef GDK_KEY_dead_caron + || keysym == GDK_KEY_dead_caron +#endif +#ifdef GDK_KEY_dead_doubleacute + || keysym == GDK_KEY_dead_doubleacute +#endif +#ifdef GDK_KEY_dead_abovedot + || keysym == GDK_KEY_dead_abovedot +#endif + || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */ + || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */ + /* Any "vendor-specific" key is ok. */ + || (keysym & (1 << 28)))) + { + inev.ie.kind = NON_ASCII_KEYSTROKE_EVENT; + inev.ie.code = keysym; + goto done; + } + + uc = gdk_keyval_to_unicode (keysym); + + if (uc) + { + inev.ie.kind = (SINGLE_BYTE_CHAR_P (uc) + ? ASCII_KEYSTROKE_EVENT + : MULTIBYTE_CHAR_KEYSTROKE_EVENT); + inev.ie.code = uc; + } + else + { + inev.ie.kind = NON_ASCII_KEYSTROKE_EVENT; + inev.ie.code = keysym; + } + + done: + if (inev.ie.kind != NO_EVENT) + { + xg_pending_quit_event.kind = NO_EVENT; + kbd_buffer_store_buffered_event (&inev, &xg_pending_quit_event); + } + + XNoOp (FRAME_X_DISPLAY (f)); +#ifdef USABLE_SIGIO + raise (SIGIO); +#endif + return true; +} + +bool +xg_filter_key (struct frame *frame, XEvent *xkey) +{ + GdkEvent *xg_event = gdk_event_new ((xkey->type == KeyPress +#ifdef HAVE_XINPUT2 + || (xkey->type == GenericEvent + && xkey->xgeneric.evtype == XI_KeyPress) +#endif + ) ? GDK_KEY_PRESS : GDK_KEY_RELEASE); + GdkDisplay *dpy = gtk_widget_get_display (FRAME_GTK_WIDGET (frame)); + GdkKeymap *keymap = gdk_keymap_get_for_display (dpy); + GdkModifierType consumed; + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame); + bool result; + + xg_event->any.window = gtk_widget_get_window (FRAME_GTK_WIDGET (frame)); + g_object_ref (xg_event->any.window); + +#if GTK_CHECK_VERSION (3, 20, 0) + GdkSeat *seat = gdk_display_get_default_seat (dpy); + + gdk_event_set_device (xg_event, + gdk_seat_get_keyboard (seat)); +#elif GTK_CHECK_VERSION (3, 16, 0) + GdkDeviceManager *manager = gdk_display_get_device_manager (dpy); + GList *devices = gdk_device_manager_list_devices (manager, + GDK_DEVICE_TYPE_MASTER); + GdkDevice *device; + GList *tem; + for (tem = devices; tem; tem = tem->next) + { + device = GDK_DEVICE (tem->data); + + if (gdk_device_get_source (device) == GDK_SOURCE_KEYBOARD) + { + gdk_event_set_device (xg_event, device); + break; + } + } + + g_list_free (devices); +#endif + +#ifdef HAVE_XINPUT2 + if (xkey->type != GenericEvent) + { +#endif + xg_event->key.hardware_keycode = xkey->xkey.keycode; + +#ifdef HAVE_XKB + if (dpyinfo->supports_xkb) + xg_event->key.group = XkbGroupForCoreState (xkey->xkey.state); +#endif + xg_event->key.state = xkey->xkey.state; + gdk_keymap_translate_keyboard_state (keymap, + xkey->xkey.keycode, + xkey->xkey.state, + xg_event->key.group, + &xg_event->key.keyval, + NULL, NULL, &consumed); + xg_add_virtual_mods (dpyinfo, &xg_event->key); + xg_event->key.state &= ~consumed; + xg_event->key.time = xkey->xkey.time; +#if GTK_CHECK_VERSION (3, 6, 0) + xg_event->key.is_modifier = gdk_x11_keymap_key_is_modifier (keymap, + xg_event->key.hardware_keycode); +#endif +#ifdef HAVE_XINPUT2 + } + else + { + XIDeviceEvent *xev = (XIDeviceEvent *) xkey->xcookie.data; + + xg_event->key.hardware_keycode = xev->detail; + xg_event->key.group = xev->group.effective; + xg_event->key.state = xev->mods.effective; + xg_event->key.time = xev->time; + gdk_keymap_translate_keyboard_state (keymap, + xev->detail, + xev->mods.effective, + xg_event->key.group, + &xg_event->key.keyval, + NULL, NULL, &consumed); + xg_add_virtual_mods (dpyinfo, &xg_event->key); + xg_event->key.state &= ~consumed; +#if GTK_CHECK_VERSION (3, 6, 0) + xg_event->key.is_modifier = gdk_x11_keymap_key_is_modifier (keymap, + xg_event->key.hardware_keycode); +#endif + } +#endif + + result = gtk_im_context_filter_keypress (FRAME_X_OUTPUT (frame)->im_context, + &xg_event->key); + + gdk_event_free (xg_event); + + return result; +} +#endif + +#if GTK_CHECK_VERSION (3, 10, 0) +static void +xg_widget_style_updated (GtkWidget *widget, gpointer user_data) +{ + struct frame *f = user_data; + + if (f->alpha_background < 1.0) + { +#ifndef HAVE_PGTK + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + NULL, 0); +#else + if (FRAME_GTK_OUTER_WIDGET (f) + && gtk_widget_get_realized (FRAME_GTK_OUTER_WIDGET (f))) + gdk_window_set_opaque_region (gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)), + NULL); +#endif + } +} +#endif #endif /* USE_GTK */ diff --git a/src/gtkutil.h b/src/gtkutil.h index 1a975e2439a..63ecac07907 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -25,7 +25,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <gtk/gtk.h> #include "../lwlib/lwlib-widget.h" +#ifdef HAVE_PGTK +#include "pgtkterm.h" +#define EVENT GdkEvent +#else #include "xterm.h" +#define EVENT XEvent +#endif /* Minimum and maximum values used for GTK scroll bars */ @@ -105,7 +111,7 @@ extern void xg_modify_menubar_widgets (GtkWidget *menubar, extern void xg_update_frame_menubar (struct frame *f); -extern bool xg_event_is_for_menubar (struct frame *, const XEvent *); +extern bool xg_event_is_for_menubar (struct frame *, const EVENT *); extern ptrdiff_t xg_get_scroll_id_for_window (Display *dpy, Window wid); @@ -142,7 +148,8 @@ extern void xg_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, int position, int whole); -extern bool xg_event_is_for_scrollbar (struct frame *, const XEvent *); +extern bool xg_event_is_for_scrollbar (struct frame *, const EVENT *, + bool for_valuator); extern int xg_get_default_scrollbar_width (struct frame *f); extern int xg_get_default_scrollbar_height (struct frame *f); @@ -157,9 +164,15 @@ extern void xg_frame_set_char_size (struct frame *f, int width, int height); extern GtkWidget * xg_win_to_widget (Display *dpy, Window wdesc); extern int xg_get_scale (struct frame *f); +#ifndef HAVE_PGTK extern void xg_display_open (char *display_name, Display **dpy); extern void xg_display_close (Display *dpy); extern GdkCursor * xg_create_default_cursor (Display *dpy); +#else +extern void xg_display_open (char *display_name, GdkDisplay **dpy); +extern void xg_display_close (GdkDisplay *gdpy); +extern GdkCursor * xg_create_default_cursor (GdkDisplay *gdpy); +#endif extern bool xg_create_frame_widgets (struct frame *f); extern void xg_free_frame_widgets (struct frame *f); @@ -167,10 +180,15 @@ extern void xg_set_background_color (struct frame *f, unsigned long bg); extern bool xg_check_special_colors (struct frame *f, const char *color_name, Emacs_Color *color); +#ifdef HAVE_PGTK +extern void xg_create_frame_outer_widgets (struct frame *f); +#endif +#ifndef HAVE_PGTK extern void xg_set_frame_icon (struct frame *f, Pixmap icon_pixmap, Pixmap icon_mask); +#endif extern void xg_set_undecorated (struct frame *f, Lisp_Object undecorated); extern void xg_frame_restack (struct frame *f1, struct frame *f2, bool above); @@ -183,7 +201,11 @@ extern bool xg_prepare_tooltip (struct frame *f, Lisp_Object string, int *width, int *height); +#ifndef HAVE_PGTK extern void xg_show_tooltip (struct frame *f, int root_x, int root_y); +#else +extern void xg_show_tooltip (struct frame *f, Lisp_Object string); +#endif extern bool xg_hide_tooltip (struct frame *f); #ifdef USE_CAIRO @@ -192,6 +214,14 @@ extern Lisp_Object xg_get_page_setup (void); extern void xg_print_frames_dialog (Lisp_Object); #endif +#if defined HAVE_GTK3 && defined HAVE_XINPUT2 +extern bool xg_is_menu_window (Display *dpy, Window); +#endif + +#ifndef HAVE_PGTK +extern bool xg_filter_key (struct frame *frame, XEvent *xkey); +#endif + /* Mark all callback data that are Lisp_object:s during GC. */ extern void xg_mark_data (void); diff --git a/src/haiku.c b/src/haiku.c new file mode 100644 index 00000000000..1c786012555 --- /dev/null +++ b/src/haiku.c @@ -0,0 +1,286 @@ +/* Haiku subroutines that are general to the Haiku operating system. + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include "lisp.h" +#include "process.h" +#include "coding.h" + +#include <kernel/OS.h> + +#include <pwd.h> +#include <stdlib.h> + +Lisp_Object +list_system_processes (void) +{ + team_info info; + int32 cookie = 0; + Lisp_Object lval = Qnil; + + while (get_next_team_info (&cookie, &info) == B_OK) + lval = Fcons (make_fixnum (info.team), lval); + + return lval; +} + +Lisp_Object +system_process_attributes (Lisp_Object pid) +{ + CHECK_FIXNUM (pid); + + team_info info; + Lisp_Object lval = Qnil; + thread_info inf; + area_info area; + team_id id = (team_id) XFIXNUM (pid); + struct passwd *g; + size_t mem = 0; + + if (get_team_info (id, &info) != B_OK) + return Qnil; + + bigtime_t everything = 0, vsample = 0; + bigtime_t cpu_eaten = 0, esample = 0; + + lval = Fcons (Fcons (Qeuid, make_fixnum (info.uid)), lval); + lval = Fcons (Fcons (Qegid, make_fixnum (info.gid)), lval); + lval = Fcons (Fcons (Qthcount, make_fixnum (info.thread_count)), lval); + lval = Fcons (Fcons (Qcomm, build_string_from_utf8 (info.args)), lval); + + g = getpwuid (info.uid); + + if (g && g->pw_name) + lval = Fcons (Fcons (Quser, build_string (g->pw_name)), lval); + + /* FIXME: Calculating this makes Emacs show up as using 100% CPU! */ + + for (int32 team_cookie = 0; + get_next_team_info (&team_cookie, &info) == B_OK;) + for (int32 thread_cookie = 0; + get_next_thread_info (info.team, &thread_cookie, &inf) == B_OK;) + { + if (inf.team == id && strncmp (inf.name, "idle thread ", 12)) + cpu_eaten += inf.user_time + inf.kernel_time; + everything += inf.user_time + inf.kernel_time; + } + + sleep (0.05); + + for (int32 team_cookie = 0; + get_next_team_info (&team_cookie, &info) == B_OK;) + for (int32 thread_cookie = 0; + get_next_thread_info (info.team, &thread_cookie, &inf) == B_OK;) + { + if (inf.team == id && strncmp (inf.name, "idle thread ", 12)) + esample += inf.user_time + inf.kernel_time; + vsample += inf.user_time + inf.kernel_time; + } + + cpu_eaten = esample - cpu_eaten; + everything = vsample - everything; + + if (everything) + lval = Fcons (Fcons (Qpcpu, make_float (((double) (cpu_eaten) / + (double) (everything)) * 100)), + lval); + else + lval = Fcons (Fcons (Qpcpu, make_float (0.0)), lval); + + for (ssize_t area_cookie = 0; + get_next_area_info (id, &area_cookie, &area) == B_OK;) + mem += area.ram_size; + + system_info sinfo; + get_system_info (&sinfo); + int64 max = (int64) sinfo.max_pages * B_PAGE_SIZE; + + lval = Fcons (Fcons (Qpmem, make_float (((double) mem / + (double) max) * 100)), + lval); + lval = Fcons (Fcons (Qrss, make_fixnum (mem / 1024)), lval); + + return lval; +} + + +/* Borrowed from w32 implementation. */ + +struct load_sample +{ + time_t sample_time; + bigtime_t idle; + bigtime_t kernel; + bigtime_t user; +}; + +/* We maintain 1-sec samples for the last 16 minutes in a circular buffer. */ +static struct load_sample samples[16*60]; +static int first_idx = -1, last_idx = -1; +static int max_idx = ARRAYELTS (samples); +static unsigned num_of_processors = 0; + +static int +buf_next (int from) +{ + int next_idx = from + 1; + + if (next_idx >= max_idx) + next_idx = 0; + + return next_idx; +} + +static int +buf_prev (int from) +{ + int prev_idx = from - 1; + + if (prev_idx < 0) + prev_idx = max_idx - 1; + + return prev_idx; +} + +static double +getavg (int which) +{ + double retval = -1.0; + double tdiff; + int idx; + double span = (which == 0 ? 1.0 : (which == 1 ? 5.0 : 15.0)) * 60; + time_t now = samples[last_idx].sample_time; + + if (first_idx != last_idx) + { + for (idx = buf_prev (last_idx); ; idx = buf_prev (idx)) + { + tdiff = difftime (now, samples[idx].sample_time); + if (tdiff >= span - 2 * DBL_EPSILON * now) + { + long double sys = + (samples[last_idx].kernel + samples[last_idx].user) - + (samples[idx].kernel + samples[idx].user); + long double idl = samples[last_idx].idle - samples[idx].idle; + + retval = (idl / (sys + idl)) * num_of_processors; + break; + } + if (idx == first_idx) + break; + } + } + + return retval; +} + +static void +sample_sys_load (bigtime_t *idle, bigtime_t *system, bigtime_t *user) +{ + bigtime_t i = 0, s = 0, u = 0; + team_info info; + thread_info inf; + + for (int32 team_cookie = 0; + get_next_team_info (&team_cookie, &info) == B_OK;) + for (int32 thread_cookie = 0; + get_next_thread_info (info.team, &thread_cookie, &inf) == B_OK;) + { + if (!strncmp (inf.name, "idle thread ", 12)) + i += inf.user_time + inf.kernel_time; + else + s += inf.kernel_time, u += inf.user_time; + } + + *idle = i; + *system = s; + *user = u; +} + +int +getloadavg (double loadavg[], int nelem) +{ + int elem; + bigtime_t idle, kernel, user; + time_t now = time (NULL); + + if (num_of_processors <= 0) + { + system_info i; + if (get_system_info (&i) == B_OK) + num_of_processors = i.cpu_count; + } + + /* If system time jumped back for some reason, delete all samples + whose time is later than the current wall-clock time. This + prevents load average figures from becoming frozen for prolonged + periods of time, when system time is reset backwards. */ + if (last_idx >= 0) + { + while (difftime (now, samples[last_idx].sample_time) < -1.0) + { + if (last_idx == first_idx) + { + first_idx = last_idx = -1; + break; + } + last_idx = buf_prev (last_idx); + } + } + + /* Store another sample. We ignore samples that are less than 1 sec + apart. */ + if (last_idx < 0 + || (difftime (now, samples[last_idx].sample_time) + >= 1.0 - 2 * DBL_EPSILON * now)) + { + sample_sys_load (&idle, &kernel, &user); + last_idx = buf_next (last_idx); + samples[last_idx].sample_time = now; + samples[last_idx].idle = idle; + samples[last_idx].kernel = kernel; + samples[last_idx].user = user; + /* If the buffer has more that 15 min worth of samples, discard + the old ones. */ + if (first_idx == -1) + first_idx = last_idx; + while (first_idx != last_idx + && (difftime (now, samples[first_idx].sample_time) + >= 15.0 * 60 + 2 * DBL_EPSILON * now)) + first_idx = buf_next (first_idx); + } + + for (elem = 0; elem < nelem; elem++) + { + double avg = getavg (elem); + + if (avg < 0) + break; + loadavg[elem] = avg; + } + + /* Always return at least one element, otherwise load-average + returns nil, and Lisp programs might decide we cannot measure + system load. For example, jit-lock-stealth-load's defcustom + might decide that feature is "unsupported". */ + if (elem == 0) + loadavg[elem++] = 0.09; /* < display-time-load-average-threshold */ + + return elem; +} diff --git a/src/haiku_draw_support.cc b/src/haiku_draw_support.cc new file mode 100644 index 00000000000..f8df298958f --- /dev/null +++ b/src/haiku_draw_support.cc @@ -0,0 +1,487 @@ +/* Haiku window system support. Hey, Emacs, this is -*- C++ -*- + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include <View.h> +#include <Region.h> +#include <Font.h> +#include <Window.h> +#include <Bitmap.h> + +#include <cmath> + +#include "haiku_support.h" + +#define RGB_TO_UINT32(r, g, b) ((255 << 24) | ((r) << 16) | ((g) << 8) | (b)) +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) + +#define RGB_COLOR_UINT32(r) RGB_TO_UINT32 ((r).red, (r).green, (r).blue) + +static void +rgb32_to_rgb_color (uint32_t rgb, rgb_color *color) +{ + color->red = RED_FROM_ULONG (rgb); + color->green = GREEN_FROM_ULONG (rgb); + color->blue = BLUE_FROM_ULONG (rgb); + color->alpha = 255; +} + +static BView * +get_view (void *vw) +{ + BView *view = (BView *) find_appropriate_view_for_draw (vw); + return view; +} + +void +BView_StartClip (void *view) +{ + BView *vw = get_view (view); + vw->PushState (); +} + +void +BView_EndClip (void *view) +{ + BView *vw = get_view (view); + vw->PopState (); +} + +void +BView_SetHighColor (void *view, uint32_t color) +{ + BView *vw = get_view (view); + rgb_color col; + rgb32_to_rgb_color (color, &col); + + vw->SetHighColor (col); +} + +void +BView_SetLowColor (void *view, uint32_t color) +{ + BView *vw = get_view (view); + rgb_color col; + rgb32_to_rgb_color (color, &col); + + vw->SetLowColor (col); +} + +void +BView_SetPenSize (void *view, int u) +{ + BView *vw = get_view (view); + vw->SetPenSize (u); +} + +void +BView_FillRectangle (void *view, int x, int y, int width, int height) +{ + BView *vw = get_view (view); + BRect rect = BRect (x, y, x + width - 1, y + height - 1); + + vw->FillRect (rect); +} + +void +BView_FillRectangleAbs (void *view, int x, int y, int x1, int y1) +{ + BView *vw = get_view (view); + BRect rect = BRect (x, y, x1, y1); + + vw->FillRect (rect); +} + +void +BView_StrokeRectangle (void *view, int x, int y, int width, int height) +{ + BView *vw = get_view (view); + BRect rect = BRect (x, y, x + width - 1, y + height - 1); + + vw->StrokeRect (rect); +} + +void +BView_SetViewColor (void *view, uint32_t color) +{ + BView *vw = get_view (view); + rgb_color col; + rgb32_to_rgb_color (color, &col); + +#ifndef USE_BE_CAIRO + vw->SetViewColor (col); +#else + vw->SetViewColor (B_TRANSPARENT_32_BIT); +#endif +} + +void +BView_ClipToRect (void *view, int x, int y, int width, int height) +{ + BView *vw = get_view (view); + BRect rect = BRect (x, y, x + width - 1, y + height - 1); + + vw->ClipToRect (rect); +} + +void +BView_ClipToInverseRect (void *view, int x, int y, int width, int height) +{ + BView *vw = get_view (view); + BRect rect = BRect (x, y, x + width - 1, y + height - 1); + + vw->ClipToInverseRect (rect); +} + +void +BView_StrokeLine (void *view, int sx, int sy, int tx, int ty) +{ + BView *vw = get_view (view); + BPoint from = BPoint (sx, sy); + BPoint to = BPoint (tx, ty); + + vw->StrokeLine (from, to); +} + +void +BView_SetFont (void *view, void *font) +{ + BView *vw = get_view (view); + + vw->SetFont ((BFont *) font); +} + +void +BView_MovePenTo (void *view, int x, int y) +{ + BView *vw = get_view (view); + BPoint pt = BPoint (x, y); + + vw->MovePenTo (pt); +} + +void +BView_DrawString (void *view, const char *chr, ptrdiff_t len) +{ + BView *vw = get_view (view); + + vw->DrawString (chr, len); +} + +void +BView_DrawChar (void *view, char chr) +{ + BView *vw = get_view (view); + + vw->DrawChar (chr); +} + +void +BView_CopyBits (void *view, int x, int y, int width, int height, + int tox, int toy, int towidth, int toheight) +{ + BView *vw = get_view (view); + + vw->CopyBits (BRect (x, y, x + width - 1, y + height - 1), + BRect (tox, toy, tox + towidth - 1, toy + toheight - 1)); + vw->Sync (); +} + +/* Convert RGB32 color color from RGB color space to its + HSL components pointed to by H, S and L. */ +void +rgb_color_hsl (uint32_t rgb, double *h, double *s, double *l) +{ + rgb_color col; + rgb32_to_rgb_color (rgb, &col); + + double red = col.red / 255.0; + double green = col.green / 255.0; + double blue = col.blue / 255.0; + + double max = std::fmax (std::fmax (red, blue), green); + double min = std::fmin (std::fmin (red, blue), green); + double delta = max - min; + *l = (max + min) / 2.0; + + if (!delta) + { + *h = 0; + *s = 0; + return; + } + + *s = (*l < 0.5) ? delta / (max + min) : + delta / (20 - max - min); + double rc = (max - red) / delta; + double gc = (max - green) / delta; + double bc = (max - blue) / delta; + + if (red == max) + *h = bc - gc; + else if (green == max) + *h = 2.0 + rc + -bc; + else + *h = 4.0 + gc + -rc; + *h = std::fmod (*h / 6, 1.0); +} + +static double +hue_to_rgb (double v1, double v2, double h) +{ + if (h < 1 / 6) + return v1 + (v2 - v1) * h * 6.0; + else if (h < 0.5) + return v2; + else if (h < 2.0 / 3) + return v1 + (v2 - v1) * (2.0 / 3 - h) * 6.0; + return v1; +} + +void +hsl_color_rgb (double h, double s, double l, uint32_t *rgb) +{ + if (!s) + *rgb = RGB_TO_UINT32 (std::lrint (l * 255), + std::lrint (l * 255), + std::lrint (l * 255)); + else + { + double m2 = l <= 0.5 ? l * (1 + s) : l + s - l * s; + double m1 = 2.0 * l - m2; + + *rgb = RGB_TO_UINT32 + (std::lrint (hue_to_rgb (m1, m2, + std::fmod (h + 1 / 3.0, 1)) * 255), + std::lrint (hue_to_rgb (m1, m2, h) * 255), + std::lrint (hue_to_rgb (m1, m2, + std::fmod (h - 1 / 3.0, 1)) * 255)); + } +} + +void +BView_DrawBitmap (void *view, void *bitmap, int x, int y, + int width, int height, int vx, int vy, int vwidth, + int vheight) +{ + BView *vw = get_view (view); + BBitmap *bm = (BBitmap *) bitmap; + + vw->PushState (); + vw->SetDrawingMode (B_OP_OVER); + vw->DrawBitmap (bm, BRect (x, y, x + width - 1, y + height - 1), + BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1)); + vw->PopState (); +} + +void +BView_DrawBitmapWithEraseOp (void *view, void *bitmap, int x, + int y, int width, int height) +{ + BView *vw = get_view (view); + BBitmap *bm = (BBitmap *) bitmap; + BBitmap bc (bm->Bounds (), B_RGBA32); + BRect rect (x, y, x + width - 1, y + height - 1); + + if (bc.InitCheck () != B_OK || bc.ImportBits (bm) != B_OK) + return; + + uint32_t *bits = (uint32_t *) bc.Bits (); + size_t stride = bc.BytesPerRow (); + + if (bm->ColorSpace () == B_GRAY1) + { + rgb_color low_color = vw->LowColor (); + BRect bounds = bc.Bounds (); + for (int y = 0; y < BE_RECT_HEIGHT (bounds); ++y) + { + for (int x = 0; x < BE_RECT_WIDTH (bounds); ++x) + { + if (bits[y * (stride / 4) + x] == 0xFF000000) + bits[y * (stride / 4) + x] = RGB_COLOR_UINT32 (low_color); + else + bits[y * (stride / 4) + x] = 0; + } + } + } + + vw->PushState (); + vw->SetDrawingMode (bm->ColorSpace () == B_GRAY1 ? B_OP_OVER : B_OP_ERASE); + vw->DrawBitmap (&bc, rect); + vw->PopState (); +} + +void +BView_DrawMask (void *src, void *view, + int x, int y, int width, int height, + int vx, int vy, int vwidth, int vheight, + uint32_t color) +{ + BBitmap *source = (BBitmap *) src; + BBitmap bm (source->Bounds (), B_RGBA32); + BRect bounds = bm.Bounds (); + + if (bm.InitCheck () != B_OK) + return; + for (int y = 0; y < BE_RECT_HEIGHT (bounds); ++y) + { + for (int x = 0; x < BE_RECT_WIDTH (bounds); ++x) + { + int bit = haiku_get_pixel ((void *) source, x, y); + + if (!bit) + haiku_put_pixel ((void *) &bm, x, y, ((uint32_t) 255 << 24) | color); + else + haiku_put_pixel ((void *) &bm, x, y, 0); + } + } + BView *vw = get_view (view); + vw->SetDrawingMode (B_OP_OVER); + vw->DrawBitmap (&bm, BRect (x, y, x + width - 1, y + height - 1), + BRect (vx, vy, vx + vwidth - 1, vy + vheight - 1)); +} + +static BBitmap * +rotate_bitmap_270 (BBitmap *bmp) +{ + BRect r = bmp->Bounds (); + BBitmap *bm = new BBitmap (BRect (r.top, r.left, r.bottom, r.right), + bmp->ColorSpace (), true); + if (bm->InitCheck () != B_OK) + gui_abort ("Failed to init bitmap for rotate"); + int w = BE_RECT_WIDTH (r); + int h = BE_RECT_HEIGHT (r); + + for (int y = 0; y < h; ++y) + for (int x = 0; x < w; ++x) + haiku_put_pixel ((void *) bm, y, w - x - 1, + haiku_get_pixel ((void *) bmp, x, y)); + + return bm; +} + +static BBitmap * +rotate_bitmap_90 (BBitmap *bmp) +{ + BRect r = bmp->Bounds (); + BBitmap *bm = new BBitmap (BRect (r.top, r.left, r.bottom, r.right), + bmp->ColorSpace (), true); + if (bm->InitCheck () != B_OK) + gui_abort ("Failed to init bitmap for rotate"); + int w = BE_RECT_WIDTH (r); + int h = BE_RECT_HEIGHT (r); + + for (int y = 0; y < h; ++y) + for (int x = 0; x < w; ++x) + haiku_put_pixel ((void *) bm, h - y - 1, x, + haiku_get_pixel ((void *) bmp, x, y)); + + return bm; +} + +void * +BBitmap_transform_bitmap (void *bitmap, void *mask, uint32_t m_color, + double rot, int desw, int desh) +{ + BBitmap *bm = (BBitmap *) bitmap; + BBitmap *mk = (BBitmap *) mask; + int copied_p = 0; + + if (rot == 90) + { + copied_p = 1; + bm = rotate_bitmap_90 (bm); + if (mk) + mk = rotate_bitmap_90 (mk); + } + + if (rot == 270) + { + copied_p = 1; + bm = rotate_bitmap_270 (bm); + if (mk) + mk = rotate_bitmap_270 (mk); + } + + BRect n = BRect (0, 0, desw - 1, desh - 1); + BView vw (n, NULL, B_FOLLOW_NONE, 0); + BBitmap *dst = new BBitmap (n, bm->ColorSpace (), true); + if (dst->InitCheck () != B_OK) + if (bm->InitCheck () != B_OK) + gui_abort ("Failed to init bitmap for scale"); + dst->AddChild (&vw); + + if (!vw.LockLooper ()) + gui_abort ("Failed to lock offscreen view for scale"); + + if (rot != 90 && rot != 270) + { + BAffineTransform tr; + tr.RotateBy (BPoint (desw / 2, desh / 2), rot * M_PI / 180.0); + vw.SetTransform (tr); + } + + vw.MovePenTo (0, 0); + vw.DrawBitmap (bm, n); + if (mk) + { + BRect k = mk->Bounds (); + BView_DrawMask ((void *) mk, (void *) &vw, + 0, 0, BE_RECT_WIDTH (k), + BE_RECT_HEIGHT (k), + 0, 0, desw, desh, m_color); + } + vw.Sync (); + vw.RemoveSelf (); + + if (copied_p) + delete bm; + if (copied_p && mk) + delete mk; + return dst; +} + +void +BView_FillTriangle (void *view, int x1, int y1, + int x2, int y2, int x3, int y3) +{ + BView *vw = get_view (view); + vw->FillTriangle (BPoint (x1, y1), BPoint (x2, y2), + BPoint (x3, y3)); +} + +void +BView_SetHighColorForVisibleBell (void *view, uint32_t color) +{ + BView *vw = (BView *) view; + rgb_color col; + rgb32_to_rgb_color (color, &col); + + vw->SetHighColor (col); +} + +void +BView_InvertRect (void *view, int x, int y, int width, int height) +{ + BView *vw = get_view (view); + + vw->InvertRect (BRect (x, y, x + width - 1, y + height - 1)); +} diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc new file mode 100644 index 00000000000..d3e1128e091 --- /dev/null +++ b/src/haiku_font_support.cc @@ -0,0 +1,647 @@ +/* Haiku window system support. Hey, Emacs, this is -*- C++ -*- + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include <Font.h> +#include <Rect.h> +#include <AffineTransform.h> + +#include <cstring> +#include <cmath> + +#include "haiku_support.h" + +/* Haiku doesn't expose font language data in BFont objects. Thus, we + select a few representative characters for each supported `:lang' + (currently Chinese, Korean and Japanese,) and test for those + instead. */ + +static uint32_t language_code_points[MAX_LANGUAGE][4] = + {{20154, 20754, 22996, 0}, /* Chinese. */ + {51312, 49440, 44544, 0}, /* Korean. */ + {26085, 26412, 12371, 0}, /* Japanese. */}; + +static void +estimate_font_ascii (BFont *font, int *max_width, + int *min_width, int *avg_width) +{ + char ch[2]; + bool tems[1]; + int total = 0; + int count = 0; + int min = 0; + int max = 0; + + std::memset (ch, 0, sizeof ch); + for (ch[0] = 32; ch[0] < 127; ++ch[0]) + { + tems[0] = false; + font->GetHasGlyphs (ch, 1, tems); + if (tems[0]) + { + int w = font->StringWidth (ch); + ++count; + total += w; + + if (!min || min > w) + min = w; + if (max < w) + max = w; + } + } + + *min_width = min; + *max_width = max; + + if (count) + *avg_width = total / count; + else + *avg_width = 0; +} + +void +BFont_close (void *font) +{ + if (font != (void *) be_fixed_font && + font != (void *) be_plain_font && + font != (void *) be_bold_font) + delete (BFont *) font; +} + +void +BFont_dat (void *font, int *px_size, int *min_width, int *max_width, + int *avg_width, int *height, int *space_width, int *ascent, + int *descent, int *underline_position, int *underline_thickness) +{ + BFont *ft = (BFont *) font; + struct font_height fheight; + bool have_space_p; + + char atem[1]; + bool otem[1]; + + ft->GetHeight (&fheight); + atem[0] = ' '; + otem[0] = false; + ft->GetHasGlyphs (atem, 1, otem); + have_space_p = otem[0]; + + estimate_font_ascii (ft, max_width, min_width, avg_width); + *ascent = std::lrint (fheight.ascent); + *descent = std::lrint (fheight.descent); + *height = *ascent + *descent; + + *space_width = have_space_p ? ft->StringWidth (" ") : 0; + + *px_size = std::lrint (ft->Size ()); + *underline_position = 0; + *underline_thickness = 0; +} + +/* Return non-null if FONT contains CHR, a Unicode code-point. */ +int +BFont_have_char_p (void *font, int32_t chr) +{ + BFont *ft = (BFont *) font; + return ft->IncludesBlock (chr, chr); +} + +/* Return non-null if font contains a block from BEG to END. */ +int +BFont_have_char_block (void *font, int32_t beg, int32_t end) +{ + BFont *ft = (BFont *) font; + return ft->IncludesBlock (beg, end); +} + +/* Compute bounds for MB_STR, a character in multibyte encoding, used + with FONT. The distance to move rightwards before reaching to the + next character's left escapement boundary is returned in ADVANCE, + the left bearing in LB, and the right bearing in RB. + + The left bearing is the amount of pixels from the left escapement + boundary (origin) to the left-most pixel that constitutes the glyph + corresponding to mb_str, and RB is the amount of pixels from the + origin to the right-most pixel constituting the glyph. + + Both the left and right bearings are positive values measured + towards the right, which means that the left bearing will only be + negative if the left-most pixel is to the left of the origin. + + The bearing values correspond to X11 XCharStruct semantics, which + is what Emacs code operates on. Haiku itself uses a slightly + different scheme, where the "left edge" is the distance from the + origin to the left-most pixel, where leftwards is negative and + rightwards is positive, and the "right edge" is the distance (where + leftwards is similarly negative) between the right-most pixel and + the right escapement boundary, which is the left escapement + boundary plus the advance. */ +void +BFont_char_bounds (void *font, const char *mb_str, int *advance, + int *lb, int *rb) +{ + BFont *ft = (BFont *) font; + edge_info edge_info; + float size, escapement; + size = ft->Size (); + + ft->GetEdges (mb_str, 1, &edge_info); + ft->GetEscapements (mb_str, 1, &escapement); + *advance = std::lrint (escapement * size); + *lb = std::lrint (edge_info.left * size); + *rb = *advance + std::lrint (edge_info.right * size); +} + +/* The same, but for a variable amount of chars. */ +void +BFont_nchar_bounds (void *font, const char *mb_str, int *advance, + int *lb, int *rb, int32_t n) +{ + BFont *ft = (BFont *) font; + edge_info edge_info[n]; + float size; + float escapement[n]; + + size = ft->Size (); + + ft->GetEdges (mb_str, n, edge_info); + ft->GetEscapements (mb_str, n, (float *) escapement); + + for (int32_t i = 0; i < n; ++i) + { + advance[i] = std::lrint (escapement[i] * size); + lb[i] = advance[i] - std::lrint (edge_info[i].left * size); + rb[i] = advance[i] + std::lrint (edge_info[i].right * size); + } +} + +static void +font_style_to_flags (char *st, struct haiku_font_pattern *pattern) +{ + char *style = strdup (st); + char *token; + pattern->weight = -1; + pattern->width = NO_WIDTH; + pattern->slant = NO_SLANT; + int tok = 0; + + while ((token = std::strtok (!tok ? style : NULL, " ")) && tok < 3) + { + if (token && !strcmp (token, "Thin")) + pattern->weight = HAIKU_THIN; + else if (token && !strcmp (token, "UltraLight")) + pattern->weight = HAIKU_ULTRALIGHT; + else if (token && !strcmp (token, "ExtraLight")) + pattern->weight = HAIKU_EXTRALIGHT; + else if (token && !strcmp (token, "Light")) + pattern->weight = HAIKU_LIGHT; + else if (token && !strcmp (token, "SemiLight")) + pattern->weight = HAIKU_SEMI_LIGHT; + else if (token && !strcmp (token, "Regular")) + { + if (pattern->slant == NO_SLANT) + pattern->slant = SLANT_REGULAR; + + if (pattern->width == NO_WIDTH) + pattern->width = NORMAL_WIDTH; + + if (pattern->weight == -1) + pattern->weight = HAIKU_REGULAR; + } + else if (token && (!strcmp (token, "SemiBold") + /* Likewise, this was reported by a user. */ + || !strcmp (token, "Semibold"))) + pattern->weight = HAIKU_SEMI_BOLD; + else if (token && !strcmp (token, "Bold")) + pattern->weight = HAIKU_BOLD; + else if (token && (!strcmp (token, "ExtraBold") || + /* This has actually been seen in the wild. */ + !strcmp (token, "Extrabold"))) + pattern->weight = HAIKU_EXTRA_BOLD; + else if (token && !strcmp (token, "UltraBold")) + pattern->weight = HAIKU_ULTRA_BOLD; + else if (token && !strcmp (token, "Book")) + pattern->weight = HAIKU_BOOK; + else if (token && !strcmp (token, "Heavy")) + pattern->weight = HAIKU_HEAVY; + else if (token && !strcmp (token, "UltraHeavy")) + pattern->weight = HAIKU_ULTRA_HEAVY; + else if (token && !strcmp (token, "Black")) + pattern->weight = HAIKU_BLACK; + else if (token && !strcmp (token, "Medium")) + pattern->weight = HAIKU_MEDIUM; + else if (token && !strcmp (token, "Oblique")) + pattern->slant = SLANT_OBLIQUE; + else if (token && !strcmp (token, "Italic")) + pattern->slant = SLANT_ITALIC; + else if (token && !strcmp (token, "UltraCondensed")) + pattern->width = ULTRA_CONDENSED; + else if (token && !strcmp (token, "ExtraCondensed")) + pattern->width = EXTRA_CONDENSED; + else if (token && !strcmp (token, "Condensed")) + pattern->width = CONDENSED; + else if (token && !strcmp (token, "SemiCondensed")) + pattern->width = SEMI_CONDENSED; + else if (token && !strcmp (token, "SemiExpanded")) + pattern->width = SEMI_EXPANDED; + else if (token && !strcmp (token, "Expanded")) + pattern->width = EXPANDED; + else if (token && !strcmp (token, "ExtraExpanded")) + pattern->width = EXTRA_EXPANDED; + else if (token && !strcmp (token, "UltraExpanded")) + pattern->width = ULTRA_EXPANDED; + else + { + tok = 1000; + break; + } + tok++; + } + + if (pattern->weight != -1) + pattern->specified |= FSPEC_WEIGHT; + if (pattern->slant != NO_SLANT) + pattern->specified |= FSPEC_SLANT; + if (pattern->width != NO_WIDTH) + pattern->specified |= FSPEC_WIDTH; + + if (tok > 3) + { + pattern->specified &= ~FSPEC_SLANT; + pattern->specified &= ~FSPEC_WEIGHT; + pattern->specified &= ~FSPEC_WIDTH; + pattern->specified |= FSPEC_STYLE; + std::strncpy ((char *) &pattern->style, st, + sizeof pattern->style - 1); + pattern->style[sizeof pattern->style - 1] = '\0'; + } + + free (style); +} + +static bool +font_check_wanted_chars (struct haiku_font_pattern *pattern, font_family family, + char *style) +{ + BFont ft; + + if (ft.SetFamilyAndStyle (family, style) != B_OK) + return false; + + for (int i = 0; i < pattern->want_chars_len; ++i) + if (!ft.IncludesBlock (pattern->wanted_chars[i], + pattern->wanted_chars[i])) + return false; + + return true; +} + +static bool +font_check_one_of (struct haiku_font_pattern *pattern, font_family family, + char *style) +{ + BFont ft; + + if (ft.SetFamilyAndStyle (family, style) != B_OK) + return false; + + for (int i = 0; i < pattern->need_one_of_len; ++i) + if (ft.IncludesBlock (pattern->need_one_of[i], + pattern->need_one_of[i])) + return true; + + return false; +} + +static bool +font_check_language (struct haiku_font_pattern *pattern, font_family family, + char *style) +{ + BFont ft; + + if (ft.SetFamilyAndStyle (family, style) != B_OK) + return false; + + if (pattern->language == MAX_LANGUAGE) + return false; + + for (uint32_t *ch = (uint32_t *) + &language_code_points[pattern->language]; *ch; ch++) + if (!ft.IncludesBlock (*ch, *ch)) + return false; + + return true; +} + +static bool +font_family_style_matches_p (font_family family, char *style, uint32_t flags, + struct haiku_font_pattern *pattern, + int ignore_flags_p = 0) +{ + struct haiku_font_pattern m; + m.specified = 0; + + if (style) + font_style_to_flags (style, &m); + + if ((pattern->specified & FSPEC_FAMILY) && + strcmp ((char *) &pattern->family, family)) + return false; + + if (!ignore_flags_p && (pattern->specified & FSPEC_SPACING) && + !(pattern->mono_spacing_p) != !(flags & B_IS_FIXED)) + return false; + + if (pattern->specified & FSPEC_STYLE) + return style && !strcmp (style, pattern->style); + + if ((pattern->specified & FSPEC_WEIGHT) + && (pattern->weight + != ((m.specified & FSPEC_WEIGHT) ? m.weight : HAIKU_REGULAR))) + return false; + + if ((pattern->specified & FSPEC_SLANT) + && (pattern->slant + != ((m.specified & FSPEC_SLANT) ? m.slant : SLANT_REGULAR))) + return false; + + if ((pattern->specified & FSPEC_WANTED) + && !font_check_wanted_chars (pattern, family, style)) + return false; + + if ((pattern->specified & FSPEC_WIDTH) + && (pattern->width != + ((m.specified & FSPEC_WIDTH) ? m.width : NORMAL_WIDTH))) + return false; + + if ((pattern->specified & FSPEC_NEED_ONE_OF) + && !font_check_one_of (pattern, family, style)) + return false; + + if ((pattern->specified & FSPEC_LANGUAGE) + && !font_check_language (pattern, family, style)) + return false; + + return true; +} + +static void +haiku_font_fill_pattern (struct haiku_font_pattern *pattern, + font_family family, char *style, + uint32_t flags) +{ + if (style) + font_style_to_flags (style, pattern); + + pattern->specified |= FSPEC_FAMILY; + std::strncpy (pattern->family, family, + sizeof pattern->family - 1); + pattern->family[sizeof pattern->family - 1] = '\0'; + pattern->specified |= FSPEC_SPACING; + pattern->mono_spacing_p = flags & B_IS_FIXED; +} + +/* Delete every element of the font pattern PT. */ +void +haiku_font_pattern_free (struct haiku_font_pattern *pt) +{ + struct haiku_font_pattern *tem = pt; + while (tem) + { + struct haiku_font_pattern *t = tem; + tem = t->next; + delete t; + } +} + +/* Find all fonts matching the font pattern PT. */ +struct haiku_font_pattern * +BFont_find (struct haiku_font_pattern *pt) +{ + struct haiku_font_pattern *r = NULL; + font_family name; + font_style sname; + uint32 flags; + int sty_count; + int fam_count = count_font_families (); + + for (int fi = 0; fi < fam_count; ++fi) + { + if (get_font_family (fi, &name, &flags) == B_OK) + { + sty_count = count_font_styles (name); + if (!sty_count && + font_family_style_matches_p (name, NULL, flags, pt)) + { + struct haiku_font_pattern *p = new struct haiku_font_pattern; + p->specified = 0; + p->oblique_seen_p = 1; + haiku_font_fill_pattern (p, name, NULL, flags); + p->next = r; + if (p->next) + p->next->last = p; + p->last = NULL; + p->next_family = r; + r = p; + } + else if (sty_count) + { + for (int si = 0; si < sty_count; ++si) + { + int oblique_seen_p = 0; + struct haiku_font_pattern *head = r; + struct haiku_font_pattern *p = NULL; + + if (get_font_style (name, si, &sname, &flags) == B_OK) + { + if (font_family_style_matches_p (name, (char *) &sname, flags, pt)) + { + p = new struct haiku_font_pattern; + p->specified = 0; + haiku_font_fill_pattern (p, name, (char *) &sname, flags); + if (p->specified & FSPEC_SLANT && + ((p->slant == SLANT_OBLIQUE) || (p->slant == SLANT_ITALIC))) + oblique_seen_p = 1; + + p->next = r; + if (p->next) + p->next->last = p; + r = p; + p->next_family = head; + } + } + + if (p) + p->last = NULL; + + for (; head; head = head->last) + { + head->oblique_seen_p = oblique_seen_p; + } + } + } + } + } + + /* There's a very good chance that this result will get cached if no + slant is specified. Thus, we look through each font that hasn't + seen an oblique style, and add one. */ + + if (!(pt->specified & FSPEC_SLANT)) + { + /* r->last is invalid from here onwards. */ + for (struct haiku_font_pattern *p = r; p;) + { + if (!p->oblique_seen_p) + { + struct haiku_font_pattern *n = new haiku_font_pattern; + *n = *p; + n->slant = SLANT_OBLIQUE; + p->next = n; + p = p->next_family; + } + else + p = p->next_family; + } + } + + return r; +} + +/* Find and open a font matching the pattern PAT, which must have its + family set. */ +int +BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size) +{ + int sty_count; + font_family name; + font_style sname; + uint32 flags = 0; + if (!(pat->specified & FSPEC_FAMILY)) + return 1; + strncpy (name, pat->family, sizeof name - 1); + name[sizeof name - 1] = '\0'; + + sty_count = count_font_styles (name); + + if (!sty_count && + font_family_style_matches_p (name, NULL, flags, pat, 1)) + { + BFont *ft = new BFont; + ft->SetSize (size); + ft->SetEncoding (B_UNICODE_UTF8); + ft->SetSpacing (B_BITMAP_SPACING); + + if (ft->SetFamilyAndStyle (name, NULL) != B_OK) + { + delete ft; + return 1; + } + *font = (void *) ft; + return 0; + } + else if (sty_count) + { + for (int si = 0; si < sty_count; ++si) + { + if (get_font_style (name, si, &sname, &flags) == B_OK && + font_family_style_matches_p (name, (char *) &sname, flags, pat)) + { + BFont *ft = new BFont; + ft->SetSize (size); + ft->SetEncoding (B_UNICODE_UTF8); + ft->SetSpacing (B_BITMAP_SPACING); + + if (ft->SetFamilyAndStyle (name, sname) != B_OK) + { + delete ft; + return 1; + } + *font = (void *) ft; + return 0; + } + } + } + + if (pat->specified & FSPEC_SLANT && pat->slant == SLANT_OBLIQUE) + { + struct haiku_font_pattern copy = *pat; + copy.slant = SLANT_REGULAR; + int code = BFont_open_pattern (©, font, size); + if (code) + return code; + BFont *ft = (BFont *) *font; + /* XXX Font measurements don't respect shear. Haiku bug? + This apparently worked in BeOS. + ft->SetShear (100.0); */ + ft->SetFace (B_ITALIC_FACE); + return 0; + } + + return 1; +} + +/* Query the family of the default fixed font. */ +void +BFont_populate_fixed_family (struct haiku_font_pattern *ptn) +{ + font_family f; + font_style s; + be_fixed_font->GetFamilyAndStyle (&f, &s); + + ptn->specified |= FSPEC_FAMILY; + strncpy (ptn->family, f, sizeof ptn->family - 1); + ptn->family[sizeof ptn->family - 1] = '\0'; +} + +void +BFont_populate_plain_family (struct haiku_font_pattern *ptn) +{ + font_family f; + font_style s; + be_plain_font->GetFamilyAndStyle (&f, &s); + + ptn->specified |= FSPEC_FAMILY; + strncpy (ptn->family, f, sizeof ptn->family - 1); + ptn->family[sizeof ptn->family - 1] = '\0'; +} + +haiku_font_family_or_style * +be_list_font_families (size_t *length) +{ + int32 families = count_font_families (); + haiku_font_family_or_style *array; + int32 idx; + uint32 flags; + + array = (haiku_font_family_or_style *) malloc (sizeof *array * families); + + if (!array) + return NULL; + + for (idx = 0; idx < families; ++idx) + { + if (get_font_family (idx, &array[idx], &flags) != B_OK) + array[idx][0] = '\0'; + } + + *length = families; + + return array; +} diff --git a/src/haiku_io.c b/src/haiku_io.c new file mode 100644 index 00000000000..89f0877eb67 --- /dev/null +++ b/src/haiku_io.c @@ -0,0 +1,225 @@ +/* Haiku window system support. + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include <signal.h> +#include <stdio.h> +#include <pthread.h> +#include <unistd.h> + +#include <OS.h> + +#include "haiku_support.h" +#include "lisp.h" +#include "haikuterm.h" +#include "blockinput.h" + +#define PORT_CAP 1200 + +/* The port used to send messages from the application thread to + Emacs. */ +port_id port_application_to_emacs; + +/* The port used to send popup menu messages from the application + thread to Emacs. */ +port_id port_popup_menu_to_emacs; + +void +haiku_io_init (void) +{ + port_application_to_emacs = create_port (PORT_CAP, "application emacs port"); +} + +static ssize_t +haiku_len (enum haiku_event_type type) +{ + switch (type) + { + case QUIT_REQUESTED: + return sizeof (struct haiku_quit_requested_event); + case FRAME_RESIZED: + return sizeof (struct haiku_resize_event); + case FRAME_EXPOSED: + return sizeof (struct haiku_expose_event); + case KEY_DOWN: + case KEY_UP: + return sizeof (struct haiku_key_event); + case ACTIVATION: + return sizeof (struct haiku_activation_event); + case MOUSE_MOTION: + return sizeof (struct haiku_mouse_motion_event); + case BUTTON_DOWN: + case BUTTON_UP: + return sizeof (struct haiku_button_event); + case ICONIFICATION: + return sizeof (struct haiku_iconification_event); + case MOVE_EVENT: + return sizeof (struct haiku_move_event); + case SCROLL_BAR_VALUE_EVENT: + return sizeof (struct haiku_scroll_bar_value_event); + case SCROLL_BAR_DRAG_EVENT: + return sizeof (struct haiku_scroll_bar_drag_event); + case WHEEL_MOVE_EVENT: + return sizeof (struct haiku_wheel_move_event); + case MENU_BAR_RESIZE: + return sizeof (struct haiku_menu_bar_resize_event); + case MENU_BAR_OPEN: + case MENU_BAR_CLOSE: + return sizeof (struct haiku_menu_bar_state_event); + case MENU_BAR_SELECT_EVENT: + return sizeof (struct haiku_menu_bar_select_event); + case FILE_PANEL_EVENT: + return sizeof (struct haiku_file_panel_event); + case MENU_BAR_HELP_EVENT: + return sizeof (struct haiku_menu_bar_help_event); + case ZOOM_EVENT: + return sizeof (struct haiku_zoom_event); + case DRAG_AND_DROP_EVENT: + return sizeof (struct haiku_drag_and_drop_event); + case APP_QUIT_REQUESTED_EVENT: + return sizeof (struct haiku_app_quit_requested_event); + case DUMMY_EVENT: + return sizeof (struct haiku_dummy_event); + case MENU_BAR_LEFT: + return sizeof (struct haiku_menu_bar_left_event); + case SCROLL_BAR_PART_EVENT: + return sizeof (struct haiku_scroll_bar_part_event); + } + + emacs_abort (); +} + +/* Read the size of the next message into len, returning -1 if the + query fails or there is no next message. */ +void +haiku_read_size (ssize_t *len, bool popup_menu_p) +{ + port_id from = (popup_menu_p + ? port_popup_menu_to_emacs + : port_application_to_emacs); + ssize_t size; + + size = port_buffer_size_etc (from, B_TIMEOUT, 0); + + if (size < B_OK) + *len = -1; + else + *len = size; +} + +/* Read the next message into BUF, putting its type into TYPE, + assuming the message is at most LEN long. Return 0 if successful + and -1 if the read fails. */ +int +haiku_read (enum haiku_event_type *type, void *buf, ssize_t len) +{ + int32 typ; + port_id from = port_application_to_emacs; + + if (read_port (from, &typ, buf, len) < B_OK) + return -1; + + *type = (enum haiku_event_type) typ; + eassert (len >= haiku_len (typ)); + return 0; +} + +/* The same as haiku_read, but time out after TIMEOUT microseconds. + POPUP_MENU_P means to read from the popup menu port instead. + Input is blocked when an attempt to read is in progress. */ +int +haiku_read_with_timeout (enum haiku_event_type *type, void *buf, ssize_t len, + bigtime_t timeout, bool popup_menu_p) +{ + int32 typ; + port_id from = (popup_menu_p + ? port_popup_menu_to_emacs + : port_application_to_emacs); + + block_input (); + if (read_port_etc (from, &typ, buf, len, + B_TIMEOUT, (bigtime_t) timeout) < B_OK) + { + unblock_input (); + return -1; + } + unblock_input (); + *type = (enum haiku_event_type) typ; + eassert (len >= haiku_len (typ)); + return 0; +} + +/* Write a message with type TYPE into BUF. */ +int +haiku_write (enum haiku_event_type type, void *buf) +{ + port_id to = port_application_to_emacs; + + if (write_port (to, (int32_t) type, buf, haiku_len (type)) < B_OK) + return -1; + + kill (getpid (), SIGPOLL); + + return 0; +} + +int +haiku_write_without_signal (enum haiku_event_type type, void *buf, + bool popup_menu_p) +{ + port_id to = (popup_menu_p + ? port_popup_menu_to_emacs + : port_application_to_emacs); + + if (write_port (to, (int32_t) type, buf, haiku_len (type)) < B_OK) + return -1; + + return 0; +} + +void +haiku_io_init_in_app_thread (void) +{ + sigset_t set; + sigfillset (&set); + + if (pthread_sigmask (SIG_BLOCK, &set, NULL)) + perror ("pthread_sigmask"); +} + +/* Record an unwind protect from C++ code. */ +void +record_c_unwind_protect_from_cxx (void (*fn) (void *), void *r) +{ + record_unwind_protect_ptr (fn, r); +} + +/* SPECPDL_IDX that is safe from C++ code. */ +specpdl_ref +c_specpdl_idx_from_cxx (void) +{ + return SPECPDL_INDEX (); +} + +/* unbind_to (IDX, Qnil), but safe from C++ code. */ +void +c_unbind_to_nil_from_cxx (specpdl_ref idx) +{ + unbind_to (idx, Qnil); +} diff --git a/src/haiku_select.cc b/src/haiku_select.cc new file mode 100644 index 00000000000..be8026b6a16 --- /dev/null +++ b/src/haiku_select.cc @@ -0,0 +1,483 @@ +/* Haiku window system selection support. Hey Emacs, this is -*- C++ -*- + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include <Clipboard.h> +#include <Message.h> +#include <Path.h> +#include <Entry.h> + +#include <cstdlib> +#include <cstring> + +#include "haikuselect.h" + +static BClipboard *primary = NULL; +static BClipboard *secondary = NULL; +static BClipboard *system_clipboard = NULL; +static int64 count_clipboard = -1; +static int64 count_primary = -1; +static int64 count_secondary = -1; + +int selection_state_flag; + +static char * +BClipboard_find_data (BClipboard *cb, const char *type, ssize_t *len) +{ + if (!cb->Lock ()) + return 0; + + BMessage *dat = cb->Data (); + if (!dat) + { + cb->Unlock (); + return 0; + } + + const char *ptr; + ssize_t bt; + dat->FindData (type, B_MIME_TYPE, (const void **) &ptr, &bt); + + if (!ptr) + { + cb->Unlock (); + return NULL; + } + + if (len) + *len = bt; + + void *data = malloc (bt); + + if (!data) + { + cb->Unlock (); + return NULL; + } + + memcpy (data, ptr, bt); + cb->Unlock (); + return (char *) data; +} + +static void +BClipboard_get_targets (BClipboard *cb, char **buf, int buf_size) +{ + BMessage *data; + char *name; + int32 count_found; + type_code type; + int32 i; + int index; + + if (!cb->Lock ()) + { + buf[0] = NULL; + return; + } + + data = cb->Data (); + index = 0; + + if (!data) + { + buf[0] = NULL; + cb->Unlock (); + return; + } + + for (i = 0; (data->GetInfo (B_ANY_TYPE, i, &name, + &type, &count_found) + == B_OK); ++i) + { + if (type == B_MIME_TYPE) + { + if (index < (buf_size - 1)) + { + buf[index++] = strdup (name); + + if (!buf[index - 1]) + break; + } + } + } + + buf[index] = NULL; + + cb->Unlock (); +} + +static void +BClipboard_set_data (BClipboard *cb, const char *type, const char *dat, + ssize_t len, bool clear) +{ + if (!cb->Lock ()) + return; + + if (clear) + cb->Clear (); + + BMessage *mdat = cb->Data (); + if (!mdat) + { + cb->Unlock (); + return; + } + + if (dat) + { + if (mdat->ReplaceData (type, B_MIME_TYPE, dat, len) + == B_NAME_NOT_FOUND) + mdat->AddData (type, B_MIME_TYPE, dat, len); + } + else + mdat->RemoveName (type); + cb->Commit (); + cb->Unlock (); +} + +char * +BClipboard_find_system_data (const char *type, ssize_t *len) +{ + if (!system_clipboard) + return 0; + + return BClipboard_find_data (system_clipboard, type, len); +} + +char * +BClipboard_find_primary_selection_data (const char *type, ssize_t *len) +{ + if (!primary) + return 0; + + return BClipboard_find_data (primary, type, len); +} + +char * +BClipboard_find_secondary_selection_data (const char *type, ssize_t *len) +{ + if (!secondary) + return 0; + + return BClipboard_find_data (secondary, type, len); +} + +void +BClipboard_set_system_data (const char *type, const char *data, + ssize_t len, bool clear) +{ + if (!system_clipboard) + return; + + count_clipboard = system_clipboard->SystemCount (); + BClipboard_set_data (system_clipboard, type, data, len, clear); +} + +void +BClipboard_set_primary_selection_data (const char *type, const char *data, + ssize_t len, bool clear) +{ + if (!primary) + return; + + count_primary = primary->SystemCount (); + BClipboard_set_data (primary, type, data, len, clear); +} + +void +BClipboard_set_secondary_selection_data (const char *type, const char *data, + ssize_t len, bool clear) +{ + if (!secondary) + return; + + count_secondary = secondary->SystemCount (); + BClipboard_set_data (secondary, type, data, len, clear); +} + +void +BClipboard_free_data (void *ptr) +{ + std::free (ptr); +} + +void +BClipboard_system_targets (char **buf, int len) +{ + BClipboard_get_targets (system_clipboard, buf, len); +} + +void +BClipboard_primary_targets (char **buf, int len) +{ + BClipboard_get_targets (primary, buf, len); +} + +void +BClipboard_secondary_targets (char **buf, int len) +{ + BClipboard_get_targets (secondary, buf, len); +} + +bool +BClipboard_owns_clipboard (void) +{ + return (count_clipboard >= 0 + && (count_clipboard + 1 + == system_clipboard->SystemCount ())); +} + +bool +BClipboard_owns_primary (void) +{ + return (count_primary >= 0 + && (count_primary + 1 + == primary->SystemCount ())); +} + +bool +BClipboard_owns_secondary (void) +{ + return (count_secondary >= 0 + && (count_secondary + 1 + == secondary->SystemCount ())); +} + +void +init_haiku_select (void) +{ + system_clipboard = new BClipboard ("system"); + primary = new BClipboard ("primary"); + secondary = new BClipboard ("secondary"); +} + +int +be_enum_message (void *message, int32 *tc, int32 index, + int32 *count, const char **name_return) +{ + BMessage *msg = (BMessage *) message; + type_code type; + char *name; + status_t rc; + + rc = msg->GetInfo (B_ANY_TYPE, index, &name, &type, count); + + if (rc != B_OK) + return 1; + + *tc = type; + *name_return = name; + return 0; +} + +int +be_get_refs_data (void *message, const char *name, + int32 index, char **path_buffer) +{ + status_t rc; + BEntry entry; + BPath path; + entry_ref ref; + BMessage *msg; + + msg = (BMessage *) message; + rc = msg->FindRef (name, index, &ref); + + if (rc != B_OK) + return 1; + + rc = entry.SetTo (&ref, 0); + + if (rc != B_OK) + return 1; + + rc = entry.GetPath (&path); + + if (rc != B_OK) + return 1; + + *path_buffer = strdup (path.Path ()); + return 0; +} + +int +be_get_point_data (void *message, const char *name, + int32 index, float *x, float *y) +{ + status_t rc; + BMessage *msg; + BPoint point; + + msg = (BMessage *) message; + rc = msg->FindPoint (name, index, &point); + + if (rc != B_OK) + return 1; + + *x = point.x; + *y = point.y; + + return 0; +} + +int +be_get_message_data (void *message, const char *name, + int32 type_code, int32 index, + const void **buf_return, + ssize_t *size_return) +{ + BMessage *msg = (BMessage *) message; + + return msg->FindData (name, type_code, + index, buf_return, size_return) != B_OK; +} + +uint32 +be_get_message_type (void *message) +{ + BMessage *msg = (BMessage *) message; + + return msg->what; +} + +void +be_set_message_type (void *message, uint32 what) +{ + BMessage *msg = (BMessage *) message; + + msg->what = what; +} + +void * +be_get_message_message (void *message, const char *name, + int32 index) +{ + BMessage *msg = (BMessage *) message; + BMessage *out = new (std::nothrow) BMessage; + + if (!out) + return NULL; + + if (msg->FindMessage (name, index, out) != B_OK) + { + delete out; + return NULL; + } + + return out; +} + +void * +be_create_simple_message (void) +{ + return new BMessage (B_SIMPLE_DATA); +} + +int +be_add_message_data (void *message, const char *name, + int32 type_code, const void *buf, + ssize_t buf_size) +{ + BMessage *msg = (BMessage *) message; + + return msg->AddData (name, type_code, buf, buf_size) != B_OK; +} + +int +be_add_refs_data (void *message, const char *name, + const char *filename) +{ + BEntry entry (filename); + entry_ref ref; + BMessage *msg = (BMessage *) message; + + if (entry.InitCheck () != B_OK) + return 1; + + if (entry.GetRef (&ref) != B_OK) + return 1; + + return msg->AddRef (name, &ref) != B_OK; +} + +int +be_add_point_data (void *message, const char *name, + float x, float y) +{ + BMessage *msg = (BMessage *) message; + + return msg->AddPoint (name, BPoint (x, y)) != B_OK; +} + +int +be_add_message_message (void *message, const char *name, + void *data) +{ + BMessage *msg = (BMessage *) message; + BMessage *data_message = (BMessage *) data; + + if (msg->AddMessage (name, data_message) != B_OK) + return 1; + + return 0; +} + +int +be_lock_clipboard_message (enum haiku_clipboard clipboard, + void **message_return, bool clear) +{ + BClipboard *board; + + if (clipboard == CLIPBOARD_PRIMARY) + board = primary; + else if (clipboard == CLIPBOARD_SECONDARY) + board = secondary; + else + board = system_clipboard; + + if (!board->Lock ()) + return 1; + + if (clear) + board->Clear (); + + *message_return = board->Data (); + return 0; +} + +void +be_unlock_clipboard (enum haiku_clipboard clipboard, bool discard) +{ + BClipboard *board; + + if (clipboard == CLIPBOARD_PRIMARY) + board = primary; + else if (clipboard == CLIPBOARD_SECONDARY) + board = secondary; + else + board = system_clipboard; + + if (discard) + board->Revert (); + else + board->Commit (); + + board->Unlock (); +} diff --git a/src/haiku_support.cc b/src/haiku_support.cc new file mode 100644 index 00000000000..e7c157dac84 --- /dev/null +++ b/src/haiku_support.cc @@ -0,0 +1,4276 @@ +/* Haiku window system support. Hey, Emacs, this is -*- C++ -*- + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include <app/Application.h> +#include <app/Cursor.h> +#include <app/Messenger.h> + +#include <interface/GraphicsDefs.h> +#include <interface/InterfaceDefs.h> +#include <interface/Bitmap.h> +#include <interface/Window.h> +#include <interface/View.h> +#include <interface/Screen.h> +#include <interface/ScrollBar.h> +#include <interface/Region.h> +#include <interface/Menu.h> +#include <interface/MenuItem.h> +#include <interface/PopUpMenu.h> +#include <interface/MenuBar.h> +#include <interface/Alert.h> +#include <interface/Button.h> +#include <interface/ControlLook.h> +#include <interface/Deskbar.h> + +#include <locale/UnicodeChar.h> + +#include <game/WindowScreen.h> +#include <game/DirectWindow.h> + +#include <storage/Entry.h> +#include <storage/Path.h> +#include <storage/FilePanel.h> +#include <storage/AppFileInfo.h> +#include <storage/Path.h> +#include <storage/PathFinder.h> + +#include <support/Beep.h> +#include <support/DataIO.h> +#include <support/Locker.h> + +#include <translation/TranslatorRoster.h> +#include <translation/TranslationDefs.h> +#include <translation/TranslationUtils.h> + +#include <kernel/OS.h> +#include <kernel/fs_attr.h> +#include <kernel/scheduler.h> + +#include <private/interface/ToolTip.h> +#include <private/interface/WindowPrivate.h> + +#include <cmath> +#include <cstring> +#include <cstdint> +#include <cstdio> +#include <csignal> +#include <cfloat> + +#include <pthread.h> + +#ifdef USE_BE_CAIRO +#include <cairo.h> +#endif + +#include "haiku_support.h" + +/* Some messages that Emacs sends to itself. */ +enum + { + SCROLL_BAR_UPDATE = 3000, + WAIT_FOR_RELEASE = 3001, + RELEASE_NOW = 3002, + CANCEL_DROP = 3003, + SHOW_MENU_BAR = 3004, + BE_MENU_BAR_OPEN = 3005, + QUIT_APPLICATION = 3006, + }; + +/* X11 keysyms that we use. */ +enum + { + KEY_BACKSPACE = 0xff08, + KEY_TAB = 0xff09, + KEY_RETURN = 0xff0d, + KEY_PAUSE = 0xff13, + KEY_ESCAPE = 0xff1b, + KEY_DELETE = 0xffff, + KEY_HOME = 0xff50, + KEY_LEFT_ARROW = 0xff51, + KEY_UP_ARROW = 0xff52, + KEY_RIGHT_ARROW = 0xff53, + KEY_DOWN_ARROW = 0xff54, + KEY_PAGE_UP = 0xff55, + KEY_PAGE_DOWN = 0xff56, + KEY_END = 0xff57, + KEY_PRINT = 0xff61, + KEY_INSERT = 0xff63, + /* This is used to indicate the first function key. */ + KEY_F1 = 0xffbe, + /* These are found on some multilingual keyboards. */ + KEY_HANGUL = 0xff31, + KEY_HANGUL_HANJA = 0xff34, + KEY_HIRIGANA_KATAGANA = 0xff27, + KEY_ZENKAKU_HANKAKU = 0xff2a, + }; + +static color_space dpy_color_space = B_NO_COLOR_SPACE; +static key_map *key_map = NULL; +static char *key_chars = NULL; +static BLocker key_map_lock; + +/* The locking semantics of BWindows running in multiple threads are + so complex that child frame state (which is the only state that is + shared between different BWindows at runtime) does best with a + single global lock. */ + +static BLocker child_frame_lock; + +/* A LeaveNotify event (well, the closest equivalent on Haiku, which + is a B_MOUSE_MOVED event with `transit' set to B_EXITED_VIEW) might + be sent out-of-order with regards to motion events from other + windows, such as when the mouse pointer rapidly moves from an + undecorated child frame to its parent. This can cause a failure to + clear the mouse face on the former if an event for the latter is + read by Emacs first and ends up showing the mouse face there. + + While this lock doesn't really ensure that the events will be + delivered in the correct order, it makes them arrive in the correct + order "most of the time" on my machine, which is good enough and + preferable to adding a lot of extra complexity to the event + handling code to sort motion events by their timestamps. + + Obviously this depends on the number of execution units that are + available, and the scheduling priority of each thread involved in + the input handling, but it will be good enough for most people. */ + +static BLocker movement_locker; + +static BMessage volatile *popup_track_message; +static int32 volatile alert_popup_value; +static int current_window_id; + +static void *grab_view = NULL; +static BLocker grab_view_locker; +static bool drag_and_drop_in_progress; + +/* Many places require us to lock the child frame data, and then lock + the locker of some random window. Unfortunately, locking such a + window might be delayed due to an arriving message, which then + calls a callback inside that window that tries to lock the child + frame data but doesn't finish since the child frame lock is already + held, not letting the code that held the child frame lock proceed, + thereby causing a deadlock. + + Rectifying that problem is simple: all code in a looper callback + must lock the child frame data with this macro instead. + + IOW, If some other code is already running with the child frame + lock held, don't interfere: wait until it's finished before + continuing. */ +#define CHILD_FRAME_LOCK_INSIDE_LOOPER_CALLBACK \ + if (child_frame_lock.LockWithTimeout (200) != B_OK) \ + { \ + /* The Haiku equivalent of XPutBackEvent. */ \ + if (CurrentMessage ()) \ + PostMessage (CurrentMessage ()); \ + } \ + else + +/* This could be a private API, but it's used by (at least) the Qt + port, so it's probably here to stay. */ +extern status_t get_subpixel_antialiasing (bool *); + +extern "C" +{ + extern _Noreturn void emacs_abort (void); + /* Also defined in haikuterm.h. */ + extern void be_app_quit (void); +} + +static thread_id app_thread; + +_Noreturn void +gui_abort (const char *msg) +{ + fprintf (stderr, "Abort in GUI code: %s\n", msg); + fprintf (stderr, "Under Haiku, Emacs cannot recover from errors in GUI code\n"); + fprintf (stderr, "App Server disconnects usually manifest as bitmap " + "initialization failures or lock failures."); + emacs_abort (); +} + +struct be_popup_menu_data +{ + int x, y; + BPopUpMenu *menu; +}; + +static int32 +be_popup_menu_thread_entry (void *thread_data) +{ + struct be_popup_menu_data *data; + struct haiku_dummy_event dummy; + BMenuItem *it; + + data = (struct be_popup_menu_data *) thread_data; + + it = data->menu->Go (BPoint (data->x, data->y)); + + if (it) + popup_track_message = it->Message (); + else + popup_track_message = NULL; + + haiku_write (DUMMY_EVENT, &dummy); + return 0; +} + +/* Convert a raw character RAW produced by the keycode KEY into a key + symbol and place it in KEYSYM. + + If RAW cannot be converted into a keysym, value is 0. If RAW can + be converted into a keysym, but it should be ignored, value is -1. + + Any other value means success, and that the keysym should be used + instead of mapping the keycode into a character. */ + +static int +keysym_from_raw_char (int32 raw, int32 key, unsigned *code) +{ + switch (raw) + { + case B_BACKSPACE: + *code = KEY_BACKSPACE; + break; + case B_RETURN: + *code = KEY_RETURN; + break; + case B_TAB: + *code = KEY_TAB; + break; + case B_ESCAPE: + *code = KEY_ESCAPE; + break; + case B_LEFT_ARROW: + *code = KEY_LEFT_ARROW; + break; + case B_RIGHT_ARROW: + *code = KEY_RIGHT_ARROW; + break; + case B_UP_ARROW: + *code = KEY_UP_ARROW; + break; + case B_DOWN_ARROW: + *code = KEY_DOWN_ARROW; + break; + case B_INSERT: + *code = KEY_INSERT; + break; + case B_DELETE: + *code = KEY_DELETE; + break; + case B_HOME: + *code = KEY_HOME; + break; + case B_END: + *code = KEY_END; + break; + case B_PAGE_UP: + *code = KEY_PAGE_UP; + break; + case B_PAGE_DOWN: + *code = KEY_PAGE_DOWN; + break; + + case B_FUNCTION_KEY: + *code = KEY_F1 + key - 2; + + if (*code - KEY_F1 == 12) + *code = KEY_PRINT; + else if (*code - KEY_F1 == 13) + /* Okay, Scroll Lock is a bit too much: keyboard.c doesn't + know about it yet, and it shouldn't, since that's a + modifier key. + + *code = KEY_SCROLL_LOCK; */ + return -1; + else if (*code - KEY_F1 == 14) + *code = KEY_PAUSE; + + break; + + case B_HANGUL: + *code = KEY_HANGUL; + break; + case B_HANGUL_HANJA: + *code = KEY_HANGUL_HANJA; + break; + case B_KATAKANA_HIRAGANA: + *code = KEY_HIRIGANA_KATAGANA; + break; + case B_HANKAKU_ZENKAKU: + *code = KEY_ZENKAKU_HANKAKU; + break; + + default: + return 0; + } + + return 1; +} + +static void +map_key (char *chars, int32 offset, uint32_t *c) +{ + int size = chars[offset++]; + switch (size) + { + case 0: + break; + + case 1: + *c = chars[offset]; + break; + + default: + { + char str[5]; + int i = (size <= 4) ? size : 4; + strncpy (str, &(chars[offset]), i); + str[i] = '0'; + *c = BUnicodeChar::FromUTF8 ((char *) &str); + break; + } + } +} + +static void +map_shift (uint32_t kc, uint32_t *ch) +{ + if (!key_map_lock.Lock ()) + gui_abort ("Failed to lock keymap"); + if (!key_map) + get_key_map (&key_map, &key_chars); + if (!key_map) + return; + if (kc >= 128) + return; + + int32_t m = key_map->shift_map[kc]; + map_key (key_chars, m, ch); + key_map_lock.Unlock (); +} + +static void +map_caps (uint32_t kc, uint32_t *ch) +{ + if (!key_map_lock.Lock ()) + gui_abort ("Failed to lock keymap"); + if (!key_map) + get_key_map (&key_map, &key_chars); + if (!key_map) + return; + if (kc >= 128) + return; + + int32_t m = key_map->caps_map[kc]; + map_key (key_chars, m, ch); + key_map_lock.Unlock (); +} + +static void +map_caps_shift (uint32_t kc, uint32_t *ch) +{ + if (!key_map_lock.Lock ()) + gui_abort ("Failed to lock keymap"); + if (!key_map) + get_key_map (&key_map, &key_chars); + if (!key_map) + return; + if (kc >= 128) + return; + + int32_t m = key_map->caps_shift_map[kc]; + map_key (key_chars, m, ch); + key_map_lock.Unlock (); +} + +static void +map_normal (uint32_t kc, uint32_t *ch) +{ + if (!key_map_lock.Lock ()) + gui_abort ("Failed to lock keymap"); + if (!key_map) + get_key_map (&key_map, &key_chars); + if (!key_map) + return; + if (kc >= 128) + return; + + int32_t m = key_map->normal_map[kc]; + map_key (key_chars, m, ch); + key_map_lock.Unlock (); +} + +class Emacs : public BApplication +{ +public: + BMessage settings; + bool settings_valid_p = false; + + Emacs () : BApplication ("application/x-vnd.GNU-emacs") + { + BPath settings_path; + + if (find_directory (B_USER_SETTINGS_DIRECTORY, &settings_path) != B_OK) + return; + + settings_path.Append (PACKAGE_NAME); + + BEntry entry (settings_path.Path ()); + BFile settings_file (&entry, B_READ_ONLY | B_CREATE_FILE); + + if (settings.Unflatten (&settings_file) != B_OK) + return; + + settings_valid_p = true; + } + + void + AboutRequested (void) + { + BAlert *about = new BAlert (PACKAGE_NAME, + PACKAGE_STRING + "\nThe extensible, self-documenting, real-time display editor.", + "Close"); + about->Go (); + } + + bool + QuitRequested (void) + { + struct haiku_app_quit_requested_event rq; + haiku_write (APP_QUIT_REQUESTED_EVENT, &rq); + return 0; + } + + void + MessageReceived (BMessage *msg) + { + if (msg->what == QUIT_APPLICATION) + Quit (); + else + BApplication::MessageReceived (msg); + } +}; + +class EmacsWindow : public BWindow +{ +public: + struct child_frame + { + struct child_frame *next; + int xoff, yoff; + EmacsWindow *window; + } *subset_windows = NULL; + + EmacsWindow *parent = NULL; + BRect pre_fullscreen_rect; + BRect pre_zoom_rect; + int x_before_zoom = INT_MIN; + int y_before_zoom = INT_MIN; + bool fullscreen_p = false; + bool zoomed_p = false; + bool shown_flag = false; + volatile int was_shown_p = 0; + bool menu_bar_active_p = false; + bool override_redirect_p = false; + window_look pre_override_redirect_look; + window_feel pre_override_redirect_feel; + uint32 pre_override_redirect_workspaces; + pthread_mutex_t menu_update_mutex = PTHREAD_MUTEX_INITIALIZER; + pthread_cond_t menu_update_cv = PTHREAD_COND_INITIALIZER; + bool menu_updated_p = false; + int window_id; + bool *menus_begun = NULL; + + EmacsWindow () : BWindow (BRect (0, 0, 0, 0), "", B_TITLED_WINDOW_LOOK, + B_NORMAL_WINDOW_FEEL, B_NO_SERVER_SIDE_WINDOW_MODIFIERS) + { + window_id = current_window_id++; + + /* This pulse rate is used by scroll bars for repeating a button + action while a button is held down. */ + SetPulseRate (30000); + } + + ~EmacsWindow () + { + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + struct child_frame *next; + for (struct child_frame *f = subset_windows; f; f = next) + { + if (f->window->LockLooper ()) + gui_abort ("Failed to lock looper for unparent"); + f->window->Unparent (); + f->window->UnlockLooper (); + next = f->next; + delete f; + } + + if (this->parent) + UnparentAndUnlink (); + child_frame_lock.Unlock (); + + pthread_cond_destroy (&menu_update_cv); + pthread_mutex_destroy (&menu_update_mutex); + } + + BRect + CalculateZoomRect (void) + { + BScreen screen (this); + BDeskbar deskbar; + BRect screen_frame; + BRect frame; + BRect deskbar_frame; + BRect window_frame; + BRect decorator_frame; + + if (!screen.IsValid ()) + gui_abort ("Failed to calculate screen rect"); + + screen_frame = frame = screen.Frame (); + deskbar_frame = deskbar.Frame (); + + if (!(modifiers () & B_SHIFT_KEY) && !deskbar.IsAutoHide ()) + { + switch (deskbar.Location ()) + { + case B_DESKBAR_TOP: + frame.top = deskbar_frame.bottom + 2; + break; + + case B_DESKBAR_BOTTOM: + case B_DESKBAR_LEFT_BOTTOM: + case B_DESKBAR_RIGHT_BOTTOM: + frame.bottom = deskbar_frame.top - 2; + break; + + case B_DESKBAR_LEFT_TOP: + if (!deskbar.IsExpanded ()) + frame.top = deskbar_frame.bottom + 2; + else if (!deskbar.IsAlwaysOnTop () + && !deskbar.IsAutoRaise ()) + frame.left = deskbar_frame.right + 2; + break; + + default: + if (deskbar.IsExpanded () + && !deskbar.IsAlwaysOnTop () + && !deskbar.IsAutoRaise ()) + frame.right = deskbar_frame.left - 2; + } + } + + window_frame = Frame (); + decorator_frame = DecoratorFrame (); + + frame.top += (window_frame.top + - decorator_frame.top); + frame.bottom -= (decorator_frame.bottom + - window_frame.bottom); + frame.left += (window_frame.left + - decorator_frame.left); + frame.right -= (decorator_frame.right + - window_frame.right); + + if (frame.top > deskbar_frame.bottom + || frame.bottom < deskbar_frame.top) + { + frame.left = screen_frame.left + (window_frame.left + - decorator_frame.left); + frame.right = screen_frame.right - (decorator_frame.right + - window_frame.right); + } + + return frame; + } + + void + UpwardsSubset (EmacsWindow *w) + { + for (; w; w = w->parent) + AddToSubset (w); + } + + void + UpwardsSubsetChildren (EmacsWindow *w) + { + if (!LockLooper ()) + gui_abort ("Failed to lock looper for subset"); + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + UpwardsSubset (w); + for (struct child_frame *f = subset_windows; f; + f = f->next) + f->window->UpwardsSubsetChildren (w); + child_frame_lock.Unlock (); + UnlockLooper (); + } + + void + UpwardsUnSubset (EmacsWindow *w) + { + for (; w; w = w->parent) + RemoveFromSubset (w); + } + + void + UpwardsUnSubsetChildren (EmacsWindow *w) + { + if (!LockLooper ()) + gui_abort ("Failed to lock looper for unsubset"); + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + UpwardsUnSubset (w); + for (struct child_frame *f = subset_windows; f; + f = f->next) + f->window->UpwardsUnSubsetChildren (w); + child_frame_lock.Unlock (); + UnlockLooper (); + } + + void + Unparent (void) + { + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + this->SetFeel (B_NORMAL_WINDOW_FEEL); + UpwardsUnSubsetChildren (parent); + this->RemoveFromSubset (this); + this->parent = NULL; + if (fullscreen_p) + { + fullscreen_p = 0; + MakeFullscreen (1); + } + child_frame_lock.Unlock (); + } + + void + UnparentAndUnlink (void) + { + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + this->parent->UnlinkChild (this); + this->Unparent (); + child_frame_lock.Unlock (); + } + + void + UnlinkChild (EmacsWindow *window) + { + struct child_frame *last = NULL; + struct child_frame *tem = subset_windows; + + for (; tem; last = tem, tem = tem->next) + { + if (tem->window == window) + { + if (last) + last->next = tem->next; + else + subset_windows = tem->next; + delete tem; + return; + } + } + + gui_abort ("Failed to unlink child frame"); + } + + void + ParentTo (EmacsWindow *window) + { + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + + if (this->parent) + UnparentAndUnlink (); + + this->parent = window; + this->SetFeel (B_FLOATING_SUBSET_WINDOW_FEEL); + this->AddToSubset (this); + if (!IsHidden () && this->parent) + UpwardsSubsetChildren (parent); + if (fullscreen_p) + { + fullscreen_p = 0; + MakeFullscreen (1); + } + window->LinkChild (this); + + child_frame_lock.Unlock (); + } + + void + LinkChild (EmacsWindow *window) + { + struct child_frame *f = new struct child_frame; + + for (struct child_frame *f = subset_windows; f; + f = f->next) + { + if (window == f->window) + gui_abort ("Trying to link a child frame that is already present"); + } + + f->window = window; + f->next = subset_windows; + f->xoff = -1; + f->yoff = -1; + + subset_windows = f; + } + + void + DoMove (struct child_frame *f) + { + BRect frame = this->Frame (); + f->window->MoveTo (frame.left + f->xoff, + frame.top + f->yoff); + } + + void + DoUpdateWorkspace (struct child_frame *f) + { + f->window->SetWorkspaces (this->Workspaces ()); + } + + void + MoveChild (EmacsWindow *window, int xoff, int yoff, + int weak_p) + { + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + + for (struct child_frame *f = subset_windows; f; + f = f->next) + { + if (window == f->window) + { + f->xoff = xoff; + f->yoff = yoff; + if (!weak_p) + DoMove (f); + + child_frame_lock.Unlock (); + return; + } + } + + child_frame_lock.Unlock (); + gui_abort ("Trying to move a child frame that doesn't exist"); + } + + void + WindowActivated (bool activated) + { + struct haiku_activation_event rq; + rq.window = this; + rq.activated_p = activated; + + haiku_write (ACTIVATION, &rq); + } + + void + MessageReceived (BMessage *msg) + { + int32 old_what = 0; + + if (msg->WasDropped ()) + { + BPoint whereto; + int32 windowid; + struct haiku_drag_and_drop_event rq; + + if (msg->FindInt32 ("emacs:window_id", &windowid) == B_OK + && !msg->IsSourceRemote () + && windowid == this->window_id) + return; + + whereto = msg->DropPoint (); + + this->ConvertFromScreen (&whereto); + + rq.window = this; + rq.message = DetachCurrentMessage (); + rq.x = whereto.x; + rq.y = whereto.y; + + haiku_write (DRAG_AND_DROP_EVENT, &rq); + } + else if (msg->GetPointer ("menuptr")) + { + struct haiku_menu_bar_select_event rq; + + rq.window = this; + rq.ptr = (void *) msg->GetPointer ("menuptr"); + + haiku_write (MENU_BAR_SELECT_EVENT, &rq); + } + else if (msg->what == 'FPSE' + || ((msg->FindInt32 ("old_what", &old_what) == B_OK + && old_what == 'FPSE'))) + { + struct haiku_file_panel_event rq; + BEntry entry; + BPath path; + entry_ref ref; + + rq.ptr = NULL; + + if (msg->FindRef ("refs", &ref) == B_OK && + entry.SetTo (&ref, 0) == B_OK && + entry.GetPath (&path) == B_OK) + { + const char *str_path = path.Path (); + if (str_path) + rq.ptr = strdup (str_path); + } + + if (msg->FindRef ("directory", &ref), + entry.SetTo (&ref, 0) == B_OK && + entry.GetPath (&path) == B_OK) + { + const char *name = msg->GetString ("name"); + const char *str_path = path.Path (); + + if (name) + { + char str_buf[std::strlen (str_path) + + std::strlen (name) + 2]; + snprintf ((char *) &str_buf, + std::strlen (str_path) + + std::strlen (name) + 2, "%s/%s", + str_path, name); + rq.ptr = strdup (str_buf); + } + } + + haiku_write (FILE_PANEL_EVENT, &rq); + } + else + BWindow::MessageReceived (msg); + } + + void + DispatchMessage (BMessage *msg, BHandler *handler) + { + if (msg->what == B_KEY_DOWN || msg->what == B_KEY_UP) + { + struct haiku_key_event rq; + + /* Pass through key events to the regular dispatch mechanism + if the menu bar active, so that key navigation can work. */ + if (menu_bar_active_p) + { + BWindow::DispatchMessage (msg, handler); + return; + } + + rq.window = this; + + int32 raw, key; + int ret; + msg->FindInt32 ("raw_char", &raw); + msg->FindInt32 ("key", &key); + msg->FindInt64 ("when", &rq.time); + + rq.modifiers = 0; + uint32_t mods = modifiers (); + + if (mods & B_SHIFT_KEY) + rq.modifiers |= HAIKU_MODIFIER_SHIFT; + + if (mods & B_CONTROL_KEY) + rq.modifiers |= HAIKU_MODIFIER_CTRL; + + if (mods & B_COMMAND_KEY) + rq.modifiers |= HAIKU_MODIFIER_ALT; + + if (mods & B_OPTION_KEY) + rq.modifiers |= HAIKU_MODIFIER_SUPER; + + ret = keysym_from_raw_char (raw, key, &rq.keysym); + + if (!ret) + rq.keysym = 0; + + if (ret < 0) + return; + + rq.multibyte_char = 0; + + if (!rq.keysym) + { + if (mods & B_SHIFT_KEY) + { + if (mods & B_CAPS_LOCK) + map_caps_shift (key, &rq.multibyte_char); + else + map_shift (key, &rq.multibyte_char); + } + else + { + if (mods & B_CAPS_LOCK) + map_caps (key, &rq.multibyte_char); + else + map_normal (key, &rq.multibyte_char); + } + } + + haiku_write (msg->what == B_KEY_DOWN ? KEY_DOWN : KEY_UP, &rq); + } + else if (msg->what == B_MOUSE_WHEEL_CHANGED) + { + struct haiku_wheel_move_event rq; + rq.window = this; + rq.modifiers = 0; + + uint32_t mods = modifiers (); + + if (mods & B_SHIFT_KEY) + rq.modifiers |= HAIKU_MODIFIER_SHIFT; + + if (mods & B_CONTROL_KEY) + rq.modifiers |= HAIKU_MODIFIER_CTRL; + + if (mods & B_COMMAND_KEY) + rq.modifiers |= HAIKU_MODIFIER_ALT; + + if (mods & B_OPTION_KEY) + rq.modifiers |= HAIKU_MODIFIER_SUPER; + + float dx, dy; + if (msg->FindFloat ("be:wheel_delta_x", &dx) == B_OK && + msg->FindFloat ("be:wheel_delta_y", &dy) == B_OK) + { + rq.delta_x = dx; + rq.delta_y = dy; + + haiku_write (WHEEL_MOVE_EVENT, &rq); + }; + } + else + BWindow::DispatchMessage (msg, handler); + } + + void + MenusBeginning () + { + struct haiku_menu_bar_state_event rq; + int lock_count; + + rq.window = this; + lock_count = 0; + + if (!menus_begun) + { + haiku_write (MENU_BAR_OPEN, &rq); + while (IsLocked ()) + { + ++lock_count; + UnlockLooper (); + } + pthread_mutex_lock (&menu_update_mutex); + while (!menu_updated_p) + pthread_cond_wait (&menu_update_cv, + &menu_update_mutex); + menu_updated_p = false; + pthread_mutex_unlock (&menu_update_mutex); + for (; lock_count; --lock_count) + { + if (!LockLooper ()) + gui_abort ("Failed to lock after cv signal denoting menu update"); + } + } + else + *menus_begun = true; + + menu_bar_active_p = true; + } + + void + MenusEnded () + { + struct haiku_menu_bar_state_event rq; + rq.window = this; + + haiku_write (MENU_BAR_CLOSE, &rq); + menu_bar_active_p = false; + } + + void + FrameResized (float newWidth, float newHeight) + { + struct haiku_resize_event rq; + rq.window = this; + rq.px_heightf = newHeight + 1.0f; + rq.px_widthf = newWidth + 1.0f; + + haiku_write (FRAME_RESIZED, &rq); + BWindow::FrameResized (newWidth, newHeight); + } + + void + FrameMoved (BPoint newPosition) + { + struct haiku_move_event rq; + rq.window = this; + rq.x = std::lrint (newPosition.x); + rq.y = std::lrint (newPosition.y); + + haiku_write (MOVE_EVENT, &rq); + + CHILD_FRAME_LOCK_INSIDE_LOOPER_CALLBACK + { + for (struct child_frame *f = subset_windows; + f; f = f->next) + DoMove (f); + child_frame_lock.Unlock (); + + BWindow::FrameMoved (newPosition); + } + } + + void + WorkspacesChanged (uint32_t old, uint32_t n) + { + CHILD_FRAME_LOCK_INSIDE_LOOPER_CALLBACK + { + for (struct child_frame *f = subset_windows; + f; f = f->next) + DoUpdateWorkspace (f); + + child_frame_lock.Unlock (); + } + } + + void + EmacsMoveTo (int x, int y) + { + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + + if (!this->parent) + this->MoveTo (x, y); + else + this->parent->MoveChild (this, x, y, 0); + child_frame_lock.Unlock (); + } + + bool + QuitRequested () + { + struct haiku_quit_requested_event rq; + rq.window = this; + haiku_write (QUIT_REQUESTED, &rq); + return false; + } + + void + Minimize (bool minimized_p) + { + BWindow::Minimize (minimized_p); + struct haiku_iconification_event rq; + rq.window = this; + rq.iconified_p = !parent && minimized_p; + + haiku_write (ICONIFICATION, &rq); + } + + void + EmacsHide (void) + { + if (this->IsHidden ()) + return; + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + + Hide (); + if (this->parent) + UpwardsUnSubsetChildren (this->parent); + + child_frame_lock.Unlock (); + } + + void + EmacsShow (void) + { + if (!this->IsHidden ()) + return; + + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + + if (!was_shown_p) + { + /* This window is being shown for the first time, which means + Show will unlock the looper. In this case, it should be + locked again, since the looper is unlocked when the window + is first created. */ + + if (!LockLooper ()) + gui_abort ("Failed to lock looper during first window show"); + was_shown_p = true; + } + + if (this->parent) + shown_flag = 1; + Show (); + if (this->parent) + UpwardsSubsetChildren (this->parent); + + child_frame_lock.Unlock (); + } + + void + Zoom (BPoint o, float w, float h) + { + struct haiku_zoom_event rq; + BRect rect; + rq.window = this; + + if (fullscreen_p) + MakeFullscreen (0); + + if (!zoomed_p) + { + pre_zoom_rect = Frame (); + zoomed_p = true; + rect = CalculateZoomRect (); + } + else + { + zoomed_p = false; + rect = pre_zoom_rect; + } + + rq.zoomed = zoomed_p; + haiku_write (ZOOM_EVENT, &rq); + + BWindow::Zoom (rect.LeftTop (), BE_RECT_WIDTH (rect) - 1, + BE_RECT_HEIGHT (rect) - 1); + } + + void + UnZoom (void) + { + if (!zoomed_p) + return; + + BWindow::Zoom (); + } + + void + GetParentWidthHeight (int *width, int *height) + { + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + + if (parent) + { + BRect frame = parent->Frame (); + *width = BE_RECT_WIDTH (frame); + *height = BE_RECT_HEIGHT (frame); + } + else + { + BScreen s (this); + BRect frame = s.Frame (); + + *width = BE_RECT_WIDTH (frame); + *height = BE_RECT_HEIGHT (frame); + } + + child_frame_lock.Unlock (); + } + + void + OffsetChildRect (BRect *r, EmacsWindow *c) + { + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + + for (struct child_frame *f; f; f = f->next) + if (f->window == c) + { + r->top -= f->yoff; + r->bottom -= f->yoff; + r->left -= f->xoff; + r->right -= f->xoff; + child_frame_lock.Unlock (); + return; + } + + child_frame_lock.Lock (); + gui_abort ("Trying to calculate offsets for a child frame that doesn't exist"); + } + + void + MakeFullscreen (int make_fullscreen_p) + { + BScreen screen (this); + + if (!screen.IsValid ()) + gui_abort ("Trying to make a window fullscreen without a screen"); + + UnZoom (); + + if (make_fullscreen_p == fullscreen_p) + return; + + fullscreen_p = make_fullscreen_p; + uint32 flags = Flags (); + if (fullscreen_p) + { + if (zoomed_p) + UnZoom (); + + flags |= B_NOT_MOVABLE | B_NOT_ZOOMABLE; + pre_fullscreen_rect = Frame (); + + if (!child_frame_lock.Lock ()) + gui_abort ("Failed to lock child frame state lock"); + + if (parent) + parent->OffsetChildRect (&pre_fullscreen_rect, this); + + child_frame_lock.Unlock (); + + int w, h; + EmacsMoveTo (0, 0); + GetParentWidthHeight (&w, &h); + ResizeTo (w - 1, h - 1); + } + else + { + flags &= ~(B_NOT_MOVABLE | B_NOT_ZOOMABLE); + EmacsMoveTo (pre_fullscreen_rect.left, + pre_fullscreen_rect.top); + ResizeTo (BE_RECT_WIDTH (pre_fullscreen_rect) - 1, + BE_RECT_HEIGHT (pre_fullscreen_rect) - 1); + } + SetFlags (flags); + } +}; + +class EmacsMenuBar : public BMenuBar +{ +public: + EmacsMenuBar () : BMenuBar (BRect (0, 0, 0, 0), NULL) + { + } + + void + AttachedToWindow (void) + { + BWindow *window = Window (); + + window->SetKeyMenuBar (this); + } + + void + FrameResized (float newWidth, float newHeight) + { + struct haiku_menu_bar_resize_event rq; + rq.window = this->Window (); + rq.height = std::lrint (newHeight); + rq.width = std::lrint (newWidth); + + haiku_write (MENU_BAR_RESIZE, &rq); + BMenuBar::FrameResized (newWidth, newHeight); + } + + void + MouseMoved (BPoint point, uint32 transit, const BMessage *msg) + { + struct haiku_menu_bar_left_event rq; + + if (transit == B_EXITED_VIEW) + { + rq.x = std::lrint (point.x); + rq.y = std::lrint (point.y); + rq.window = this->Window (); + + if (movement_locker.Lock ()) + { + haiku_write (MENU_BAR_LEFT, &rq); + movement_locker.Unlock (); + } + } + + BMenuBar::MouseMoved (point, transit, msg); + } + + void + MessageReceived (BMessage *msg) + { + BRect frame; + BPoint pt, l; + EmacsWindow *window; + bool menus_begun; + + if (msg->what == SHOW_MENU_BAR) + { + window = (EmacsWindow *) Window (); + frame = Frame (); + pt = frame.LeftTop (); + l = pt; + menus_begun = false; + Parent ()->ConvertToScreen (&pt); + + window->menus_begun = &menus_begun; + set_mouse_position (pt.x, pt.y); + MouseDown (l); + window->menus_begun = NULL; + + if (!menus_begun) + msg->SendReply (msg); + else + msg->SendReply (BE_MENU_BAR_OPEN); + } + else + BMenuBar::MessageReceived (msg); + } +}; + +class EmacsView : public BView +{ +public: + uint32_t previous_buttons = 0; + int looper_locked_count = 0; + BRegion sb_region; + BRegion invalid_region; + + BView *offscreen_draw_view = NULL; + BBitmap *offscreen_draw_bitmap_1 = NULL; + BBitmap *copy_bitmap = NULL; + +#ifdef USE_BE_CAIRO + cairo_surface_t *cr_surface = NULL; + cairo_t *cr_context = NULL; + BLocker cr_surface_lock; +#endif + + BPoint tt_absl_pos; + BMessage *wait_for_release_message = NULL; + + color_space cspace; + + EmacsView () : BView (BRect (0, 0, 0, 0), "Emacs", B_FOLLOW_NONE, B_WILL_DRAW) + { + + } + + ~EmacsView () + { + if (wait_for_release_message) + { + wait_for_release_message->SendReply (wait_for_release_message); + delete wait_for_release_message; + } + + TearDownDoubleBuffering (); + + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + if (grab_view == this) + grab_view = NULL; + grab_view_locker.Unlock (); + } + + void + AttachedToWindow (void) + { + cspace = B_RGBA32; + } + + void + MessageReceived (BMessage *msg) + { + uint32 buttons; + BLooper *looper = Looper (); + + if (msg->what == WAIT_FOR_RELEASE) + { + if (wait_for_release_message) + gui_abort ("Wait for release message already exists"); + + GetMouse (NULL, &buttons, false); + + if (!buttons) + msg->SendReply (msg); + else + wait_for_release_message = looper->DetachCurrentMessage (); + } + else if (msg->what == RELEASE_NOW) + { + if (wait_for_release_message) + wait_for_release_message->SendReply (msg); + + delete wait_for_release_message; + wait_for_release_message = NULL; + } + else + BView::MessageReceived (msg); + } + +#ifdef USE_BE_CAIRO + void + DetachCairoSurface (void) + { + if (!cr_surface_lock.Lock ()) + gui_abort ("Could not lock cr surface during detachment"); + if (!cr_surface) + gui_abort ("Trying to detach window cr surface when none exists"); + cairo_destroy (cr_context); + cairo_surface_destroy (cr_surface); + cr_surface = NULL; + cr_context = NULL; + cr_surface_lock.Unlock (); + } + + void + AttachCairoSurface (void) + { + if (!cr_surface_lock.Lock ()) + gui_abort ("Could not lock cr surface during attachment"); + if (cr_surface) + gui_abort ("Trying to attach cr surface when one already exists"); + BRect bounds = offscreen_draw_bitmap_1->Bounds (); + + cr_surface = cairo_image_surface_create_for_data + ((unsigned char *) offscreen_draw_bitmap_1->Bits (), + CAIRO_FORMAT_ARGB32, BE_RECT_WIDTH (bounds), + BE_RECT_HEIGHT (bounds), + offscreen_draw_bitmap_1->BytesPerRow ()); + if (!cr_surface) + gui_abort ("Cr surface allocation failed for double-buffered view"); + + cr_context = cairo_create (cr_surface); + if (!cr_context) + gui_abort ("cairo_t allocation failed for double-buffered view"); + cr_surface_lock.Unlock (); + } +#endif + + void + TearDownDoubleBuffering (void) + { + if (offscreen_draw_view) + { + if (Window ()) + ClearViewBitmap (); + if (copy_bitmap) + { + delete copy_bitmap; + copy_bitmap = NULL; + } + if (!looper_locked_count) + if (!offscreen_draw_view->LockLooper ()) + gui_abort ("Failed to lock offscreen draw view"); +#ifdef USE_BE_CAIRO + if (cr_surface) + DetachCairoSurface (); +#endif + offscreen_draw_view->RemoveSelf (); + delete offscreen_draw_view; + offscreen_draw_view = NULL; + delete offscreen_draw_bitmap_1; + offscreen_draw_bitmap_1 = NULL; + } + } + + void + AfterResize (void) + { + if (offscreen_draw_view) + { + if (!LockLooper ()) + gui_abort ("Failed to lock looper after resize"); + + if (!offscreen_draw_view->LockLooper ()) + gui_abort ("Failed to lock offscreen draw view after resize"); +#ifdef USE_BE_CAIRO + DetachCairoSurface (); +#endif + offscreen_draw_view->RemoveSelf (); + delete offscreen_draw_bitmap_1; + offscreen_draw_bitmap_1 = new BBitmap (Frame (), cspace, 1); + if (offscreen_draw_bitmap_1->InitCheck () != B_OK) + gui_abort ("Offscreen draw bitmap initialization failed"); + + BRect frame = Frame (); + + offscreen_draw_view->MoveTo (frame.left, frame.top); + offscreen_draw_view->ResizeTo (BE_RECT_WIDTH (frame), + BE_RECT_HEIGHT (frame)); + offscreen_draw_bitmap_1->AddChild (offscreen_draw_view); +#ifdef USE_BE_CAIRO + AttachCairoSurface (); +#endif + + if (looper_locked_count) + { + offscreen_draw_bitmap_1->Lock (); + } + + UnlockLooper (); + } + } + + void + Draw (BRect expose_bounds) + { + struct haiku_expose_event rq; + EmacsWindow *w = (EmacsWindow *) Window (); + + if (w->shown_flag && offscreen_draw_view) + { + PushState (); + SetDrawingMode (B_OP_ERASE); + FillRect (Frame ()); + PopState (); + return; + } + + if (!offscreen_draw_view) + { + if (sb_region.Contains (std::lrint (expose_bounds.left), + std::lrint (expose_bounds.top)) && + sb_region.Contains (std::lrint (expose_bounds.right), + std::lrint (expose_bounds.top)) && + sb_region.Contains (std::lrint (expose_bounds.left), + std::lrint (expose_bounds.bottom)) && + sb_region.Contains (std::lrint (expose_bounds.right), + std::lrint (expose_bounds.bottom))) + return; + + rq.x = std::floor (expose_bounds.left); + rq.y = std::floor (expose_bounds.top); + rq.width = std::ceil (expose_bounds.right - expose_bounds.left + 1); + rq.height = std::ceil (expose_bounds.bottom - expose_bounds.top + 1); + if (!rq.width) + rq.width = 1; + if (!rq.height) + rq.height = 1; + rq.window = this->Window (); + + haiku_write (FRAME_EXPOSED, &rq); + } + } + + void + FlipBuffers (void) + { + if (!LockLooper ()) + gui_abort ("Failed to lock looper during buffer flip"); + if (!offscreen_draw_view) + gui_abort ("Failed to lock offscreen view during buffer flip"); + + offscreen_draw_view->Sync (); + + EmacsWindow *w = (EmacsWindow *) Window (); + w->shown_flag = 0; + + if (copy_bitmap && + copy_bitmap->Bounds () != offscreen_draw_bitmap_1->Bounds ()) + { + delete copy_bitmap; + copy_bitmap = NULL; + } + if (!copy_bitmap) + copy_bitmap = new BBitmap (offscreen_draw_bitmap_1); + else + copy_bitmap->ImportBits (offscreen_draw_bitmap_1); + + if (copy_bitmap->InitCheck () != B_OK) + gui_abort ("Failed to init copy bitmap during buffer flip"); + + SetViewBitmap (copy_bitmap, + Frame (), Frame (), B_FOLLOW_NONE, 0); + + Invalidate (&invalid_region); + invalid_region.MakeEmpty (); + UnlockLooper (); + return; + } + + void + SetUpDoubleBuffering (void) + { + if (!LockLooper ()) + gui_abort ("Failed to lock self setting up double buffering"); + if (offscreen_draw_view) + gui_abort ("Failed to lock offscreen view setting up double buffering"); + + offscreen_draw_bitmap_1 = new BBitmap (Frame (), cspace, 1); + if (offscreen_draw_bitmap_1->InitCheck () != B_OK) + gui_abort ("Failed to init offscreen bitmap"); +#ifdef USE_BE_CAIRO + AttachCairoSurface (); +#endif + offscreen_draw_view = new BView (Frame (), NULL, B_FOLLOW_NONE, B_WILL_DRAW); + offscreen_draw_bitmap_1->AddChild (offscreen_draw_view); + + if (looper_locked_count) + { + if (!offscreen_draw_bitmap_1->Lock ()) + gui_abort ("Failed to lock bitmap after double buffering was set up"); + } + + invalid_region.MakeEmpty (); + UnlockLooper (); + Invalidate (); + } + + void + MouseMoved (BPoint point, uint32 transit, const BMessage *drag_msg) + { + struct haiku_mouse_motion_event rq; + int32 windowid; + EmacsWindow *window; + + window = (EmacsWindow *) Window (); + rq.just_exited_p = transit == B_EXITED_VIEW; + rq.x = point.x; + rq.y = point.y; + rq.window = window; + rq.time = system_time (); + + if (drag_msg && (drag_msg->IsSourceRemote () + || drag_msg->FindInt32 ("emacs:window_id", + &windowid) != B_OK + || windowid != window->window_id)) + rq.dnd_message = true; + else + rq.dnd_message = false; + + if (ToolTip ()) + ToolTip ()->SetMouseRelativeLocation (BPoint (-(point.x - tt_absl_pos.x), + -(point.y - tt_absl_pos.y))); + + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + + if (grab_view && this != grab_view) + { + grab_view_locker.Unlock (); + return; + } + + grab_view_locker.Unlock (); + + if (movement_locker.Lock ()) + { + haiku_write (MOUSE_MOTION, &rq); + movement_locker.Unlock (); + } + } + + void + MouseDown (BPoint point) + { + struct haiku_button_event rq; + uint32 buttons; + + this->GetMouse (&point, &buttons, false); + + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + if (buttons) + grab_view = this; + grab_view_locker.Unlock (); + + rq.window = this->Window (); + + if (!(previous_buttons & B_PRIMARY_MOUSE_BUTTON) + && (buttons & B_PRIMARY_MOUSE_BUTTON)) + rq.btn_no = 0; + else if (!(previous_buttons & B_SECONDARY_MOUSE_BUTTON) + && (buttons & B_SECONDARY_MOUSE_BUTTON)) + rq.btn_no = 2; + else if (!(previous_buttons & B_TERTIARY_MOUSE_BUTTON) + && (buttons & B_TERTIARY_MOUSE_BUTTON)) + rq.btn_no = 1; + else + return; + + previous_buttons = buttons; + + rq.x = point.x; + rq.y = point.y; + + uint32_t mods = modifiers (); + + rq.modifiers = 0; + if (mods & B_SHIFT_KEY) + rq.modifiers |= HAIKU_MODIFIER_SHIFT; + + if (mods & B_CONTROL_KEY) + rq.modifiers |= HAIKU_MODIFIER_CTRL; + + if (mods & B_COMMAND_KEY) + rq.modifiers |= HAIKU_MODIFIER_ALT; + + if (mods & B_OPTION_KEY) + rq.modifiers |= HAIKU_MODIFIER_SUPER; + + SetMouseEventMask (B_POINTER_EVENTS, (B_LOCK_WINDOW_FOCUS + | B_NO_POINTER_HISTORY)); + + rq.time = system_time (); + haiku_write (BUTTON_DOWN, &rq); + } + + void + MouseUp (BPoint point) + { + struct haiku_button_event rq; + uint32 buttons; + + this->GetMouse (&point, &buttons, false); + + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + if (!buttons) + grab_view = NULL; + grab_view_locker.Unlock (); + + if (!buttons && wait_for_release_message) + { + wait_for_release_message->SendReply (wait_for_release_message); + delete wait_for_release_message; + wait_for_release_message = NULL; + + previous_buttons = buttons; + return; + } + + rq.window = this->Window (); + + if ((previous_buttons & B_PRIMARY_MOUSE_BUTTON) + && !(buttons & B_PRIMARY_MOUSE_BUTTON)) + rq.btn_no = 0; + else if ((previous_buttons & B_SECONDARY_MOUSE_BUTTON) + && !(buttons & B_SECONDARY_MOUSE_BUTTON)) + rq.btn_no = 2; + else if ((previous_buttons & B_TERTIARY_MOUSE_BUTTON) + && !(buttons & B_TERTIARY_MOUSE_BUTTON)) + rq.btn_no = 1; + else + return; + + previous_buttons = buttons; + + rq.x = point.x; + rq.y = point.y; + + uint32_t mods = modifiers (); + + rq.modifiers = 0; + if (mods & B_SHIFT_KEY) + rq.modifiers |= HAIKU_MODIFIER_SHIFT; + + if (mods & B_CONTROL_KEY) + rq.modifiers |= HAIKU_MODIFIER_CTRL; + + if (mods & B_COMMAND_KEY) + rq.modifiers |= HAIKU_MODIFIER_ALT; + + if (mods & B_OPTION_KEY) + rq.modifiers |= HAIKU_MODIFIER_SUPER; + + if (!buttons) + SetMouseEventMask (0, 0); + + rq.time = system_time (); + haiku_write (BUTTON_UP, &rq); + } +}; + +class EmacsScrollBar : public BScrollBar +{ +public: + int dragging = 0; + bool horizontal; + enum haiku_scroll_bar_part current_part; + float old_value; + scroll_bar_info info; + + /* True if button events should be passed to the parent. */ + bool handle_button = false; + bool in_overscroll = false; + bool can_overscroll = false; + bool maybe_overscroll = false; + BPoint last_overscroll; + int last_reported_overscroll_value; + int max_value, real_max_value; + int overscroll_start_value; + bigtime_t repeater_start; + + EmacsScrollBar (int x, int y, int x1, int y1, bool horizontal_p) : + BScrollBar (BRect (x, y, x1, y1), NULL, NULL, 0, 0, horizontal_p ? + B_HORIZONTAL : B_VERTICAL) + { + BView *vw = (BView *) this; + vw->SetResizingMode (B_FOLLOW_NONE); + horizontal = horizontal_p; + get_scroll_bar_info (&info); + SetSteps (5000, 10000); + } + + void + MessageReceived (BMessage *msg) + { + int32 portion, range, dragging, value; + float proportion; + + if (msg->what == SCROLL_BAR_UPDATE) + { + portion = msg->GetInt32 ("emacs:portion", 0); + range = msg->GetInt32 ("emacs:range", 0); + dragging = msg->GetInt32 ("emacs:dragging", 0); + proportion = ((range <= 0 || portion <= 0) + ? 1.0f : (float) portion / range); + value = msg->GetInt32 ("emacs:units", 0); + can_overscroll = msg->GetBool ("emacs:overscroll", false); + + if (value < 0) + value = 0; + + if (dragging != 1) + { + if (in_overscroll || dragging != -1) + { + /* Set the value to the smallest possible one. + Otherwise, the call to SetRange could lead to + spurious updates. */ + old_value = 0; + SetValue (0); + + /* Unlike on Motif, PORTION isn't included in the total + range of the scroll bar. */ + + SetRange (0, range - portion); + SetProportion (proportion); + max_value = range - portion; + real_max_value = range; + + if (in_overscroll || value > max_value) + value = max_value; + + old_value = roundf (value); + SetValue (old_value); + } + else + { + value = Value (); + + old_value = 0; + SetValue (0); + SetRange (0, range - portion); + SetProportion (proportion); + old_value = value; + SetValue (value); + max_value = range - portion; + real_max_value = range; + } + } + } + + BScrollBar::MessageReceived (msg); + } + + void + Pulse (void) + { + struct haiku_scroll_bar_part_event rq; + BPoint point; + uint32 buttons; + + if (!dragging) + { + SetFlags (Flags () & ~B_PULSE_NEEDED); + return; + } + + if (repeater_start < system_time ()) + { + GetMouse (&point, &buttons, false); + + if (ButtonRegionFor (current_part).Contains (point)) + { + rq.scroll_bar = this; + rq.window = Window (); + rq.part = current_part; + haiku_write (SCROLL_BAR_PART_EVENT, &rq); + } + } + + BScrollBar::Pulse (); + } + + void + ValueChanged (float new_value) + { + struct haiku_scroll_bar_value_event rq; + + new_value = Value (); + + if (dragging) + { + if (new_value != old_value) + { + if (dragging > 1) + { + SetValue (old_value); + SetFlags (Flags () | B_PULSE_NEEDED); + } + else + dragging++; + } + + return; + } + + if (new_value != old_value) + { + rq.scroll_bar = this; + rq.window = Window (); + rq.position = new_value; + old_value = new_value; + + haiku_write (SCROLL_BAR_VALUE_EVENT, &rq); + } + } + + BRegion + ButtonRegionFor (enum haiku_scroll_bar_part button) + { + BRegion region; + BRect bounds; + BRect rect; + float button_size; + + bounds = Bounds (); + bounds.InsetBy (0.0, 0.0); + + if (horizontal) + button_size = bounds.Height () + 1.0f; + else + button_size = bounds.Width () + 1.0f; + + rect = BRect (bounds.left, bounds.top, + bounds.left + button_size - 1.0f, + bounds.top + button_size - 1.0f); + + if (button == HAIKU_SCROLL_BAR_UP_BUTTON) + { + if (!horizontal) + { + region.Include (rect); + if (info.double_arrows) + region.Include (rect.OffsetToCopy (bounds.left, + bounds.bottom - 2 * button_size + 1)); + } + else + { + region.Include (rect); + if (info.double_arrows) + region.Include (rect.OffsetToCopy (bounds.right - 2 * button_size, + bounds.top)); + } + } + else + { + if (!horizontal) + { + region.Include (rect.OffsetToCopy (bounds.left, bounds.bottom - button_size)); + + if (info.double_arrows) + region.Include (rect.OffsetByCopy (0.0, button_size)); + } + else + { + region.Include (rect.OffsetToCopy (bounds.right - button_size, bounds.top)); + + if (info.double_arrows) + region.Include (rect.OffsetByCopy (button_size, 0.0)); + } + } + + return region; + } + + void + MouseDown (BPoint pt) + { + struct haiku_scroll_bar_drag_event rq; + struct haiku_scroll_bar_part_event part; + BRegion r; + BLooper *looper; + BMessage *message; + int32 buttons, mods; + BView *parent; + + looper = Looper (); + message = NULL; + + if (!looper) + GetMouse (&pt, (uint32 *) &buttons, false); + else + { + message = looper->CurrentMessage (); + + if (!message || message->FindInt32 ("buttons", &buttons) != B_OK) + GetMouse (&pt, (uint32 *) &buttons, false); + } + + if (message && (message->FindInt32 ("modifiers", &mods) + == B_OK) + && mods & B_CONTROL_KEY) + { + /* Allow C-mouse-3 to split the window on a scroll bar. */ + handle_button = true; + parent = Parent (); + parent->MouseDown (ConvertToParent (pt)); + + return; + } + + repeater_start = system_time () + 300000; + + if (buttons == B_PRIMARY_MOUSE_BUTTON) + { + r = ButtonRegionFor (HAIKU_SCROLL_BAR_UP_BUTTON); + + if (r.Contains (pt)) + { + part.scroll_bar = this; + part.window = Window (); + part.part = HAIKU_SCROLL_BAR_UP_BUTTON; + dragging = 1; + current_part = HAIKU_SCROLL_BAR_UP_BUTTON; + + haiku_write (SCROLL_BAR_PART_EVENT, &part); + goto out; + } + + r = ButtonRegionFor (HAIKU_SCROLL_BAR_DOWN_BUTTON); + + if (r.Contains (pt)) + { + part.scroll_bar = this; + part.window = Window (); + part.part = HAIKU_SCROLL_BAR_DOWN_BUTTON; + dragging = 1; + current_part = HAIKU_SCROLL_BAR_DOWN_BUTTON; + + if (Value () == max_value) + { + SetFlags (Flags () | B_PULSE_NEEDED); + dragging = 2; + } + + haiku_write (SCROLL_BAR_PART_EVENT, &part); + goto out; + } + + maybe_overscroll = true; + } + + rq.dragging_p = 1; + rq.window = Window (); + rq.scroll_bar = this; + + SetMouseEventMask (B_POINTER_EVENTS, (B_SUSPEND_VIEW_FOCUS + | B_LOCK_WINDOW_FOCUS)); + + haiku_write (SCROLL_BAR_DRAG_EVENT, &rq); + + out: + BScrollBar::MouseDown (pt); + } + + void + MouseUp (BPoint pt) + { + struct haiku_scroll_bar_drag_event rq; + BView *parent; + + in_overscroll = false; + maybe_overscroll = false; + + if (handle_button) + { + handle_button = false; + parent = Parent (); + parent->MouseUp (ConvertToParent (pt)); + + return; + } + + rq.dragging_p = 0; + rq.scroll_bar = this; + rq.window = Window (); + + haiku_write (SCROLL_BAR_DRAG_EVENT, &rq); + dragging = 0; + + BScrollBar::MouseUp (pt); + } + + void + MouseMoved (BPoint point, uint32 transit, const BMessage *msg) + { + struct haiku_menu_bar_left_event rq; + struct haiku_scroll_bar_value_event value_event; + int range, diff, value, trough_size; + BRect bounds; + BPoint conv; + uint32 buttons; + + GetMouse (NULL, &buttons, false); + + if (transit == B_EXITED_VIEW) + { + conv = ConvertToParent (point); + + rq.x = std::lrint (conv.x); + rq.y = std::lrint (conv.y); + rq.window = this->Window (); + + if (movement_locker.Lock ()) + { + haiku_write (MENU_BAR_LEFT, &rq); + movement_locker.Unlock (); + } + } + + if (in_overscroll) + { + if (horizontal) + diff = point.x - last_overscroll.x; + else + diff = point.y - last_overscroll.y; + + if (diff < 0) + { + in_overscroll = false; + goto allow; + } + + range = real_max_value; + bounds = Bounds (); + bounds.InsetBy (1.0, 1.0); + value = overscroll_start_value; + trough_size = (horizontal + ? BE_RECT_WIDTH (bounds) + : BE_RECT_HEIGHT (bounds)); + trough_size -= (horizontal + ? BE_RECT_HEIGHT (bounds) + : BE_RECT_WIDTH (bounds)) / 2; + if (info.double_arrows) + trough_size -= (horizontal + ? BE_RECT_HEIGHT (bounds) + : BE_RECT_WIDTH (bounds)) / 2; + + value += ((double) range / trough_size) * diff; + + if (value != last_reported_overscroll_value) + { + last_reported_overscroll_value = value; + + value_event.scroll_bar = this; + value_event.window = Window (); + value_event.position = value; + + haiku_write (SCROLL_BAR_VALUE_EVENT, &value_event); + return; + } + } + else if (can_overscroll + && (buttons == B_PRIMARY_MOUSE_BUTTON) + && maybe_overscroll) + { + value = Value (); + + if (value >= max_value) + { + BScrollBar::MouseMoved (point, transit, msg); + + if (value == Value ()) + { + overscroll_start_value = value; + in_overscroll = true; + last_overscroll = point; + last_reported_overscroll_value = value; + + MouseMoved (point, transit, msg); + return; + } + } + } + + allow: + BScrollBar::MouseMoved (point, transit, msg); + } +}; + +class EmacsTitleMenuItem : public BMenuItem +{ +public: + EmacsTitleMenuItem (const char *str) : BMenuItem (str, NULL) + { + SetEnabled (0); + } + + void + DrawContent (void) + { + BMenu *menu = Menu (); + + menu->PushState (); + menu->SetFont (be_bold_font); + BView_SetHighColorForVisibleBell (menu, 0); + BMenuItem::DrawContent (); + menu->PopState (); + } +}; + +class EmacsMenuItem : public BMenuItem +{ +public: + int menu_bar_id = -1; + void *menu_ptr = NULL; + void *wind_ptr = NULL; + char *key = NULL; + char *help = NULL; + + EmacsMenuItem (const char *ky, + const char *str, + const char *help, + BMessage *message = NULL) : BMenuItem (str, message) + { + if (ky) + { + key = strdup (ky); + if (!key) + gui_abort ("strdup failed"); + } + + if (help) + { + this->help = strdup (help); + if (!this->help) + gui_abort ("strdup failed"); + } + } + + ~EmacsMenuItem () + { + if (key) + free (key); + if (help) + free (help); + } + + void + DrawContent (void) + { + BMenu *menu = Menu (); + + BMenuItem::DrawContent (); + + if (key) + { + BRect r = Frame (); + int w; + + menu->PushState (); + menu->ClipToRect (r); + menu->SetFont (be_plain_font); + w = menu->StringWidth (key); + menu->MovePenTo (BPoint (BE_RECT_WIDTH (r) - w - 4, + menu->PenLocation ().y)); + menu->DrawString (key); + menu->PopState (); + } + } + + void + GetContentSize (float *w, float *h) + { + BMenuItem::GetContentSize (w, h); + if (Menu () && key) + *w += 4 + Menu ()->StringWidth (key); + } + + void + Highlight (bool highlight_p) + { + struct haiku_menu_bar_help_event rq; + struct haiku_dummy_event dummy; + BMenu *menu = Menu (); + BRect r; + BPoint pt; + uint32 buttons; + + if (help) + menu->SetToolTip (highlight_p ? help : NULL); + else + { + rq.window = wind_ptr; + rq.mb_idx = highlight_p ? menu_bar_id : -1; + rq.highlight_p = highlight_p; + rq.data = menu_ptr; + + r = Frame (); + menu->GetMouse (&pt, &buttons); + + if (!highlight_p || r.Contains (pt)) + { + if (menu_bar_id > 0) + haiku_write (MENU_BAR_HELP_EVENT, &rq); + else + { + haiku_write_without_signal (MENU_BAR_HELP_EVENT, &rq, true); + haiku_write (DUMMY_EVENT, &dummy); + } + } + } + + BMenuItem::Highlight (highlight_p); + } +}; + +class EmacsPopUpMenu : public BPopUpMenu +{ +public: + EmacsPopUpMenu (const char *name) : BPopUpMenu (name, 0) + { + + } + + void + FrameResized (float w, float h) + { + Invalidate (); + BPopUpMenu::FrameResized (w, h); + } +}; + +static int32 +start_running_application (void *data) +{ + Emacs *app = (Emacs *) data; + + haiku_io_init_in_app_thread (); + + if (!app->Lock ()) + gui_abort ("Failed to lock application"); + + app->Run (); + app->Unlock (); + return 0; +} + +/* Take BITMAP, a reference to a BBitmap, and return a pointer to its + data. */ +void * +BBitmap_data (void *bitmap) +{ + return ((BBitmap *) bitmap)->Bits (); +} + +/* Convert bitmap if required, placing the new bitmap in NEW_BITMAP, + and return non-null if bitmap was successfully converted. Bitmaps + should be freed with `BBitmap_free'. */ +int +BBitmap_convert (void *_bitmap, void **new_bitmap) +{ + BBitmap *bitmap = (BBitmap *) _bitmap; + if (bitmap->ColorSpace () == B_RGBA32) + return -1; + BRect bounds = bitmap->Bounds (); + BBitmap *bmp = new (std::nothrow) BBitmap (bounds, B_RGBA32); + if (!bmp || bmp->InitCheck () != B_OK) + { + if (bmp) + delete bmp; + return 0; + } + if (bmp->ImportBits (bitmap) != B_OK) + { + delete bmp; + return 0; + } + *(BBitmap **) new_bitmap = bmp; + return 1; +} + +void +BBitmap_free (void *bitmap) +{ + delete (BBitmap *) bitmap; +} + +/* Create new bitmap in RGB32 format, or in GRAY1 if MONO_P is + non-zero. */ +void * +BBitmap_new (int width, int height, int mono_p) +{ + BBitmap *bn = new (std::nothrow) BBitmap (BRect (0, 0, width - 1, height - 1), + mono_p ? B_GRAY1 : B_RGB32); + + return bn->InitCheck () == B_OK ? (void *) bn : (void *) (delete bn, NULL); +} + +void +BBitmap_dimensions (void *bitmap, int *left, int *top, + int *right, int *bottom, + int32_t *bytes_per_row, int *mono_p) +{ + BRect rect = ((BBitmap *) bitmap)->Bounds (); + *left = rect.left; + *top = rect.top; + *right = rect.right; + *bottom = rect.bottom; + + *bytes_per_row = ((BBitmap *) bitmap)->BytesPerRow (); + *mono_p = (((BBitmap *) bitmap)->ColorSpace () == B_GRAY1); +} + +static void +wait_for_exit_of_app_thread (void) +{ + status_t ret; + + be_app->PostMessage (QUIT_APPLICATION); + wait_for_thread (app_thread, &ret); +} + +/* Set up an application and return it. If starting the application + thread fails, abort Emacs. */ +void * +BApplication_setup (void) +{ + thread_id id; + Emacs *app; + + if (be_app) + return be_app; + + app = new Emacs; + app->Unlock (); + + if ((id = spawn_thread (start_running_application, "Emacs app thread", + B_DEFAULT_MEDIA_PRIORITY, app)) < 0) + gui_abort ("spawn_thread failed"); + + resume_thread (id); + app_thread = id; + + atexit (wait_for_exit_of_app_thread); + return app; +} + +/* Set up and return a window with its view put in VIEW. */ +void * +BWindow_new (void **view) +{ + BWindow *window; + BView *vw; + + window = new (std::nothrow) EmacsWindow; + if (!window) + { + *view = NULL; + return window; + } + + vw = new (std::nothrow) EmacsView; + if (!vw) + { + *view = NULL; + window->LockLooper (); + window->Quit (); + return NULL; + } + + /* Windows are created locked by the current thread, but calling + Show for the first time causes them to be unlocked. To avoid a + deadlock when a frame is created invisible in one thread, and + another thread later tries to lock it, the window is unlocked + here, and EmacsShow will lock it manually if it's being shown for + the first time. */ + window->UnlockLooper (); + window->AddChild (vw); + *view = vw; + return window; +} + +void +BWindow_quit (void *window) +{ + BWindow *w = (BWindow *) window; + + w->LockLooper (); + w->Quit (); +} + +/* Set WINDOW's offset to X, Y. */ +void +BWindow_set_offset (void *window, int x, int y) +{ + BWindow *wn = (BWindow *) window; + EmacsWindow *w = dynamic_cast<EmacsWindow *> (wn); + if (w) + { + if (!w->LockLooper ()) + gui_abort ("Failed to lock window looper setting offset"); + w->EmacsMoveTo (x, y); + w->UnlockLooper (); + } + else + wn->MoveTo (x, y); +} + +void +BWindow_dimensions (void *window, int *width, int *height) +{ + BWindow *w = (BWindow *) window; + BRect frame = w->Frame (); + + *width = BE_RECT_WIDTH (frame); + *height = BE_RECT_HEIGHT (frame); +} + +/* Iconify WINDOW. */ +void +BWindow_iconify (void *window) +{ + if (((BWindow *) window)->IsHidden ()) + BWindow_set_visible (window, true); + ((BWindow *) window)->Minimize (true); +} + +/* Show or hide WINDOW. */ +void +BWindow_set_visible (void *window, int visible_p) +{ + EmacsWindow *win = (EmacsWindow *) window; + if (visible_p) + { + if (win->IsMinimized ()) + win->Minimize (false); + win->EmacsShow (); + } + else if (!win->IsHidden ()) + { + if (win->IsMinimized ()) + win->Minimize (false); + win->EmacsHide (); + } +} + +/* Change the title of WINDOW to the multibyte string TITLE. */ +void +BWindow_retitle (void *window, const char *title) +{ + ((BWindow *) window)->SetTitle (title); +} + +/* Resize WINDOW to WIDTH by HEIGHT. */ +void +BWindow_resize (void *window, int width, int height) +{ + ((BWindow *) window)->ResizeTo (width - 1, height - 1); +} + +/* Activate WINDOW, making it the subject of keyboard focus and + bringing it to the front of the screen. */ +void +BWindow_activate (void *window) +{ + ((BWindow *) window)->Activate (); +} + +/* Return the pixel dimensions of the main screen in WIDTH and + HEIGHT. */ +void +BScreen_px_dim (int *width, int *height) +{ + BScreen screen; + if (!screen.IsValid ()) + gui_abort ("Invalid screen"); + BRect frame = screen.Frame (); + + *width = frame.right - frame.left; + *height = frame.bottom - frame.top; +} + +/* Resize VIEW to WIDTH, HEIGHT. */ +void +BView_resize_to (void *view, int width, int height) +{ + EmacsView *vw = (EmacsView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view for resize"); + vw->ResizeTo (width, height); + vw->AfterResize (); + vw->UnlockLooper (); +} + +void * +BCursor_create_default (void) +{ + return new BCursor (B_CURSOR_ID_SYSTEM_DEFAULT); +} + +void * +BCursor_create_modeline (void) +{ + return new BCursor (B_CURSOR_ID_CONTEXT_MENU); +} + +void * +BCursor_from_id (enum haiku_cursor cursor) +{ + return new BCursor ((enum BCursorID) cursor); +} + +void * +BCursor_create_i_beam (void) +{ + return new BCursor (B_CURSOR_ID_I_BEAM); +} + +void * +BCursor_create_progress_cursor (void) +{ + return new BCursor (B_CURSOR_ID_PROGRESS); +} + +void * +BCursor_create_grab (void) +{ + return new BCursor (B_CURSOR_ID_GRAB); +} + +void +BCursor_delete (void *cursor) +{ + if (cursor) + delete (BCursor *) cursor; +} + +void +BView_set_view_cursor (void *view, void *cursor) +{ + if (!((BView *) view)->LockLooper ()) + gui_abort ("Failed to lock view setting cursor"); + ((BView *) view)->SetViewCursor ((BCursor *) cursor); + ((BView *) view)->UnlockLooper (); +} + +void +BWindow_Flush (void *window) +{ + ((BWindow *) window)->Flush (); +} + +/* Make a scrollbar, attach it to VIEW's window, and return it. */ +void * +BScrollBar_make_for_view (void *view, int horizontal_p, + int x, int y, int x1, int y1, + void *scroll_bar_ptr) +{ + EmacsScrollBar *sb = new EmacsScrollBar (x, y, x1, y1, horizontal_p); + BView *vw = (BView *) view; + BView *sv = (BView *) sb; + + if (!vw->LockLooper ()) + gui_abort ("Failed to lock scrollbar owner"); + vw->AddChild ((BView *) sb); + sv->WindowActivated (vw->Window ()->IsActive ()); + vw->UnlockLooper (); + return sb; +} + +void +BScrollBar_delete (void *sb) +{ + BView *view = (BView *) sb; + BView *pr = view->Parent (); + + if (!pr->LockLooper ()) + gui_abort ("Failed to lock scrollbar parent"); + pr->RemoveChild (view); + pr->UnlockLooper (); + + delete (EmacsScrollBar *) sb; +} + +void +BView_move_frame (void *view, int x, int y, int x1, int y1) +{ + BView *vw = (BView *) view; + + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view moving frame"); + vw->MoveTo (x, y); + vw->ResizeTo (x1 - x, y1 - y); + vw->UnlockLooper (); +} + +/* DRAGGING can either be 0 (which means to update everything), 1 + (which means to update nothing), or -1 (which means to update only + the thumb size and range). */ + +void +BView_scroll_bar_update (void *sb, int portion, int whole, int position, + int dragging, bool can_overscroll) +{ + BScrollBar *bar = (BScrollBar *) sb; + BMessage msg = BMessage (SCROLL_BAR_UPDATE); + BMessenger mr = BMessenger (bar); + msg.AddInt32 ("emacs:range", whole); + msg.AddInt32 ("emacs:units", position); + msg.AddInt32 ("emacs:portion", portion); + msg.AddInt32 ("emacs:dragging", dragging); + msg.AddBool ("emacs:overscroll", can_overscroll); + + mr.SendMessage (&msg); +} + +/* Return the default scrollbar size. */ +int +BScrollBar_default_size (int horizontal_p) +{ + return be_control_look->GetScrollBarWidth (horizontal_p + ? B_HORIZONTAL + : B_VERTICAL); +} + +/* Invalidate VIEW, causing it to be drawn again. */ +void +BView_invalidate (void *view) +{ + BView *vw = (BView *) view; + if (!vw->LockLooper ()) + gui_abort ("Couldn't lock view while invalidating it"); + vw->Invalidate (); + vw->UnlockLooper (); +} + +/* Lock VIEW in preparation for drawing operations. This should be + called before any attempt to draw onto VIEW or to lock it for Cairo + drawing. `BView_draw_unlock' should be called afterwards. + + If any drawing is going to take place, INVALID_REGION should be + true, and X, Y, WIDTH, HEIGHT should specify a rectangle in which + the drawing will take place. */ +void +BView_draw_lock (void *view, bool invalidate_region, + int x, int y, int width, int height) +{ + EmacsView *vw = (EmacsView *) view; + if (vw->looper_locked_count) + { + vw->looper_locked_count++; + + if (invalidate_region && vw->offscreen_draw_view) + vw->invalid_region.Include (BRect (x, y, x + width - 1, + y + height - 1)); + return; + } + BView *v = (BView *) find_appropriate_view_for_draw (vw); + if (v != vw) + { + if (!vw->offscreen_draw_bitmap_1->Lock ()) + gui_abort ("Failed to lock offscreen bitmap while acquiring draw lock"); + } + else if (!v->LockLooper ()) + gui_abort ("Failed to lock draw view while acquiring draw lock"); + + if (v != vw && !vw->LockLooper ()) + gui_abort ("Failed to lock view while acquiring draw lock"); + + if (invalidate_region && vw->offscreen_draw_view) + vw->invalid_region.Include (BRect (x, y, x + width - 1, + y + height - 1)); + vw->looper_locked_count++; +} + +void +BView_invalidate_region (void *view, int x, int y, int width, int height) +{ + EmacsView *vw = (EmacsView *) view; + + if (vw->offscreen_draw_view) + vw->invalid_region.Include (BRect (x, y, x + width - 1, + y + height - 1)); +} + +void +BView_draw_unlock (void *view) +{ + EmacsView *vw = (EmacsView *) view; + if (--vw->looper_locked_count) + return; + + BView *v = (BView *) find_appropriate_view_for_draw (view); + if (v == vw) + vw->UnlockLooper (); + else + { + vw->offscreen_draw_bitmap_1->Unlock (); + vw->UnlockLooper (); + } +} + +void +BWindow_center_on_screen (void *window) +{ + BWindow *w = (BWindow *) window; + w->CenterOnScreen (); +} + +/* Import fringe bitmap (short array, low bit rightmost) BITS into + BITMAP using the B_GRAY1 colorspace. */ +void +BBitmap_import_fringe_bitmap (void *bitmap, unsigned short *bits, int wd, int h) +{ + BBitmap *bmp = (BBitmap *) bitmap; + unsigned char *data = (unsigned char *) bmp->Bits (); + int i; + + for (i = 0; i < h; i++) + { + if (wd <= 8) + data[0] = bits[i] & 0xff; + else + { + data[1] = bits[i] & 0xff; + data[0] = bits[i] >> 8; + } + + data += bmp->BytesPerRow (); + } +} + +void +BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h) +{ + BBitmap *bmp = (BBitmap *) bitmap; + + if (wd % 8) + wd += 8 - (wd % 8); + + bmp->ImportBits (bits, wd / 8 * h, wd / 8, 0, B_GRAY1); +} + +/* Make a scrollbar at X, Y known to the view VIEW. */ +void +BView_publish_scroll_bar (void *view, int x, int y, int width, int height) +{ + EmacsView *vw = (EmacsView *) view; + if (vw->LockLooper ()) + { + vw->sb_region.Include (BRect (x, y, x - 1 + width, + y - 1 + height)); + vw->UnlockLooper (); + } +} + +void +BView_forget_scroll_bar (void *view, int x, int y, int width, int height) +{ + EmacsView *vw = (EmacsView *) view; + if (vw->LockLooper ()) + { + vw->sb_region.Exclude (BRect (x, y, x - 1 + width, + y - 1 + height)); + vw->UnlockLooper (); + } +} + +bool +BView_inside_scroll_bar (void *view, int x, int y) +{ + EmacsView *vw = (EmacsView *) view; + bool val; + + if (vw->LockLooper ()) + { + val = vw->sb_region.Contains (BPoint (x, y)); + vw->UnlockLooper (); + } + else + val = false; + + return val; +} + +void +BView_get_mouse (void *view, int *x, int *y) +{ + BPoint l; + BView *vw = (BView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view in BView_get_mouse"); + vw->GetMouse (&l, NULL, 1); + vw->UnlockLooper (); + + *x = std::lrint (l.x); + *y = std::lrint (l.y); +} + +/* Perform an in-place conversion of X and Y from VIEW's coordinate + system to its screen's coordinate system. */ +void +BView_convert_to_screen (void *view, int *x, int *y) +{ + BPoint l = BPoint (*x, *y); + BView *vw = (BView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view in convert_to_screen"); + vw->ConvertToScreen (&l); + vw->UnlockLooper (); + + *x = std::lrint (l.x); + *y = std::lrint (l.y); +} + +void +BView_convert_from_screen (void *view, int *x, int *y) +{ + BPoint l = BPoint (*x, *y); + BView *vw = (BView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view in convert_from_screen"); + vw->ConvertFromScreen (&l); + vw->UnlockLooper (); + + *x = std::lrint (l.x); + *y = std::lrint (l.y); +} + +/* Decorate or undecorate WINDOW depending on DECORATE_P. */ +void +BWindow_change_decoration (void *window, int decorate_p) +{ + EmacsWindow *w = (EmacsWindow *) window; + if (!w->LockLooper ()) + gui_abort ("Failed to lock window while changing its decorations"); + + if (!w->override_redirect_p) + { + if (decorate_p) + w->SetLook (B_TITLED_WINDOW_LOOK); + else + w->SetLook (B_NO_BORDER_WINDOW_LOOK); + } + else + { + if (decorate_p) + w->pre_override_redirect_look = B_TITLED_WINDOW_LOOK; + else + w->pre_override_redirect_look = B_NO_BORDER_WINDOW_LOOK; + } + w->UnlockLooper (); +} + +/* Decorate WINDOW appropriately for use as a tooltip. */ +void +BWindow_set_tooltip_decoration (void *window) +{ + BWindow *w = (BWindow *) window; + if (!w->LockLooper ()) + gui_abort ("Failed to lock window while setting ttip decoration"); + w->SetLook (B_BORDERED_WINDOW_LOOK); + w->SetFeel (kMenuWindowFeel); + w->SetFlags (B_NOT_ZOOMABLE + | B_NOT_MINIMIZABLE + | B_AVOID_FRONT + | B_AVOID_FOCUS); + w->UnlockLooper (); +} + +/* Set B_AVOID_FOCUS on WINDOW if AVOID_FOCUS_P is non-nil, or clear + it otherwise. */ +void +BWindow_set_avoid_focus (void *window, int avoid_focus_p) +{ + BWindow *w = (BWindow *) window; + if (!w->LockLooper ()) + gui_abort ("Failed to lock window while setting avoid focus"); + + if (!avoid_focus_p) + w->SetFlags (w->Flags () & ~B_AVOID_FOCUS); + else + w->SetFlags (w->Flags () | B_AVOID_FOCUS); + w->UnlockLooper (); +} + +void +BView_emacs_delete (void *view) +{ + EmacsView *vw = (EmacsView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view while deleting it"); + vw->RemoveSelf (); + delete vw; +} + +/* Return the current workspace. */ +uint32_t +haiku_current_workspace (void) +{ + return current_workspace (); +} + +/* Return a bitmask consisting of workspaces WINDOW is on. */ +uint32_t +BWindow_workspaces (void *window) +{ + return ((BWindow *) window)->Workspaces (); +} + +/* Create a popup menu. */ +void * +BPopUpMenu_new (const char *name) +{ + BPopUpMenu *menu = new EmacsPopUpMenu (name); + menu->SetRadioMode (0); + return menu; +} + +/* Add a title item to MENU. These items cannot be highlighted or + triggered, and their labels will display as bold text. */ +void +BMenu_add_title (void *menu, const char *text) +{ + EmacsTitleMenuItem *it = new EmacsTitleMenuItem (text); + BMenu *mn = (BMenu *) menu; + mn->AddItem (it); +} + +/* Add an item to the menu MENU. */ +void +BMenu_add_item (void *menu, const char *label, void *ptr, bool enabled_p, + bool marked_p, bool mbar_p, void *mbw_ptr, const char *key, + const char *help) +{ + BMenu *m = (BMenu *) menu; + BMessage *msg; + if (ptr) + msg = new BMessage (); + EmacsMenuItem *it = new EmacsMenuItem (key, label, help, ptr ? msg : NULL); + it->SetTarget (m->Window ()); + it->SetEnabled (enabled_p); + it->SetMarked (marked_p); + if (mbar_p) + { + it->menu_bar_id = (intptr_t) ptr; + it->wind_ptr = mbw_ptr; + } + it->menu_ptr = ptr; + if (ptr) + msg->AddPointer ("menuptr", ptr); + m->AddItem (it); +} + +/* Add a separator to the menu MENU. */ +void +BMenu_add_separator (void *menu) +{ + BMenu *m = (BMenu *) menu; + + m->AddSeparatorItem (); +} + +/* Create a submenu and attach it to MENU. */ +void * +BMenu_new_submenu (void *menu, const char *label, bool enabled_p) +{ + BMenu *m = (BMenu *) menu; + BMenu *mn = new BMenu (label, B_ITEMS_IN_COLUMN); + mn->SetRadioMode (0); + BMenuItem *i = new BMenuItem (mn); + i->SetEnabled (enabled_p); + m->AddItem (i); + return mn; +} + +/* Create a submenu that notifies Emacs upon opening. */ +void * +BMenu_new_menu_bar_submenu (void *menu, const char *label) +{ + BMenu *m = (BMenu *) menu; + BMenu *mn = new BMenu (label, B_ITEMS_IN_COLUMN); + mn->SetRadioMode (0); + BMenuItem *i = new BMenuItem (mn); + i->SetEnabled (1); + m->AddItem (i); + return mn; +} + +/* Run MENU, waiting for it to close, and return a pointer to the + data of the selected item (if one exists), or NULL. X, Y should + be in the screen coordinate system. */ +void * +BMenu_run (void *menu, int x, int y, + void (*run_help_callback) (void *, void *), + void (*block_input_function) (void), + void (*unblock_input_function) (void), + struct timespec (*process_pending_signals_function) (void), + void *run_help_callback_data) +{ + BPopUpMenu *mn = (BPopUpMenu *) menu; + enum haiku_event_type type; + void *buf; + void *ptr = NULL; + struct be_popup_menu_data data; + struct object_wait_info infos[3]; + struct haiku_menu_bar_help_event *event; + BMessage *msg; + ssize_t stat; + struct timespec next_time; + bigtime_t timeout; + + block_input_function (); + port_popup_menu_to_emacs = create_port (1800, "popup menu port"); + data.x = x; + data.y = y; + data.menu = mn; + unblock_input_function (); + + if (port_popup_menu_to_emacs < B_OK) + return NULL; + + block_input_function (); + mn->SetRadioMode (0); + buf = alloca (200); + + infos[0].object = port_popup_menu_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + infos[1].object = spawn_thread (be_popup_menu_thread_entry, + "Menu tracker", B_DEFAULT_MEDIA_PRIORITY, + (void *) &data); + infos[1].type = B_OBJECT_TYPE_THREAD; + infos[1].events = B_EVENT_INVALID; + + infos[2].object = port_application_to_emacs; + infos[2].type = B_OBJECT_TYPE_PORT; + infos[2].events = B_EVENT_READ; + unblock_input_function (); + + if (infos[1].object < B_OK) + { + block_input_function (); + delete_port (port_popup_menu_to_emacs); + unblock_input_function (); + return NULL; + } + + block_input_function (); + resume_thread (infos[1].object); + unblock_input_function (); + + while (true) + { + next_time = process_pending_signals_function (); + + if (next_time.tv_nsec < 0) + timeout = 10000000000; + else + timeout = (next_time.tv_sec * 1000000 + + next_time.tv_nsec / 1000); + + if ((stat = wait_for_objects_etc ((object_wait_info *) &infos, 3, + B_RELATIVE_TIMEOUT, timeout)) < B_OK) + { + if (stat == B_INTERRUPTED || stat == B_TIMED_OUT + || stat == B_WOULD_BLOCK) + continue; + else + gui_abort ("Failed to wait for popup"); + } + + if (infos[0].events & B_EVENT_READ) + { + while (!haiku_read_with_timeout (&type, buf, 200, 0, true)) + { + switch (type) + { + case MENU_BAR_HELP_EVENT: + event = (struct haiku_menu_bar_help_event *) buf; + run_help_callback (event->highlight_p + ? event->data + : NULL, run_help_callback_data); + break; + default: + gui_abort ("Unknown popup menu event"); + } + } + } + + if (infos[1].events & B_EVENT_INVALID) + { + block_input_function (); + msg = (BMessage *) popup_track_message; + if (popup_track_message) + ptr = (void *) msg->GetPointer ("menuptr"); + + delete_port (port_popup_menu_to_emacs); + unblock_input_function (); + return ptr; + } + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_INVALID; + infos[2].events = B_EVENT_READ; + } +} + +/* Delete the entire menu hierarchy of MENU, and then delete MENU + itself. */ +void +BPopUpMenu_delete (void *menu) +{ + delete (BPopUpMenu *) menu; +} + +/* Create a menubar, attach it to VIEW, and return it. */ +void * +BMenuBar_new (void *view) +{ + BView *vw = (BView *) view; + EmacsMenuBar *bar = new EmacsMenuBar (); + + if (!vw->LockLooper ()) + gui_abort ("Failed to lock menu bar parent"); + vw->AddChild ((BView *) bar); + vw->UnlockLooper (); + + return bar; +} + +/* Delete MENUBAR along with all subitems. */ +void +BMenuBar_delete (void *menubar) +{ + BView *vw = (BView *) menubar; + BView *p = vw->Parent (); + EmacsWindow *window = (EmacsWindow *) p->Window (); + + if (!p->LockLooper ()) + gui_abort ("Failed to lock menu bar parent while removing menubar"); + window->SetKeyMenuBar (NULL); + /* MenusEnded isn't called if the menu bar is destroyed + before it closes. */ + window->menu_bar_active_p = false; + vw->RemoveSelf (); + p->UnlockLooper (); + delete vw; +} + +/* Delete all items from MENU. */ +void +BMenu_delete_all (void *menu) +{ + BMenu *mn = (BMenu *) menu; + mn->RemoveItems (0, mn->CountItems (), true); +} + +/* Delete COUNT items from MENU starting from START. */ +void +BMenu_delete_from (void *menu, int start, int count) +{ + BMenu *mn = (BMenu *) menu; + mn->RemoveItems (start, count, true); +} + +/* Count items in menu MENU. */ +int +BMenu_count_items (void *menu) +{ + return ((BMenu *) menu)->CountItems (); +} + +/* Find the item in MENU at IDX. */ +void * +BMenu_item_at (void *menu, int idx) +{ + return ((BMenu *) menu)->ItemAt (idx); +} + +/* Set ITEM's label to LABEL. */ +void +BMenu_item_set_label (void *item, const char *label) +{ + ((BMenuItem *) item)->SetLabel (label); +} + +/* Get ITEM's menu. */ +void * +BMenu_item_get_menu (void *item) +{ + return ((BMenuItem *) item)->Submenu (); +} + +/* Emit a beep noise. */ +void +haiku_ring_bell (void) +{ + beep (); +} + +/* Create a BAlert with TEXT. */ +void * +BAlert_new (const char *text, enum haiku_alert_type type) +{ + return new BAlert (NULL, text, NULL, NULL, NULL, B_WIDTH_AS_USUAL, + (enum alert_type) type); +} + +/* Add a button to ALERT and return the button. */ +void * +BAlert_add_button (void *alert, const char *text) +{ + BAlert *al = (BAlert *) alert; + al->AddButton (text); + return al->ButtonAt (al->CountButtons () - 1); +} + +/* Make sure the leftmost button is grouped to the left hand side of + the alert. */ +void +BAlert_set_offset_spacing (void *alert) +{ + BAlert *al = (BAlert *) alert; + + al->SetButtonSpacing (B_OFFSET_SPACING); +} + +static int32 +be_alert_thread_entry (void *thread_data) +{ + BAlert *alert = (BAlert *) thread_data; + int32 value; + + if (alert->LockLooper ()) + value = alert->Go (); + else + value = -1; + + alert_popup_value = value; + return 0; +} + +/* Run ALERT, returning the number of the button that was selected, + or -1 if no button was selected before the alert was closed. */ +int32 +BAlert_go (void *alert, + void (*block_input_function) (void), + void (*unblock_input_function) (void), + void (*process_pending_signals_function) (void)) +{ + struct object_wait_info infos[2]; + ssize_t stat; + BAlert *alert_object = (BAlert *) alert; + + infos[0].object = port_application_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + block_input_function (); + /* Alerts are created locked, just like other windows. */ + alert_object->UnlockLooper (); + infos[1].object = spawn_thread (be_alert_thread_entry, + "Popup tracker", + B_DEFAULT_MEDIA_PRIORITY, + alert); + infos[1].type = B_OBJECT_TYPE_THREAD; + infos[1].events = B_EVENT_INVALID; + unblock_input_function (); + + if (infos[1].object < B_OK) + return -1; + + block_input_function (); + resume_thread (infos[1].object); + unblock_input_function (); + + while (true) + { + stat = wait_for_objects ((object_wait_info *) &infos, 2); + + if (stat == B_INTERRUPTED) + continue; + else if (stat < B_OK) + gui_abort ("Failed to wait for popup dialog"); + + if (infos[1].events & B_EVENT_INVALID) + return alert_popup_value; + + if (infos[0].events & B_EVENT_READ) + process_pending_signals_function (); + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_INVALID; + } +} + +/* Enable or disable BUTTON depending on ENABLED_P. */ +void +BButton_set_enabled (void *button, int enabled_p) +{ + ((BButton *) button)->SetEnabled (enabled_p); +} + +/* Set VIEW's tooltip to TOOLTIP. */ +void +BView_set_tooltip (void *view, const char *tooltip) +{ + ((BView *) view)->SetToolTip (tooltip); +} + +/* Set VIEW's tooltip to a sticky tooltip at X by Y. */ +void +BView_set_and_show_sticky_tooltip (void *view, const char *tooltip, + int x, int y) +{ + BToolTip *tip; + BView *vw = (BView *) view; + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view while showing sticky tooltip"); + vw->SetToolTip (tooltip); + tip = vw->ToolTip (); + BPoint pt; + EmacsView *ev = dynamic_cast<EmacsView *> (vw); + if (ev) + ev->tt_absl_pos = BPoint (x, y); + + vw->GetMouse (&pt, NULL, 1); + pt.x -= x; + pt.y -= y; + + pt.x = -pt.x; + pt.y = -pt.y; + + tip->SetMouseRelativeLocation (pt); + tip->SetSticky (1); + vw->ShowToolTip (tip); + vw->UnlockLooper (); +} + +/* Delete ALERT. */ +void +BAlert_delete (void *alert) +{ + delete (BAlert *) alert; +} + +/* Place the resolution of the monitor in DPI in RSSX and RSSY. */ +void +BScreen_res (double *rrsx, double *rrsy) +{ + BScreen s (B_MAIN_SCREEN_ID); + if (!s.IsValid ()) + gui_abort ("Invalid screen for resolution checks"); + monitor_info i; + + if (s.GetMonitorInfo (&i) == B_OK) + { + *rrsx = (double) i.width / (double) 2.54; + *rrsy = (double) i.height / (double) 2.54; + } + else + { + *rrsx = 72.27; + *rrsy = 72.27; + } +} + +/* Add WINDOW to OTHER_WINDOW's subset and parent it to + OTHER_WINDOW. */ +void +EmacsWindow_parent_to (void *window, void *other_window) +{ + EmacsWindow *w = (EmacsWindow *) window; + if (!w->LockLooper ()) + gui_abort ("Failed to lock window while parenting"); + w->ParentTo ((EmacsWindow *) other_window); + w->UnlockLooper (); +} + +void +EmacsWindow_unparent (void *window) +{ + EmacsWindow *w = (EmacsWindow *) window; + if (!w->LockLooper ()) + gui_abort ("Failed to lock window while unparenting"); + w->UnparentAndUnlink (); + w->UnlockLooper (); +} + +/* Place text describing the current version of Haiku in VERSION, + which should be a buffer LEN bytes wide. */ +void +be_get_version_string (char *version, int len) +{ + std::strncpy (version, "Unknown Haiku release", len - 1); + version[len - 1] = '\0'; + + BPath path; + if (find_directory (B_BEOS_LIB_DIRECTORY, &path) == B_OK) + { + path.Append ("libbe.so"); + + BAppFileInfo appFileInfo; + version_info versionInfo; + BFile file; + if (file.SetTo (path.Path (), B_READ_ONLY) == B_OK + && appFileInfo.SetTo (&file) == B_OK + && appFileInfo.GetVersionInfo (&versionInfo, + B_APP_VERSION_KIND) == B_OK + && versionInfo.short_info[0] != '\0') + { + std::strncpy (version, versionInfo.short_info, len - 1); + version[len - 1] = '\0'; + } + } +} + +/* Return the amount of color planes in the current display. */ +int +be_get_display_planes (void) +{ + color_space space = dpy_color_space; + if (space == B_NO_COLOR_SPACE) + { + BScreen screen; /* This is actually a very slow operation. */ + if (!screen.IsValid ()) + gui_abort ("Invalid screen"); + space = dpy_color_space = screen.ColorSpace (); + } + + if (space == B_RGB32 || space == B_RGB24) + return 24; + if (space == B_RGB16) + return 16; + if (space == B_RGB15) + return 15; + if (space == B_CMAP8) + return 8; + + gui_abort ("Bad colorspace for screen"); + /* https://www.haiku-os.org/docs/api/classBScreen.html + says a valid screen can't be anything else. */ + return -1; +} + +/* Return the amount of colors the display can handle. */ +int +be_get_display_color_cells (void) +{ + color_space space = dpy_color_space; + if (space == B_NO_COLOR_SPACE) + { + BScreen screen; + if (!screen.IsValid ()) + gui_abort ("Invalid screen"); + space = dpy_color_space = screen.ColorSpace (); + } + + if (space == B_RGB32 || space == B_RGB24) + return 1677216; + if (space == B_RGB16) + return 65536; + if (space == B_RGB15) + return 32768; + if (space == B_CMAP8) + return 256; + + gui_abort ("Bad colorspace for screen"); + return -1; +} + +/* Warp the pointer to X by Y. */ +void +be_warp_pointer (int x, int y) +{ + /* We're not supposed to use the following function without a + BWindowScreen object, but in Haiku nothing actually prevents us + from doing so. */ + + set_mouse_position (x, y); +} + +/* Update the position of CHILD in WINDOW without actually moving + it. */ +void +EmacsWindow_move_weak_child (void *window, void *child, int xoff, int yoff) +{ + EmacsWindow *w = (EmacsWindow *) window; + EmacsWindow *c = (EmacsWindow *) child; + + if (!w->LockLooper ()) + gui_abort ("Couldn't lock window for weak move"); + w->MoveChild (c, xoff, yoff, 1); + w->UnlockLooper (); +} + +/* Find an appropriate view to draw onto. If VW is double-buffered, + this will be the view used for double buffering instead of VW + itself. */ +void * +find_appropriate_view_for_draw (void *vw) +{ + BView *v = (BView *) vw; + EmacsView *ev = dynamic_cast<EmacsView *>(v); + if (!ev) + return v; + + return ev->offscreen_draw_view ? ev->offscreen_draw_view : vw; +} + +/* Set up double buffering for VW. */ +void +EmacsView_set_up_double_buffering (void *vw) +{ + EmacsView *view = (EmacsView *) vw; + if (!view->LockLooper ()) + gui_abort ("Couldn't lock view while setting up double buffering"); + if (view->offscreen_draw_view) + { + view->UnlockLooper (); + return; + } + view->SetUpDoubleBuffering (); + view->UnlockLooper (); +} + +/* Flip and invalidate the view VW. */ +void +EmacsView_flip_and_blit (void *vw) +{ + EmacsView *view = (EmacsView *) vw; + if (!view->offscreen_draw_view) + return; + if (!view->LockLooper ()) + gui_abort ("Couldn't lock view in flip_and_blit"); + view->FlipBuffers (); + view->UnlockLooper (); +} + +/* Disable double buffering for VW. */ +void +EmacsView_disable_double_buffering (void *vw) +{ + EmacsView *view = (EmacsView *) vw; + if (!view->LockLooper ()) + gui_abort ("Couldn't lock view tearing down double buffering"); + view->TearDownDoubleBuffering (); + view->UnlockLooper (); +} + +/* Return non-0 if VW is double-buffered. */ +int +EmacsView_double_buffered_p (void *vw) +{ + EmacsView *view = (EmacsView *) vw; + if (!view->LockLooper ()) + gui_abort ("Couldn't lock view testing double buffering status"); + int db_p = !!view->offscreen_draw_view; + view->UnlockLooper (); + return db_p; +} + +struct popup_file_dialog_data +{ + BMessage *msg; + BFilePanel *panel; + BEntry *entry; +}; + +static void +unwind_popup_file_dialog (void *ptr) +{ + struct popup_file_dialog_data *data + = (struct popup_file_dialog_data *) ptr; + BFilePanel *panel = data->panel; + + delete panel; + delete data->entry; + delete data->msg; +} + +/* Popup a file dialog. */ +char * +be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, + int dir_only_p, void *window, const char *save_text, + const char *prompt, void (*block_input_function) (void), + void (*unblock_input_function) (void), + void (*maybe_quit_function) (void)) +{ + specpdl_ref idx = c_specpdl_idx_from_cxx (); + /* setjmp/longjmp is UB with automatic objects. */ + BWindow *w = (BWindow *) window; + uint32_t mode = (dir_only_p + ? B_DIRECTORY_NODE + : B_FILE_NODE | B_DIRECTORY_NODE); + BEntry *path = new BEntry; + BMessage *msg = new BMessage ('FPSE'); + BFilePanel *panel = new BFilePanel (open_p ? B_OPEN_PANEL : B_SAVE_PANEL, + NULL, NULL, mode); + void *buf; + enum haiku_event_type type; + char *ptr; + struct popup_file_dialog_data dat; + ssize_t b_s; + + dat.entry = path; + dat.msg = msg; + dat.panel = panel; + + record_c_unwind_protect_from_cxx (unwind_popup_file_dialog, &dat); + + if (default_dir) + { + if (path->SetTo (default_dir, 0) != B_OK) + default_dir = NULL; + } + + panel->SetMessage (msg); + + if (default_dir) + panel->SetPanelDirectory (path); + if (save_text) + panel->SetSaveText (save_text); + + panel->SetHideWhenDone (0); + panel->Window ()->SetTitle (prompt); + panel->SetTarget (BMessenger (w)); + panel->Show (); + + buf = alloca (200); + while (1) + { + ptr = NULL; + + if (!haiku_read_with_timeout (&type, buf, 200, 1000000, false)) + { + block_input_function (); + if (type != FILE_PANEL_EVENT) + haiku_write (type, buf); + else if (!ptr) + ptr = (char *) ((struct haiku_file_panel_event *) buf)->ptr; + unblock_input_function (); + + maybe_quit_function (); + } + + block_input_function (); + haiku_read_size (&b_s, false); + if (!b_s || ptr || panel->Window ()->IsHidden ()) + { + c_unbind_to_nil_from_cxx (idx); + unblock_input_function (); + return ptr; + } + unblock_input_function (); + } +} + +/* Zoom WINDOW. */ +void +BWindow_zoom (void *window) +{ + BWindow *w = (BWindow *) window; + w->Zoom (); +} + +/* Make WINDOW fullscreen if FULLSCREEN_P. */ +void +EmacsWindow_make_fullscreen (void *window, int fullscreen_p) +{ + EmacsWindow *w = (EmacsWindow *) window; + w->MakeFullscreen (fullscreen_p); +} + +/* Unzoom (maximize) WINDOW. */ +void +EmacsWindow_unzoom (void *window) +{ + EmacsWindow *w = (EmacsWindow *) window; + w->UnZoom (); +} + +/* Move the pointer into MBAR and start tracking. Return whether the + menu bar was opened correctly. */ +bool +BMenuBar_start_tracking (void *mbar) +{ + EmacsMenuBar *mb = (EmacsMenuBar *) mbar; + BMessenger messenger (mb); + BMessage reply; + + messenger.SendMessage (SHOW_MENU_BAR, &reply); + + return reply.what == BE_MENU_BAR_OPEN; +} + +#ifdef HAVE_NATIVE_IMAGE_API +int +be_can_translate_type_to_bitmap_p (const char *mime) +{ + BTranslatorRoster *r = BTranslatorRoster::Default (); + translator_id *ids; + int32 id_len; + + if (r->GetAllTranslators (&ids, &id_len) != B_OK) + return 0; + + int found_in = 0; + int found_out = 0; + + for (int i = 0; i < id_len; ++i) + { + found_in = 0; + found_out = 0; + const translation_format *i_fmts; + const translation_format *o_fmts; + + int32 i_count, o_count; + + if (r->GetInputFormats (ids[i], &i_fmts, &i_count) != B_OK) + continue; + + if (r->GetOutputFormats (ids[i], &o_fmts, &o_count) != B_OK) + continue; + + for (int x = 0; x < i_count; ++x) + { + if (!strcmp (i_fmts[x].MIME, mime)) + { + found_in = 1; + break; + } + } + + for (int x = 0; x < i_count; ++x) + { + if (!strcmp (o_fmts[x].MIME, "image/x-be-bitmap") || + !strcmp (o_fmts[x].MIME, "image/x-vnd.Be-bitmap")) + { + found_out = 1; + break; + } + } + + if (found_in && found_out) + break; + } + + delete [] ids; + + return found_in && found_out; +} + +void * +be_translate_bitmap_from_file_name (const char *filename) +{ + BBitmap *bm = BTranslationUtils::GetBitmap (filename); + return bm; +} + +void * +be_translate_bitmap_from_memory (const void *buf, size_t bytes) +{ + BMemoryIO io (buf, bytes); + BBitmap *bm = BTranslationUtils::GetBitmap (&io); + return bm; +} +#endif + +/* Return the size of BITMAP's data, in bytes. */ +size_t +BBitmap_bytes_length (void *bitmap) +{ + BBitmap *bm = (BBitmap *) bitmap; + return bm->BitsLength (); +} + +/* Show VIEW's tooltip. */ +void +BView_show_tooltip (void *view) +{ + BView *vw = (BView *) view; + if (vw->LockLooper ()) + { + vw->ShowToolTip (vw->ToolTip ()); + vw->UnlockLooper (); + } +} + + +#ifdef USE_BE_CAIRO +/* Return VIEW's cairo context. */ +cairo_t * +EmacsView_cairo_context (void *view) +{ + EmacsView *vw = (EmacsView *) view; + return vw->cr_context; +} + +/* Transfer each clip rectangle in VIEW to the cairo context + CTX. */ +void +BView_cr_dump_clipping (void *view, cairo_t *ctx) +{ + BView *vw = (BView *) find_appropriate_view_for_draw (view); + BRegion cr; + vw->GetClippingRegion (&cr); + + for (int i = 0; i < cr.CountRects (); ++i) + { + BRect r = cr.RectAt (i); + cairo_rectangle (ctx, r.left, r.top, + BE_RECT_WIDTH (r), + BE_RECT_HEIGHT (r)); + } + + cairo_clip (ctx); +} + +/* Lock WINDOW in preparation for drawing using Cairo. */ +void +EmacsWindow_begin_cr_critical_section (void *window) +{ + BWindow *w = (BWindow *) window; + BView *vw = (BView *) w->FindView ("Emacs"); + EmacsView *ev = dynamic_cast <EmacsView *> (vw); + if (ev && !ev->cr_surface_lock.Lock ()) + gui_abort ("Couldn't lock view cairo surface"); +} + +/* Unlock WINDOW in preparation for drawing using Cairo. */ +void +EmacsWindow_end_cr_critical_section (void *window) +{ + BWindow *w = (BWindow *) window; + BView *vw = (BView *) w->FindView ("Emacs"); + EmacsView *ev = dynamic_cast <EmacsView *> (vw); + if (ev) + ev->cr_surface_lock.Unlock (); +} +#endif + +/* Get the width of STR in the plain font. */ +int +be_string_width_with_plain_font (const char *str) +{ + return be_plain_font->StringWidth (str); +} + +/* Get the ascent + descent of the plain font. */ +int +be_plain_font_height (void) +{ + struct font_height fheight; + be_plain_font->GetHeight (&fheight); + + return fheight.ascent + fheight.descent; +} + +/* Return the number of physical displays connected. */ +int +be_get_display_screens (void) +{ + int count = 1; + BScreen scr; + + if (!scr.IsValid ()) + gui_abort ("Main screen vanished!"); + while (scr.SetToNext () == B_OK && scr.IsValid ()) + ++count; + + return count; +} + +/* Set the minimum width the user can resize WINDOW to. */ +void +BWindow_set_min_size (void *window, int width, int height) +{ + BWindow *w = (BWindow *) window; + + if (!w->LockLooper ()) + gui_abort ("Failed to lock window looper setting min size"); + w->SetSizeLimits (width, -1, height, -1); + w->UnlockLooper (); +} + +/* Synchronize WINDOW's connection to the App Server. */ +void +BWindow_sync (void *window) +{ + BWindow *w = (BWindow *) window; + + if (!w->LockLooper ()) + gui_abort ("Failed to lock window looper for sync"); + w->Sync (); + w->UnlockLooper (); +} + +/* Set the alignment of WINDOW's dimensions. */ +void +BWindow_set_size_alignment (void *window, int align_width, int align_height) +{ + BWindow *w = (BWindow *) window; + + if (!w->LockLooper ()) + gui_abort ("Failed to lock window looper setting alignment"); +#if 0 /* Haiku does not currently implement SetWindowAlignment. */ + if (w->SetWindowAlignment (B_PIXEL_ALIGNMENT, -1, -1, align_width, + align_width, -1, -1, align_height, + align_height) != B_NO_ERROR) + gui_abort ("Invalid pixel alignment"); +#endif + w->UnlockLooper (); +} + +void +BWindow_send_behind (void *window, void *other_window) +{ + BWindow *w = (BWindow *) window; + BWindow *other = (BWindow *) other_window; + + if (!w->LockLooper ()) + gui_abort ("Failed to lock window in order to send it behind another"); + w->SendBehind (other); + w->UnlockLooper (); +} + +bool +BWindow_is_active (void *window) +{ + BWindow *w = (BWindow *) window; + return w->IsActive (); +} + +bool +be_use_subpixel_antialiasing (void) +{ + bool current_subpixel_antialiasing; + + if (get_subpixel_antialiasing (¤t_subpixel_antialiasing) != B_OK) + return false; + + return current_subpixel_antialiasing; +} + +void +BWindow_set_override_redirect (void *window, bool override_redirect_p) +{ + EmacsWindow *w = (EmacsWindow *) window; + + if (w->LockLooper ()) + { + if (override_redirect_p && !w->override_redirect_p) + { + w->override_redirect_p = true; + w->pre_override_redirect_feel = w->Feel (); + w->pre_override_redirect_look = w->Look (); + w->SetFeel (kMenuWindowFeel); + w->SetLook (B_NO_BORDER_WINDOW_LOOK); + w->pre_override_redirect_workspaces = w->Workspaces (); + w->SetWorkspaces (B_ALL_WORKSPACES); + } + else if (w->override_redirect_p) + { + w->override_redirect_p = false; + w->SetFeel (w->pre_override_redirect_feel); + w->SetLook (w->pre_override_redirect_look); + w->SetWorkspaces (w->pre_override_redirect_workspaces); + } + + w->UnlockLooper (); + } +} + +/* Find a resource by the name NAME inside the settings file. The + string returned is in UTF-8 encoding, and will stay allocated as + long as the BApplication (a.k.a display) is alive. */ +const char * +be_find_setting (const char *name) +{ + Emacs *app = (Emacs *) be_app; + const char *value; + + /* Note that this is thread-safe since the constructor of `Emacs' + runs in the main thread. */ + if (!app->settings_valid_p) + return NULL; + + if (app->settings.FindString (name, 0, &value) != B_OK) + return NULL; + + return value; +} + +void +EmacsWindow_signal_menu_update_complete (void *window) +{ + EmacsWindow *w = (EmacsWindow *) window; + + pthread_mutex_lock (&w->menu_update_mutex); + w->menu_updated_p = true; + pthread_cond_signal (&w->menu_update_cv); + pthread_mutex_unlock (&w->menu_update_mutex); +} + +void +BMessage_delete (void *message) +{ + delete (BMessage *) message; +} + +static int32 +be_drag_message_thread_entry (void *thread_data) +{ + BMessenger *messenger; + BMessage reply; + + messenger = (BMessenger *) thread_data; + messenger->SendMessage (WAIT_FOR_RELEASE, &reply); + + return 0; +} + +bool +be_drag_message (void *view, void *message, bool allow_same_view, + void (*block_input_function) (void), + void (*unblock_input_function) (void), + void (*process_pending_signals_function) (void), + bool (*should_quit_function) (void)) +{ + EmacsView *vw = (EmacsView *) view; + EmacsWindow *window = (EmacsWindow *) vw->Window (); + BMessage *msg = (BMessage *) message; + BMessage wait_for_release; + BMessenger messenger (vw); + BMessage cancel_message (CANCEL_DROP); + struct object_wait_info infos[2]; + ssize_t stat; + + block_input_function (); + + if (!allow_same_view && + (msg->ReplaceInt32 ("emacs:window_id", window->window_id) + == B_NAME_NOT_FOUND)) + msg->AddInt32 ("emacs:window_id", window->window_id); + + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view looper for drag"); + + vw->DragMessage (msg, BRect (0, 0, 0, 0)); + vw->UnlockLooper (); + + infos[0].object = port_application_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + infos[1].object = spawn_thread (be_drag_message_thread_entry, + "Drag waiter thread", + B_DEFAULT_MEDIA_PRIORITY, + (void *) &messenger); + infos[1].type = B_OBJECT_TYPE_THREAD; + infos[1].events = B_EVENT_INVALID; + unblock_input_function (); + + if (infos[1].object < B_OK) + return false; + + block_input_function (); + resume_thread (infos[1].object); + unblock_input_function (); + + drag_and_drop_in_progress = true; + + while (true) + { + block_input_function (); + stat = wait_for_objects ((struct object_wait_info *) &infos, 2); + unblock_input_function (); + + if (stat == B_INTERRUPTED || stat == B_TIMED_OUT + || stat == B_WOULD_BLOCK) + continue; + + if (stat < B_OK) + gui_abort ("Failed to wait for drag"); + + if (infos[0].events & B_EVENT_READ) + process_pending_signals_function (); + + if (should_quit_function ()) + { + /* Do the best we can to prevent something from being + dropped, since Haiku doesn't provide a way to actually + cancel drag-and-drop. */ + if (vw->LockLooper ()) + { + vw->DragMessage (&cancel_message, BRect (0, 0, 0, 0)); + vw->UnlockLooper (); + } + + messenger.SendMessage (CANCEL_DROP); + drag_and_drop_in_progress = false; + return true; + } + + if (infos[1].events & B_EVENT_INVALID) + { + drag_and_drop_in_progress = false; + return false; + } + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_INVALID; + } +} + +bool +be_drag_and_drop_in_progress (void) +{ + return drag_and_drop_in_progress; +} diff --git a/src/haiku_support.h b/src/haiku_support.h new file mode 100644 index 00000000000..9935906f0e3 --- /dev/null +++ b/src/haiku_support.h @@ -0,0 +1,644 @@ +/* Haiku window system support. Hey Emacs, this is -*- C++ -*- + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#ifndef _HAIKU_SUPPORT_H +#define _HAIKU_SUPPORT_H + +#include <stdint.h> + +#ifdef HAVE_FREETYPE +#include <ft2build.h> +#include <fontconfig/fontconfig.h> +#include FT_FREETYPE_H +#include FT_SIZES_H +#endif + +#ifdef USE_BE_CAIRO +#include <cairo.h> +#endif + +#include <math.h> + +#include <kernel/OS.h> + +enum haiku_cursor + { + CURSOR_ID_NO_CURSOR = 12, + CURSOR_ID_RESIZE_NORTH = 15, + CURSOR_ID_RESIZE_EAST = 16, + CURSOR_ID_RESIZE_SOUTH = 17, + CURSOR_ID_RESIZE_WEST = 18, + CURSOR_ID_RESIZE_NORTH_EAST = 19, + CURSOR_ID_RESIZE_NORTH_WEST = 20, + CURSOR_ID_RESIZE_SOUTH_EAST = 21, + CURSOR_ID_RESIZE_SOUTH_WEST = 22, + CURSOR_ID_RESIZE_NORTH_SOUTH = 23, + CURSOR_ID_RESIZE_EAST_WEST = 24, + CURSOR_ID_RESIZE_NORTH_EAST_SOUTH_WEST = 25, + CURSOR_ID_RESIZE_NORTH_WEST_SOUTH_EAST = 26 + }; + +enum haiku_alert_type + { + HAIKU_EMPTY_ALERT = 0, + HAIKU_INFO_ALERT, + HAIKU_IDEA_ALERT, + HAIKU_WARNING_ALERT, + HAIKU_STOP_ALERT + }; + +enum haiku_event_type + { + QUIT_REQUESTED, + FRAME_RESIZED, + FRAME_EXPOSED, + KEY_DOWN, + KEY_UP, + ACTIVATION, + MOUSE_MOTION, + BUTTON_DOWN, + BUTTON_UP, + ICONIFICATION, + MOVE_EVENT, + SCROLL_BAR_VALUE_EVENT, + SCROLL_BAR_PART_EVENT, + SCROLL_BAR_DRAG_EVENT, + WHEEL_MOVE_EVENT, + MENU_BAR_RESIZE, + MENU_BAR_OPEN, + MENU_BAR_SELECT_EVENT, + MENU_BAR_CLOSE, + FILE_PANEL_EVENT, + MENU_BAR_HELP_EVENT, + ZOOM_EVENT, + DRAG_AND_DROP_EVENT, + APP_QUIT_REQUESTED_EVENT, + DUMMY_EVENT, + MENU_BAR_LEFT + }; + +struct haiku_quit_requested_event +{ + void *window; +}; + +struct haiku_resize_event +{ + void *window; + float px_heightf; + float px_widthf; +}; + +struct haiku_expose_event +{ + void *window; + int x; + int y; + int width; + int height; +}; + +struct haiku_drag_and_drop_event +{ + void *window; + int x, y; + void *message; +}; + +struct haiku_app_quit_requested_event +{ + char dummy; +}; + +struct haiku_dummy_event +{ + char dummy; +}; + +#define HAIKU_MODIFIER_ALT (1) +#define HAIKU_MODIFIER_CTRL (1 << 1) +#define HAIKU_MODIFIER_SHIFT (1 << 2) +#define HAIKU_MODIFIER_SUPER (1 << 3) + +struct haiku_key_event +{ + void *window; + int modifiers; + unsigned keysym; + uint32_t multibyte_char; + + /* Time the keypress occurred, in microseconds. */ + bigtime_t time; +}; + +struct haiku_activation_event +{ + void *window; + int activated_p; +}; + +struct haiku_mouse_motion_event +{ + void *window; + bool just_exited_p; + int x; + int y; + bigtime_t time; + bool dnd_message; +}; + +struct haiku_menu_bar_left_event +{ + void *window; + int x, y; +}; + +struct haiku_button_event +{ + void *window; + int btn_no; + int modifiers; + int x; + int y; + bigtime_t time; +}; + +struct haiku_iconification_event +{ + void *window; + int iconified_p; +}; + +struct haiku_move_event +{ + void *window; + int x; + int y; +}; + +struct haiku_wheel_move_event +{ + void *window; + int modifiers; + float delta_x; + float delta_y; +}; + +struct haiku_menu_bar_select_event +{ + void *window; + void *ptr; +}; + +struct haiku_file_panel_event +{ + void *ptr; +}; + +struct haiku_menu_bar_help_event +{ + void *window; + int mb_idx; + void *data; + bool highlight_p; +}; + +struct haiku_zoom_event +{ + void *window; + bool zoomed; +}; + +enum haiku_font_specification + { + FSPEC_FAMILY = 1, + FSPEC_STYLE = 1 << 1, + FSPEC_SLANT = 1 << 2, + FSPEC_WEIGHT = 1 << 3, + FSPEC_SPACING = 1 << 4, + FSPEC_WANTED = 1 << 5, + FSPEC_NEED_ONE_OF = 1 << 6, + FSPEC_WIDTH = 1 << 7, + FSPEC_LANGUAGE = 1 << 8, + }; + +typedef char haiku_font_family_or_style[64]; + +enum haiku_font_slant + { + NO_SLANT = -1, + SLANT_OBLIQUE, + SLANT_REGULAR, + SLANT_ITALIC + }; + +enum haiku_font_width + { + NO_WIDTH = -1, + ULTRA_CONDENSED, + EXTRA_CONDENSED, + CONDENSED, + SEMI_CONDENSED, + NORMAL_WIDTH, + SEMI_EXPANDED, + EXPANDED, + EXTRA_EXPANDED, + ULTRA_EXPANDED + }; + +enum haiku_font_language + { + LANGUAGE_CN, + LANGUAGE_KO, + LANGUAGE_JP, + MAX_LANGUAGE /* This isn't a language. */ + }; + +struct haiku_font_pattern +{ + int specified; + struct haiku_font_pattern *next; + /* The next two fields are only temporarily used during the font + discovery process! Do not rely on them being correct outside + BFont_find. */ + struct haiku_font_pattern *last; + struct haiku_font_pattern *next_family; + haiku_font_family_or_style family; + haiku_font_family_or_style style; + int weight; + int mono_spacing_p; + int want_chars_len; + int need_one_of_len; + enum haiku_font_slant slant; + enum haiku_font_width width; + enum haiku_font_language language; + uint32_t *wanted_chars; + uint32_t *need_one_of; + + int oblique_seen_p; +}; + +struct haiku_scroll_bar_value_event +{ + void *scroll_bar; + void *window; + int position; +}; + +struct haiku_scroll_bar_drag_event +{ + void *scroll_bar; + void *window; + int dragging_p; +}; + +enum haiku_scroll_bar_part + { + HAIKU_SCROLL_BAR_UP_BUTTON, + HAIKU_SCROLL_BAR_DOWN_BUTTON + }; + +struct haiku_scroll_bar_part_event +{ + void *scroll_bar; + void *window; + enum haiku_scroll_bar_part part; +}; + +struct haiku_menu_bar_resize_event +{ + void *window; + int width; + int height; +}; + +struct haiku_menu_bar_state_event +{ + void *window; +}; + +#define HAIKU_THIN 0 +#define HAIKU_ULTRALIGHT 20 +#define HAIKU_EXTRALIGHT 40 +#define HAIKU_LIGHT 50 +#define HAIKU_SEMI_LIGHT 75 +#define HAIKU_REGULAR 100 +#define HAIKU_SEMI_BOLD 180 +#define HAIKU_BOLD 200 +#define HAIKU_EXTRA_BOLD 205 +#define HAIKU_ULTRA_BOLD 210 +#define HAIKU_BOOK 400 +#define HAIKU_HEAVY 800 +#define HAIKU_ULTRA_HEAVY 900 +#define HAIKU_BLACK 1000 +#define HAIKU_MEDIUM 2000 + +#ifdef __cplusplus +/* Haiku's built in Height and Width functions for calculating + rectangle sizes are broken, probably for compatibility with BeOS: + they do not round up in a reasonable fashion, and they return the + numerical difference between the end and start sides in both + directions, instead of the actual size. + + For example: + + BRect (1, 1, 5, 5).IntegerWidth () + + Will return 4, when in reality the rectangle is 5 pixels wide, + since the left corner is also a pixel! + + All code in Emacs should use the macros below to calculate the + dimensions of a BRect, instead of relying on the broken Width and + Height functions. */ + +#define BE_RECT_HEIGHT(rect) (ceil (((rect).bottom - (rect).top) + 1)) +#define BE_RECT_WIDTH(rect) (ceil (((rect).right - (rect).left) + 1)) +#endif /* __cplusplus */ + +/* C++ code cannot include lisp.h, but file dialogs need to be able + to bind to the specpdl and handle quitting correctly. */ + +#ifdef __cplusplus +#if SIZE_MAX > 0xffffffff +#define WRAP_SPECPDL_REF 1 +#endif +#ifdef WRAP_SPECPDL_REF +typedef struct { ptrdiff_t bytes; } specpdl_ref; +#else +typedef ptrdiff_t specpdl_ref; +#endif + +#else +#include "lisp.h" +#endif + +#ifdef __cplusplus +extern "C" +{ +#endif +#include <pthread.h> +#include <OS.h> + +#ifdef __cplusplus +typedef void *haiku; + +extern void haiku_put_pixel (haiku, int, int, unsigned long); +extern unsigned long haiku_get_pixel (haiku, int, int); +#endif + +extern port_id port_application_to_emacs; +extern port_id port_popup_menu_to_emacs; + +extern void haiku_io_init (void); +extern void haiku_io_init_in_app_thread (void); + +extern void haiku_read_size (ssize_t *, bool); + +extern int haiku_read (enum haiku_event_type *, void *, ssize_t); +extern int haiku_read_with_timeout (enum haiku_event_type *, void *, ssize_t, + bigtime_t, bool); +extern int haiku_write (enum haiku_event_type, void *); +extern int haiku_write_without_signal (enum haiku_event_type, void *, bool); + +extern void rgb_color_hsl (uint32_t, double *, double *, double *); +extern void hsl_color_rgb (double, double, double, uint32_t *); + +extern void *BBitmap_new (int, int, int); +extern void *BBitmap_data (void *); +extern int BBitmap_convert (void *, void **); + +extern void BBitmap_free (void *); + +extern void BBitmap_dimensions (void *, int *, int *, int *, int *, + int32_t *, int *); +extern void *BApplication_setup (void); +extern void *BWindow_new (void **); +extern void BWindow_quit (void *); + +extern void BWindow_set_offset (void *, int, int); +extern void BWindow_iconify (void *); +extern void BWindow_set_visible (void *, int); +extern void BWindow_retitle (void *, const char *); +extern void BWindow_resize (void *, int, int); +extern void BWindow_activate (void *); +extern void BWindow_center_on_screen (void *); +extern void BWindow_change_decoration (void *, int); +extern void BWindow_set_tooltip_decoration (void *); +extern void BWindow_set_avoid_focus (void *, int); +extern uint32_t BWindow_workspaces (void *); +extern void BWindow_zoom (void *); +extern void BWindow_set_min_size (void *, int, int); +extern void BWindow_set_size_alignment (void *, int, int); +extern void BWindow_sync (void *); +extern void BWindow_send_behind (void *, void *); +extern bool BWindow_is_active (void *); +extern void BWindow_set_override_redirect (void *, bool); +extern void BWindow_dimensions (void *, int *, int *); +extern void BWindow_Flush (void *); + +extern void BFont_close (void *); +extern void BFont_dat (void *, int *, int *, int *, int *, + int *, int *, int *, int *, int *, int *); +extern int BFont_have_char_p (void *, int32_t); +extern int BFont_have_char_block (void *, int32_t, int32_t); +extern void BFont_char_bounds (void *, const char *, int *, int *, int *); +extern void BFont_nchar_bounds (void *, const char *, int *, int *, + int *, int32_t); +extern struct haiku_font_pattern *BFont_find (struct haiku_font_pattern *); + + +extern void BView_StartClip (void *); +extern void BView_EndClip (void *); +extern void BView_SetHighColor (void *, uint32_t); +extern void BView_SetHighColorForVisibleBell (void *, uint32_t); +extern void BView_SetLowColor (void *, uint32_t); +extern void BView_SetPenSize (void *, int); +extern void BView_SetFont (void *, void *); +extern void BView_MovePenTo (void *, int, int); +extern void BView_DrawString (void *, const char *, ptrdiff_t); +extern void BView_DrawChar (void *, char); +extern void BView_FillRectangle (void *, int, int, int, int); +extern void BView_FillRectangleAbs (void *, int, int, int, int); +extern void BView_FillTriangle (void *, int, int, int, int, int, int); +extern void BView_StrokeRectangle (void *, int, int, int, int); +extern void BView_SetViewColor (void *, uint32_t); +extern void BView_ClipToRect (void *, int, int, int, int); +extern void BView_ClipToInverseRect (void *, int, int, int, int); +extern void BView_StrokeLine (void *, int, int, int, int); +extern void BView_CopyBits (void *, int, int, int, int, int, int, int, int); +extern void BView_InvertRect (void *, int, int, int, int); +extern void BView_DrawBitmap (void *, void *, int, int, int, int, int, int, + int, int); +extern void BView_DrawBitmapWithEraseOp (void *, void *, int, int, int, int); +extern void BView_DrawMask (void *, void *, int, int, int, int, int, int, + int, int, uint32_t); + +extern void BView_resize_to (void *, int, int); +extern void BView_set_view_cursor (void *, void *); +extern void BView_move_frame (void *, int, int, int, int); +extern void BView_scroll_bar_update (void *, int, int, int, int, bool); + +extern void *BBitmap_transform_bitmap (void *, void *, uint32_t, double, + int, int); + +extern void BScreen_px_dim (int *, int *); +extern void BScreen_res (double *, double *); + +/* Functions for creating and freeing cursors. */ +extern void *BCursor_create_default (void); +extern void *BCursor_from_id (enum haiku_cursor); +extern void *BCursor_create_modeline (void); +extern void *BCursor_create_i_beam (void); +extern void *BCursor_create_progress_cursor (void); +extern void *BCursor_create_grab (void); +extern void BCursor_delete (void *); + +extern void *BScrollBar_make_for_view (void *, int, int, int, int, int, void *); +extern void BScrollBar_delete (void *); +extern int BScrollBar_default_size (int); + +extern void BView_invalidate (void *); +extern void BView_draw_lock (void *, bool, int, int, int, int); +extern void BView_invalidate_region (void *, int, int, int, int); +extern void BView_draw_unlock (void *); + +extern void BBitmap_import_fringe_bitmap (void *, unsigned short *, int, int); +extern void BBitmap_import_mono_bits (void *, void *, int, int); + +extern void haiku_font_pattern_free (struct haiku_font_pattern *); + +extern int BFont_open_pattern (struct haiku_font_pattern *, void **, float); +extern void BFont_populate_fixed_family (struct haiku_font_pattern *); +extern void BFont_populate_plain_family (struct haiku_font_pattern *); + +extern void BView_publish_scroll_bar (void *, int, int, int, int); +extern void BView_forget_scroll_bar (void *, int, int, int, int); +extern bool BView_inside_scroll_bar (void *, int, int); +extern void BView_get_mouse (void *, int *, int *); +extern void BView_convert_to_screen (void *, int *, int *); +extern void BView_convert_from_screen (void *, int *, int *); + +extern void BView_emacs_delete (void *); +extern uint32_t haiku_current_workspace (void); + +extern void *BPopUpMenu_new (const char *); + +extern void BMenu_add_item (void *, const char *, void *, bool, + bool, bool, void *, const char *, + const char *); +extern void BMenu_add_separator (void *); +extern void *BMenu_new_submenu (void *, const char *, bool); +extern void *BMenu_new_menu_bar_submenu (void *, const char *); +extern int BMenu_count_items (void *); +extern void *BMenu_item_at (void *, int); +extern void *BMenu_run (void *, int, int, void (*) (void *, void *), + void (*) (void), void (*) (void), + struct timespec (*) (void), void *); +extern void BPopUpMenu_delete (void *); +extern void *BMenuBar_new (void *); +extern void BMenu_delete_all (void *); +extern void BMenuBar_delete (void *); +extern void BMenu_item_set_label (void *, const char *); +extern void *BMenu_item_get_menu (void *); +extern void BMenu_delete_from (void *, int, int); + +extern void haiku_ring_bell (void); + +extern void *BAlert_new (const char *, enum haiku_alert_type); +extern void *BAlert_add_button (void *, const char *); +extern void BAlert_set_offset_spacing (void *); +extern int32 BAlert_go (void *, void (*) (void), void (*) (void), + void (*) (void)); +extern void BButton_set_enabled (void *, int); +extern void BView_set_tooltip (void *, const char *); +extern void BView_show_tooltip (void *); +extern void BView_set_and_show_sticky_tooltip (void *, const char *, + int, int); + +extern void BAlert_delete (void *); + +extern void EmacsWindow_parent_to (void *, void *); +extern void EmacsWindow_unparent (void *); +extern void EmacsWindow_move_weak_child (void *, void *, int, int); +extern void EmacsWindow_make_fullscreen (void *, int); +extern void EmacsWindow_unzoom (void *); +extern void EmacsWindow_signal_menu_update_complete (void *); + +extern void be_get_version_string (char *, int); +extern int be_get_display_planes (void); +extern int be_get_display_color_cells (void); +extern void be_warp_pointer (int, int); + +extern void EmacsView_set_up_double_buffering (void *); +extern void EmacsView_disable_double_buffering (void *); +extern void EmacsView_flip_and_blit (void *); +extern int EmacsView_double_buffered_p (void *); + +extern char *be_popup_file_dialog (int, const char *, int, + int, void *, const char *, + const char *, void (*) (void), + void (*) (void), void (*) (void)); + +extern void record_c_unwind_protect_from_cxx (void (*) (void *), void *); +extern specpdl_ref c_specpdl_idx_from_cxx (void); +extern void c_unbind_to_nil_from_cxx (specpdl_ref); + +#ifdef HAVE_NATIVE_IMAGE_API +extern int be_can_translate_type_to_bitmap_p (const char *); +extern void *be_translate_bitmap_from_file_name (const char *); +extern void *be_translate_bitmap_from_memory (const void *, size_t); +#endif + +extern bool BMenuBar_start_tracking (void *); +extern size_t BBitmap_bytes_length (void *); + +#ifdef USE_BE_CAIRO +extern cairo_t *EmacsView_cairo_context (void *); +extern void BView_cr_dump_clipping (void *, cairo_t *); +extern void EmacsWindow_begin_cr_critical_section (void *); +extern void EmacsWindow_end_cr_critical_section (void *); +#endif + +extern void BMenu_add_title (void *, const char *); + +extern int be_plain_font_height (void); +extern int be_string_width_with_plain_font (const char *); +extern int be_get_display_screens (void); +extern bool be_use_subpixel_antialiasing (void); +extern const char *be_find_setting (const char *); +extern haiku_font_family_or_style *be_list_font_families (size_t *); + +extern void BMessage_delete (void *); + +extern bool be_drag_message (void *, void *, bool, void (*) (void), + void (*) (void), void (*) (void), + bool (*) (void)); +extern bool be_drag_and_drop_in_progress (void); + +#ifdef __cplusplus +extern void *find_appropriate_view_for_draw (void *); +} + +extern _Noreturn void gui_abort (const char *); +#endif /* _cplusplus */ + +#endif /* _HAIKU_SUPPORT_H_ */ + +// Local Variables: +// eval: (setf (alist-get 'inextern-lang c-offsets-alist) 0) +// End: diff --git a/src/haikufns.c b/src/haikufns.c new file mode 100644 index 00000000000..874ebaaf919 --- /dev/null +++ b/src/haikufns.c @@ -0,0 +1,2717 @@ +/* Haiku window system support + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include <math.h> + +#include "lisp.h" +#include "frame.h" +#include "blockinput.h" +#include "termchar.h" +#include "font.h" +#include "keyboard.h" +#include "buffer.h" +#include "dispextern.h" + +#include "haikugui.h" +#include "haikuterm.h" +#include "haiku_support.h" +#include "termhooks.h" + +#include <stdlib.h> + +#include <kernel/OS.h> + +#define RGB_TO_ULONG(r, g, b) \ + (((r) << 16) | ((g) << 8) | (b)); +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) + +/* The frame of the currently visible tooltip. */ +Lisp_Object tip_frame; + +/* The window-system window corresponding to the frame of the + currently visible tooltip. */ +static Window tip_window; + +/* A timer that hides or deletes the currently visible tooltip when it + fires. */ +static Lisp_Object tip_timer; + +/* STRING argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_string; + +/* Normalized FRAME argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_frame; + +/* PARMS argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_parms; + +static void haiku_explicitly_set_name (struct frame *, Lisp_Object, Lisp_Object); +static void haiku_set_title (struct frame *, Lisp_Object, Lisp_Object); +static ptrdiff_t image_cache_refcount; + +static Lisp_Object +get_geometry_from_preferences (struct haiku_display_info *dpyinfo, + Lisp_Object parms) +{ + struct { + const char *val; + const char *cls; + Lisp_Object tem; + } r[] = { + { "width", "Width", Qwidth }, + { "height", "Height", Qheight }, + { "left", "Left", Qleft }, + { "top", "Top", Qtop }, + }; + + int i; + for (i = 0; i < ARRAYELTS (r); ++i) + { + if (NILP (Fassq (r[i].tem, parms))) + { + Lisp_Object value + = gui_display_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls, + RES_TYPE_NUMBER); + if (! EQ (value, Qunbound)) + parms = Fcons (Fcons (r[i].tem, value), parms); + } + } + + return parms; +} + +void +haiku_change_tool_bar_height (struct frame *f, int height) +{ + int unit = FRAME_LINE_HEIGHT (f); + int old_height = FRAME_TOOL_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); + + FRAME_TOOL_BAR_HEIGHT (f) = height; + FRAME_TOOL_BAR_LINES (f) = lines; + store_frame_param (f, Qtool_bar_lines, make_fixnum (lines)); + + if (FRAME_HAIKU_WINDOW (f) && FRAME_TOOL_BAR_HEIGHT (f) == 0) + { + clear_frame (f); + clear_current_matrices (f); + } + + if ((height < old_height) && WINDOWP (f->tool_bar_window)) + clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix); + + if (!f->tool_bar_resized) + { + /* As long as tool_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, Qtool_bar_lines); + else + adjust_frame_size (f, -1, -1, 4, false, Qtool_bar_lines); + + f->tool_bar_resized = f->tool_bar_redisplayed; + } + else + /* Any other change may leave the native size of F alone. */ + adjust_frame_size (f, -1, -1, 3, false, Qtool_bar_lines); + + /* adjust_frame_size might not have done anything, garbage frame + here. */ + adjust_frame_glyphs (f); + SET_FRAME_GARBAGED (f); + + if (FRAME_HAIKU_WINDOW (f)) + haiku_clear_under_internal_border (f); +} + +void +haiku_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_HAIKU_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); + if (FRAME_HAIKU_WINDOW (f)) + haiku_clear_under_internal_border (f); +} + +static void +haiku_set_no_focus_on_map (struct frame *f, Lisp_Object value, + Lisp_Object oldval) +{ + if (!EQ (value, oldval)) + FRAME_NO_FOCUS_ON_MAP (f) = !NILP (value); +} + +static void +haiku_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + if (FRAME_TOOLTIP_P (f)) + return; + int nlines; + + /* Treat tool 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; + + haiku_change_tool_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); +} + +static void +haiku_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + if (FRAME_TOOLTIP_P (f)) + return; + 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)) + haiku_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); +} + + +int +haiku_get_color (const char *name, Emacs_Color *color) +{ + unsigned short r16, g16, b16; + Lisp_Object tem, col; + int32 clr; + + if (parse_color_spec (name, &r16, &g16, &b16)) + { + color->pixel = RGB_TO_ULONG (r16 / 256, g16 / 256, b16 / 256); + color->red = r16; + color->green = g16; + color->blue = b16; + return 0; + } + else + { + block_input (); + eassert (x_display_list && !NILP (x_display_list->color_map)); + tem = x_display_list->color_map; + for (; CONSP (tem); tem = XCDR (tem)) + { + col = XCAR (tem); + + if (CONSP (col) && !xstrcasecmp (SSDATA (XCAR (col)), name)) + { + clr = XFIXNUM (XCDR (col)); + color->pixel = clr; + color->red = RED_FROM_ULONG (clr) * 257; + color->green = GREEN_FROM_ULONG (clr) * 257; + color->blue = BLUE_FROM_ULONG (clr) * 257; + unblock_input (); + return 0; + } + } + + unblock_input (); + } + + return 1; +} + +static struct haiku_display_info * +haiku_display_info_for_name (Lisp_Object name) +{ + CHECK_STRING (name); + + if (!NILP (Fstring_equal (name, build_string ("be")))) + { + if (!x_display_list) + return x_display_list; + + error ("Haiku windowing not initialized"); + } + + error ("Haiku displays can only be named \"be\""); +} + +static struct haiku_display_info * +check_haiku_display_info (Lisp_Object object) +{ + struct haiku_display_info *dpyinfo = NULL; + + if (NILP (object)) + { + struct frame *sf = XFRAME (selected_frame); + + if (FRAME_HAIKU_P (sf) && FRAME_LIVE_P (sf)) + dpyinfo = FRAME_DISPLAY_INFO (sf); + else if (x_display_list) + dpyinfo = x_display_list; + else + error ("Haiku windowing not present"); + } + else if (TERMINALP (object)) + { + struct terminal *t = decode_live_terminal (object); + + if (t->type != output_haiku) + error ("Terminal %d is not a Haiku display", t->id); + + dpyinfo = t->display_info.haiku; + } + else if (STRINGP (object)) + dpyinfo = haiku_display_info_for_name (object); + else + { + struct frame *f = decode_window_system_frame (object); + dpyinfo = FRAME_DISPLAY_INFO (f); + } + + return dpyinfo; +} + +static void +haiku_set_title_bar_text (struct frame *f, Lisp_Object text) +{ + if (FRAME_HAIKU_WINDOW (f)) + { + block_input (); + BWindow_retitle (FRAME_HAIKU_WINDOW (f), SSDATA (ENCODE_UTF_8 (text))); + unblock_input (); + } +} + +static void +haiku_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) +{ + /* Don't change the title if it's already NAME. */ + if (EQ (name, f->title)) + return; + + update_mode_lines = 26; + + fset_title (f, name); + + if (NILP (name)) + name = f->name; + + haiku_set_title_bar_text (f, name); +} + +static void +haiku_set_child_frame_border_width (struct frame *f, + Lisp_Object arg, Lisp_Object oldval) +{ + int border; + + if (NILP (arg)) + border = -1; + else if (RANGED_FIXNUMP (0, arg, INT_MAX)) + border = XFIXNAT (arg); + else + signal_error ("Invalid child frame border width", arg); + + if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f)) + { + f->child_frame_border_width = border; + + if (FRAME_HAIKU_WINDOW (f)) + adjust_frame_size (f, -1, -1, 3, 0, Qchild_frame_border_width); + + SET_FRAME_GARBAGED (f); + } +} + +static void +haiku_set_parent_frame (struct frame *f, + Lisp_Object new_value, Lisp_Object old_value) +{ + struct frame *p = NULL; + block_input (); + if (!NILP (new_value) + && (!FRAMEP (new_value) + || !FRAME_LIVE_P (p = XFRAME (new_value)) + || !FRAME_HAIKU_P (p))) + { + store_frame_param (f, Qparent_frame, old_value); + unblock_input (); + error ("Invalid specification of `parent-frame'"); + } + + if (EQ (new_value, old_value)) + { + unblock_input (); + return; + } + + if (!NILP (old_value)) + { + EmacsWindow_unparent (FRAME_HAIKU_WINDOW (f)); + FRAME_OUTPUT_DATA (f)->parent_desc = NULL; + } + if (!NILP (new_value)) + { + EmacsWindow_parent_to (FRAME_HAIKU_WINDOW (f), + FRAME_HAIKU_WINDOW (p)); + BWindow_set_offset (FRAME_HAIKU_WINDOW (f), + f->left_pos, f->top_pos); + + /* This isn't actually used for anything, but makes the + `parent-id' parameter correct. */ + FRAME_OUTPUT_DATA (f)->parent_desc = FRAME_HAIKU_WINDOW (p); + } + fset_parent_frame (f, new_value); + unblock_input (); +} + +static void +haiku_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + haiku_set_name (f, arg, 1); +} + +static void +haiku_set_no_accept_focus (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) +{ + block_input (); + if (!EQ (new_value, old_value)) + FRAME_NO_ACCEPT_FOCUS (f) = !NILP (new_value); + + if (FRAME_HAIKU_WINDOW (f)) + { + BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), + FRAME_NO_ACCEPT_FOCUS (f)); + } + unblock_input (); +} + +static void +initial_setup_back_buffer (struct frame *f) +{ + block_input (); + if (NILP (CDR (Fassq (Qinhibit_double_buffering, f->param_alist)))) + EmacsView_set_up_double_buffering (FRAME_HAIKU_VIEW (f)); + unblock_input (); +} + +static void +unwind_create_frame (Lisp_Object frame) +{ + struct frame *f = XFRAME (frame); + + /* If frame is already dead, nothing to do. This can happen if the + display is disconnected after the frame has become official, but + before x_create_frame removes the unwind protect. */ + if (!FRAME_LIVE_P (f)) + return; + + /* If frame is ``official'', nothing to do. */ + if (NILP (Fmemq (frame, Vframe_list))) + { +#if defined GLYPH_DEBUG && defined ENABLE_CHECKING + struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); +#endif + + /* If the frame's image cache refcount is still the same as our + private shadow variable, it means we are unwinding a frame + for which we didn't yet call init_frame_faces, where the + refcount is incremented. Therefore, we increment it here, so + that free_frame_faces, called in free_frame_resources later, + will not mistakenly decrement the counter that was not + incremented yet to account for this new frame. */ + if (FRAME_IMAGE_CACHE (f) != NULL + && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount) + FRAME_IMAGE_CACHE (f)->refcount++; + + haiku_free_frame_resources (f); + free_glyphs (f); + +#if defined GLYPH_DEBUG && defined ENABLE_CHECKING + /* Check that reference counts are indeed correct. */ + if (dpyinfo->terminal->image_cache) + eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount); +#endif + } +} + +static void +unwind_create_tip_frame (Lisp_Object frame) +{ + unwind_create_frame (frame); + tip_window = NULL; + tip_frame = Qnil; +} + +static void +haiku_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + struct haiku_output *output = FRAME_OUTPUT_DATA (f); + unsigned long old_fg; + + Emacs_Color color; + + if (haiku_get_color (SSDATA (arg), &color)) + { + store_frame_param (f, Qforeground_color, oldval); + unblock_input (); + error ("Bad color"); + } + + old_fg = FRAME_FOREGROUND_PIXEL (f); + FRAME_FOREGROUND_PIXEL (f) = color.pixel; + + if (FRAME_HAIKU_WINDOW (f)) + { + + block_input (); + if (output->cursor_color.pixel == old_fg) + { + output->cursor_color.pixel = old_fg; + output->cursor_color.red = RED_FROM_ULONG (old_fg); + output->cursor_color.green = GREEN_FROM_ULONG (old_fg); + output->cursor_color.blue = BLUE_FROM_ULONG (old_fg); + } + + unblock_input (); + + update_face_from_frame_parameter (f, Qforeground_color, arg); + + if (FRAME_VISIBLE_P (f)) + redraw_frame (f); + } +} + +static void +unwind_popup (void) +{ + if (!popup_activated_p) + emacs_abort (); + --popup_activated_p; +} + +static Lisp_Object +haiku_create_frame (Lisp_Object parms) +{ + struct frame *f, *cascade_target; + Lisp_Object frame, tem; + Lisp_Object name; + bool minibuffer_only = false; + long window_prompting = 0; + specpdl_ref count = SPECPDL_INDEX (); + Lisp_Object display; + struct haiku_display_info *dpyinfo = NULL; + struct kboard *kb; + + if (x_display_list->focused_frame) + cascade_target = x_display_list->focused_frame; + else if (x_display_list->focus_event_frame) + cascade_target = x_display_list->focus_event_frame; + else + cascade_target = NULL; + + /* Always cascade from the most toplevel frame. */ + + while (cascade_target && FRAME_PARENT_FRAME (cascade_target)) + cascade_target = FRAME_PARENT_FRAME (cascade_target); + + parms = Fcopy_alist (parms); + + Vx_resource_name = Vinvocation_name; + + display = gui_display_get_arg (dpyinfo, parms, Qterminal, 0, 0, + RES_TYPE_STRING); + if (EQ (display, Qunbound)) + display = Qnil; + dpyinfo = check_haiku_display_info (display); + kb = dpyinfo->terminal->kboard; + + if (!dpyinfo->terminal->name) + error ("Terminal is not live, can't create new frames on it"); + + name = gui_display_get_arg (dpyinfo, parms, Qname, 0, 0, + RES_TYPE_STRING); + if (!STRINGP (name) + && ! EQ (name, Qunbound) + && ! NILP (name)) + error ("Invalid frame name--not a string or nil"); + + if (STRINGP (name)) + Vx_resource_name = name; + + /* make_frame_without_minibuffer can run Lisp code and garbage collect. */ + /* No need to protect DISPLAY because that's not used after passing + it to make_frame_without_minibuffer. */ + frame = Qnil; + tem = gui_display_get_arg (dpyinfo, parms, Qminibuffer, + "minibuffer", "Minibuffer", + RES_TYPE_SYMBOL); + if (EQ (tem, Qnone) || NILP (tem)) + f = make_frame_without_minibuffer (Qnil, kb, display); + else if (EQ (tem, Qonly)) + { + f = make_minibuffer_frame (); + minibuffer_only = 1; + } + else if (WINDOWP (tem)) + f = make_frame_without_minibuffer (tem, kb, display); + else + f = make_frame (1); + + XSETFRAME (frame, f); + + f->terminal = dpyinfo->terminal; + + f->output_method = output_haiku; + f->output_data.haiku = xzalloc (sizeof *f->output_data.haiku); + + fset_icon_name (f, gui_display_get_arg (dpyinfo, parms, Qicon_name, + "iconName", "Title", + RES_TYPE_STRING)); + if (! STRINGP (f->icon_name)) + fset_icon_name (f, Qnil); + + FRAME_DISPLAY_INFO (f) = dpyinfo; + + /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe. */ + record_unwind_protect (unwind_create_frame, frame); + + /* Set the name; the functions to which we pass f expect the name to + be set. */ + if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name)) + { + fset_name (f, Vinvocation_name); + f->explicit_name = 0; + } + else + { + fset_name (f, name); + f->explicit_name = 1; + specbind (Qx_resource_name, name); + } + +#ifdef USE_BE_CAIRO + register_font_driver (&ftcrfont_driver, f); +#ifdef HAVE_HARFBUZZ + register_font_driver (&ftcrhbfont_driver, f); +#endif +#endif + register_font_driver (&haikufont_driver, f); + + image_cache_refcount = + FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0; + + gui_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + + FRAME_RIF (f)->default_font_parameter (f, parms); + + if (!FRAME_FONT (f)) + { + delete_frame (frame, Qnoelisp); + error ("Invalid frame font"); + } + + gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), + "borderwidth", "BorderWidth", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (2), + "internalBorderWidth", "InternalBorderWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qchild_frame_border_width, Qnil, + "childFrameBorderWidth", "childFrameBorderWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qvertical_scroll_bars, Qt, + "verticalScrollBars", "VerticalScrollBars", + RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qhorizontal_scroll_bars, Qnil, + "horizontalScrollBars", "HorizontalScrollBars", + RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qforeground_color, build_string ("black"), + "foreground", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qbackground_color, build_string ("white"), + "background", "Background", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qline_spacing, Qnil, + "lineSpacing", "LineSpacing", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qleft_fringe, Qnil, + "leftFringe", "LeftFringe", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qright_fringe, Qnil, + "rightFringe", "RightFringe", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qno_special_glyphs, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + + init_frame_faces (f); + + /* Read comment about this code in corresponding place in xfns.c. */ + tem = gui_display_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, + RES_TYPE_NUMBER); + if (FIXNUMP (tem)) + store_frame_param (f, Qmin_width, tem); + tem = gui_display_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, + RES_TYPE_NUMBER); + if (FIXNUMP (tem)) + store_frame_param (f, Qmin_height, tem); + adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), + FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, + Qx_create_frame_1); + + gui_default_parameter (f, parms, Qz_group, Qnil, NULL, NULL, RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qno_focus_on_map, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qno_accept_focus, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + + /* The resources controlling the menu-bar, tool-bar, and tab-bar are + processed specially at startup, and reflected in the mode + variables; ignore them here. */ + gui_default_parameter (f, parms, Qmenu_bar_lines, + NILP (Vmenu_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qtab_bar_lines, + NILP (Vtab_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qtool_bar_lines, + NILP (Vtool_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate", + "BufferPredicate", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qtitle, Qnil, "title", "Title", + RES_TYPE_STRING); + + parms = get_geometry_from_preferences (dpyinfo, parms); + window_prompting = gui_figure_window_size (f, parms, false, true); + + tem = gui_display_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, + RES_TYPE_BOOLEAN); + f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !NILP (tem)); + + block_input (); +#define ASSIGN_CURSOR(cursor) \ + (FRAME_OUTPUT_DATA (f)->cursor = dpyinfo->cursor) + + ASSIGN_CURSOR (text_cursor); + ASSIGN_CURSOR (nontext_cursor); + ASSIGN_CURSOR (modeline_cursor); + ASSIGN_CURSOR (hand_cursor); + ASSIGN_CURSOR (hourglass_cursor); + ASSIGN_CURSOR (horizontal_drag_cursor); + ASSIGN_CURSOR (vertical_drag_cursor); + ASSIGN_CURSOR (left_edge_cursor); + ASSIGN_CURSOR (top_left_corner_cursor); + ASSIGN_CURSOR (top_edge_cursor); + ASSIGN_CURSOR (top_right_corner_cursor); + ASSIGN_CURSOR (right_edge_cursor); + ASSIGN_CURSOR (bottom_right_corner_cursor); + ASSIGN_CURSOR (bottom_edge_cursor); + ASSIGN_CURSOR (bottom_left_corner_cursor); + ASSIGN_CURSOR (no_cursor); + + FRAME_OUTPUT_DATA (f)->current_cursor = dpyinfo->text_cursor; +#undef ASSIGN_CURSOR + + f->terminal->reference_count++; + + FRAME_OUTPUT_DATA (f)->window = BWindow_new (&FRAME_OUTPUT_DATA (f)->view); + unblock_input (); + + if (!FRAME_OUTPUT_DATA (f)->window) + xsignal1 (Qerror, build_unibyte_string ("Could not create window")); + + block_input (); + if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f)) + initialize_frame_menubar (f); + unblock_input (); + + Vframe_list = Fcons (frame, Vframe_list); + + Lisp_Object parent_frame = gui_display_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL, + RES_TYPE_SYMBOL); + + if (EQ (parent_frame, Qunbound) + || NILP (parent_frame) + || !FRAMEP (parent_frame) + || !FRAME_LIVE_P (XFRAME (parent_frame))) + parent_frame = Qnil; + + /* It doesn't make sense to center child frames, the resulting + position makes no sense. */ + if (!NILP (parent_frame)) + window_prompting |= PPosition; + + fset_parent_frame (f, parent_frame); + store_frame_param (f, Qparent_frame, parent_frame); + + if (!NILP (parent_frame)) + haiku_set_parent_frame (f, parent_frame, Qnil); + + gui_default_parameter (f, parms, Qundecorated, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qoverride_redirect, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); + + gui_default_parameter (f, parms, Qicon_type, Qnil, + "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qauto_raise, Qnil, + "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qauto_lower, Qnil, + "autoLower", "AutoLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qcursor_type, Qbox, + "cursorType", "CursorType", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qscroll_bar_width, Qnil, + "scrollBarWidth", "ScrollBarWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qscroll_bar_height, Qnil, + "scrollBarHeight", "ScrollBarHeight", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha, Qnil, + "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qfullscreen, Qnil, + "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); + + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + + f->can_set_window_size = true; + + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 0, true, Qx_create_frame_2); + + Lisp_Object visibility; + + visibility = gui_display_get_arg (dpyinfo, parms, Qvisibility, 0, 0, + RES_TYPE_SYMBOL); + if (EQ (visibility, Qunbound)) + visibility = Qt; + if (EQ (visibility, Qicon)) + haiku_iconify_frame (f); + else if (!NILP (visibility)) + haiku_visualize_frame (f); + else /* Qnil */ + { + f->was_invisible = true; + } + + if (FRAME_HAS_MINIBUF_P (f) + && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) + || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) + kset_default_minibuffer_frame (kb, frame); + + for (tem = parms; CONSP (tem); tem = XCDR (tem)) + if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) + fset_param_alist (f, Fcons (XCAR (tem), f->param_alist)); + + block_input (); + if (window_prompting & (USPosition | PPosition)) + haiku_set_offset (f, f->left_pos, f->top_pos, 1); + else if (cascade_target) + haiku_set_offset (f, cascade_target->left_pos + 15, + cascade_target->top_pos + 15, 1); + else + BWindow_center_on_screen (FRAME_HAIKU_WINDOW (f)); + unblock_input (); + + FRAME_OUTPUT_DATA (f)->configury_done = true; + + if (f->want_fullscreen != FULLSCREEN_NONE) + FRAME_TERMINAL (f)->fullscreen_hook (f); + + /* Make sure windows on this frame appear in calls to next-window + and similar functions. */ + Vwindow_list = Qnil; + + return unbind_to (count, frame); +} + +/* Create a frame for a tooltip. PARMS is a list of frame parameters. + TEXT is the string to display in the tip frame. Value is the + frame. + + Note that functions called here, esp. gui_default_parameter can + signal errors, for instance when a specified color name is + undefined. We have to make sure that we're in a consistent state + when this happens. */ + +static Lisp_Object +haiku_create_tip_frame (Lisp_Object parms) +{ + struct frame *f; + Lisp_Object frame; + Lisp_Object name; + specpdl_ref count = SPECPDL_INDEX (); + bool face_change_before = face_change; + struct haiku_display_info *dpyinfo = x_display_list; + + if (!dpyinfo->terminal->name) + error ("Terminal is not live, can't create new frames on it"); + + parms = Fcopy_alist (parms); + + /* Get the name of the frame to use for resource lookup. */ + name = gui_display_get_arg (dpyinfo, parms, Qname, "name", "Name", + RES_TYPE_STRING); + if (!STRINGP (name) + && !EQ (name, Qunbound) + && !NILP (name)) + error ("Invalid frame name--not a string or nil"); + + frame = Qnil; + f = make_frame (false); + f->wants_modeline = false; + XSETFRAME (frame, f); + record_unwind_protect (unwind_create_tip_frame, frame); + + f->terminal = dpyinfo->terminal; + + /* By setting the output method, we're essentially saying that + the frame is live, as per FRAME_LIVE_P. If we get a signal + from this point on, x_destroy_window might screw up reference + counts etc. */ + f->output_method = output_haiku; + f->output_data.haiku = xzalloc (sizeof *f->output_data.haiku); + + f->tooltip = true; + fset_icon_name (f, Qnil); + FRAME_DISPLAY_INFO (f) = dpyinfo; + + FRAME_OUTPUT_DATA (f)->parent_desc = NULL; + + /* Set the name; the functions to which we pass f expect the name to + be set. */ + if (EQ (name, Qunbound) || NILP (name)) + f->explicit_name = false; + else + { + fset_name (f, name); + f->explicit_name = true; + /* use the frame's title when getting resources for this frame. */ + specbind (Qx_resource_name, name); + } + +#ifdef USE_BE_CAIRO + register_font_driver (&ftcrfont_driver, f); +#ifdef HAVE_HARFBUZZ + register_font_driver (&ftcrhbfont_driver, f); +#endif +#endif + register_font_driver (&haikufont_driver, f); + + image_cache_refcount = + FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0; + + gui_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + + /* Extract the window parameters from the supplied values that are + needed to determine window geometry. */ + FRAME_RIF (f)->default_font_parameter (f, parms); + + /* This defaults to 1 in order to match xterm. We recognize either + internalBorderWidth or internalBorder (which is what xterm calls + it). */ + if (NILP (Fassq (Qinternal_border_width, parms))) + { + Lisp_Object value; + + value = gui_display_get_arg (dpyinfo, parms, Qinternal_border_width, + "internalBorder", "internalBorder", + RES_TYPE_NUMBER); + if (! EQ (value, Qunbound)) + parms = Fcons (Fcons (Qinternal_border_width, value), + parms); + } + + gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (1), + "internalBorderWidth", "internalBorderWidth", + RES_TYPE_NUMBER); + + gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + + /* Also do the stuff which must be set before the window exists. */ + gui_default_parameter (f, parms, Qforeground_color, build_string ("black"), + "foreground", "Foreground", RES_TYPE_STRING); + + gui_default_parameter (f, parms, Qbackground_color, build_string ("white"), + "background", "Background", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qmouse_color, build_string ("black"), + "pointerColor", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qcursor_color, build_string ("black"), + "cursorColor", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qborder_color, build_string ("black"), + "borderColor", "BorderColor", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qno_special_glyphs, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + + /* Init faces before gui_default_parameter is called for the + scroll-bar-width parameter because otherwise we end up in + init_iterator with a null face cache, which should not happen. */ + init_frame_faces (f); + + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + + gui_figure_window_size (f, parms, false, false); + + { + void *window; + + block_input (); + window = BWindow_new (&FRAME_OUTPUT_DATA (f)->view); + + FRAME_OUTPUT_DATA (f)->window = window; + if (!window) + emacs_abort (); + + BWindow_set_tooltip_decoration (window); + unblock_input (); + } + + gui_default_parameter (f, parms, Qauto_raise, Qnil, + "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qauto_lower, Qnil, + "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qcursor_type, Qbox, + "cursorType", "CursorType", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qalpha, Qnil, + "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); + + initial_setup_back_buffer (f); + + /* Add `tooltip' frame parameter's default value. */ + if (NILP (Fframe_parameter (frame, Qtooltip))) + { + AUTO_FRAME_ARG (arg, Qtooltip, Qt); + Fmodify_frame_parameters (frame, arg); + } + + /* FIXME - can this be done in a similar way to normal frames? + https://lists.gnu.org/r/emacs-devel/2007-10/msg00641.html */ + + /* Set up faces after all frame parameters are known. This call + also merges in face attributes specified for new frames. + + Frame parameters may be changed if .Xdefaults contains + specifications for the default font. For example, if there is an + `Emacs.default.attributeBackground: pink', the `background-color' + attribute of the frame gets set, which let's the internal border + of the tooltip frame appear in pink. Prevent this. */ + { + Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); + + call2 (Qface_set_after_frame_default, frame, Qnil); + + if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) + { + AUTO_FRAME_ARG (arg, Qbackground_color, bg); + Fmodify_frame_parameters (frame, arg); + } + } + + f->no_split = true; + + /* Now that the frame will be official, it counts as a reference to + its display and terminal. */ + f->terminal->reference_count++; + + /* It is now ok to make the frame official even if we get an error + below. And the frame needs to be on Vframe_list or making it + visible won't work. */ + Vframe_list = Fcons (frame, Vframe_list); + f->can_set_window_size = true; + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 0, true, Qtip_frame); + + /* Setting attributes of faces of the tooltip frame from resources + and similar will set face_change, which leads to the clearing of + all current matrices. Since this isn't necessary here, avoid it + by resetting face_change to the value it had before we created + the tip frame. */ + face_change = face_change_before; + + /* Discard the unwind_protect. */ + return unbind_to (count, frame); +} + + +static void +compute_tip_xy (struct frame *f, + Lisp_Object parms, Lisp_Object dx, Lisp_Object dy, + int width, int height, int *root_x, int *root_y) +{ + Lisp_Object left, top, right, bottom; + int min_x = 0, min_y = 0, max_x = 0, max_y = 0; + + /* User-specified position? */ + left = Fcdr (Fassq (Qleft, parms)); + top = Fcdr (Fassq (Qtop, parms)); + right = Fcdr (Fassq (Qright, parms)); + bottom = Fcdr (Fassq (Qbottom, parms)); + + /* Move the tooltip window where the mouse pointer is. Resize and + show it. */ + if ((!FIXNUMP (left) && !FIXNUMP (right)) + || (!FIXNUMP (top) && !FIXNUMP (bottom))) + { + int x, y; + + /* Default min and max values. */ + min_x = 0; + min_y = 0; + BScreen_px_dim (&max_x, &max_y); + + block_input (); + BView_get_mouse (FRAME_HAIKU_VIEW (f), &x, &y); + BView_convert_to_screen (FRAME_HAIKU_VIEW (f), &x, &y); + *root_x = x; + *root_y = y; + unblock_input (); + } + + if (FIXNUMP (top)) + *root_y = XFIXNUM (top); + else if (FIXNUMP (bottom)) + *root_y = XFIXNUM (bottom) - height; + else if (*root_y + XFIXNUM (dy) <= min_y) + *root_y = min_y; /* Can happen for negative dy */ + else if (*root_y + XFIXNUM (dy) + height <= max_y) + /* It fits below the pointer */ + *root_y += XFIXNUM (dy); + else if (height + XFIXNUM (dy) + min_y <= *root_y) + /* It fits above the pointer. */ + *root_y -= height + XFIXNUM (dy); + else + /* Put it on the top. */ + *root_y = min_y; + + if (FIXNUMP (left)) + *root_x = XFIXNUM (left); + else if (FIXNUMP (right)) + *root_x = XFIXNUM (right) - width; + else if (*root_x + XFIXNUM (dx) <= min_x) + *root_x = 0; /* Can happen for negative dx */ + else if (*root_x + XFIXNUM (dx) + width <= max_x) + /* It fits to the right of the pointer. */ + *root_x += XFIXNUM (dx); + else if (width + XFIXNUM (dx) + min_x <= *root_x) + /* It fits to the left of the pointer. */ + *root_x -= width + XFIXNUM (dx); + else + /* Put it left justified on the screen -- it ought to fit that way. */ + *root_x = min_x; +} + +static Lisp_Object +haiku_hide_tip (bool delete) +{ + if (!NILP (tip_timer)) + { + call1 (Qcancel_timer, tip_timer); + tip_timer = Qnil; + } + + Lisp_Object it, frame; + FOR_EACH_FRAME (it, frame) + if (FRAME_WINDOW_P (XFRAME (frame)) && + FRAME_HAIKU_VIEW (XFRAME (frame))) + BView_set_tooltip (FRAME_HAIKU_VIEW (XFRAME (frame)), NULL); + + if (NILP (tip_frame) + || (!delete && !NILP (tip_frame) + && !FRAME_VISIBLE_P (XFRAME (tip_frame)))) + return Qnil; + else + { + Lisp_Object was_open = Qnil; + + specpdl_ref count = SPECPDL_INDEX (); + specbind (Qinhibit_redisplay, Qt); + specbind (Qinhibit_quit, Qt); + + if (!NILP (tip_frame)) + { + if (FRAME_LIVE_P (XFRAME (tip_frame))) + { + if (delete) + { + delete_frame (tip_frame, Qnil); + tip_frame = Qnil; + } + else + haiku_unvisualize_frame (XFRAME (tip_frame)); + + was_open = Qt; + } + else + tip_frame = Qnil; + } + else + tip_frame = Qnil; + + return unbind_to (count, was_open); + } +} + +static void +haiku_set_undecorated (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + if (EQ (new_value, old_value)) + return; + + block_input (); + FRAME_UNDECORATED (f) = !NILP (new_value); + BWindow_change_decoration (FRAME_HAIKU_WINDOW (f), NILP (new_value)); + unblock_input (); +} + +static void +haiku_set_override_redirect (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + if (EQ (new_value, old_value)) + return; + + block_input (); + BWindow_set_override_redirect (FRAME_HAIKU_WINDOW (f), + !NILP (new_value)); + FRAME_OVERRIDE_REDIRECT (f) = !NILP (new_value); + unblock_input (); +} + +static void +haiku_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + if (FRAME_TOOLTIP_P (f)) + return; + int nlines; + if (TYPE_RANGED_FIXNUMP (int, value)) + nlines = XFIXNUM (value); + else + nlines = 0; + + fset_redisplay (f); + + FRAME_MENU_BAR_LINES (f) = 0; + FRAME_MENU_BAR_HEIGHT (f) = 0; + + if (nlines) + { + FRAME_EXTERNAL_MENU_BAR (f) = 1; + if (FRAME_HAIKU_P (f) && !FRAME_HAIKU_MENU_BAR (f)) + XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = 1; + } + else + { + if (FRAME_EXTERNAL_MENU_BAR (f)) + free_frame_menubar (f); + FRAME_EXTERNAL_MENU_BAR (f) = 0; + if (FRAME_HAIKU_P (f)) + FRAME_HAIKU_MENU_BAR (f) = 0; + } + + adjust_frame_glyphs (f); +} + +/* Return geometric attributes of FRAME. According to the value of + ATTRIBUTES return the outer edges of FRAME (Qouter_edges), the inner + edges of FRAME, the root window edges of frame (Qroot_edges). Any + other value means to return the geometry as returned by + Fx_frame_geometry. */ +static Lisp_Object +frame_geometry (Lisp_Object frame, Lisp_Object attribute) +{ + struct frame *f = decode_live_frame (frame); + check_window_system (f); + + if (EQ (attribute, Qouter_edges)) + return list4i (f->left_pos, f->top_pos, + f->left_pos, f->top_pos); + else if (EQ (attribute, Qnative_edges)) + return list4i (f->left_pos, f->top_pos, + f->left_pos + FRAME_PIXEL_WIDTH (f), + f->top_pos + FRAME_PIXEL_HEIGHT (f)); + else if (EQ (attribute, Qinner_edges)) + return list4i (f->left_pos + FRAME_INTERNAL_BORDER_WIDTH (f), + f->top_pos + FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_MENU_BAR_HEIGHT (f) + FRAME_TOOL_BAR_HEIGHT (f), + f->left_pos - FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_PIXEL_WIDTH (f), + f->top_pos + FRAME_PIXEL_HEIGHT (f) - + FRAME_INTERNAL_BORDER_WIDTH (f)); + + else + return + list (Fcons (Qouter_position, + Fcons (make_fixnum (f->left_pos), + make_fixnum (f->top_pos))), + Fcons (Qouter_size, + Fcons (make_fixnum (FRAME_PIXEL_WIDTH (f)), + make_fixnum (FRAME_PIXEL_HEIGHT (f)))), + Fcons (Qexternal_border_size, + Fcons (make_fixnum (0), make_fixnum (0))), + Fcons (Qtitle_bar_size, + Fcons (make_fixnum (0), make_fixnum (0))), + Fcons (Qmenu_bar_external, Qnil), + Fcons (Qmenu_bar_size, Fcons (make_fixnum (FRAME_PIXEL_WIDTH (f) - + (FRAME_INTERNAL_BORDER_WIDTH (f) * 2)), + make_fixnum (FRAME_MENU_BAR_HEIGHT (f)))), + Fcons (Qtool_bar_external, Qnil), + Fcons (Qtool_bar_position, Qtop), + Fcons (Qtool_bar_size, Fcons (make_fixnum (FRAME_PIXEL_WIDTH (f) - + (FRAME_INTERNAL_BORDER_WIDTH (f) * 2)), + make_fixnum (FRAME_TOOL_BAR_HEIGHT (f)))), + Fcons (Qinternal_border_width, make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f)))); +} + +void +haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + CHECK_STRING (arg); + + block_input (); + Emacs_Color color; + + if (haiku_get_color (SSDATA (arg), &color)) + { + store_frame_param (f, Qbackground_color, oldval); + unblock_input (); + error ("Bad color"); + } + + FRAME_OUTPUT_DATA (f)->cursor_fg = color.pixel; + FRAME_BACKGROUND_PIXEL (f) = color.pixel; + + if (FRAME_HAIKU_VIEW (f)) + { + struct face *defface; + + BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0); + BView_SetViewColor (FRAME_HAIKU_VIEW (f), color.pixel); + BView_draw_unlock (FRAME_HAIKU_VIEW (f)); + + defface = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID); + if (defface) + { + defface->background = color.pixel; + update_face_from_frame_parameter (f, Qbackground_color, arg); + clear_frame (f); + } + } + + if (FRAME_VISIBLE_P (f)) + SET_FRAME_GARBAGED (f); + unblock_input (); +} + +void +haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + CHECK_STRING (arg); + + block_input (); + Emacs_Color color, fore_pixel; + + if (haiku_get_color (SSDATA (arg), &color)) + { + store_frame_param (f, Qcursor_color, oldval); + unblock_input (); + error ("Bad color"); + } + + FRAME_CURSOR_COLOR (f) = color; + + if (STRINGP (Vx_cursor_fore_pixel)) + { + if (haiku_get_color (SSDATA (Vx_cursor_fore_pixel), + &fore_pixel)) + error ("Bad color %s", SSDATA (Vx_cursor_fore_pixel)); + FRAME_OUTPUT_DATA (f)->cursor_fg = fore_pixel.pixel; + } + else + FRAME_OUTPUT_DATA (f)->cursor_fg = FRAME_BACKGROUND_PIXEL (f); + + if (FRAME_VISIBLE_P (f)) + { + gui_update_cursor (f, 0); + gui_update_cursor (f, 1); + } + update_face_from_frame_parameter (f, Qcursor_color, arg); + unblock_input (); +} + +void +haiku_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + set_frame_cursor_types (f, arg); +} + +unsigned long +haiku_get_pixel (haiku bitmap, int x, int y) +{ + unsigned char *data; + int32_t bytes_per_row; + int mono_p; + int left; + int right; + int top; + int bottom; + + data = BBitmap_data (bitmap); + BBitmap_dimensions (bitmap, &left, &top, &right, &bottom, + &bytes_per_row, &mono_p); + + if (x < 0 || x > right - left || y < 0 || y > bottom - top) + emacs_abort (); + + if (!mono_p) + return ((uint32_t *) (data + (bytes_per_row * y)))[x]; + + int byte = y * bytes_per_row + x / 8; + return data[byte] & (1 << (x % 8)); +} + +void +haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel) +{ + unsigned char *data; + int32_t bytes_per_row; + int mono_p; + int left; + int right; + int top; + int bottom; + + data = BBitmap_data (bitmap); + BBitmap_dimensions (bitmap, &left, &top, &right, &bottom, + &bytes_per_row, &mono_p); + + if (x < 0 || x > right - left || y < 0 || y > bottom - top) + emacs_abort (); + + if (mono_p) + { + ptrdiff_t off = y * bytes_per_row; + ptrdiff_t bit = x % 8; + ptrdiff_t xoff = x / 8; + + unsigned char *byte = data + off + xoff; + if (!pixel) + *byte &= ~(1 << bit); + else + *byte |= 1 << bit; + } + else + ((uint32_t *) (data + (bytes_per_row * y)))[x] = pixel; +} + +void +haiku_free_frame_resources (struct frame *f) +{ + haiku window, drawable, mbar; + Mouse_HLInfo *hlinfo; + struct haiku_display_info *dpyinfo; + Lisp_Object bar; + struct scroll_bar *b; + + check_window_system (f); + block_input (); + + hlinfo = MOUSE_HL_INFO (f); + window = FRAME_HAIKU_WINDOW (f); + drawable = FRAME_HAIKU_VIEW (f); + mbar = FRAME_HAIKU_MENU_BAR (f); + dpyinfo = FRAME_DISPLAY_INFO (f); + + free_frame_faces (f); + + /* Free scroll bars */ + for (bar = FRAME_SCROLL_BARS (f); !NILP (bar); bar = b->next) + { + b = XSCROLL_BAR (bar); + haiku_scroll_bar_remove (b); + } + + if (f == dpyinfo->highlight_frame) + dpyinfo->highlight_frame = 0; + if (f == dpyinfo->focused_frame) + dpyinfo->focused_frame = 0; + if (f == dpyinfo->last_mouse_motion_frame) + dpyinfo->last_mouse_motion_frame = NULL; + if (f == dpyinfo->last_mouse_frame) + dpyinfo->last_mouse_frame = NULL; + if (f == dpyinfo->focus_event_frame) + dpyinfo->focus_event_frame = NULL; + + if (f == hlinfo->mouse_face_mouse_frame) + reset_mouse_highlight (hlinfo); + + if (mbar) + { + BMenuBar_delete (mbar); + if (f->output_data.haiku->menu_bar_open_p) + { + --popup_activated_p; + f->output_data.haiku->menu_bar_open_p = 0; + } + } + + if (drawable) + BView_emacs_delete (drawable); + + if (window) + BWindow_quit (window); + + xfree (FRAME_OUTPUT_DATA (f)); + FRAME_OUTPUT_DATA (f) = NULL; + + unblock_input (); +} + +void +haiku_iconify_frame (struct frame *frame) +{ + if (FRAME_ICONIFIED_P (frame)) + return; + + block_input (); + + SET_FRAME_VISIBLE (frame, false); + SET_FRAME_ICONIFIED (frame, true); + + BWindow_iconify (FRAME_HAIKU_WINDOW (frame)); + + unblock_input (); +} + +void +haiku_visualize_frame (struct frame *f) +{ + block_input (); + + if (!FRAME_VISIBLE_P (f)) + { + if (FRAME_NO_FOCUS_ON_MAP (f)) + BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), 1); + BWindow_set_visible (FRAME_HAIKU_WINDOW (f), 1); + if (FRAME_NO_FOCUS_ON_MAP (f) && + !FRAME_NO_ACCEPT_FOCUS (f)) + BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), 0); + BWindow_sync (FRAME_HAIKU_WINDOW (f)); + + haiku_set_offset (f, f->left_pos, f->top_pos, 0); + + SET_FRAME_VISIBLE (f, 1); + SET_FRAME_ICONIFIED (f, 0); + } + + unblock_input (); +} + +void +haiku_unvisualize_frame (struct frame *f) +{ + block_input (); + + BWindow_set_visible (FRAME_HAIKU_WINDOW (f), 0); + BWindow_sync (FRAME_HAIKU_WINDOW (f)); + SET_FRAME_VISIBLE (f, 0); + SET_FRAME_ICONIFIED (f, 0); + + unblock_input (); +} + +void +haiku_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + int old_width = FRAME_INTERNAL_BORDER_WIDTH (f); + int new_width = check_int_nonnegative (arg); + + if (new_width == old_width) + return; + + f->internal_border_width = new_width; + + if (FRAME_HAIKU_WINDOW (f)) + { + adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width); + haiku_clear_under_internal_border (f); + } + + SET_FRAME_GARBAGED (f); +} + +void +haiku_set_frame_visible_invisible (struct frame *f, bool visible_p) +{ + if (visible_p) + haiku_visualize_frame (f); + else + haiku_unvisualize_frame (f); +} + +void +frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) +{ + block_input (); + + BView_convert_to_screen (FRAME_HAIKU_VIEW (f), &pix_x, &pix_y); + be_warp_pointer (pix_x, pix_y); + + unblock_input (); +} + +void +haiku_query_color (uint32_t col, Emacs_Color *color_def) +{ + color_def->red = RED_FROM_ULONG (col) * 257; + color_def->green = GREEN_FROM_ULONG (col) * 257; + color_def->blue = BLUE_FROM_ULONG (col) * 257; + + color_def->pixel = col; +} + +Display_Info * +check_x_display_info (Lisp_Object object) +{ + return check_haiku_display_info (object); +} + +/* Rename frame F to NAME. If NAME is nil, set F's name to "GNU + Emacs". If EXPLICIT_P is non-zero, that indicates Lisp code is + setting the name, not redisplay; in that case, set F's name to NAME + and set F->explicit_name; if NAME is nil, clear F->explicit_name. + + If EXPLICIT_P is zero, it means redisplay is setting the name; the + name provided will be ignored if explicit_name is set. */ +void +haiku_set_name (struct frame *f, Lisp_Object name, bool explicit_p) +{ + if (explicit_p) + { + if (f->explicit_name && NILP (name)) + update_mode_lines = 24; + + f->explicit_name = !NILP (name); + } + else if (f->explicit_name) + return; + + if (NILP (name)) + name = build_unibyte_string ("GNU Emacs"); + + if (!NILP (Fstring_equal (name, f->name))) + return; + + fset_name (f, name); + + if (!NILP (f->title)) + name = f->title; + + haiku_set_title_bar_text (f, name); +} + +static void +haiku_set_inhibit_double_buffering (struct frame *f, + Lisp_Object new_value, + Lisp_Object old_value) +{ + block_input (); + if (FRAME_HAIKU_WINDOW (f)) + { +#ifndef USE_BE_CAIRO + if (NILP (new_value)) + { +#endif + EmacsView_set_up_double_buffering (FRAME_HAIKU_VIEW (f)); + if (!NILP (old_value)) + { + SET_FRAME_GARBAGED (f); + expose_frame (f, 0, 0, 0, 0); + } +#ifndef USE_BE_CAIRO + } + else + EmacsView_disable_double_buffering (FRAME_HAIKU_VIEW (f)); +#endif + } + unblock_input (); +} + + + +DEFUN ("haiku-set-mouse-absolute-pixel-position", + Fhaiku_set_mouse_absolute_pixel_position, + Shaiku_set_mouse_absolute_pixel_position, 2, 2, 0, + doc: /* Move mouse pointer to a pixel position at (X, Y). The +coordinates X and Y are interpreted to start from the top-left +corner of the screen. */) + (Lisp_Object x, Lisp_Object y) +{ + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); + + if (!x_display_list) + error ("Window system not initialized"); + + block_input (); + be_warp_pointer (xval, yval); + unblock_input (); + return Qnil; +} + +DEFUN ("haiku-mouse-absolute-pixel-position", Fhaiku_mouse_absolute_pixel_position, + Shaiku_mouse_absolute_pixel_position, 0, 0, 0, + doc: /* Return absolute position of mouse cursor in pixels. +The position is returned as a cons cell (X . Y) of the coordinates of +the mouse cursor position in pixels relative to a position (0, 0) of the +selected frame's display. */) + (void) +{ + if (!x_display_list) + return Qnil; + + struct frame *f = SELECTED_FRAME (); + + if (FRAME_INITIAL_P (f) || !FRAME_HAIKU_P (f) + || !FRAME_HAIKU_VIEW (f)) + return Qnil; + + block_input (); + void *view = FRAME_HAIKU_VIEW (f); + + int x, y; + BView_get_mouse (view, &x, &y); + BView_convert_to_screen (view, &x, &y); + unblock_input (); + + return Fcons (make_fixnum (x), make_fixnum (y)); +} + +DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + return Qt; +} + +DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object color, Lisp_Object frame) +{ + Emacs_Color col; + CHECK_STRING (color); + decode_window_system_frame (frame); + + return haiku_get_color (SSDATA (color), &col) ? Qnil : Qt; +} + +DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object color, Lisp_Object frame) +{ + Emacs_Color col; + CHECK_STRING (color); + decode_window_system_frame (frame); + + block_input (); + if (haiku_get_color (SSDATA (color), &col)) + { + unblock_input (); + return Qnil; + } + unblock_input (); + return list3i (lrint (col.red), lrint (col.green), lrint (col.blue)); +} + +DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + return Qnil; +} + +DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, + 1, 3, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed) +{ + struct haiku_display_info *dpyinfo; + CHECK_STRING (display); + + if (NILP (Fstring_equal (display, build_string ("be")))) + { + if (!NILP (must_succeed)) + fatal ("Bad display"); + else + error ("Bad display"); + } + + if (x_display_list) + return Qnil; + + dpyinfo = haiku_term_init (); + + if (!dpyinfo) + { + if (!NILP (must_succeed)) + fatal ("Display not responding"); + else + error ("Display not responding"); + } + + return Qnil; +} + +DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) + +{ + check_haiku_display_info (terminal); + + int width, height; + BScreen_px_dim (&width, &height); + return make_fixnum (width); +} + +DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_height, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) + +{ + check_haiku_display_info (terminal); + + int width, height; + BScreen_px_dim (&width, &height); + return make_fixnum (width); +} + +DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal); + + int width, height; + BScreen_px_dim (&width, &height); + + return make_fixnum (height / (dpyinfo->resy / 25.4)); +} + + +DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal); + + int width, height; + BScreen_px_dim (&width, &height); + + return make_fixnum (width / (dpyinfo->resx / 25.4)); +} + +DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, + 1, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object parms) +{ + return haiku_create_frame (parms); +} + +DEFUN ("x-display-visual-class", Fx_display_visual_class, + Sx_display_visual_class, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + int planes = be_get_display_planes (); + + if (planes == 8) + return intern ("static-color"); + + return intern ("true-color"); +} + +DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, + Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy) +{ + struct frame *f, *tip_f; + struct window *w; + int root_x, root_y; + struct buffer *old_buffer; + struct text_pos pos; + int width, height; + int old_windows_or_buffers_changed = windows_or_buffers_changed; + specpdl_ref count = SPECPDL_INDEX (); + Lisp_Object window, size, tip_buf; + AUTO_STRING (tip, " *tip*"); + + specbind (Qinhibit_redisplay, Qt); + + CHECK_STRING (string); + if (SCHARS (string) == 0) + string = make_unibyte_string (" ", 1); + + if (NILP (frame)) + frame = selected_frame; + f = decode_window_system_frame (frame); + + if (NILP (timeout)) + timeout = make_fixnum (5); + else + CHECK_FIXNAT (timeout); + + if (NILP (dx)) + dx = make_fixnum (5); + else + CHECK_FIXNUM (dx); + + if (NILP (dy)) + dy = make_fixnum (-10); + else + CHECK_FIXNUM (dy); + + if (use_system_tooltips) + { + int root_x, root_y; + CHECK_STRING (string); + if (STRING_MULTIBYTE (string)) + string = ENCODE_UTF_8 (string); + + if (NILP (frame)) + frame = selected_frame; + + struct frame *f = decode_window_system_frame (frame); + block_input (); + + char *str = xstrdup (SSDATA (string)); + int height = be_plain_font_height (); + int width; + char *tok = strtok (str, "\n"); + width = be_string_width_with_plain_font (tok); + + while ((tok = strtok (NULL, "\n"))) + { + height = be_plain_font_height (); + int w = be_string_width_with_plain_font (tok); + if (w > width) + w = width; + } + free (str); + + height += 16; /* Default margin. */ + width += 16; /* Ditto. Unfortunately there isn't a more + reliable way to get it. */ + compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y); + BView_convert_from_screen (FRAME_HAIKU_VIEW (f), &root_x, &root_y); + BView_set_and_show_sticky_tooltip (FRAME_HAIKU_VIEW (f), SSDATA (string), + root_x, root_y); + unblock_input (); + goto start_timer; + } + + if (!NILP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame))) + { + if (FRAME_VISIBLE_P (XFRAME (tip_frame)) + && EQ (frame, tip_last_frame) + && !NILP (Fequal_including_properties (tip_last_string, string)) + && !NILP (Fequal (tip_last_parms, parms))) + { + /* Only DX and DY have changed. */ + tip_f = XFRAME (tip_frame); + if (!NILP (tip_timer)) + { + call1 (Qcancel_timer, tip_timer); + tip_timer = Qnil; + } + + block_input (); + compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f), + FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y); + BWindow_set_offset (FRAME_HAIKU_WINDOW (tip_f), root_x, root_y); + unblock_input (); + + goto start_timer; + } + else if (tooltip_reuse_hidden_frame && EQ (frame, tip_last_frame)) + { + bool delete = false; + Lisp_Object tail, elt, parm, last; + + /* Check if every parameter in PARMS has the same value in + tip_last_parms. This may destruct tip_last_parms which, + however, will be recreated below. */ + for (tail = parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = Fcar (elt); + /* The left, top, right and bottom parameters are handled + by compute_tip_xy so they can be ignored here. */ + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) + && !EQ (parm, Qright) && !EQ (parm, Qbottom)) + { + last = Fassq (parm, tip_last_parms); + if (NILP (Fequal (Fcdr (elt), Fcdr (last)))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + else + tip_last_parms = + call2 (Qassq_delete_all, parm, tip_last_parms); + } + else + tip_last_parms = + call2 (Qassq_delete_all, parm, tip_last_parms); + } + + /* Now check if every parameter in what is left of + tip_last_parms with a non-nil value has an association in + PARMS. */ + for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = Fcar (elt); + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright) + && !EQ (parm, Qbottom) && !NILP (Fcdr (elt))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + } + + haiku_hide_tip (delete); + } + else + haiku_hide_tip (true); + } + else + haiku_hide_tip (true); + + tip_last_frame = frame; + tip_last_string = string; + tip_last_parms = parms; + + if (NILP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame))) + { + /* Add default values to frame parameters. */ + if (NILP (Fassq (Qname, parms))) + parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms); + if (NILP (Fassq (Qinternal_border_width, parms))) + parms = Fcons (Fcons (Qinternal_border_width, make_fixnum (3)), parms); + if (NILP (Fassq (Qborder_width, parms))) + parms = Fcons (Fcons (Qborder_width, make_fixnum (1)), parms); + if (NILP (Fassq (Qborder_color, parms))) + parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms); + if (NILP (Fassq (Qbackground_color, parms))) + parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")), + parms); + + /* Create a frame for the tooltip, and record it in the global + variable tip_frame. */ + if (NILP (tip_frame = haiku_create_tip_frame (parms))) + /* Creating the tip frame failed. */ + return unbind_to (count, Qnil); + } + + tip_f = XFRAME (tip_frame); + window = FRAME_ROOT_WINDOW (tip_f); + tip_buf = Fget_buffer_create (tip, Qnil); + /* We will mark the tip window a "pseudo-window" below, and such + windows cannot have display margins. */ + bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); + bset_right_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); + set_window_buffer (window, tip_buf, false, false); + w = XWINDOW (window); + w->pseudo_window_p = true; + /* Try to avoid that `other-window' select us (Bug#47207). */ + Fset_window_parameter (window, Qno_other_window, Qt); + + /* Set up the frame's root window. Note: The following code does not + try to size the window or its frame correctly. Its only purpose is + to make the subsequent text size calculations work. The right + sizes should get installed when the toolkit gets back to us. */ + w->left_col = 0; + w->top_line = 0; + w->pixel_left = 0; + w->pixel_top = 0; + + if (CONSP (Vx_max_tooltip_size) + && RANGED_FIXNUMP (1, XCAR (Vx_max_tooltip_size), INT_MAX) + && RANGED_FIXNUMP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) + { + w->total_cols = XFIXNAT (XCAR (Vx_max_tooltip_size)); + w->total_lines = XFIXNAT (XCDR (Vx_max_tooltip_size)); + } + else + { + w->total_cols = 80; + w->total_lines = 40; + } + + w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (tip_f); + w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (tip_f); + FRAME_TOTAL_COLS (tip_f) = w->total_cols; + adjust_frame_glyphs (tip_f); + + /* Insert STRING into root window's buffer and fit the frame to the + buffer. */ + specpdl_ref count_1 = SPECPDL_INDEX (); + old_buffer = current_buffer; + set_buffer_internal_1 (XBUFFER (w->contents)); + bset_truncate_lines (current_buffer, Qnil); + specbind (Qinhibit_read_only, Qt); + specbind (Qinhibit_modification_hooks, Qt); + specbind (Qinhibit_point_motion_hooks, Qt); + Ferase_buffer (); + Finsert (1, &string); + clear_glyph_matrix (w->desired_matrix); + clear_glyph_matrix (w->current_matrix); + SET_TEXT_POS (pos, BEGV, BEGV_BYTE); + try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); + /* Calculate size of tooltip window. */ + size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, + make_fixnum (w->pixel_height), Qnil, + Qnil); + /* Add the frame's internal border to calculated size. */ + width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + + /* Calculate position of tooltip frame. */ + compute_tip_xy (tip_f, parms, dx, dy, width, height, &root_x, &root_y); + + /* Show tooltip frame. */ + block_input (); + void *wnd = FRAME_HAIKU_WINDOW (tip_f); + BWindow_resize (wnd, width, height); + /* The window decorator might cause the actual width and height to + be larger than WIDTH and HEIGHT, so use the actual sizes. */ + BWindow_dimensions (wnd, &width, &height); + BView_resize_to (FRAME_HAIKU_VIEW (tip_f), width, height); + BView_set_view_cursor (FRAME_HAIKU_VIEW (tip_f), + FRAME_OUTPUT_DATA (f)->current_cursor); + BWindow_set_offset (wnd, root_x, root_y); + BWindow_set_visible (wnd, true); + SET_FRAME_VISIBLE (tip_f, true); + FRAME_PIXEL_WIDTH (tip_f) = width; + FRAME_PIXEL_HEIGHT (tip_f) = height; + BWindow_sync (wnd); + + /* This is needed because the app server resets the cursor whenever + a new window is mapped, so we won't see the cursor set on the + tooltip if the mouse pointer isn't actually over it. */ + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), + FRAME_OUTPUT_DATA (f)->current_cursor); + unblock_input (); + + w->must_be_updated_p = true; + update_single_window (w); + flush_frame (tip_f); + set_buffer_internal_1 (old_buffer); + unbind_to (count_1, Qnil); + windows_or_buffers_changed = old_windows_or_buffers_changed; + + start_timer: + /* Let the tip disappear after timeout seconds. */ + tip_timer = call3 (intern ("run-at-time"), timeout, Qnil, + intern ("x-hide-tip")); + + return unbind_to (count, Qnil); +} + +DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0, + doc: /* SKIP: real doc in xfns.c. */) + (void) +{ + return haiku_hide_tip (!tooltip_reuse_hidden_frame); +} + +DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection, 1, 1, 0, + doc: /* SKIP: real doc in xfns.c. */ + attributes: noreturn) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + error ("Cannot close Haiku displays"); +} + +DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, + doc: /* SKIP: real doc in xfns.c. */) + (void) +{ + if (!x_display_list) + return Qnil; + + return list1 (XCAR (x_display_list->name_list_element)); +} + +DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + return build_string ("Haiku, Inc."); +} + +DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + return list3i (5, 1, 1); +} + +DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + return make_fixnum (be_get_display_screens ()); +} + +DEFUN ("haiku-get-version-string", Fhaiku_get_version_string, + Shaiku_get_version_string, 0, 0, 0, + doc: /* Return a string describing the current Haiku version. */) + (void) +{ + char buf[1024]; + + be_get_version_string ((char *) &buf, sizeof buf); + return build_string (buf); +} + +DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + return make_fixnum (be_get_display_color_cells ()); +} + +DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + return make_fixnum (be_get_display_planes ()); +} + +DEFUN ("x-double-buffered-p", Fx_double_buffered_p, Sx_double_buffered_p, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object frame) +{ + struct frame *f = decode_live_frame (frame); + check_window_system (f); + + return EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f)) ? Qt : Qnil; +} + +DEFUN ("x-display-backing-store", Fx_display_backing_store, Sx_display_backing_store, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + if (FRAMEP (terminal)) + { + CHECK_LIVE_FRAME (terminal); + struct frame *f = decode_window_system_frame (terminal); + + if (FRAME_HAIKU_VIEW (f) && + EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f))) + return FRAME_PARENT_FRAME (f) ? Qwhen_mapped : Qalways; + else + return Qnot_useful; + } + else + { + check_haiku_display_info (terminal); + return Qnot_useful; + } +} + +DEFUN ("haiku-frame-geometry", Fhaiku_frame_geometry, Shaiku_frame_geometry, 0, 1, 0, + doc: /* Return geometric attributes of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is an association list of the attributes listed below. All height +and width values are in pixels. + +`outer-position' is a cons of the outer left and top edges of FRAME + relative to the origin - the position (0, 0) - of FRAME's display. + +`outer-size' is a cons of the outer width and height of FRAME. The + outer size includes the title bar and the external borders as well as + any menu and/or tool bar of frame. + +`external-border-size' is a cons of the horizontal and vertical width of + FRAME's external borders as supplied by the window manager. + +`title-bar-size' is a cons of the width and height of the title bar of + FRAME as supplied by the window manager. If both of them are zero, + FRAME has no title bar. If only the width is zero, Emacs was not + able to retrieve the width information. + +`menu-bar-external', if non-nil, means the menu bar is external (never + included in the inner edges of FRAME). + +`menu-bar-size' is a cons of the width and height of the menu bar of + FRAME. + +`tool-bar-external', if non-nil, means the tool bar is external (never + included in the inner edges of FRAME). + +`tool-bar-position' tells on which side the tool bar on FRAME is and can + be one of `left', `top', `right' or `bottom'. If this is nil, FRAME + has no tool bar. + +`tool-bar-size' is a cons of the width and height of the tool bar of + FRAME. + +`internal-border-width' is the width of the internal border of + FRAME. */) + (Lisp_Object frame) +{ + return frame_geometry (frame, Qnil); +} + +DEFUN ("haiku-frame-edges", Fhaiku_frame_edges, Shaiku_frame_edges, 0, 2, 0, + doc: /* Return edge coordinates of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are +in pixels relative to the origin - the position (0, 0) - of FRAME's +display. + +If optional argument TYPE is the symbol `outer-edges', return the outer +edges of FRAME. The outer edges comprise the decorations of the window +manager (like the title bar or external borders) as well as any external +menu or tool bar of FRAME. If optional argument TYPE is the symbol +`native-edges' or nil, return the native edges of FRAME. The native +edges exclude the decorations of the window manager and any external +menu or tool bar of FRAME. If TYPE is the symbol `inner-edges', return +the inner edges of FRAME. These edges exclude title bar, any borders, +menu bar or tool bar of FRAME. */) + (Lisp_Object frame, Lisp_Object type) +{ + return frame_geometry (frame, ((EQ (type, Qouter_edges) + || EQ (type, Qinner_edges)) + ? type + : Qnative_edges)); +} + +DEFUN ("haiku-read-file-name", Fhaiku_read_file_name, Shaiku_read_file_name, 1, 6, 0, + doc: /* Use a graphical panel to read a file name, using prompt PROMPT. +Optional arg FRAME specifies a frame on which to display the file panel. +If it is nil, the current frame is used instead. +The frame being used will be brought to the front of +the display after the file panel is closed. +Optional arg DIR, if non-nil, supplies a default directory. +Optional arg MUSTMATCH, if non-nil, means the returned file or +directory must exist. +Optional arg DIR_ONLY_P, if non-nil, means choose only directories. +Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry field. */) + (Lisp_Object prompt, Lisp_Object frame, + Lisp_Object dir, Lisp_Object mustmatch, + Lisp_Object dir_only_p, Lisp_Object save_text) +{ + if (!x_display_list) + error ("Haiku windowing not initialized"); + + if (!NILP (dir)) + CHECK_STRING (dir); + + if (!NILP (save_text)) + CHECK_STRING (save_text); + + if (NILP (frame)) + frame = selected_frame; + + CHECK_STRING (prompt); + + CHECK_LIVE_FRAME (frame); + check_window_system (XFRAME (frame)); + + specpdl_ref idx = SPECPDL_INDEX (); + record_unwind_protect_void (unwind_popup); + + struct frame *f = XFRAME (frame); + + FRAME_DISPLAY_INFO (f)->focus_event_frame = f; + + ++popup_activated_p; + char *fn = be_popup_file_dialog (!NILP (mustmatch) || !NILP (dir_only_p), + !NILP (dir) ? SSDATA (ENCODE_UTF_8 (dir)) : NULL, + !NILP (mustmatch), !NILP (dir_only_p), + FRAME_HAIKU_WINDOW (f), + !NILP (save_text) ? SSDATA (ENCODE_UTF_8 (save_text)) : NULL, + SSDATA (ENCODE_UTF_8 (prompt)), + block_input, unblock_input, maybe_quit); + + unbind_to (idx, Qnil); + + block_input (); + BWindow_activate (FRAME_HAIKU_WINDOW (f)); + unblock_input (); + + if (!fn) + return Qnil; + + Lisp_Object p = build_string_from_utf8 (fn); + free (fn); + return p; +} + +DEFUN ("haiku-put-resource", Fhaiku_put_resource, Shaiku_put_resource, + 2, 2, 0, doc: /* Place STRING by the key RESOURCE in the resource database. +It can later be retrieved with `x-get-resource'. */) + (Lisp_Object resource, Lisp_Object string) +{ + CHECK_STRING (resource); + if (!NILP (string)) + CHECK_STRING (string); + + put_xrm_resource (resource, string); + return Qnil; +} + +DEFUN ("haiku-frame-list-z-order", Fhaiku_frame_list_z_order, + Shaiku_frame_list_z_order, 0, 1, 0, + doc: /* Return list of Emacs' frames, in Z (stacking) order. +If TERMINAL is non-nil and specifies a live frame, return the child +frames of that frame in Z (stacking) order. + +As it is impossible to reliably determine the frame stacking order on +Haiku, the selected frame is always the first element of the returned +list, while the rest are not guaranteed to be in any particular order. + +Frames are listed from topmost (first) to bottommost (last). */) + (Lisp_Object terminal) +{ + Lisp_Object frames = Qnil; + Lisp_Object head, tail; + Lisp_Object sel = Qnil; + + FOR_EACH_FRAME (head, tail) + { + struct frame *f = XFRAME (tail); + if (!FRAME_HAIKU_P (f) || + (FRAMEP (terminal) && + FRAME_LIVE_P (XFRAME (terminal)) && + !EQ (terminal, get_frame_param (f, Qparent_frame)))) + continue; + + if (EQ (tail, selected_frame)) + sel = tail; + else + frames = Fcons (tail, frames); + } + + if (NILP (sel)) + return frames; + return Fcons (sel, frames); +} + +DEFUN ("x-display-save-under", Fx_display_save_under, + Sx_display_save_under, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + struct frame *f; + check_haiku_display_info (terminal); + + if (FRAMEP (terminal)) + { + f = decode_window_system_frame (terminal); + return ((FRAME_HAIKU_VIEW (f) + && EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f))) + ? Qt : Qnil); + } + + return Qnil; +} + +DEFUN ("haiku-frame-restack", Fhaiku_frame_restack, Shaiku_frame_restack, 2, 3, 0, + doc: /* Restack FRAME1 below FRAME2. +This means that if both frames are visible and the display areas of +these frames overlap, FRAME2 (partially) obscures FRAME1. If optional +third argument ABOVE is non-nil, restack FRAME1 above FRAME2. This +means that if both frames are visible and the display areas of these +frames overlap, FRAME1 (partially) obscures FRAME2. + +Some window managers may refuse to restack windows. */) + (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object above) +{ + struct frame *f1 = decode_window_system_frame (frame1); + struct frame *f2 = decode_window_system_frame (frame2); + + block_input (); + + if (NILP (above)) + { + /* If the window that is currently active will be sent behind + another window, make the window that it is being sent behind + active first, to avoid both windows being moved to the back of + the display. */ + + if (BWindow_is_active (FRAME_HAIKU_WINDOW (f1)) + /* But don't do this if any of the frames involved have + child frames, since they are guaranteed to be in front of + their toplevel parents. */ + && !FRAME_PARENT_FRAME (f1) + && !FRAME_PARENT_FRAME (f2)) + { + BWindow_activate (FRAME_HAIKU_WINDOW (f2)); + BWindow_sync (FRAME_HAIKU_WINDOW (f2)); + } + + BWindow_send_behind (FRAME_HAIKU_WINDOW (f1), + FRAME_HAIKU_WINDOW (f2)); + } + else + { + if (BWindow_is_active (FRAME_HAIKU_WINDOW (f2)) + && !FRAME_PARENT_FRAME (f1) + && !FRAME_PARENT_FRAME (f2)) + { + BWindow_activate (FRAME_HAIKU_WINDOW (f1)); + BWindow_sync (FRAME_HAIKU_WINDOW (f1)); + } + + BWindow_send_behind (FRAME_HAIKU_WINDOW (f2), + FRAME_HAIKU_WINDOW (f1)); + } + BWindow_sync (FRAME_HAIKU_WINDOW (f1)); + BWindow_sync (FRAME_HAIKU_WINDOW (f2)); + + unblock_input (); + + return Qnil; +} + +frame_parm_handler haiku_frame_parm_handlers[] = + { + gui_set_autoraise, + gui_set_autolower, + haiku_set_background_color, + NULL, /* x_set_border_color */ + gui_set_border_width, + haiku_set_cursor_color, + haiku_set_cursor_type, + gui_set_font, + haiku_set_foreground_color, + NULL, /* set icon name */ + NULL, /* set icon type */ + haiku_set_child_frame_border_width, + haiku_set_internal_border_width, + gui_set_right_divider_width, + gui_set_bottom_divider_width, + haiku_set_menu_bar_lines, + NULL, /* set mouse color */ + haiku_explicitly_set_name, + gui_set_scroll_bar_width, + gui_set_scroll_bar_height, + haiku_set_title, + gui_set_unsplittable, + gui_set_vertical_scroll_bars, + gui_set_horizontal_scroll_bars, + gui_set_visibility, + haiku_set_tab_bar_lines, + haiku_set_tool_bar_lines, + NULL, /* set scroll bar fg */ + NULL, /* set scroll bar bkg */ + gui_set_screen_gamma, + gui_set_line_spacing, + gui_set_left_fringe, + gui_set_right_fringe, + NULL, /* x wait for wm */ + gui_set_fullscreen, + gui_set_font_backend, + gui_set_alpha, + NULL, /* set sticky */ + NULL, /* set tool bar pos */ + haiku_set_inhibit_double_buffering, + haiku_set_undecorated, + haiku_set_parent_frame, + NULL, /* set skip taskbar */ + haiku_set_no_focus_on_map, + haiku_set_no_accept_focus, + NULL, /* set z group */ + haiku_set_override_redirect, + gui_set_no_special_glyphs, + gui_set_alpha_background, + }; + +void +syms_of_haikufns (void) +{ + DEFSYM (Qfont_parameter, "font-parameter"); + DEFSYM (Qcancel_timer, "cancel-timer"); + DEFSYM (Qassq_delete_all, "assq-delete-all"); + + DEFSYM (Qalways, "always"); + DEFSYM (Qnot_useful, "not-useful"); + DEFSYM (Qwhen_mapped, "when-mapped"); + DEFSYM (Qtooltip_reuse_hidden_frame, "tooltip-reuse-hidden-frame"); + + defsubr (&Sx_hide_tip); + defsubr (&Sxw_display_color_p); + defsubr (&Sx_display_grayscale_p); + defsubr (&Sx_open_connection); + defsubr (&Sx_create_frame); + defsubr (&Sx_display_pixel_width); + defsubr (&Sx_display_pixel_height); + defsubr (&Sxw_color_values); + defsubr (&Sxw_color_defined_p); + defsubr (&Sx_display_visual_class); + defsubr (&Sx_show_tip); + defsubr (&Sx_display_mm_height); + defsubr (&Sx_display_mm_width); + defsubr (&Sx_close_connection); + defsubr (&Sx_display_list); + defsubr (&Sx_server_vendor); + defsubr (&Sx_server_version); + defsubr (&Sx_display_screens); + defsubr (&Shaiku_get_version_string); + defsubr (&Sx_display_color_cells); + defsubr (&Sx_display_planes); + defsubr (&Shaiku_set_mouse_absolute_pixel_position); + defsubr (&Shaiku_mouse_absolute_pixel_position); + defsubr (&Shaiku_frame_geometry); + defsubr (&Shaiku_frame_edges); + defsubr (&Sx_double_buffered_p); + defsubr (&Sx_display_backing_store); + defsubr (&Shaiku_read_file_name); + defsubr (&Shaiku_put_resource); + defsubr (&Shaiku_frame_list_z_order); + defsubr (&Sx_display_save_under); + defsubr (&Shaiku_frame_restack); + + tip_timer = Qnil; + staticpro (&tip_timer); + tip_frame = Qnil; + staticpro (&tip_frame); + tip_last_frame = Qnil; + staticpro (&tip_last_frame); + tip_last_string = Qnil; + staticpro (&tip_last_string); + tip_last_parms = Qnil; + staticpro (&tip_last_parms); + + DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size, + doc: /* SKIP: real doc in xfns.c. */); + Vx_max_tooltip_size = Fcons (make_fixnum (80), make_fixnum (40)); + + DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel, + doc: /* SKIP: real doc in xfns.c. */); + Vx_cursor_fore_pixel = Qnil; + +#ifdef USE_BE_CAIRO + DEFVAR_LISP ("cairo-version-string", Vcairo_version_string, + doc: /* Version info for cairo. */); + { + char cairo_version[sizeof ".." + 3 * INT_STRLEN_BOUND (int)]; + int len = sprintf (cairo_version, "%d.%d.%d", + CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR, + CAIRO_VERSION_MICRO); + Vcairo_version_string = make_pure_string (cairo_version, len, len, false); + } +#endif + + return; +} diff --git a/src/haikufont.c b/src/haikufont.c new file mode 100644 index 00000000000..f2ead5d6c25 --- /dev/null +++ b/src/haikufont.c @@ -0,0 +1,1101 @@ +/* Font support for Haiku windowing + +Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include "lisp.h" +#include "dispextern.h" +#include "composite.h" +#include "blockinput.h" +#include "charset.h" +#include "frame.h" +#include "window.h" +#include "fontset.h" +#include "haikuterm.h" +#include "character.h" +#include "coding.h" +#include "font.h" +#include "termchar.h" +#include "pdumper.h" +#include "haiku_support.h" + +#include <math.h> +#include <stdlib.h> + +static Lisp_Object font_cache; + +#define METRICS_NCOLS_PER_ROW (128) + +enum metrics_status + { + METRICS_INVALID = -1, /* metrics entry is invalid */ + }; + +#define METRICS_STATUS(metrics) ((metrics)->ascent + (metrics)->descent) +#define METRICS_SET_STATUS(metrics, status) \ + ((metrics)->ascent = 0, (metrics)->descent = (status)) + +static struct +{ + /* registry name */ + const char *name; + /* characters to distinguish the charset from the others */ + int uniquifier[6]; + /* additional constraint by language */ + const char *lang; +} em_charset_table[] = + { { "iso8859-1", { 0x00A0, 0x00A1, 0x00B4, 0x00BC, 0x00D0 } }, + { "iso8859-2", { 0x00A0, 0x010E }}, + { "iso8859-3", { 0x00A0, 0x0108 }}, + { "iso8859-4", { 0x00A0, 0x00AF, 0x0128, 0x0156, 0x02C7 }}, + { "iso8859-5", { 0x00A0, 0x0401 }}, + { "iso8859-6", { 0x00A0, 0x060C }}, + { "iso8859-7", { 0x00A0, 0x0384 }}, + { "iso8859-8", { 0x00A0, 0x05D0 }}, + { "iso8859-9", { 0x00A0, 0x00A1, 0x00BC, 0x011E }}, + { "iso8859-10", { 0x00A0, 0x00D0, 0x0128, 0x2015 }}, + { "iso8859-11", { 0x00A0, 0x0E01 }}, + { "iso8859-13", { 0x00A0, 0x201C }}, + { "iso8859-14", { 0x00A0, 0x0174 }}, + { "iso8859-15", { 0x00A0, 0x00A1, 0x00D0, 0x0152 }}, + { "iso8859-16", { 0x00A0, 0x0218}}, + { "gb2312.1980-0", { 0x4E13 }, "zh-cn"}, + { "big5-0", { 0x9C21 }, "zh-tw" }, + { "jisx0208.1983-0", { 0x4E55 }, "ja"}, + { "ksc5601.1985-0", { 0xAC00 }, "ko"}, + { "cns11643.1992-1", { 0xFE32 }, "zh-tw"}, + { "cns11643.1992-2", { 0x4E33, 0x7934 }}, + { "cns11643.1992-3", { 0x201A9 }}, + { "cns11643.1992-4", { 0x20057 }}, + { "cns11643.1992-5", { 0x20000 }}, + { "cns11643.1992-6", { 0x20003 }}, + { "cns11643.1992-7", { 0x20055 }}, + { "gbk-0", { 0x4E06 }, "zh-cn"}, + { "jisx0212.1990-0", { 0x4E44 }}, + { "jisx0213.2000-1", { 0xFA10 }, "ja"}, + { "jisx0213.2000-2", { 0xFA49 }}, + { "jisx0213.2004-1", { 0x20B9F }}, + { "viscii1.1-1", { 0x1EA0, 0x1EAE, 0x1ED2 }, "vi"}, + { "tis620.2529-1", { 0x0E01 }, "th"}, + { "microsoft-cp1251", { 0x0401, 0x0490 }, "ru"}, + { "koi8-r", { 0x0401, 0x2219 }, "ru"}, + { "mulelao-1", { 0x0E81 }, "lo"}, + { "unicode-sip", { 0x20000 }}, + { "mulearabic-0", { 0x628 }}, + { "mulearabic-1", { 0x628 }}, + { "mulearabic-2", { 0x628 }}, + { NULL } + }; + +static void +haikufont_apply_registry (struct haiku_font_pattern *pattern, + Lisp_Object registry) +{ + char *str = SSDATA (SYMBOL_NAME (registry)); + USE_SAFE_ALLOCA; + char *re = SAFE_ALLOCA (SBYTES (SYMBOL_NAME (registry)) * 2 + 1); + int i, j; + + for (i = j = 0; i < SBYTES (SYMBOL_NAME (registry)); i++, j++) + { + if (str[i] == '.') + re[j++] = '\\'; + else if (str[i] == '*') + re[j++] = '.'; + re[j] = str[i]; + if (re[j] == '?') + re[j] = '.'; + } + re[j] = '\0'; + AUTO_STRING_WITH_LEN (regexp, re, j); + for (i = 0; em_charset_table[i].name; i++) + if (fast_c_string_match_ignore_case + (regexp, em_charset_table[i].name, + strlen (em_charset_table[i].name)) >= 0) + break; + SAFE_FREE (); + if (!em_charset_table[i].name) + return; + int *uniquifier = em_charset_table[i].uniquifier; + int l; + + for (l = 0; uniquifier[l]; ++l); + + uint32_t *a = xmalloc (l * sizeof *a); + for (l = 0; uniquifier[l]; ++l) + a[l] = uniquifier[l]; + + if (pattern->specified & FSPEC_WANTED) + { + int old_l = l; + l += pattern->want_chars_len; + a = xrealloc (a, l * sizeof *a); + memcpy (&a[old_l], pattern->wanted_chars, (l - old_l) * sizeof *a); + xfree (pattern->wanted_chars); + } + + pattern->specified |= FSPEC_WANTED; + pattern->want_chars_len = l; + pattern->wanted_chars = a; + + if (em_charset_table[i].lang) + { + if (!strncmp (em_charset_table[i].lang, "zh", 2)) + { + pattern->specified |= FSPEC_LANGUAGE; + pattern->language = LANGUAGE_CN; + } + else if (!strncmp (em_charset_table[i].lang, "ko", 2)) + { + pattern->specified |= FSPEC_LANGUAGE; + pattern->language = LANGUAGE_KO; + } + else if (!strncmp (em_charset_table[i].lang, "ja", 2)) + { + pattern->specified |= FSPEC_LANGUAGE; + pattern->language = LANGUAGE_JP; + } + } + + return; +} + +static Lisp_Object +haikufont_get_fallback_entity (void) +{ + Lisp_Object ent = font_make_entity (); + ASET (ent, FONT_TYPE_INDEX, Qhaiku); + ASET (ent, FONT_FOUNDRY_INDEX, Qhaiku); + ASET (ent, FONT_FAMILY_INDEX, Qnil); + ASET (ent, FONT_ADSTYLE_INDEX, Qnil); + ASET (ent, FONT_REGISTRY_INDEX, Qiso10646_1); + ASET (ent, FONT_SIZE_INDEX, make_fixnum (0)); + ASET (ent, FONT_AVGWIDTH_INDEX, make_fixnum (0)); + ASET (ent, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_MONO)); + FONT_SET_STYLE (ent, FONT_WIDTH_INDEX, Qnil); + FONT_SET_STYLE (ent, FONT_WEIGHT_INDEX, Qnil); + FONT_SET_STYLE (ent, FONT_SLANT_INDEX, Qnil); + + return ent; +} + +static Lisp_Object +haikufont_get_cache (struct frame *frame) +{ + return font_cache; +} + +static Lisp_Object +haikufont_weight_to_lisp (int weight) +{ + switch (weight) + { + case HAIKU_THIN: + return Qthin; + case HAIKU_ULTRALIGHT: + return Qultra_light; + case HAIKU_EXTRALIGHT: + return Qextra_light; + case HAIKU_LIGHT: + return Qlight; + case HAIKU_SEMI_LIGHT: + return Qsemi_light; + case HAIKU_REGULAR: + return Qnormal; + case HAIKU_SEMI_BOLD: + return Qsemi_bold; + case HAIKU_BOLD: + return Qbold; + case HAIKU_EXTRA_BOLD: + return Qextra_bold; + case HAIKU_ULTRA_BOLD: + return Qultra_bold; + case HAIKU_BOOK: + return Qbook; + case HAIKU_HEAVY: + return Qheavy; + case HAIKU_ULTRA_HEAVY: + return Qultra_heavy; + case HAIKU_BLACK: + return Qblack; + case HAIKU_MEDIUM: + return Qmedium; + } + emacs_abort (); +} + +static int +haikufont_lisp_to_weight (Lisp_Object weight) +{ + if (EQ (weight, Qthin)) + return HAIKU_THIN; + if (EQ (weight, Qultra_light)) + return HAIKU_ULTRALIGHT; + if (EQ (weight, Qextra_light)) + return HAIKU_EXTRALIGHT; + if (EQ (weight, Qlight)) + return HAIKU_LIGHT; + if (EQ (weight, Qsemi_light)) + return HAIKU_SEMI_LIGHT; + if (EQ (weight, Qnormal)) + return HAIKU_REGULAR; + if (EQ (weight, Qsemi_bold)) + return HAIKU_SEMI_BOLD; + if (EQ (weight, Qbold)) + return HAIKU_BOLD; + if (EQ (weight, Qextra_bold)) + return HAIKU_EXTRA_BOLD; + if (EQ (weight, Qultra_bold)) + return HAIKU_ULTRA_BOLD; + if (EQ (weight, Qbook)) + return HAIKU_BOOK; + if (EQ (weight, Qheavy)) + return HAIKU_HEAVY; + if (EQ (weight, Qultra_heavy)) + return HAIKU_ULTRA_HEAVY; + if (EQ (weight, Qblack)) + return HAIKU_BLACK; + if (EQ (weight, Qmedium)) + return HAIKU_MEDIUM; + + emacs_abort (); +} + +static Lisp_Object +haikufont_slant_to_lisp (enum haiku_font_slant slant) +{ + switch (slant) + { + case NO_SLANT: + emacs_abort (); + case SLANT_ITALIC: + return Qitalic; + case SLANT_REGULAR: + return Qnormal; + case SLANT_OBLIQUE: + return Qoblique; + } + emacs_abort (); +} + +static enum haiku_font_slant +haikufont_lisp_to_slant (Lisp_Object slant) +{ + if (EQ (slant, Qitalic) || + EQ (slant, Qreverse_italic)) + return SLANT_ITALIC; + if (EQ (slant, Qoblique) || + EQ (slant, Qreverse_oblique)) + return SLANT_OBLIQUE; + if (EQ (slant, Qnormal)) + return SLANT_REGULAR; + emacs_abort (); +} + +static Lisp_Object +haikufont_width_to_lisp (enum haiku_font_width width) +{ + switch (width) + { + case NO_WIDTH: + emacs_abort (); + case ULTRA_CONDENSED: + return Qultra_condensed; + case EXTRA_CONDENSED: + return Qextra_condensed; + case CONDENSED: + return Qcondensed; + case SEMI_CONDENSED: + return Qsemi_condensed; + case NORMAL_WIDTH: + return Qnormal; + case SEMI_EXPANDED: + return Qsemi_expanded; + case EXPANDED: + return Qexpanded; + case EXTRA_EXPANDED: + return Qextra_expanded; + case ULTRA_EXPANDED: + return Qultra_expanded; + } + + emacs_abort (); +} + +static enum haiku_font_width +haikufont_lisp_to_width (Lisp_Object lisp) +{ + if (EQ (lisp, Qultra_condensed)) + return ULTRA_CONDENSED; + if (EQ (lisp, Qextra_condensed)) + return EXTRA_CONDENSED; + if (EQ (lisp, Qcondensed)) + return CONDENSED; + if (EQ (lisp, Qsemi_condensed)) + return SEMI_CONDENSED; + if (EQ (lisp, Qnormal)) + return NORMAL_WIDTH; + if (EQ (lisp, Qexpanded)) + return EXPANDED; + if (EQ (lisp, Qextra_expanded)) + return EXTRA_EXPANDED; + if (EQ (lisp, Qultra_expanded)) + return ULTRA_EXPANDED; + emacs_abort (); +} + +static int +haikufont_maybe_handle_special_family (Lisp_Object family, + struct haiku_font_pattern *ptn) +{ + CHECK_SYMBOL (family); + + if (EQ (family, Qmonospace) || EQ (family, Qfixed) || + EQ (family, Qdefault)) + { + BFont_populate_fixed_family (ptn); + return 1; + } + else if (EQ (family, intern ("Sans Serif"))) + { + BFont_populate_plain_family (ptn); + return 1; + } + return 0; +} + +static Lisp_Object +haikufont_pattern_to_entity (struct haiku_font_pattern *ptn) +{ + Lisp_Object ent = font_make_entity (); + ASET (ent, FONT_TYPE_INDEX, Qhaiku); + ASET (ent, FONT_FOUNDRY_INDEX, Qhaiku); + ASET (ent, FONT_FAMILY_INDEX, Qdefault); + ASET (ent, FONT_ADSTYLE_INDEX, Qnil); + ASET (ent, FONT_REGISTRY_INDEX, Qiso10646_1); + ASET (ent, FONT_SIZE_INDEX, make_fixnum (0)); + ASET (ent, FONT_AVGWIDTH_INDEX, make_fixnum (0)); + ASET (ent, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_MONO)); + FONT_SET_STYLE (ent, FONT_WIDTH_INDEX, Qnormal); + FONT_SET_STYLE (ent, FONT_WEIGHT_INDEX, Qnormal); + FONT_SET_STYLE (ent, FONT_SLANT_INDEX, Qnormal); + + if (ptn->specified & FSPEC_FAMILY) + ASET (ent, FONT_FAMILY_INDEX, intern (ptn->family)); + else + ASET (ent, FONT_FAMILY_INDEX, Qdefault); + + if (ptn->specified & FSPEC_STYLE) + ASET (ent, FONT_ADSTYLE_INDEX, intern (ptn->style)); + else + { + if (ptn->specified & FSPEC_WEIGHT) + FONT_SET_STYLE (ent, FONT_WEIGHT_INDEX, + haikufont_weight_to_lisp (ptn->weight)); + if (ptn->specified & FSPEC_SLANT) + FONT_SET_STYLE (ent, FONT_SLANT_INDEX, + haikufont_slant_to_lisp (ptn->slant)); + if (ptn->specified & FSPEC_WIDTH) + FONT_SET_STYLE (ent, FONT_WIDTH_INDEX, + haikufont_width_to_lisp (ptn->width)); + } + + if (ptn->specified & FSPEC_SPACING) + ASET (ent, FONT_SPACING_INDEX, + make_fixnum (ptn->mono_spacing_p ? + FONT_SPACING_MONO : FONT_SPACING_PROPORTIONAL)); + return ent; +} + +static void +haikufont_spec_or_entity_to_pattern (Lisp_Object ent, int list_p, + struct haiku_font_pattern *ptn) +{ + Lisp_Object tem; + ptn->specified = 0; + + tem = AREF (ent, FONT_ADSTYLE_INDEX); + if (!NILP (tem)) + { + ptn->specified |= FSPEC_STYLE; + strncpy ((char *) &ptn->style, + SSDATA (SYMBOL_NAME (tem)), + sizeof ptn->style - 1); + ptn->style[sizeof ptn->style - 1] = '\0'; + } + + tem = FONT_SLANT_SYMBOLIC (ent); + if (!NILP (tem) && !EQ (tem, Qunspecified)) + { + ptn->specified |= FSPEC_SLANT; + ptn->slant = haikufont_lisp_to_slant (tem); + } + + tem = FONT_WEIGHT_SYMBOLIC (ent); + if (!NILP (tem) && !EQ (tem, Qunspecified)) + { + ptn->specified |= FSPEC_WEIGHT; + ptn->weight = haikufont_lisp_to_weight (tem); + } + + tem = FONT_WIDTH_SYMBOLIC (ent); + if (!NILP (tem) && !EQ (tem, Qunspecified)) + { + ptn->specified |= FSPEC_WIDTH; + ptn->width = haikufont_lisp_to_width (tem); + } + + tem = AREF (ent, FONT_SPACING_INDEX); + if (!NILP (tem) && !EQ (tem, Qunspecified)) + { + ptn->specified |= FSPEC_SPACING; + ptn->mono_spacing_p = XFIXNUM (tem) != FONT_SPACING_PROPORTIONAL; + } + + tem = AREF (ent, FONT_FAMILY_INDEX); + if (!NILP (tem) && !EQ (tem, Qunspecified) && + (list_p && !haikufont_maybe_handle_special_family (tem, ptn))) + { + ptn->specified |= FSPEC_FAMILY; + strncpy ((char *) &ptn->family, + SSDATA (SYMBOL_NAME (tem)), + sizeof ptn->family - 1); + ptn->family[sizeof ptn->family - 1] = '\0'; + } + + tem = assq_no_quit (QCscript, AREF (ent, FONT_EXTRA_INDEX)); + if (!NILP (tem)) + { + tem = assq_no_quit (XCDR (tem), Vscript_representative_chars); + + if (CONSP (tem) && VECTORP (XCDR (tem))) + { + tem = XCDR (tem); + + int count = 0; + + for (int j = 0; j < ASIZE (tem); ++j) + if (TYPE_RANGED_FIXNUMP (uint32_t, AREF (tem, j))) + ++count; + + if (count) + { + ptn->specified |= FSPEC_NEED_ONE_OF; + ptn->need_one_of_len = count; + ptn->need_one_of = xmalloc (count * sizeof *ptn->need_one_of); + count = 0; + for (int j = 0; j < ASIZE (tem); ++j) + if (TYPE_RANGED_FIXNUMP (uint32_t, AREF (tem, j))) + { + ptn->need_one_of[j] = XFIXNAT (AREF (tem, j)); + ++count; + } + } + } + else if (CONSP (tem) && CONSP (XCDR (tem))) + { + int count = 0; + + for (Lisp_Object it = XCDR (tem); CONSP (it); it = XCDR (it)) + if (TYPE_RANGED_FIXNUMP (uint32_t, XCAR (it))) + ++count; + + if (count) + { + ptn->specified |= FSPEC_WANTED; + ptn->want_chars_len = count; + ptn->wanted_chars = xmalloc (count * sizeof *ptn->wanted_chars); + count = 0; + + for (tem = XCDR (tem); CONSP (tem); tem = XCDR (tem)) + if (TYPE_RANGED_FIXNUMP (uint32_t, XCAR (tem))) + { + ptn->wanted_chars[count] = XFIXNAT (XCAR (tem)); + ++count; + } + } + } + } + + tem = assq_no_quit (QClang, AREF (ent, FONT_EXTRA_INDEX)); + if (CONSP (tem)) + { + tem = XCDR (tem); + if (EQ (tem, Qzh)) + { + ptn->specified |= FSPEC_LANGUAGE; + ptn->language = LANGUAGE_CN; + } + else if (EQ (tem, Qko)) + { + ptn->specified |= FSPEC_LANGUAGE; + ptn->language = LANGUAGE_KO; + } + else if (EQ (tem, Qjp)) + { + ptn->specified |= FSPEC_LANGUAGE; + ptn->language = LANGUAGE_JP; + } + } + + tem = AREF (ent, FONT_REGISTRY_INDEX); + if (SYMBOLP (tem)) + haikufont_apply_registry (ptn, tem); +} + +static void +haikufont_done_with_query_pattern (struct haiku_font_pattern *ptn) +{ + if (ptn->specified & FSPEC_WANTED) + xfree (ptn->wanted_chars); + + if (ptn->specified & FSPEC_NEED_ONE_OF) + xfree (ptn->need_one_of); +} + +static Lisp_Object +haikufont_match (struct frame *f, Lisp_Object font_spec) +{ + block_input (); + Lisp_Object tem = Qnil; + struct haiku_font_pattern ptn; + haikufont_spec_or_entity_to_pattern (font_spec, 0, &ptn); + ptn.specified &= ~FSPEC_FAMILY; + struct haiku_font_pattern *found = BFont_find (&ptn); + haikufont_done_with_query_pattern (&ptn); + if (found) + { + tem = haikufont_pattern_to_entity (found); + haiku_font_pattern_free (found); + } + unblock_input (); + return !NILP (tem) ? tem : haikufont_get_fallback_entity (); +} + +static Lisp_Object +haikufont_list (struct frame *f, Lisp_Object font_spec) +{ + Lisp_Object lst, tem; + struct haiku_font_pattern ptn, *found, *pt; + + lst = Qnil; + + block_input (); + /* Returning irrelevant results on receiving an OTF form will cause + fontset.c to loop over and over, making displaying some + characters very slow. */ + tem = assq_no_quit (QCotf, AREF (font_spec, FONT_EXTRA_INDEX)); + + if (CONSP (tem) && !NILP (XCDR (tem))) + { + unblock_input (); + return Qnil; + } + + haikufont_spec_or_entity_to_pattern (font_spec, 1, &ptn); + found = BFont_find (&ptn); + haikufont_done_with_query_pattern (&ptn); + if (found) + { + for (pt = found; pt; pt = pt->next) + lst = Fcons (haikufont_pattern_to_entity (pt), lst); + haiku_font_pattern_free (found); + } + unblock_input (); + return lst; +} + +static void +haiku_bulk_encode (struct haikufont_info *font_info, int block) +{ + unsigned short *unichars = xmalloc (0x101 * sizeof (*unichars)); + unsigned int i, idx; + + block_input (); + + font_info->glyphs[block] = unichars; + if (!unichars) + emacs_abort (); + + for (idx = block << 8, i = 0; i < 0x100; idx++, i++) + unichars[i] = idx; + unichars[0x100] = 0; + + + /* If the font contains the entire block, just store it. */ + if (!BFont_have_char_block (font_info->be_font, + unichars[0], unichars[0xff])) + { + for (int i = 0; i < 0x100; ++i) + if (!BFont_have_char_p (font_info->be_font, unichars[i])) + unichars[i] = 0xFFFF; + } + + unblock_input (); +} + +static unsigned int +haikufont_encode_char (struct font *font, int c) +{ + struct haikufont_info *font_info = (struct haikufont_info *) font; + unsigned char high = (c & 0xff00) >> 8, low = c & 0x00ff; + unsigned short g; + + if (c > 0xFFFF) + return FONT_INVALID_CODE; + + if (!font_info->glyphs[high]) + haiku_bulk_encode (font_info, high); + g = font_info->glyphs[high][low]; + return g == 0xFFFF ? FONT_INVALID_CODE : g; +} + +static Lisp_Object +haikufont_open (struct frame *f, Lisp_Object font_entity, int x) +{ + struct haikufont_info *font_info; + struct haiku_font_pattern ptn; + struct font *font; + void *be_font; + Lisp_Object font_object; + Lisp_Object tem; + + block_input (); + if (x <= 0) + { + /* Get pixel size from frame instead. */ + tem = get_frame_param (f, Qfontsize); + x = NILP (tem) ? 0 : XFIXNAT (tem); + } + + haikufont_spec_or_entity_to_pattern (font_entity, 1, &ptn); + + if (BFont_open_pattern (&ptn, &be_font, x)) + { + haikufont_done_with_query_pattern (&ptn); + unblock_input (); + return Qnil; + } + + haikufont_done_with_query_pattern (&ptn); + + font_object = font_make_object (VECSIZE (struct haikufont_info), + font_entity, x); + + ASET (font_object, FONT_TYPE_INDEX, Qhaiku); + font_info = (struct haikufont_info *) XFONT_OBJECT (font_object); + font = (struct font *) font_info; + + if (!font) + { + unblock_input (); + return Qnil; + } + + font_info->be_font = be_font; + font_info->glyphs = xzalloc (0x100 * sizeof *font_info->glyphs); + + font->pixel_size = 0; + font->driver = &haikufont_driver; + font->encoding_charset = -1; + font->repertory_charset = -1; + font->default_ascent = 0; + font->vertical_centering = 0; + font->baseline_offset = 0; + font->relative_compose = 0; + + font_info->metrics = NULL; + font_info->metrics_nrows = 0; + + int px_size, min_width, max_width, + avg_width, height, space_width, ascent, + descent, underline_pos, underline_thickness; + + BFont_dat (be_font, &px_size, &min_width, + &max_width, &avg_width, &height, + &space_width, &ascent, &descent, + &underline_pos, &underline_thickness); + + font->pixel_size = px_size; + font->min_width = min_width; + font->max_width = max_width; + font->average_width = avg_width; + font->height = height; + font->space_width = space_width; + font->ascent = ascent; + font->descent = descent; + font->default_ascent = ascent; + font->underline_position = underline_pos; + font->underline_thickness = underline_thickness; + + font->vertical_centering = 0; + font->baseline_offset = 0; + font->relative_compose = 0; + + font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil); + + unblock_input (); + return font_object; +} + +static void +haikufont_close (struct font *font) +{ + if (font_data_structures_may_be_ill_formed ()) + return; + struct haikufont_info *info = (struct haikufont_info *) font; + + block_input (); + if (info && info->be_font) + BFont_close (info->be_font); + + for (int i = 0; i < info->metrics_nrows; i++) + if (info->metrics[i]) + xfree (info->metrics[i]); + if (info->metrics) + xfree (info->metrics); + for (int i = 0; i < 0x100; ++i) + if (info->glyphs[i]) + xfree (info->glyphs[i]); + xfree (info->glyphs); + unblock_input (); +} + +static void +haikufont_prepare_face (struct frame *f, struct face *face) +{ + +} + +static void +haikufont_glyph_extents (struct font *font, unsigned code, + struct font_metrics *metrics) +{ + struct haikufont_info *info = (struct haikufont_info *) font; + + struct font_metrics *cache; + int row, col; + + row = code / METRICS_NCOLS_PER_ROW; + col = code % METRICS_NCOLS_PER_ROW; + if (row >= info->metrics_nrows) + { + info->metrics = + xrealloc (info->metrics, + sizeof (struct font_metrics *) * (row + 1)); + memset (info->metrics + info->metrics_nrows, 0, + (sizeof (struct font_metrics *) + * (row + 1 - info->metrics_nrows))); + info->metrics_nrows = row + 1; + } + + if (info->metrics[row] == NULL) + { + struct font_metrics *new; + int i; + + new = xmalloc (sizeof (struct font_metrics) * METRICS_NCOLS_PER_ROW); + for (i = 0; i < METRICS_NCOLS_PER_ROW; i++) + METRICS_SET_STATUS (new + i, METRICS_INVALID); + info->metrics[row] = new; + } + cache = info->metrics[row] + col; + + if (METRICS_STATUS (cache) == METRICS_INVALID) + { + unsigned char utf8[MAX_MULTIBYTE_LENGTH]; + memset (utf8, 0, MAX_MULTIBYTE_LENGTH); + CHAR_STRING (code, utf8); + int advance, lb, rb; + BFont_char_bounds (info->be_font, (const char *) utf8, &advance, &lb, &rb); + + cache->lbearing = lb; + cache->rbearing = rb; + cache->width = advance; + cache->ascent = font->ascent; + cache->descent = font->descent; + } + + if (metrics) + *metrics = *cache; +} + +static void +haikufont_text_extents (struct font *font, const unsigned int *code, + int nglyphs, struct font_metrics *metrics) +{ + int totalwidth = 0; + memset (metrics, 0, sizeof (struct font_metrics)); + + block_input (); + for (int i = 0; i < nglyphs; i++) + { + struct font_metrics m; + haikufont_glyph_extents (font, code[i], &m); + if (metrics) + { + if (totalwidth + m.lbearing < metrics->lbearing) + metrics->lbearing = totalwidth + m.lbearing; + if (totalwidth + m.rbearing > metrics->rbearing) + metrics->rbearing = totalwidth + m.rbearing; + if (m.ascent > metrics->ascent) + metrics->ascent = m.ascent; + if (m.descent > metrics->descent) + metrics->descent = m.descent; + } + totalwidth += m.width; + } + + unblock_input (); + + if (metrics) + metrics->width = totalwidth; +} + +static Lisp_Object +haikufont_shape (Lisp_Object lgstring, Lisp_Object direction) +{ + struct haikufont_info *font = + (struct haikufont_info *) CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring)); + int *advance, *lb, *rb; + ptrdiff_t glyph_len, len, i, b_len; + Lisp_Object tem; + char *b; + uint32_t *mb_buf; + + 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 (); + + b_len = 0; + b = xmalloc (b_len); + mb_buf = alloca (len * sizeof *mb_buf); + + for (i = b_len; i < len; ++i) + { + uint32_t c = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, i)); + mb_buf[i] = c; + unsigned char mb[MAX_MULTIBYTE_LENGTH]; + int slen = CHAR_STRING (c, mb); + + b = xrealloc (b, b_len = (b_len + slen)); + if (len == 1) + b[b_len - slen] = mb[0]; + else + memcpy (b + b_len - slen, mb, slen); + } + + advance = alloca (len * sizeof *advance); + lb = alloca (len * sizeof *lb); + rb = alloca (len * sizeof *rb); + + eassert (font->be_font); + BFont_nchar_bounds (font->be_font, b, advance, lb, rb, len); + xfree (b); + + for (i = 0; i < len; ++i) + { + tem = LGSTRING_GLYPH (lgstring, i); + if (NILP (tem)) + { + tem = LGLYPH_NEW (); + LGSTRING_SET_GLYPH (lgstring, i, tem); + } + + LGLYPH_SET_FROM (tem, i); + LGLYPH_SET_TO (tem, i); + LGLYPH_SET_CHAR (tem, mb_buf[i]); + LGLYPH_SET_CODE (tem, mb_buf[i]); + + LGLYPH_SET_WIDTH (tem, advance[i]); + LGLYPH_SET_LBEARING (tem, lb[i]); + LGLYPH_SET_RBEARING (tem, rb[i]); + LGLYPH_SET_ASCENT (tem, font->font.ascent); + LGLYPH_SET_DESCENT (tem, font->font.descent); + } + + unblock_input (); + + return make_fixnum (len); +} + +static int +haikufont_draw (struct glyph_string *s, int from, int to, + int x, int y, bool with_background) +{ + struct frame *f = s->f; + struct face *face = s->face; + struct font_info *info = (struct font_info *) s->font; + unsigned char mb[MAX_MULTIBYTE_LENGTH]; + void *view = FRAME_HAIKU_VIEW (f); + unsigned long foreground, background; + + block_input (); + prepare_face_for_display (s->f, face); + + if (s->hl != DRAW_CURSOR) + { + foreground = s->face->foreground; + background = s->face->background; + } + else + haiku_merge_cursor_foreground (s, &foreground, &background); + + /* Presumably the draw lock is already held by + haiku_draw_glyph_string; */ + if (with_background) + { + int height = FONT_HEIGHT (s->font), ascent = FONT_BASE (s->font); + + /* Font's global height and ascent values might be + preposterously large for some fonts. We fix here the case + when those fonts are used for display of glyphless + characters, because drawing background with font dimensions + in those cases makes the display illegible. There's only one + more call to the draw method with with_background set to + true, and that's in x_draw_glyph_string_foreground, when + drawing the cursor, where we have no such heuristics + available. FIXME. */ + if (s->first_glyph->type == GLYPHLESS_GLYPH + && (s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE + || s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM)) + height = ascent = + s->first_glyph->slice.glyphless.lower_yoff + - s->first_glyph->slice.glyphless.upper_yoff; + + BView_SetHighColor (view, background); + BView_FillRectangle (view, x, y - ascent, s->width, height); + s->background_filled_p = 1; + } + + BView_SetHighColor (view, foreground); + BView_MovePenTo (view, x, y); + BView_SetFont (view, ((struct haikufont_info *) info)->be_font); + + if (from == to) + { + int len = CHAR_STRING (s->char2b[from], mb); + BView_DrawString (view, (char *) mb, len); + } + else + { + ptrdiff_t b_len = 0; + char *b = alloca ((to - from + 1) * MAX_MULTIBYTE_LENGTH); + + for (int idx = from; idx < to; ++idx) + { + int len = CHAR_STRING (s->char2b[idx], mb); + b_len += len; + + if (len == 1) + b[b_len - len] = mb[0]; + else + memcpy (b + b_len - len, mb, len); + } + + BView_DrawString (view, b, b_len); + } + + unblock_input (); + return 1; +} + +static Lisp_Object +haikufont_list_family (struct frame *f) +{ + Lisp_Object list = Qnil; + size_t length; + ptrdiff_t idx; + haiku_font_family_or_style *styles; + + block_input (); + styles = be_list_font_families (&length); + unblock_input (); + + if (!styles) + return list; + + block_input (); + for (idx = 0; idx < length; ++idx) + { + if (styles[idx][0]) + list = Fcons (intern ((char *) &styles[idx]), list); + } + + free (styles); + unblock_input (); + + return list; +} + +struct font_driver const haikufont_driver = + { + .type = LISPSYM_INITIALLY (Qhaiku), + .case_sensitive = true, + .get_cache = haikufont_get_cache, + .list = haikufont_list, + .match = haikufont_match, + .draw = haikufont_draw, + .open_font = haikufont_open, + .close_font = haikufont_close, + .prepare_face = haikufont_prepare_face, + .encode_char = haikufont_encode_char, + .text_extents = haikufont_text_extents, + .shape = haikufont_shape, + .list_family = haikufont_list_family + }; + +void +syms_of_haikufont (void) +{ + DEFSYM (Qfontsize, "fontsize"); + DEFSYM (Qfixed, "fixed"); + DEFSYM (Qplain, "plain"); + DEFSYM (Qultra_light, "ultra-light"); + DEFSYM (Qthin, "thin"); + DEFSYM (Qreverse_italic, "reverse-italic"); + DEFSYM (Qreverse_oblique, "reverse-oblique"); + DEFSYM (Qmonospace, "monospace"); + DEFSYM (Qultra_condensed, "ultra-condensed"); + DEFSYM (Qextra_condensed, "extra-condensed"); + DEFSYM (Qcondensed, "condensed"); + DEFSYM (Qsemi_condensed, "semi-condensed"); + DEFSYM (Qsemi_expanded, "semi-expanded"); + DEFSYM (Qexpanded, "expanded"); + DEFSYM (Qextra_expanded, "extra-expanded"); + DEFSYM (Qultra_expanded, "ultra-expanded"); + DEFSYM (Qzh, "zh"); + DEFSYM (Qko, "ko"); + DEFSYM (Qjp, "jp"); + + font_cache = list (Qnil); + staticpro (&font_cache); +} diff --git a/src/haikugui.h b/src/haikugui.h new file mode 100644 index 00000000000..a6cf3a4e6ce --- /dev/null +++ b/src/haikugui.h @@ -0,0 +1,98 @@ +/* Haiku window system support + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#ifndef _HAIKU_GUI_H_ +#define _HAIKU_GUI_H_ + +typedef struct haiku_char_struct +{ + int rbearing; + int lbearing; + int width; + int ascent; + int descent; +} XCharStruct; + +struct haiku_rect +{ + int x, y; + int width, height; +}; + +typedef void *haiku; + +typedef haiku Emacs_Pixmap; +typedef haiku Emacs_Window; +typedef haiku Emacs_Cursor; +typedef haiku Drawable; + +#define NativeRectangle struct haiku_rect +#define CONVERT_TO_EMACS_RECT(xr, nr) \ + ((xr).x = (nr).x, \ + (xr).y = (nr).y, \ + (xr).width = (nr).width, \ + (xr).height = (nr).height) + +#define CONVERT_FROM_EMACS_RECT(xr, nr) \ + ((nr).x = (xr).x, \ + (nr).y = (xr).y, \ + (nr).width = (xr).width, \ + (nr).height = (xr).height) + +#define STORE_NATIVE_RECT(nr, px, py, pwidth, pheight) \ + ((nr).x = (px), \ + (nr).y = (py), \ + (nr).width = (pwidth), \ + (nr).height = (pheight)) + +#define ForgetGravity 0 +#define NorthWestGravity 1 +#define NorthGravity 2 +#define NorthEastGravity 3 +#define WestGravity 4 +#define CenterGravity 5 +#define EastGravity 6 +#define SouthWestGravity 7 +#define SouthGravity 8 +#define SouthEastGravity 9 +#define StaticGravity 10 + +#define NoValue 0x0000 +#define XValue 0x0001 +#define YValue 0x0002 +#define WidthValue 0x0004 +#define HeightValue 0x0008 +#define AllValues 0x000F +#define XNegative 0x0010 +#define YNegative 0x0020 + +#define USPosition (1L << 0) /* user specified x, y */ +#define USSize (1L << 1) /* user specified width, height */ +#define PPosition (1L << 2) /* program specified position */ +#define PSize (1L << 3) /* program specified size */ +#define PMinSize (1L << 4) /* program specified minimum size */ +#define PMaxSize (1L << 5) /* program specified maximum size */ +#define PResizeInc (1L << 6) /* program specified resize increments */ +#define PAspect (1L << 7) /* program specified min, max aspect ratios */ +#define PBaseSize (1L << 8) /* program specified base for incrementing */ +#define PWinGravity (1L << 9) /* program specified window gravity */ + +typedef haiku Window; +typedef int Display; + +#endif /* _HAIKU_GUI_H_ */ diff --git a/src/haikuimage.c b/src/haikuimage.c new file mode 100644 index 00000000000..af3021c5cd9 --- /dev/null +++ b/src/haikuimage.c @@ -0,0 +1,116 @@ +/* Haiku window system support. + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include "lisp.h" +#include "dispextern.h" +#include "haikuterm.h" +#include "coding.h" + +#include "haiku_support.h" + +bool +haiku_can_use_native_image_api (Lisp_Object type) +{ + const char *mime_type = NULL; + + if (EQ (type, Qnative_image)) + return 1; + +#ifdef HAVE_RSVG + if (EQ (type, Qsvg)) + return 0; +#endif + + if (EQ (type, Qjpeg)) + mime_type = "image/jpeg"; + else if (EQ (type, Qpng)) + mime_type = "image/png"; +#ifndef HAVE_GIF + else if (EQ (type, Qgif)) + mime_type = "image/gif"; +#endif + else if (EQ (type, Qtiff)) + mime_type = "image/tiff"; + else if (EQ (type, Qbmp)) + mime_type = "image/bmp"; + else if (EQ (type, Qsvg)) + mime_type = "image/svg"; + else if (EQ (type, Qpbm)) + mime_type = "image/pbm"; + /* Don't use native image APIs for image types that have animations, + since those aren't supported by the Translation Kit. */ +#ifndef HAVE_WEBP + else if (EQ (type, Qwebp)) + mime_type = "image/webp"; +#endif + + if (!mime_type) + return 0; + + return be_can_translate_type_to_bitmap_p (mime_type); +} + +extern int +haiku_load_image (struct frame *f, struct image *img, + Lisp_Object spec_file, Lisp_Object spec_data) +{ + eassert (valid_image_p (img->spec)); + + void *pixmap = NULL; + + if (STRINGP (spec_file)) + { + pixmap = be_translate_bitmap_from_file_name + (SSDATA (ENCODE_UTF_8 (spec_file))); + } + else if (STRINGP (spec_data)) + { + pixmap = be_translate_bitmap_from_memory + (SSDATA (spec_data), SBYTES (spec_data)); + } + + void *conv = NULL; + + if (!pixmap || !BBitmap_convert (pixmap, &conv)) + { + add_to_log ("Unable to load image %s", img->spec); + return 0; + } + + if (conv) + { + BBitmap_free (pixmap); + pixmap = conv; + } + + int left, top, right, bottom, stride, mono_p; + BBitmap_dimensions (pixmap, &left, &top, &right, &bottom, &stride, &mono_p); + + img->width = (1 + right - left); + img->height = (1 + bottom - top); + img->pixmap = pixmap; + + return 1; +} + +void +syms_of_haikuimage (void) +{ +} diff --git a/src/haikumenu.c b/src/haikumenu.c new file mode 100644 index 00000000000..22e9c4ecad3 --- /dev/null +++ b/src/haikumenu.c @@ -0,0 +1,788 @@ +/* Haiku window system support + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include "lisp.h" +#include "frame.h" +#include "keyboard.h" +#include "menu.h" +#include "buffer.h" +#include "blockinput.h" + +#include "haikuterm.h" +#include "haiku_support.h" + +static Lisp_Object *volatile menu_item_selection; +static struct timespec menu_timer_timespec; + +int popup_activated_p = 0; + +static void +digest_menu_items (void *first_menu, int start, int menu_items_used, + int mbar_p) +{ + void **menus, **panes; + ssize_t menu_len = (menu_items_used + 1 - start) * sizeof *menus; + ssize_t pane_len = (menu_items_used + 1 - start) * sizeof *panes; + + menus = alloca (menu_len); + panes = alloca (pane_len); + + int i = start, menu_depth = 0; + + memset (menus, 0, menu_len); + memset (panes, 0, pane_len); + + void *menu = first_menu; + + menus[0] = first_menu; + + void *window = NULL; + void *view = NULL; + if (FRAMEP (Vmenu_updating_frame) && + FRAME_LIVE_P (XFRAME (Vmenu_updating_frame)) && + FRAME_HAIKU_P (XFRAME (Vmenu_updating_frame))) + { + window = FRAME_HAIKU_WINDOW (XFRAME (Vmenu_updating_frame)); + view = FRAME_HAIKU_VIEW (XFRAME (Vmenu_updating_frame)); + } + + if (view) + BView_draw_lock (view, false, 0, 0, 0, 0); + + while (i < menu_items_used) + { + if (NILP (AREF (menu_items, i))) + { + menus[++menu_depth] = menu; + i++; + } + else if (EQ (AREF (menu_items, i), Qlambda)) + { + panes[menu_depth] = NULL; + menu = panes[--menu_depth] ? panes[menu_depth] : menus[menu_depth]; + i++; + } + else if (EQ (AREF (menu_items, i), Qquote)) + i += 1; + else if (EQ (AREF (menu_items, i), Qt)) + { + Lisp_Object pane_name, prefix; + const char *pane_string; + + if (menu_items_n_panes == 1) + { + i += MENU_ITEMS_PANE_LENGTH; + continue; + } + + pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); + prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); + + if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name)) + { + pane_name = ENCODE_UTF_8 (pane_name); + ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); + } + + pane_string = (NILP (pane_name) + ? "" : SSDATA (pane_name)); + if (!NILP (prefix)) + pane_string++; + + if (strcmp (pane_string, "")) + { + panes[menu_depth] = + menu = BMenu_new_submenu (menus[menu_depth], pane_string, 1); + } + + i += MENU_ITEMS_PANE_LENGTH; + } + else + { + Lisp_Object item_name, enable, descrip, def, selected, help; + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); + enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); + descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); + def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION); + selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED); + help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); + + if (STRINGP (item_name) && STRING_MULTIBYTE (item_name)) + { + item_name = ENCODE_UTF_8 (item_name); + ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); + } + + if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) + { + descrip = ENCODE_UTF_8 (descrip); + ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); + } + + if (STRINGP (help) && STRING_MULTIBYTE (help)) + help = ENCODE_UTF_8 (help); + + if (i + MENU_ITEMS_ITEM_LENGTH < menu_items_used && + NILP (AREF (menu_items, i + MENU_ITEMS_ITEM_LENGTH))) + menu = BMenu_new_submenu (menu, SSDATA (item_name), !NILP (enable)); + else if (NILP (def) && menu_separator_name_p (SSDATA (item_name))) + BMenu_add_separator (menu); + else if (!mbar_p) + { + if (!use_system_tooltips || NILP (Fsymbol_value (Qtooltip_mode))) + BMenu_add_item (menu, SSDATA (item_name), + !NILP (def) ? aref_addr (menu_items, i) : NULL, + !NILP (enable), !NILP (selected), 0, window, + !NILP (descrip) ? SSDATA (descrip) : NULL, + NULL); + else + BMenu_add_item (menu, SSDATA (item_name), + !NILP (def) ? aref_addr (menu_items, i) : NULL, + !NILP (enable), !NILP (selected), 0, window, + !NILP (descrip) ? SSDATA (descrip) : NULL, + STRINGP (help) ? SSDATA (help) : NULL); + } + else if (!use_system_tooltips || NILP (Fsymbol_value (Qtooltip_mode))) + BMenu_add_item (menu, SSDATA (item_name), + !NILP (def) ? (void *) (intptr_t) i : NULL, + !NILP (enable), !NILP (selected), 1, window, + !NILP (descrip) ? SSDATA (descrip) : NULL, + NULL); + else + BMenu_add_item (menu, SSDATA (item_name), + !NILP (def) ? (void *) (intptr_t) i : NULL, + !NILP (enable), !NILP (selected), 1, window, + !NILP (descrip) ? SSDATA (descrip) : NULL, + STRINGP (help) ? SSDATA (help) : NULL); + + i += MENU_ITEMS_ITEM_LENGTH; + } + } + + if (view) + BView_draw_unlock (view); +} + +static Lisp_Object +haiku_dialog_show (struct frame *f, Lisp_Object title, + Lisp_Object header, const char **error_name) +{ + int i, nb_buttons = 0; + bool boundary_seen = false; + Lisp_Object pane_name, vals[10]; + void *alert, *button; + bool enabled_item_seen_p = false; + int32 val; + + *error_name = NULL; + + if (menu_items_n_panes > 1) + { + *error_name = "Multiple panes in dialog box"; + return Qnil; + } + + pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME); + i = MENU_ITEMS_PANE_LENGTH; + + if (STRING_MULTIBYTE (pane_name)) + pane_name = ENCODE_UTF_8 (pane_name); + + block_input (); + alert = BAlert_new (SSDATA (pane_name), NILP (header) ? HAIKU_INFO_ALERT : + HAIKU_IDEA_ALERT); + + while (i < menu_items_used) + { + Lisp_Object item_name, enable, descrip, value; + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); + enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); + descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); + value = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); + + if (NILP (item_name)) + { + BAlert_delete (alert); + *error_name = "Submenu in dialog items"; + unblock_input (); + return Qnil; + } + + if (EQ (item_name, Qquote)) + { + if (nb_buttons) + boundary_seen = true; + + i++; + continue; + } + + if (nb_buttons >= 9) + { + BAlert_delete (alert); + *error_name = "Too many dialog items"; + unblock_input (); + return Qnil; + } + + if (STRING_MULTIBYTE (item_name)) + item_name = ENCODE_UTF_8 (item_name); + if (!NILP (descrip) && STRING_MULTIBYTE (descrip)) + descrip = ENCODE_UTF_8 (descrip); + + button = BAlert_add_button (alert, SSDATA (item_name)); + + BButton_set_enabled (button, !NILP (enable)); + enabled_item_seen_p |= !NILP (enable); + + if (!NILP (descrip)) + BView_set_tooltip (button, SSDATA (descrip)); + + vals[nb_buttons] = value; + ++nb_buttons; + i += MENU_ITEMS_ITEM_LENGTH; + } + + /* Haiku only lets us specify a single button to place on the + left. */ + if (boundary_seen) + BAlert_set_offset_spacing (alert); + + /* If there isn't a single enabled item, add an "Ok" button so the + popup can be dismissed. */ + if (!enabled_item_seen_p) + BAlert_add_button (alert, "Ok"); + unblock_input (); + + unrequest_sigio (); + ++popup_activated_p; + val = BAlert_go (alert, block_input, unblock_input, + process_pending_signals); + --popup_activated_p; + request_sigio (); + + if (val < 0) + quit (); + else if (val < nb_buttons) + return vals[val]; + + /* The dialog was dismissed via the button appended to dismiss popup + dialogs without a single enabled item. */ + if (nb_buttons) + quit (); + /* Otherwise, the Ok button was added because no buttons were seen + at all. */ + else + return Qt; + + emacs_abort (); +} + +Lisp_Object +haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) +{ + Lisp_Object title; + const char *error_name = NULL; + Lisp_Object selection; + specpdl_ref specpdl_count = SPECPDL_INDEX (); + + check_window_system (f); + + /* Decode the dialog items from what was specified. */ + title = Fcar (contents); + CHECK_STRING (title); + record_unwind_protect_void (unuse_menu_items); + + if (NILP (Fcar (Fcdr (contents)))) + /* No buttons specified, add an "Ok" button so users can pop down + the dialog. Also, the lesstif/motif version crashes if there are + no buttons. */ + contents = list2 (title, Fcons (build_string ("Ok"), Qt)); + + list_of_panes (list1 (contents)); + + /* Display them in a dialog box. */ + selection = haiku_dialog_show (f, title, header, &error_name); + + unbind_to (specpdl_count, Qnil); + discard_menu_items (); + + if (error_name) + error ("%s", error_name); + return selection; +} + +static void +haiku_menu_show_help (void *help, void *data) +{ + Lisp_Object *id = (Lisp_Object *) help; + + if (help) + show_help_echo (id[MENU_ITEMS_ITEM_HELP], + Qnil, Qnil, Qnil); + else + show_help_echo (Qnil, Qnil, Qnil, Qnil); +} + +static Lisp_Object +haiku_process_pending_signals_for_menu_1 (void *ptr) +{ + menu_timer_timespec = timer_check (); + + return Qnil; +} + +static Lisp_Object +haiku_process_pending_signals_for_menu_2 (enum nonlocal_exit exit, Lisp_Object error) +{ + menu_timer_timespec.tv_sec = 0; + menu_timer_timespec.tv_nsec = -1; + + return Qnil; +} + +static struct timespec +haiku_process_pending_signals_for_menu (void) +{ + process_pending_signals (); + + /* The original idea was to let timers throw so that timeouts can + work correctly, but there's no way to pop down a BPopupMenu + that's currently popped up. */ + internal_catch_all (haiku_process_pending_signals_for_menu_1, NULL, + haiku_process_pending_signals_for_menu_2); + + return menu_timer_timespec; +} + +Lisp_Object +haiku_menu_show (struct frame *f, int x, int y, int menuflags, + Lisp_Object title, const char **error_name) +{ + int i = 0, submenu_depth = 0; + void *view = FRAME_HAIKU_VIEW (f); + void *menu; + + Lisp_Object *subprefix_stack = + alloca (menu_items_used * sizeof (Lisp_Object)); + + eassert (FRAME_HAIKU_P (f)); + + *error_name = NULL; + + if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) + { + *error_name = "Empty menu"; + return Qnil; + } + + block_input (); + if (STRINGP (title) && STRING_MULTIBYTE (title)) + title = ENCODE_UTF_8 (title); + + menu = BPopUpMenu_new (STRINGP (title) ? SSDATA (title) : NULL); + if (STRINGP (title)) + { + BMenu_add_title (menu, SSDATA (title)); + BMenu_add_separator (menu); + } + digest_menu_items (menu, 0, menu_items_used, 0); + BView_convert_to_screen (view, &x, &y); + unblock_input (); + + popup_activated_p++; + menu_item_selection = BMenu_run (menu, x, y, haiku_menu_show_help, + block_input, unblock_input, + haiku_process_pending_signals_for_menu, NULL); + popup_activated_p--; + + FRAME_DISPLAY_INFO (f)->grabbed = 0; + + if (menu_item_selection) + { + Lisp_Object prefix, entry; + + prefix = entry = Qnil; + i = 0; + while (i < menu_items_used) + { + if (NILP (AREF (menu_items, i))) + { + subprefix_stack[submenu_depth++] = prefix; + prefix = entry; + i++; + } + else if (EQ (AREF (menu_items, i), Qlambda)) + { + prefix = subprefix_stack[--submenu_depth]; + i++; + } + else if (EQ (AREF (menu_items, i), Qt)) + { + prefix + = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); + i += MENU_ITEMS_PANE_LENGTH; + } + /* Ignore a nil in the item list. + It's meaningful only for dialog boxes. */ + else if (EQ (AREF (menu_items, i), Qquote)) + i += 1; + else + { + entry + = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); + if (menu_item_selection == aref_addr (menu_items, i)) + { + if (menuflags & MENU_KEYMAPS) + { + int j; + + entry = list1 (entry); + if (!NILP (prefix)) + entry = Fcons (prefix, entry); + for (j = submenu_depth - 1; j >= 0; j--) + if (!NILP (subprefix_stack[j])) + entry = Fcons (subprefix_stack[j], entry); + } + block_input (); + BPopUpMenu_delete (menu); + unblock_input (); + return entry; + } + i += MENU_ITEMS_ITEM_LENGTH; + } + } + } + else if (!(menuflags & MENU_FOR_CLICK)) + { + block_input (); + BPopUpMenu_delete (menu); + unblock_input (); + quit (); + } + block_input (); + BPopUpMenu_delete (menu); + unblock_input (); + return Qnil; +} + +void +free_frame_menubar (struct frame *f) +{ + FRAME_MENU_BAR_LINES (f) = 0; + FRAME_MENU_BAR_HEIGHT (f) = 0; + FRAME_EXTERNAL_MENU_BAR (f) = 0; + + block_input (); + void *mbar = FRAME_HAIKU_MENU_BAR (f); + if (mbar) + BMenuBar_delete (mbar); + if (FRAME_OUTPUT_DATA (f)->menu_bar_open_p) + --popup_activated_p; + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 0; + unblock_input (); + + adjust_frame_size (f, -1, -1, 2, false, Qmenu_bar_lines); +} + +void +initialize_frame_menubar (struct frame *f) +{ + /* This function is called before the first chance to redisplay + the frame. It has to be, so the frame will have the right size. */ + fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); + set_frame_menubar (f, true); +} + +void +set_frame_menubar (struct frame *f, bool deep_p) +{ + void *mbar = FRAME_HAIKU_MENU_BAR (f); + void *view = FRAME_HAIKU_VIEW (f); + + int first_time_p = 0; + + if (!mbar) + { + mbar = FRAME_HAIKU_MENU_BAR (f) = BMenuBar_new (view); + first_time_p = 1; + } + + Lisp_Object items; + struct buffer *prev = current_buffer; + Lisp_Object buffer; + specpdl_ref specpdl_count = SPECPDL_INDEX (); + int previous_menu_items_used = f->menu_bar_items_used; + Lisp_Object *previous_items + = alloca (previous_menu_items_used * sizeof *previous_items); + int count; + ptrdiff_t subitems, i; + int *submenu_start, *submenu_end, *submenu_n_panes; + Lisp_Object *submenu_names; + + XSETFRAME (Vmenu_updating_frame, f); + + if (!deep_p) + { + FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 0; + items = FRAME_MENU_BAR_ITEMS (f); + Lisp_Object string; + + block_input (); + int count = BMenu_count_items (mbar); + + int i; + for (i = 0; i < ASIZE (items); i += 4) + { + string = AREF (items, i + 1); + + if (!STRINGP (string)) + break; + + if (STRING_MULTIBYTE (string)) + string = ENCODE_UTF_8 (string); + + if (i / 4 < count) + { + void *it = BMenu_item_at (mbar, i / 4); + BMenu_item_set_label (it, SSDATA (string)); + } + else + BMenu_new_menu_bar_submenu (mbar, SSDATA (string)); + } + + if (i / 4 < count) + BMenu_delete_from (mbar, i / 4, count - i / 4 + 1); + unblock_input (); + + f->menu_bar_items_used = 0; + } + else + { + /* If we are making a new widget, its contents are empty, + do always reinitialize them. */ + if (first_time_p) + previous_menu_items_used = 0; + + buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->contents; + specbind (Qinhibit_quit, Qt); + /* Don't let the debugger step into this code + because it is not reentrant. */ + specbind (Qdebug_on_next_call, Qnil); + + record_unwind_save_match_data (); + if (NILP (Voverriding_local_map_menu_flag)) + { + specbind (Qoverriding_terminal_local_map, Qnil); + specbind (Qoverriding_local_map, Qnil); + } + + set_buffer_internal_1 (XBUFFER (buffer)); + + /* Run the Lucid hook. */ + safe_run_hooks (Qactivate_menubar_hook); + + /* If it has changed current-menubar from previous value, + really recompute the menubar from the value. */ + if (! NILP (Vlucid_menu_bar_dirty_flag)) + call0 (Qrecompute_lucid_menubar); + safe_run_hooks (Qmenu_bar_update_hook); + fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); + + items = FRAME_MENU_BAR_ITEMS (f); + + /* Save the frame's previous menu bar contents data. */ + if (previous_menu_items_used) + memcpy (previous_items, xvector_contents (f->menu_bar_vector), + previous_menu_items_used * word_size); + + /* Fill in menu_items with the current menu bar contents. + This can evaluate Lisp code. */ + save_menu_items (); + + menu_items = f->menu_bar_vector; + menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0; + subitems = ASIZE (items) / 4; + submenu_start = alloca ((subitems + 1) * sizeof *submenu_start); + submenu_end = alloca (subitems * sizeof *submenu_end); + submenu_n_panes = alloca (subitems * sizeof *submenu_n_panes); + submenu_names = alloca (subitems * sizeof (Lisp_Object)); + + init_menu_items (); + for (i = 0; i < subitems; i++) + { + Lisp_Object key, string, maps; + + key = AREF (items, 4 * i); + string = AREF (items, 4 * i + 1); + maps = AREF (items, 4 * i + 2); + if (NILP (string)) + break; + + if (STRINGP (string) && STRING_MULTIBYTE (string)) + string = ENCODE_UTF_8 (string); + + submenu_start[i] = menu_items_used; + + menu_items_n_panes = 0; + parse_single_submenu (key, string, maps); + submenu_n_panes[i] = menu_items_n_panes; + + submenu_end[i] = menu_items_used; + submenu_names[i] = string; + } + + submenu_start[i] = -1; + finish_menu_items (); + + set_buffer_internal_1 (prev); + + FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 1; + + /* If there has been no change in the Lisp-level contents + of the menu bar, skip redisplaying it. Just exit. */ + + /* Compare the new menu items with the ones computed last time. */ + for (i = 0; i < previous_menu_items_used; i++) + if (menu_items_used == i + || (!EQ (previous_items[i], AREF (menu_items, i)))) + break; + if (i == menu_items_used && i == previous_menu_items_used && i != 0) + { + /* The menu items have not changed. Don't bother updating + the menus in any form, since it would be a no-op. */ + discard_menu_items (); + unbind_to (specpdl_count, Qnil); + return; + } + + /* Convert menu_items into widget_value trees + to display the menu. This cannot evaluate Lisp code. */ + + block_input (); + count = BMenu_count_items (mbar); + for (i = 0; submenu_start[i] >= 0; ++i) + { + void *mn = NULL; + if (i < count) + mn = BMenu_item_get_menu (BMenu_item_at (mbar, i)); + if (mn) + BMenu_delete_all (mn); + else + mn = BMenu_new_menu_bar_submenu (mbar, SSDATA (submenu_names[i])); + + menu_items_n_panes = submenu_n_panes[i]; + digest_menu_items (mn, submenu_start[i], submenu_end[i], 1); + } + unblock_input (); + + /* The menu items are different, so store them in the frame. */ + fset_menu_bar_vector (f, menu_items); + f->menu_bar_items_used = menu_items_used; + } + + /* This undoes save_menu_items. */ + unbind_to (specpdl_count, Qnil); +} + +void +run_menu_bar_help_event (struct frame *f, int mb_idx) +{ + Lisp_Object frame; + Lisp_Object vec; + Lisp_Object help; + + block_input (); + if (!FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) + { + unblock_input (); + return; + } + + XSETFRAME (frame, f); + + if (mb_idx < 0) + { + kbd_buffer_store_help_event (frame, Qnil); + unblock_input (); + return; + } + + vec = f->menu_bar_vector; + if ((mb_idx + MENU_ITEMS_ITEM_HELP) >= ASIZE (vec)) + emacs_abort (); + + help = AREF (vec, mb_idx + MENU_ITEMS_ITEM_HELP); + if (STRINGP (help) || NILP (help)) + kbd_buffer_store_help_event (frame, help); + unblock_input (); +} + +DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, + 0, 0, 0, doc: /* SKIP: real doc in xmenu.c. */) + (void) +{ + return popup_activated_p ? Qt : Qnil; +} + +DEFUN ("haiku-menu-bar-open", Fhaiku_menu_bar_open, Shaiku_menu_bar_open, 0, 1, "i", + doc: /* Show and start key navigation of the menu bar in FRAME. +This initially opens the first menu bar item and you can then navigate +with the arrow keys, select a menu entry with the return key, or +cancel with the escape key. If FRAME is nil or not given, use the +selected frame. If FRAME has no menu bar, a pop-up is displayed at +the position of the last non-menu event instead. */) + (Lisp_Object frame) +{ + struct frame *f = decode_window_system_frame (frame); + int rc; + + if (FRAME_EXTERNAL_MENU_BAR (f)) + { + block_input (); + set_frame_menubar (f, 1); + rc = BMenuBar_start_tracking (FRAME_HAIKU_MENU_BAR (f)); + unblock_input (); + + if (!rc) + return Qnil; + + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; + popup_activated_p += 1; + } + else + return call2 (Qpopup_menu, call0 (Qmouse_menu_bar_map), + last_nonmenu_event); + + return Qnil; +} + +void +syms_of_haikumenu (void) +{ + DEFSYM (Qdebug_on_next_call, "debug-on-next-call"); + DEFSYM (Qpopup_menu, "popup-menu"); + DEFSYM (Qmouse_menu_bar_map, "mouse-menu-bar-map"); + DEFSYM (Qtooltip_mode, "tooltip-mode"); + + defsubr (&Smenu_or_popup_active_p); + defsubr (&Shaiku_menu_bar_open); + return; +} diff --git a/src/haikuselect.c b/src/haikuselect.c new file mode 100644 index 00000000000..a186acc66ff --- /dev/null +++ b/src/haikuselect.c @@ -0,0 +1,865 @@ +/* Haiku window system selection support. + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include "lisp.h" +#include "blockinput.h" +#include "coding.h" +#include "haikuselect.h" +#include "haikuterm.h" +#include "haiku_support.h" + +#include <stdlib.h> + +/* The frame that is currently the source of a drag-and-drop + operation, or NULL if none is in progress. The reason for this + variable is to prevent it from being deleted, which really breaks + the nested event loop inside be_drag_message. */ +struct frame *haiku_dnd_frame; + +static void haiku_lisp_to_message (Lisp_Object, void *); + +DEFUN ("haiku-selection-data", Fhaiku_selection_data, Shaiku_selection_data, + 2, 2, 0, + doc: /* Retrieve content typed as NAME from the clipboard +CLIPBOARD. CLIPBOARD is the symbol `PRIMARY', `SECONDARY' or +`CLIPBOARD'. NAME is a string describing the MIME type denoting the +type of the data to fetch. If NAME is nil, then the entire contents +of the clipboard will be returned instead, as a serialized system +message in the format accepted by `haiku-drag-message', which see. */) + (Lisp_Object clipboard, Lisp_Object name) +{ + char *dat; + ssize_t len; + Lisp_Object str; + void *message; + enum haiku_clipboard clipboard_name; + int rc; + + CHECK_SYMBOL (clipboard); + + if (!EQ (clipboard, QPRIMARY) && !EQ (clipboard, QSECONDARY) + && !EQ (clipboard, QCLIPBOARD)) + signal_error ("Invalid clipboard", clipboard); + + if (!NILP (name)) + { + CHECK_STRING (name); + + block_input (); + if (EQ (clipboard, QPRIMARY)) + dat = BClipboard_find_primary_selection_data (SSDATA (name), &len); + else if (EQ (clipboard, QSECONDARY)) + dat = BClipboard_find_secondary_selection_data (SSDATA (name), &len); + else + dat = BClipboard_find_system_data (SSDATA (name), &len); + unblock_input (); + + if (!dat) + return Qnil; + + str = make_unibyte_string (dat, len); + + /* `foreign-selection' just means that the selection has to be + decoded by `gui-get-selection'. It has no other meaning, + AFAICT. */ + Fput_text_property (make_fixnum (0), make_fixnum (len), + Qforeign_selection, Qt, str); + + block_input (); + BClipboard_free_data (dat); + unblock_input (); + } + else + { + if (EQ (clipboard, QPRIMARY)) + clipboard_name = CLIPBOARD_PRIMARY; + else if (EQ (clipboard, QSECONDARY)) + clipboard_name = CLIPBOARD_SECONDARY; + else + clipboard_name = CLIPBOARD_CLIPBOARD; + + block_input (); + rc = be_lock_clipboard_message (clipboard_name, &message, false); + unblock_input (); + + if (rc) + signal_error ("Couldn't open clipboard", clipboard); + + block_input (); + str = haiku_message_to_lisp (message); + be_unlock_clipboard (clipboard_name, true); + unblock_input (); + } + + return str; +} + +static void +haiku_unwind_clipboard_lock (int clipboard) +{ + be_unlock_clipboard (clipboard, false); +} + +DEFUN ("haiku-selection-put", Fhaiku_selection_put, Shaiku_selection_put, + 2, 4, 0, + doc: /* Add or remove content from the clipboard CLIPBOARD. +CLIPBOARD is the symbol `PRIMARY', `SECONDARY' or `CLIPBOARD'. NAME +is a MIME type denoting the type of the data to add. DATA is the +string that will be placed in the clipboard, or nil if the content is +to be removed. CLEAR, if non-nil, means to erase all the previous +contents of the clipboard. + +Alternatively, NAME can be a system message in the format accepted by +`haiku-drag-message', which will replace the contents of CLIPBOARD. +In that case, the arguments after NAME are ignored. */) + (Lisp_Object clipboard, Lisp_Object name, Lisp_Object data, + Lisp_Object clear) +{ + enum haiku_clipboard clipboard_name; + specpdl_ref ref; + char *dat; + ptrdiff_t len; + int rc; + void *message; + + if (CONSP (name) || NILP (name)) + { + if (EQ (clipboard, QPRIMARY)) + clipboard_name = CLIPBOARD_PRIMARY; + else if (EQ (clipboard, QSECONDARY)) + clipboard_name = CLIPBOARD_SECONDARY; + else if (EQ (clipboard, QCLIPBOARD)) + clipboard_name = CLIPBOARD_CLIPBOARD; + else + signal_error ("Invalid clipboard", clipboard); + + rc = be_lock_clipboard_message (clipboard_name, + &message, true); + + if (rc) + signal_error ("Couldn't open clipboard", clipboard); + + ref = SPECPDL_INDEX (); + record_unwind_protect_int (haiku_unwind_clipboard_lock, + clipboard_name); + haiku_lisp_to_message (name, message); + + return unbind_to (ref, Qnil); + } + + CHECK_SYMBOL (clipboard); + CHECK_STRING (name); + if (!NILP (data)) + CHECK_STRING (data); + + dat = !NILP (data) ? SSDATA (data) : NULL; + len = !NILP (data) ? SBYTES (data) : 0; + + if (EQ (clipboard, QPRIMARY)) + BClipboard_set_primary_selection_data (SSDATA (name), dat, len, + !NILP (clear)); + else if (EQ (clipboard, QSECONDARY)) + BClipboard_set_secondary_selection_data (SSDATA (name), dat, len, + !NILP (clear)); + else if (EQ (clipboard, QCLIPBOARD)) + BClipboard_set_system_data (SSDATA (name), dat, len, !NILP (clear)); + else + { + unblock_input (); + signal_error ("Bad clipboard", clipboard); + } + + return Qnil; +} + +DEFUN ("haiku-selection-owner-p", Fhaiku_selection_owner_p, Shaiku_selection_owner_p, + 0, 1, 0, + doc: /* Whether the current Emacs process owns the given SELECTION. +The arg should be the name of the selection in question, typically one +of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. For +convenience, the symbol nil is the same as `PRIMARY', and t is the +same as `SECONDARY'. */) + (Lisp_Object selection) +{ + bool value; + + if (NILP (selection)) + selection = QPRIMARY; + else if (EQ (selection, Qt)) + selection = QSECONDARY; + + block_input (); + if (EQ (selection, QPRIMARY)) + value = BClipboard_owns_primary (); + else if (EQ (selection, QSECONDARY)) + value = BClipboard_owns_secondary (); + else if (EQ (selection, QCLIPBOARD)) + value = BClipboard_owns_clipboard (); + else + value = false; + unblock_input (); + + return value ? Qt : Qnil; +} + +/* Return the Lisp representation of MESSAGE. See Fhaiku_drag_message + for the format of the object returned. */ +Lisp_Object +haiku_message_to_lisp (void *message) +{ + Lisp_Object list = Qnil, tem, t1, t2; + const char *name; + char *pbuf; + const void *buf; + ssize_t buf_size; + int32 i, j, count, type_code; + int rc; + void *msg; + float point_x, point_y; + + for (i = 0; !be_enum_message (message, &type_code, i, + &count, &name); ++i) + { + tem = Qnil; + + for (j = 0; j < count; ++j) + { + rc = be_get_message_data (message, name, + type_code, j, + &buf, &buf_size); + if (rc) + emacs_abort (); + + switch (type_code) + { + case 'MSGG': + msg = be_get_message_message (message, name, j); + if (!msg) + memory_full (SIZE_MAX); + t1 = haiku_message_to_lisp (msg); + BMessage_delete (msg); + + break; + + case 'BOOL': + t1 = (*(bool *) buf) ? Qt : Qnil; + break; + + case 'RREF': + rc = be_get_refs_data (message, name, + j, &pbuf); + + if (rc) + { + t1 = Qnil; + break; + } + + if (!pbuf) + memory_full (SIZE_MAX); + + t1 = build_string (pbuf); + + free (pbuf); + break; + + case 'BPNT': + rc = be_get_point_data (message, name, + j, &point_x, + &point_y); + + if (rc) + { + t1 = Qnil; + break; + } + + t1 = Fcons (make_float (point_x), + make_float (point_y)); + break; + + case 'SHRT': + t1 = make_fixnum (*(int16 *) buf); + break; + + case 'LONG': + t1 = make_int (*(int32 *) buf); + break; + + case 'LLNG': + t1 = make_int ((intmax_t) *(int64 *) buf); + break; + + case 'BYTE': + case 'CHAR': + t1 = make_fixnum (*(int8 *) buf); + break; + + case 'SIZT': + t1 = make_uint ((uintmax_t) *(size_t *) buf); + break; + + case 'SSZT': + t1 = make_int ((intmax_t) *(ssize_t *) buf); + break; + + default: + t1 = make_uninit_string (buf_size); + memcpy (SDATA (t1), buf, buf_size); + } + + tem = Fcons (t1, tem); + } + + switch (type_code) + { + case 'CSTR': + t2 = Qstring; + break; + + case 'SHRT': + t2 = Qshort; + break; + + case 'LONG': + t2 = Qlong; + break; + + case 'LLNG': + t2 = Qllong; + break; + + case 'BYTE': + t2 = Qbyte; + break; + + case 'RREF': + t2 = Qref; + break; + + case 'CHAR': + t2 = Qchar; + break; + + case 'BOOL': + t2 = Qbool; + break; + + case 'MSGG': + t2 = Qmessage; + break; + + case 'SIZT': + t2 = Qsize_t; + break; + + case 'SSZT': + t2 = Qssize_t; + break; + + case 'BPNT': + t2 = Qpoint; + break; + + default: + t2 = make_int (type_code); + } + + tem = Fcons (t2, tem); + list = Fcons (Fcons (build_string_from_utf8 (name), tem), list); + } + + tem = Fcons (Qtype, make_uint (be_get_message_type (message))); + return Fcons (tem, list); +} + +static int32 +lisp_to_type_code (Lisp_Object obj) +{ + if (BIGNUMP (obj)) + return (int32) bignum_to_intmax (obj); + + if (FIXNUMP (obj)) + return XFIXNUM (obj); + + if (EQ (obj, Qstring)) + return 'CSTR'; + else if (EQ (obj, Qshort)) + return 'SHRT'; + else if (EQ (obj, Qlong)) + return 'LONG'; + else if (EQ (obj, Qllong)) + return 'LLNG'; + else if (EQ (obj, Qbyte)) + return 'BYTE'; + else if (EQ (obj, Qref)) + return 'RREF'; + else if (EQ (obj, Qchar)) + return 'CHAR'; + else if (EQ (obj, Qbool)) + return 'BOOL'; + else if (EQ (obj, Qmessage)) + return 'MSGG'; + else if (EQ (obj, Qsize_t)) + return 'SIZT'; + else if (EQ (obj, Qssize_t)) + return 'SSZT'; + else if (EQ (obj, Qpoint)) + return 'BPNT'; + else + return -1; +} + +static void +haiku_lisp_to_message (Lisp_Object obj, void *message) +{ + Lisp_Object tem, t1, name, type_sym, t2, data; + int32 type_code, long_data; + int16 short_data; + int64 llong_data; + int8 char_data; + bool bool_data; + void *msg_data; + size_t sizet_data; + ssize_t ssizet_data; + intmax_t t4; + uintmax_t t5; + float t6, t7; + int rc; + specpdl_ref ref; + + CHECK_LIST (obj); + for (tem = obj; CONSP (tem); tem = XCDR (tem)) + { + maybe_quit (); + t1 = XCAR (tem); + CHECK_CONS (t1); + + name = XCAR (t1); + + if (EQ (name, Qtype)) + { + t2 = XCDR (t1); + + if (BIGNUMP (t2)) + { + t5 = bignum_to_uintmax (t2); + + if (!t5 || t5 > TYPE_MAXIMUM (uint32)) + signal_error ("Value too large", t2); + + block_input (); + be_set_message_type (message, t5); + unblock_input (); + } + else + { + if (!TYPE_RANGED_FIXNUMP (uint32, t2)) + signal_error ("Invalid data type", t2); + + block_input (); + be_set_message_type (message, XFIXNAT (t2)); + unblock_input (); + } + + continue; + } + + CHECK_STRING (name); + + t1 = XCDR (t1); + CHECK_CONS (t1); + + type_sym = XCAR (t1); + type_code = lisp_to_type_code (type_sym); + + if (type_code == -1) + signal_error ("Unknown data type", type_sym); + + CHECK_LIST (t1); + for (t2 = XCDR (t1); CONSP (t2); t2 = XCDR (t2)) + { + maybe_quit (); + data = XCAR (t2); + + if (FIXNUMP (type_sym) || BIGNUMP (type_sym)) + goto decode_normally; + + switch (type_code) + { + case 'MSGG': + ref = SPECPDL_INDEX (); + + block_input (); + msg_data = be_create_simple_message (); + unblock_input (); + + record_unwind_protect_ptr (BMessage_delete, msg_data); + haiku_lisp_to_message (data, msg_data); + + block_input (); + rc = be_add_message_message (message, SSDATA (name), msg_data); + unblock_input (); + + if (rc) + signal_error ("Invalid message", msg_data); + unbind_to (ref, Qnil); + break; + + case 'RREF': + CHECK_STRING (data); + + if (be_add_refs_data (message, SSDATA (name), SSDATA (data)) + && haiku_signal_invalid_refs) + signal_error ("Invalid file name", data); + break; + + case 'BPNT': + CHECK_CONS (data); + CHECK_NUMBER (XCAR (data)); + CHECK_NUMBER (XCDR (data)); + + t6 = XFLOATINT (XCAR (data)); + t7 = XFLOATINT (XCDR (data)); + + if (be_add_point_data (message, SSDATA (name), + t6, t7)) + signal_error ("Invalid point", data); + break; + + case 'SHRT': + if (!TYPE_RANGED_FIXNUMP (int16, data)) + signal_error ("Invalid value", data); + short_data = XFIXNUM (data); + + block_input (); + rc = be_add_message_data (message, SSDATA (name), + type_code, &short_data, + sizeof short_data); + unblock_input (); + + if (rc) + signal_error ("Failed to add short", data); + break; + + case 'LONG': + if (BIGNUMP (data)) + { + t4 = bignum_to_intmax (data); + + /* We know that int32 is signed. */ + if (!t4 || t4 > TYPE_MINIMUM (int32) + || t4 < TYPE_MAXIMUM (int32)) + signal_error ("Value too large", data); + + long_data = (int32) t4; + } + else + { + if (!TYPE_RANGED_FIXNUMP (int32, data)) + signal_error ("Invalid value", data); + + long_data = (int32) XFIXNUM (data); + } + + block_input (); + rc = be_add_message_data (message, SSDATA (name), + type_code, &long_data, + sizeof long_data); + unblock_input (); + + if (rc) + signal_error ("Failed to add long", data); + break; + + case 'LLNG': + if (BIGNUMP (data)) + { + t4 = bignum_to_intmax (data); + + if (!t4 || t4 > TYPE_MINIMUM (int64) + || t4 < TYPE_MAXIMUM (int64)) + signal_error ("Value too large", data); + + llong_data = (int64) t4; + } + else + { + if (!TYPE_RANGED_FIXNUMP (int64, data)) + signal_error ("Invalid value", data); + + llong_data = (int64) XFIXNUM (data); + } + + block_input (); + rc = be_add_message_data (message, SSDATA (name), + type_code, &llong_data, + sizeof llong_data); + unblock_input (); + + if (rc) + signal_error ("Failed to add llong", data); + break; + + case 'SIZT': + if (BIGNUMP (data)) + { + t4 = bignum_to_intmax (data); + + if (!t4 || t4 > TYPE_MAXIMUM (size_t)) + signal_error ("Value too large", data); + + sizet_data = (size_t) t4; + } + else + { + if (!TYPE_RANGED_FIXNUMP (size_t, data)) + signal_error ("Invalid value", data); + + sizet_data = (int64) XFIXNUM (data); + } + + block_input (); + rc = be_add_message_data (message, SSDATA (name), + type_code, &sizet_data, + sizeof sizet_data); + unblock_input (); + + if (rc) + signal_error ("Failed to add sizet", data); + break; + + case 'SSZT': + if (BIGNUMP (data)) + { + t4 = bignum_to_intmax (data); + + if (!t4 || t4 > TYPE_MINIMUM (ssize_t) + || t4 < TYPE_MAXIMUM (ssize_t)) + signal_error ("Value too large", data); + + ssizet_data = (ssize_t) t4; + } + else + { + if (!TYPE_RANGED_FIXNUMP (ssize_t, data)) + signal_error ("Invalid value", data); + + ssizet_data = (int64) XFIXNUM (data); + } + + block_input (); + rc = be_add_message_data (message, SSDATA (name), + type_code, &ssizet_data, + sizeof ssizet_data); + unblock_input (); + + if (rc) + signal_error ("Failed to add ssizet", data); + break; + + case 'CHAR': + case 'BYTE': + if (!TYPE_RANGED_FIXNUMP (int8, data)) + signal_error ("Invalid value", data); + char_data = XFIXNUM (data); + + block_input (); + rc = be_add_message_data (message, SSDATA (name), + type_code, &char_data, + sizeof char_data); + unblock_input (); + + if (rc) + signal_error ("Failed to add char", data); + break; + + case 'BOOL': + bool_data = !NILP (data); + + block_input (); + rc = be_add_message_data (message, SSDATA (name), + type_code, &bool_data, + sizeof bool_data); + unblock_input (); + + if (rc) + signal_error ("Failed to add bool", data); + break; + + default: + decode_normally: + CHECK_STRING (data); + + block_input (); + rc = be_add_message_data (message, SSDATA (name), + type_code, SDATA (data), + SBYTES (data)); + unblock_input (); + + if (rc) + signal_error ("Failed to add", data); + } + } + CHECK_LIST_END (t2, t1); + } + CHECK_LIST_END (tem, obj); +} + +static bool +haiku_should_quit_drag (void) +{ + return !NILP (Vquit_flag); +} + +static void +haiku_unwind_drag_message (void *message) +{ + haiku_dnd_frame = NULL; + BMessage_delete (message); +} + +DEFUN ("haiku-drag-message", Fhaiku_drag_message, Shaiku_drag_message, + 2, 3, 0, + doc: /* Begin dragging MESSAGE from FRAME. + +MESSAGE an alist of strings, denoting message field names, to a list +the form (TYPE DATA ...), where TYPE is an integer denoting the system +data type of DATA, and DATA is in the general case a unibyte string. + +If TYPE is a symbol instead of an integer, then DATA was specially +decoded. If TYPE is `ref', then DATA is the absolute file name of a +file, or nil if decoding the file name failed. If TYPE is `string', +then DATA is a unibyte string. If TYPE is `short', then DATA is a +16-bit signed integer. If TYPE is `long', then DATA is a 32-bit +signed integer. If TYPE is `llong', then DATA is a 64-bit signed +integer. If TYPE is `byte' or `char', then DATA is an 8-bit signed +integer. If TYPE is `bool', then DATA is a boolean. If TYPE is +`size_t', then DATA is an integer that can hold between 0 and the +maximum value returned by the `sizeof' C operator on the current +system. If TYPE is `ssize_t', then DATA is an integer that can hold +values from -1 to the maximum value of the C data type `ssize_t' on +the current system. If TYPE is `point', then DATA is a cons of float +values describing the X and Y coordinates of an on-screen location. + +If the field name is not a string but the symbol `type', then it +associates to a 32-bit unsigned integer describing the type of the +system message. + +FRAME is a window system frame that must be visible, from which the +drag will originate. + +ALLOW-SAME-FRAME, if nil or not specified, means that MESSAGE will be +ignored if it is dropped on top of FRAME. */) + (Lisp_Object frame, Lisp_Object message, Lisp_Object allow_same_frame) +{ + specpdl_ref idx; + void *be_message; + struct frame *f; + bool rc; + + idx = SPECPDL_INDEX (); + f = decode_window_system_frame (frame); + + if (!FRAME_VISIBLE_P (f)) + error ("Frame is invisible"); + + haiku_dnd_frame = f; + be_message = be_create_simple_message (); + + record_unwind_protect_ptr (haiku_unwind_drag_message, be_message); + haiku_lisp_to_message (message, be_message); + rc = be_drag_message (FRAME_HAIKU_VIEW (f), be_message, + !NILP (allow_same_frame), + block_input, unblock_input, + process_pending_signals, + haiku_should_quit_drag); + FRAME_DISPLAY_INFO (f)->grabbed = 0; + + if (rc) + quit (); + + return unbind_to (idx, Qnil); +} + +static Lisp_Object +haiku_note_drag_motion_1 (void *data) +{ + if (!NILP (Vhaiku_drag_track_function)) + return call0 (Vhaiku_drag_track_function); + + return Qnil; +} + +static Lisp_Object +haiku_note_drag_motion_2 (enum nonlocal_exit exit, Lisp_Object error) +{ + return Qnil; +} + +void +haiku_note_drag_motion (void) +{ + internal_catch_all (haiku_note_drag_motion_1, NULL, + haiku_note_drag_motion_2); +} + +void +syms_of_haikuselect (void) +{ + DEFVAR_BOOL ("haiku-signal-invalid-refs", haiku_signal_invalid_refs, + doc: /* If nil, silently ignore invalid file names in system messages. +Otherwise, an error will be signalled if adding a file reference to a +system message failed. */); + haiku_signal_invalid_refs = true; + + DEFVAR_LISP ("haiku-drag-track-function", Vhaiku_drag_track_function, + doc: /* If non-nil, a function to call upon mouse movement while dragging a message. +The function is called without any arguments. `mouse-position' can be +used to retrieve the current position of the mouse. */); + Vhaiku_drag_track_function = Qnil; + + DEFSYM (QSECONDARY, "SECONDARY"); + DEFSYM (QCLIPBOARD, "CLIPBOARD"); + DEFSYM (QSTRING, "STRING"); + DEFSYM (QUTF8_STRING, "UTF8_STRING"); + DEFSYM (Qforeign_selection, "foreign-selection"); + DEFSYM (QTARGETS, "TARGETS"); + DEFSYM (Qmessage, "message"); + DEFSYM (Qstring, "string"); + DEFSYM (Qref, "ref"); + DEFSYM (Qshort, "short"); + DEFSYM (Qlong, "long"); + DEFSYM (Qllong, "llong"); + DEFSYM (Qbyte, "byte"); + DEFSYM (Qchar, "char"); + DEFSYM (Qbool, "bool"); + DEFSYM (Qtype, "type"); + DEFSYM (Qsize_t, "size_t"); + DEFSYM (Qssize_t, "ssize_t"); + DEFSYM (Qpoint, "point"); + + defsubr (&Shaiku_selection_data); + defsubr (&Shaiku_selection_put); + defsubr (&Shaiku_selection_owner_p); + defsubr (&Shaiku_drag_message); + + haiku_dnd_frame = NULL; +} diff --git a/src/haikuselect.h b/src/haikuselect.h new file mode 100644 index 00000000000..a99721dd221 --- /dev/null +++ b/src/haikuselect.h @@ -0,0 +1,88 @@ +/* Haiku window system selection support. Hey Emacs, this is -*- C++ -*- + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#ifndef _HAIKU_SELECT_H_ +#define _HAIKU_SELECT_H_ + +#ifdef __cplusplus +#include <cstdio> +#endif + +#include <SupportDefs.h> + +enum haiku_clipboard + { + CLIPBOARD_PRIMARY, + CLIPBOARD_SECONDARY, + CLIPBOARD_CLIPBOARD + }; + +#ifdef __cplusplus +#include <stdio.h> +extern "C" +{ +extern void init_haiku_select (void); +#endif +/* Whether or not the selection was recently changed. */ +extern int selection_state_flag; + +/* Find a string with the MIME type TYPE in the system clipboard. */ +extern char *BClipboard_find_system_data (const char *, ssize_t *); +extern char *BClipboard_find_primary_selection_data (const char *, ssize_t *); +extern char *BClipboard_find_secondary_selection_data (const char *, ssize_t *); + +extern void BClipboard_set_system_data (const char *, const char *, ssize_t, bool); +extern void BClipboard_set_primary_selection_data (const char *, const char *, + ssize_t, bool); +extern void BClipboard_set_secondary_selection_data (const char *, const char *, + ssize_t, bool); + +extern void BClipboard_system_targets (char **, int); +extern void BClipboard_primary_targets (char **, int); +extern void BClipboard_secondary_targets (char **, int); + +extern bool BClipboard_owns_clipboard (void); +extern bool BClipboard_owns_primary (void); +extern bool BClipboard_owns_secondary (void); + +/* Free the returned data. */ +extern void BClipboard_free_data (void *); + +extern int be_enum_message (void *, int32 *, int32, int32 *, const char **); +extern int be_get_message_data (void *, const char *, int32, int32, + const void **, ssize_t *); +extern int be_get_refs_data (void *, const char *, int32, char **); +extern int be_get_point_data (void *, const char *, int32, float *, float *); +extern uint32 be_get_message_type (void *); +extern void be_set_message_type (void *, uint32); +extern void *be_get_message_message (void *, const char *, int32); +extern void *be_create_simple_message (void); +extern int be_add_message_data (void *, const char *, int32, const void *, ssize_t); +extern int be_add_refs_data (void *, const char *, const char *); +extern int be_add_point_data (void *, const char *, float, float); +extern int be_add_message_message (void *, const char *, void *); +extern int be_lock_clipboard_message (enum haiku_clipboard, void **, bool); +extern void be_unlock_clipboard (enum haiku_clipboard, bool); +#ifdef __cplusplus +}; +#endif +#endif /* _HAIKU_SELECT_H_ */ + +// Local Variables: +// eval: (setf (alist-get 'inextern-lang c-offsets-alist) 0) +// End: diff --git a/src/haikuterm.c b/src/haikuterm.c new file mode 100644 index 00000000000..559ec58926c --- /dev/null +++ b/src/haikuterm.c @@ -0,0 +1,4200 @@ +/* Haiku window system support + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include "dispextern.h" +#include "frame.h" +#include "lisp.h" +#include "haikugui.h" +#include "keyboard.h" +#include "haikuterm.h" +#include "blockinput.h" +#include "termchar.h" +#include "termhooks.h" +#include "menu.h" +#include "buffer.h" +#include "haiku_support.h" +#include "thread.h" +#include "window.h" + +#include <math.h> +#include <stdlib.h> + +#ifdef USE_BE_CAIRO +#include <cairo.h> +#endif + +/* Minimum and maximum values used for Haiku scroll bars. */ +#define BE_SB_MAX 12000000 + +struct haiku_display_info *x_display_list = NULL; +extern frame_parm_handler haiku_frame_parm_handlers[]; + +static void **fringe_bmps; +static int max_fringe_bmp = 0; + +static Lisp_Object rdb; + +struct unhandled_event +{ + struct unhandled_event *next; + enum haiku_event_type type; + uint8_t buffer[200]; +}; + +static bool any_help_event_p; + +char * +get_keysym_name (int keysym) +{ + static char value[16]; + sprintf (value, "%d", keysym); + return value; +} + +static struct frame * +haiku_window_to_frame (void *window) +{ + Lisp_Object tail, tem; + struct frame *f; + + FOR_EACH_FRAME (tail, tem) + { + f = XFRAME (tem); + if (!FRAME_HAIKU_P (f)) + continue; + + eassert (FRAME_DISPLAY_INFO (f) == x_display_list); + + if (FRAME_HAIKU_WINDOW (f) == window) + return f; + } + + return 0; +} + +static void +haiku_coords_from_parent (struct frame *f, int *x, int *y) +{ + struct frame *p = FRAME_PARENT_FRAME (f); + eassert (p); + + for (struct frame *parent = p; parent; + parent = FRAME_PARENT_FRAME (parent)) + { + *x -= parent->left_pos; + *y -= parent->top_pos; + } +} + +static void +haiku_toolkit_position (struct frame *f, int x, int y, + bool *menu_bar_p, bool *tool_bar_p) +{ + if (FRAME_OUTPUT_DATA (f)->menubar) + *menu_bar_p = (x >= 0 && x < FRAME_PIXEL_WIDTH (f) + && y >= 0 && y < FRAME_MENU_BAR_HEIGHT (f)); +} + +static void +haiku_delete_terminal (struct terminal *terminal) +{ + error ("The Haiku terminal cannot be deleted"); +} + +static const char * +get_string_resource (void *ignored, const char *name, const char *class) +{ + const char *native; + + if (!name) + return NULL; + + Lisp_Object lval = assoc_no_quit (build_string (name), rdb); + + if (!NILP (lval)) + return SSDATA (XCDR (lval)); + + if ((native = be_find_setting (name))) + return native; + + return NULL; +} + +static void +haiku_update_size_hints (struct frame *f) +{ + int base_width, base_height; + eassert (FRAME_HAIKU_P (f) && FRAME_HAIKU_WINDOW (f)); + + if (f->tooltip) + return; + + base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0); + base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0); + + block_input (); + BWindow_set_size_alignment (FRAME_HAIKU_WINDOW (f), + frame_resize_pixelwise ? 1 : FRAME_COLUMN_WIDTH (f), + frame_resize_pixelwise ? 1 : FRAME_LINE_HEIGHT (f)); + BWindow_set_min_size (FRAME_HAIKU_WINDOW (f), base_width, + base_height + + FRAME_TOOL_BAR_HEIGHT (f) + + FRAME_MENU_BAR_HEIGHT (f)); + unblock_input (); +} + +static void +haiku_clip_to_string (struct glyph_string *s) +{ + struct haiku_rect r[2]; + int n = get_glyph_string_clip_rects (s, (struct haiku_rect *) &r, 2); + + if (n) + { + /* If n[FOO].width is 0, it means to not draw at all, so set the + clipping to some impossible value. */ + if (r[0].width <= 0) + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), + FRAME_PIXEL_WIDTH (s->f), + FRAME_PIXEL_HEIGHT (s->f), + 10, 10); + else + { + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[0].x, + r[0].y, r[0].width, r[0].height); + BView_invalidate_region (FRAME_HAIKU_VIEW (s->f), r[0].x, + r[0].y, r[0].width, r[0].height); + } + } + + if (n > 1) + { + /* If n[FOO].width is 0, it means to not draw at all, so set the + clipping to some impossible value. */ + if (r[1].width <= 0) + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), + FRAME_PIXEL_WIDTH (s->f), + FRAME_PIXEL_HEIGHT (s->f), + 10, 10); + else + { + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[1].x, r[1].y, + r[1].width, r[1].height); + BView_invalidate_region (FRAME_HAIKU_VIEW (s->f), r[1].x, + r[1].y, r[1].width, r[1].height); + } + } +} + +static void +haiku_clip_to_string_exactly (struct glyph_string *s, struct glyph_string *dst) +{ + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), s->x, s->y, + s->width, s->height); +} + +static void +haiku_flip_buffers (struct frame *f) +{ + void *view = FRAME_OUTPUT_DATA (f)->view; + block_input (); + + BView_draw_lock (view, false, 0, 0, 0, 0); + FRAME_DIRTY_P (f) = 0; + EmacsView_flip_and_blit (view); + BView_draw_unlock (view); + + unblock_input (); +} + +static void +haiku_frame_up_to_date (struct frame *f) +{ + block_input (); + FRAME_MOUSE_UPDATE (f); + if (FRAME_DIRTY_P (f) && !buffer_flipping_blocked_p ()) + haiku_flip_buffers (f); + unblock_input (); +} + +static void +haiku_buffer_flipping_unblocked_hook (struct frame *f) +{ + if (FRAME_DIRTY_P (f)) + haiku_flip_buffers (f); +} + +static void +haiku_clear_frame_area (struct frame *f, int x, int y, + int width, int height) +{ + void *vw = FRAME_HAIKU_VIEW (f); + block_input (); + BView_draw_lock (vw, true, x, y, width, height); + BView_StartClip (vw); + BView_ClipToRect (vw, x, y, width, height); + BView_SetHighColor (vw, FRAME_BACKGROUND_PIXEL (f)); + BView_FillRectangle (vw, x, y, width, height); + BView_EndClip (vw); + BView_draw_unlock (vw); + unblock_input (); +} + +static void +haiku_clear_frame (struct frame *f) +{ + void *view = FRAME_HAIKU_VIEW (f); + + mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f))); + + block_input (); + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + BView_StartClip (view); + BView_ClipToRect (view, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + BView_SetHighColor (view, FRAME_BACKGROUND_PIXEL (f)); + BView_FillRectangle (view, 0, 0, FRAME_PIXEL_WIDTH (f) , + FRAME_PIXEL_HEIGHT (f)); + BView_EndClip (view); + BView_draw_unlock (view); + unblock_input (); +} + +/* Give frame F the font FONT-OBJECT as its default font. The return + value is FONT-OBJECT. FONTSET is an ID of the fontset for the + frame. If it is negative, generate a new fontset from + FONT-OBJECT. */ + +static Lisp_Object +haiku_new_font (struct frame *f, Lisp_Object font_object, int fontset) +{ + struct font *font = XFONT_OBJECT (font_object); + if (fontset < 0) + fontset = fontset_from_font (font_object); + + FRAME_FONTSET (f) = fontset; + if (FRAME_FONT (f) == font) + return font_object; + + FRAME_FONT (f) = font; + FRAME_BASELINE_OFFSET (f) = font->baseline_offset; + FRAME_COLUMN_WIDTH (f) = font->average_width; + + int ascent, descent; + get_font_ascent_descent (font, &ascent, &descent); + FRAME_LINE_HEIGHT (f) = ascent + descent; + FRAME_TAB_BAR_HEIGHT (f) = FRAME_TAB_BAR_LINES (f) * FRAME_LINE_HEIGHT (f); + + int unit = FRAME_COLUMN_WIDTH (f); + if (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0) + FRAME_CONFIG_SCROLL_BAR_COLS (f) + = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + unit - 1) / unit; + else + FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + unit - 1) / unit; + + if (FRAME_HAIKU_WINDOW (f) && !FRAME_TOOLTIP_P (f)) + { + adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), + FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), + 3, false, Qfont); + + haiku_clear_under_internal_border (f); + } + return font_object; +} + +static int +haiku_valid_modifier_p (Lisp_Object sym) +{ + return EQ (sym, Qcommand) || EQ (sym, Qshift) + || EQ (sym, Qcontrol) || EQ (sym, Qoption); +} + +#define MODIFIER_OR(obj, def) (haiku_valid_modifier_p (obj) ? obj : def) + +static void +haiku_add_modifier (int modifier, int toput, Lisp_Object qtem, int *modifiers) +{ + if ((modifier & HAIKU_MODIFIER_ALT && EQ (qtem, Qcommand)) + || (modifier & HAIKU_MODIFIER_SHIFT && EQ (qtem, Qshift)) + || (modifier & HAIKU_MODIFIER_CTRL && EQ (qtem, Qcontrol)) + || (modifier & HAIKU_MODIFIER_SUPER && EQ (qtem, Qoption))) + *modifiers |= toput; +} + +static int +haiku_modifiers_to_emacs (int haiku_key) +{ + int modifiers = 0; + haiku_add_modifier (haiku_key, shift_modifier, + MODIFIER_OR (Vhaiku_shift_keysym, Qshift), &modifiers); + haiku_add_modifier (haiku_key, super_modifier, + MODIFIER_OR (Vhaiku_super_keysym, Qoption), &modifiers); + haiku_add_modifier (haiku_key, meta_modifier, + MODIFIER_OR (Vhaiku_meta_keysym, Qcommand), &modifiers); + haiku_add_modifier (haiku_key, ctrl_modifier, + MODIFIER_OR (Vhaiku_control_keysym, Qcontrol), &modifiers); + return modifiers; +} + +#undef MODIFIER_OR + +static void +haiku_rehighlight (void) +{ + eassert (x_display_list && !x_display_list->next); + + block_input (); + + struct frame *old_hl = x_display_list->highlight_frame; + + if (x_display_list->focused_frame) + { + x_display_list->highlight_frame + = ((FRAMEP (FRAME_FOCUS_FRAME (x_display_list->focused_frame))) + ? XFRAME (FRAME_FOCUS_FRAME (x_display_list->focused_frame)) + : x_display_list->focused_frame); + if (!FRAME_LIVE_P (x_display_list->highlight_frame)) + { + fset_focus_frame (x_display_list->focused_frame, Qnil); + x_display_list->highlight_frame = x_display_list->focused_frame; + } + } + else + x_display_list->highlight_frame = 0; + + if (old_hl) + gui_update_cursor (old_hl, true); + + if (x_display_list->highlight_frame) + gui_update_cursor (x_display_list->highlight_frame, true); + unblock_input (); +} + +static void +haiku_frame_raise_lower (struct frame *f, bool raise_p) +{ + if (raise_p) + { + block_input (); + BWindow_activate (FRAME_HAIKU_WINDOW (f)); + BWindow_sync (FRAME_HAIKU_WINDOW (f)); + unblock_input (); + } + else + { + block_input (); + BWindow_send_behind (FRAME_HAIKU_WINDOW (f), NULL); + BWindow_sync (FRAME_HAIKU_WINDOW (f)); + unblock_input (); + } +} + +static struct frame * +haiku_mouse_or_wdesc_frame (void *window, bool accept_tooltip) +{ + struct frame *lm_f = (gui_mouse_grabbed (x_display_list) + ? x_display_list->last_mouse_frame + : NULL); + + if (lm_f && !EQ (track_mouse, Qdropping) + && !EQ (track_mouse, Qdrag_source)) + return lm_f; + else + { + struct frame *w_f = haiku_window_to_frame (window); + + /* Do not return a tooltip frame. */ + if (!w_f || (FRAME_TOOLTIP_P (w_f) && !accept_tooltip)) + return EQ (track_mouse, Qdropping) ? lm_f : NULL; + else + /* When dropping it would be probably nice to raise w_f + here. */ + return w_f; + } +} + +/* Set the thumb size and position of scroll bar BAR. We are + currently displaying PORTION out of a whole WHOLE, and our position + POSITION. */ + +static void +haiku_set_scroll_bar_thumb (struct scroll_bar *bar, int portion, + int position, int whole) +{ + void *scroll_bar = bar->scroll_bar; + double top, shown, size, value; + + if (scroll_bar_adjust_thumb_portion_p) + { + /* We use an estimate of 30 chars per line rather than the real + `portion' value. This has the disadvantage that the thumb + size is not very representative, but it makes our life a lot + easier. Otherwise, we have to constantly adjust the thumb + size, which we can't always do quickly enough: while + dragging, the size of the thumb might prevent the user from + dragging the thumb all the way to the end. */ + portion = WINDOW_TOTAL_LINES (XWINDOW (bar->window)) * 30; + /* When the thumb is at the bottom, position == whole. So we + need to increase `whole' to make space for the thumb. */ + whole += portion; + } + else + bar->page_size = 0; + + if (whole <= 0) + top = 0, shown = 1; + else + { + top = (double) position / whole; + shown = (double) portion / whole; + } + + /* Slider size. Must be in the range [1 .. MAX - MIN] where MAX + is the scroll bar's maximum and MIN is the scroll bar's minimum + value. */ + size = clip_to_bounds (1, shown * BE_SB_MAX, BE_SB_MAX); + + /* Position. Must be in the range [MIN .. MAX - SLIDER_SIZE]. */ + value = top * BE_SB_MAX; + value = min (value, BE_SB_MAX - size); + + if (!bar->dragging && scroll_bar_adjust_thumb_portion_p) + bar->page_size = size; + + BView_scroll_bar_update (scroll_bar, lrint (size), + BE_SB_MAX, ceil (value), + (scroll_bar_adjust_thumb_portion_p + ? bar->dragging : bar->dragging ? -1 : 0), + !scroll_bar_adjust_thumb_portion_p); +} + +static void +haiku_set_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, + int position, int whole) +{ + void *scroll_bar = bar->scroll_bar; + double size, value, shown, top; + + shown = (double) portion / whole; + top = (double) position / whole; + + size = shown * BE_SB_MAX; + value = top * BE_SB_MAX; + + if (!bar->dragging) + bar->page_size = size; + + BView_scroll_bar_update (scroll_bar, lrint (size), BE_SB_MAX, + ceil (value), bar->dragging ? -1 : 0, true); +} + +static struct scroll_bar * +haiku_scroll_bar_from_widget (void *scroll_bar, void *window) +{ + Lisp_Object tem; + struct frame *frame = haiku_window_to_frame (window); + + if (!frame) + return NULL; + + if (!NILP (FRAME_SCROLL_BARS (frame))) + { + for (tem = FRAME_SCROLL_BARS (frame); !NILP (tem); + tem = XSCROLL_BAR (tem)->next) + { + if (XSCROLL_BAR (tem)->scroll_bar == scroll_bar) + return XSCROLL_BAR (tem); + } + } + + return NULL; +} + +/* Unfortunately, NOACTIVATE is not implementable on Haiku. */ +static void +haiku_focus_frame (struct frame *frame, bool noactivate) +{ + if (x_display_list->focused_frame != frame) + haiku_frame_raise_lower (frame, 1); +} + +static void +haiku_new_focus_frame (struct frame *frame) +{ + eassert (x_display_list && !x_display_list->next); + + block_input (); + if (frame != x_display_list->focused_frame) + { + if (x_display_list->focused_frame && + x_display_list->focused_frame->auto_lower) + haiku_frame_raise_lower (x_display_list->focused_frame, 0); + + x_display_list->focused_frame = frame; + + if (frame && frame->auto_raise && !popup_activated_p) + haiku_frame_raise_lower (frame, 1); + } + unblock_input (); + + haiku_rehighlight (); +} + +static void +haiku_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + haiku_set_name (f, arg, 0); +} + +static void +haiku_query_frame_background_color (struct frame *f, Emacs_Color *bgcolor) +{ + haiku_query_color (FRAME_BACKGROUND_PIXEL (f), bgcolor); +} + +static bool +haiku_defined_color (struct frame *f, + const char *name, + Emacs_Color *color, + bool alloc, + bool make_index) +{ + return !haiku_get_color (name, color); +} + +/* Adapted from xterm `x_draw_box_rect'. */ +static void +haiku_draw_box_rect (struct glyph_string *s, + int left_x, int top_y, int right_x, int bottom_y, int hwidth, + int vwidth, bool left_p, bool right_p, struct haiku_rect *clip_rect) +{ + void *view = FRAME_HAIKU_VIEW (s->f); + struct face *face = s->face; + + BView_SetHighColor (view, face->box_color); + if (clip_rect) + BView_ClipToRect (view, clip_rect->x, clip_rect->y, clip_rect->width, + clip_rect->height); + BView_FillRectangle (view, left_x, top_y, right_x - left_x + 1, hwidth); + if (left_p) + BView_FillRectangle (view, left_x, top_y, vwidth, bottom_y - top_y + 1); + + BView_FillRectangle (view, left_x, bottom_y - hwidth + 1, + right_x - left_x + 1, hwidth); + if (right_p) + BView_FillRectangle (view, right_x - vwidth + 1, + top_y, vwidth, bottom_y - top_y + 1); +} + +static void +haiku_calculate_relief_colors (struct glyph_string *s, uint32_t *rgbout_w, + uint32_t *rgbout_b) +{ + struct face *face = s->face; + + prepare_face_for_display (s->f, s->face); + + uint32_t rgbin = face->use_box_color_for_shadows_p + ? face->box_color : face->background; + + if (s->hl == DRAW_CURSOR) + rgbin = FRAME_CURSOR_COLOR (s->f).pixel; + + double h, cs, l; + rgb_color_hsl (rgbin, &h, &cs, &l); + + hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 0.6), rgbout_b); + hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.2), rgbout_w); +} + +static void +haiku_draw_relief_rect (struct glyph_string *s, + int left_x, int top_y, int right_x, int bottom_y, + int hwidth, int vwidth, bool raised_p, bool top_p, bool bot_p, + bool left_p, bool right_p, + struct haiku_rect *clip_rect, bool fancy_p) +{ + uint32_t color_white; + uint32_t color_black; + + haiku_calculate_relief_colors (s, &color_white, &color_black); + + void *view = FRAME_HAIKU_VIEW (s->f); + BView_SetHighColor (view, raised_p ? color_white : color_black); + if (clip_rect) + { + BView_StartClip (view); + haiku_clip_to_string (s); + BView_ClipToRect (view, clip_rect->x, clip_rect->y, clip_rect->width, + clip_rect->height); + } + if (top_p) + BView_FillRectangle (view, left_x, top_y, right_x - left_x + 1, hwidth); + if (left_p) + BView_FillRectangle (view, left_x, top_y, vwidth, bottom_y - top_y + 1); + BView_SetHighColor (view, !raised_p ? color_white : color_black); + + if (bot_p) + BView_FillRectangle (view, left_x, bottom_y - hwidth + 1, + right_x - left_x + 1, hwidth); + if (right_p) + BView_FillRectangle (view, right_x - vwidth + 1, top_y, + vwidth, bottom_y - top_y + 1); + + /* Draw the triangle for the bottom-left corner. */ + if (bot_p && left_p) + { + BView_SetHighColor (view, raised_p ? color_white : color_black); + BView_FillTriangle (view, left_x, bottom_y - hwidth, left_x + vwidth, + bottom_y - hwidth, left_x, bottom_y); + } + + /* Now draw the triangle for the top-right corner. */ + if (top_p && right_p) + { + BView_SetHighColor (view, raised_p ? color_white : color_black); + BView_FillTriangle (view, right_x - vwidth, top_y, + right_x, top_y, + right_x - vwidth, top_y + hwidth); + } + + /* If (h/v)width is > 1, we draw the outer-most line on each side in the + black relief color. */ + + BView_SetHighColor (view, color_black); + + if (hwidth > 1 && top_p) + BView_StrokeLine (view, left_x, top_y, right_x, top_y); + if (hwidth > 1 && bot_p) + BView_StrokeLine (view, left_x, bottom_y, right_x, bottom_y); + if (vwidth > 1 && left_p) + BView_StrokeLine (view, left_x, top_y, left_x, bottom_y); + if (vwidth > 1 && right_p) + BView_StrokeLine (view, right_x, top_y, right_x, bottom_y); + + BView_SetHighColor (view, s->face->background); + + /* Omit corner pixels. */ + if (hwidth > 1 || vwidth > 1) + { + if (left_p && top_p) + BView_FillRectangle (view, left_x, top_y, 1, 1); + if (left_p && bot_p) + BView_FillRectangle (view, left_x, bottom_y, 1, 1); + if (right_p && top_p) + BView_FillRectangle (view, right_x, top_y, 1, 1); + if (right_p && bot_p) + BView_FillRectangle (view, right_x, bottom_y, 1, 1); + } + + if (clip_rect) + BView_EndClip (view); +} + +static void +haiku_draw_underwave (struct glyph_string *s, int width, int x) +{ + int wave_height = 3, wave_length = 2; + int y, dx, dy, odd, xmax; + dx = wave_length; + dy = wave_height - 1; + y = s->ybase - wave_height + 3; + + float ax, ay, bx, by; + xmax = x + width; + + void *view = FRAME_HAIKU_VIEW (s->f); + + BView_StartClip (view); + haiku_clip_to_string (s); + BView_ClipToRect (view, x, y, width, wave_height); + ax = x - ((int) (x) % dx) + (float) 0.5; + bx = ax + dx; + odd = (int) (ax / dx) % 2; + ay = by = y + 0.5; + + if (odd) + ay += dy; + else + by += dy; + + while (ax <= xmax) + { + BView_StrokeLine (view, ax, ay, bx, by); + ax = bx, ay = by; + bx += dx, by = y + 0.5 + odd * dy; + odd = !odd; + } + BView_EndClip (view); +} + +static void +haiku_draw_text_decoration (struct glyph_string *s, struct face *face, + int width, int x) +{ + unsigned long cursor_color; + + if (s->for_overlaps) + return; + + if (s->hl == DRAW_CURSOR) + haiku_merge_cursor_foreground (s, &cursor_color, NULL); + + void *view = FRAME_HAIKU_VIEW (s->f); + + if (face->underline) + { + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, cursor_color); + else if (!face->underline_defaulted_p) + BView_SetHighColor (view, face->underline_color); + else + BView_SetHighColor (view, face->foreground); + + if (face->underline == FACE_UNDER_WAVE) + haiku_draw_underwave (s, width, x); + else if (face->underline == FACE_UNDER_LINE) + { + unsigned long thickness, position; + int y; + + if (s->prev + && s->prev->face->underline == FACE_UNDER_LINE + && (s->prev->face->underline_at_descent_line_p + == s->face->underline_at_descent_line_p) + && (s->prev->face->underline_pixels_above_descent_line + == s->face->underline_pixels_above_descent_line)) + { + /* We use the same underline style as the previous one. */ + thickness = s->prev->underline_thickness; + position = s->prev->underline_position; + } + else + { + struct font *font = font_for_underline_metrics (s); + unsigned long minimum_offset; + bool underline_at_descent_line; + bool use_underline_position_properties; + Lisp_Object val = (WINDOW_BUFFER_LOCAL_VALUE + (Qunderline_minimum_offset, s->w)); + + if (FIXNUMP (val)) + minimum_offset = max (0, XFIXNUM (val)); + else + minimum_offset = 1; + + val = (WINDOW_BUFFER_LOCAL_VALUE + (Qx_underline_at_descent_line, s->w)); + underline_at_descent_line + = (!(NILP (val) || EQ (val, Qunbound)) + || s->face->underline_at_descent_line_p); + + val = (WINDOW_BUFFER_LOCAL_VALUE + (Qx_use_underline_position_properties, s->w)); + use_underline_position_properties + = !(NILP (val) || EQ (val, Qunbound)); + + /* Get the underline thickness. Default is 1 pixel. */ + if (font && font->underline_thickness > 0) + thickness = font->underline_thickness; + else + thickness = 1; + if (underline_at_descent_line) + position = ((s->height - thickness) + - (s->ybase - s->y) + - s->face->underline_pixels_above_descent_line); + else + { + /* Get the underline position. This is the + recommended vertical offset in pixels from + the baseline to the top of the underline. + This is a signed value according to the + specs, and its default is + + ROUND ((maximum descent) / 2), with + ROUND(x) = floor (x + 0.5) */ + + if (use_underline_position_properties + && font && font->underline_position >= 0) + position = font->underline_position; + else if (font) + position = (font->descent + 1) / 2; + else + position = minimum_offset; + } + position = max (position, minimum_offset); + } + /* Check the sanity of thickness and position. We should + avoid drawing underline out of the current line area. */ + if (s->y + s->height <= s->ybase + position) + position = (s->height - 1) - (s->ybase - s->y); + if (s->y + s->height < s->ybase + position + thickness) + thickness = (s->y + s->height) - (s->ybase + position); + s->underline_thickness = thickness; + s->underline_position = position; + y = s->ybase + position; + + BView_FillRectangle (view, s->x, y, s->width, thickness); + } + } + + if (face->overline_p) + { + unsigned long dy = 0, h = 1; + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, cursor_color); + else if (!face->overline_color_defaulted_p) + BView_SetHighColor (view, face->overline_color); + else + BView_SetHighColor (view, face->foreground); + + BView_FillRectangle (view, s->x, s->y + dy, s->width, h); + } + + if (face->strike_through_p) + { + /* Y-coordinate and height of the glyph string's first + glyph. We cannot use s->y and s->height because those + could be larger if there are taller display elements + (e.g., characters displayed with a larger font) in the + same glyph row. */ + int glyph_y = s->ybase - s->first_glyph->ascent; + int glyph_height = s->first_glyph->ascent + s->first_glyph->descent; + /* Strike-through width and offset from the glyph string's + top edge. */ + unsigned long h = 1; + unsigned long dy = (glyph_height - h) / 2; + + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, cursor_color); + else if (!face->strike_through_color_defaulted_p) + BView_SetHighColor (view, face->strike_through_color); + else + BView_SetHighColor (view, face->foreground); + + BView_FillRectangle (view, s->x, glyph_y + dy, s->width, h); + } +} + +static void +haiku_draw_string_box (struct glyph_string *s) +{ + int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x; + bool raised_p, left_p, right_p; + struct glyph *last_glyph; + struct face *face = s->face; + + last_x = ((s->row->full_width_p && !s->w->pseudo_window_p) + ? WINDOW_RIGHT_EDGE_X (s->w) + : window_box_right (s->w, s->area)); + + /* The glyph that may have a right box line. For static + compositions and images, the right-box flag is on the first glyph + of the glyph string; for other types it's on the last glyph. */ + if (s->cmp || s->img) + last_glyph = s->first_glyph; + else if (s->first_glyph->type == COMPOSITE_GLYPH + && s->first_glyph->u.cmp.automatic) + { + /* For automatic compositions, we need to look up the last glyph + in the composition. */ + struct glyph *end = s->row->glyphs[s->area] + s->row->used[s->area]; + struct glyph *g = s->first_glyph; + for (last_glyph = g++; + g < end && g->u.cmp.automatic && g->u.cmp.id == s->cmp_id + && g->slice.cmp.to < s->cmp_to; + last_glyph = g++) + ; + } + else + last_glyph = s->first_glyph + s->nchars - 1; + + vwidth = eabs (face->box_vertical_line_width); + hwidth = eabs (face->box_horizontal_line_width); + raised_p = face->box == FACE_RAISED_BOX; + left_x = s->x; + right_x = (s->row->full_width_p && s->extends_to_end_of_line_p + ? last_x - 1 + : min (last_x, s->x + s->background_width) - 1); + + top_y = s->y; + bottom_y = top_y + s->height - 1; + + left_p = (s->first_glyph->left_box_line_p + || (s->hl == DRAW_MOUSE_FACE + && (s->prev == NULL + || s->prev->hl != s->hl))); + right_p = (last_glyph->right_box_line_p + || (s->hl == DRAW_MOUSE_FACE + && (s->next == NULL + || s->next->hl != s->hl))); + + if (face->box == FACE_SIMPLE_BOX) + haiku_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, left_p, right_p, NULL); + else + haiku_draw_relief_rect (s, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, raised_p, true, true, left_p, right_p, + NULL, 1); +} + +static void +haiku_draw_plain_background (struct glyph_string *s, struct face *face, + int box_line_hwidth, int box_line_vwidth) +{ + void *view = FRAME_HAIKU_VIEW (s->f); + unsigned long cursor_color; + if (s->hl == DRAW_CURSOR) + { + haiku_merge_cursor_foreground (s, NULL, &cursor_color); + BView_SetHighColor (view, cursor_color); + } + else + BView_SetHighColor (view, face->background_defaulted_p ? + FRAME_BACKGROUND_PIXEL (s->f) : + face->background); + + BView_FillRectangle (view, s->x, + s->y + box_line_hwidth, + s->background_width, + s->height - 2 * box_line_hwidth); +} + +static void +haiku_draw_stipple_background (struct glyph_string *s, struct face *face, + int box_line_hwidth, int box_line_vwidth) +{ +} + +static void +haiku_maybe_draw_background (struct glyph_string *s, int force_p) +{ + if ((s->first_glyph->type != IMAGE_GLYPH) && !s->background_filled_p) + { + struct face *face = s->face; + int box_line_width = max (face->box_horizontal_line_width, 0); + int box_vline_width = max (face->box_vertical_line_width, 0); + + if (FONT_HEIGHT (s->font) < s->height - 2 * box_vline_width + || FONT_TOO_HIGH (s->font) + || s->font_not_found_p || s->extends_to_end_of_line_p || force_p) + { + if (!face->stipple) + haiku_draw_plain_background (s, face, box_line_width, + box_vline_width); + else + haiku_draw_stipple_background (s, face, box_line_width, + box_vline_width); + s->background_filled_p = 1; + } + } +} + +static void +haiku_mouse_face_colors (struct glyph_string *s, uint32_t *fg, + uint32_t *bg) +{ + 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); + + face = FACE_FROM_ID (s->f, face_id); + prepare_face_for_display (s->f, s->face); + + if (fg) + *fg = face->foreground; + if (bg) + *bg = face->background; +} + +static void +haiku_draw_glyph_string_foreground (struct glyph_string *s) +{ + struct face *face = s->face; + + int i, x; + if (face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p) + x = s->x + max (face->box_vertical_line_width, 0); + else + x = s->x; + + void *view = FRAME_HAIKU_VIEW (s->f); + + if (s->font_not_found_p) + { + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + else + BView_SetHighColor (view, face->foreground); + for (i = 0; i < s->nchars; ++i) + { + struct glyph *g = s->first_glyph + i; + BView_StrokeRectangle (view, x, s->y, g->pixel_width, + s->height); + x += g->pixel_width; + } + } + else + { + struct font *ft = s->font; + int off = ft->baseline_offset; + int y; + + if (ft->vertical_centering) + off = VCENTER_BASELINE_OFFSET (ft, s->f) - off; + y = s->ybase - off; + if (s->for_overlaps || (s->background_filled_p && s->hl != DRAW_CURSOR)) + ft->driver->draw (s, 0, s->nchars, x, y, false); + else + ft->driver->draw (s, 0, s->nchars, x, y, true); + + if (face->overstrike) + ft->driver->draw (s, 0, s->nchars, x + 1, y, false); + } +} + +static void +haiku_draw_glyphless_glyph_string_foreground (struct glyph_string *s) +{ + struct glyph *glyph = s->first_glyph; + unsigned char2b[8]; + int x, i, j; + struct face *face = s->face; + + /* If first glyph of S has a left box line, start drawing the text + of S to the right of that box line. */ + if (face && face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p) + x = s->x + max (face->box_vertical_line_width, 0); + else + x = s->x; + + s->char2b = char2b; + + for (i = 0; i < s->nchars; i++, glyph++) + { +#ifdef GCC_LINT + enum { PACIFY_GCC_BUG_81401 = 1 }; +#else + enum { PACIFY_GCC_BUG_81401 = 0 }; +#endif + char buf[7 + PACIFY_GCC_BUG_81401]; + char *str = NULL; + int len = glyph->u.glyphless.len; + + if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM) + { + if (len > 0 + && CHAR_TABLE_P (Vglyphless_char_display) + && (CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) + >= 1)) + { + Lisp_Object acronym + = (! glyph->u.glyphless.for_no_font + ? CHAR_TABLE_REF (Vglyphless_char_display, + glyph->u.glyphless.ch) + : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + if (STRINGP (acronym)) + str = SSDATA (acronym); + } + } + else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE) + { + unsigned int ch = glyph->u.glyphless.ch; + eassume (ch <= MAX_CHAR); + sprintf (buf, "%0*X", ch < 0x10000 ? 4 : 6, ch); + str = buf; + } + + if (str) + { + int upper_len = (len + 1) / 2; + + /* It is assured that all LEN characters in STR is ASCII. */ + for (j = 0; j < len; j++) + char2b[j] = s->font->driver->encode_char (s->font, str[j]) & 0xFFFF; + + s->font->driver->draw (s, 0, upper_len, + x + glyph->slice.glyphless.upper_xoff, + s->ybase + glyph->slice.glyphless.upper_yoff, + false); + s->font->driver->draw (s, upper_len, len, + x + glyph->slice.glyphless.lower_xoff, + s->ybase + glyph->slice.glyphless.lower_yoff, + false); + } + if (glyph->u.glyphless.method != GLYPHLESS_DISPLAY_THIN_SPACE) + BView_FillRectangle (FRAME_HAIKU_VIEW (s->f), + x, s->ybase - glyph->ascent, + glyph->pixel_width - 1, + glyph->ascent + glyph->descent - 1); + x += glyph->pixel_width; + } +} + +static void +haiku_draw_stretch_glyph_string (struct glyph_string *s) +{ + eassert (s->first_glyph->type == STRETCH_GLYPH); + + struct face *face = s->face; + + if (s->hl == DRAW_CURSOR && !x_stretch_cursor_p) + { + int width, background_width = s->background_width; + int x = s->x; + + if (!s->row->reversed_p) + { + int left_x = window_box_left_offset (s->w, TEXT_AREA); + + if (x < left_x) + { + background_width -= left_x - x; + x = left_x; + } + } + else + { + /* In R2L rows, draw the cursor on the right edge of the + stretch glyph. */ + int right_x = window_box_right (s->w, TEXT_AREA); + if (x + background_width > right_x) + background_width -= x - right_x; + x += background_width; + } + + width = min (FRAME_COLUMN_WIDTH (s->f), background_width); + if (s->row->reversed_p) + x -= width; + + void *view = FRAME_HAIKU_VIEW (s->f); + unsigned long cursor_color; + + haiku_merge_cursor_foreground (s, NULL, &cursor_color); + BView_SetHighColor (view, cursor_color); + BView_FillRectangle (view, x, s->y, width, s->height); + + if (width < background_width) + { + if (!s->row->reversed_p) + x += width; + else + x = s->x; + + int y = s->y; + int w = background_width - width, h = s->height; + + if (!face->stipple) + { + uint32_t bkg; + if (s->row->mouse_face_p && cursor_in_mouse_face_p (s->w)) + haiku_mouse_face_colors (s, NULL, &bkg); + else + bkg = face->background; + + BView_SetHighColor (view, bkg); + BView_FillRectangle (view, x, y, w, h); + } + } + } + else if (!s->background_filled_p) + { + int background_width = s->background_width; + 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 (s->area == TEXT_AREA + && x < text_left_x && !s->row->mode_line_p) + { + background_width -= text_left_x - x; + x = text_left_x; + } + + if (background_width > 0) + { + void *view = FRAME_HAIKU_VIEW (s->f); + unsigned long bkg; + if (s->hl == DRAW_CURSOR) + haiku_merge_cursor_foreground (s, NULL, &bkg); + else + bkg = s->face->background; + + BView_SetHighColor (view, bkg); + BView_FillRectangle (view, x, s->y, background_width, s->height); + } + } + s->background_filled_p = 1; +} + +static void +haiku_start_clip (struct glyph_string *s) +{ + void *view = FRAME_HAIKU_VIEW (s->f); + BView_StartClip (view); +} + +static void +haiku_end_clip (struct glyph_string *s) +{ + void *view = FRAME_HAIKU_VIEW (s->f); + BView_EndClip (view); +} + +static void +haiku_clip_to_row (struct window *w, struct glyph_row *row, + enum glyph_row_area area) +{ + struct frame *f = WINDOW_XFRAME (w); + int window_x, window_y, window_width; + int x, y, width, height; + + window_box (w, area, &window_x, &window_y, &window_width, 0); + + x = window_x; + y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, row->y)); + y = max (y, window_y); + width = window_width; + height = row->visible_height; + + BView_ClipToRect (FRAME_HAIKU_VIEW (f), x, y, width, height); +} + +static void +haiku_update_begin (struct frame *f) +{ +} + +static void +haiku_update_end (struct frame *f) +{ + MOUSE_HL_INFO (f)->mouse_face_defer = false; + BWindow_Flush (FRAME_HAIKU_WINDOW (f)); +} + +static void +haiku_draw_composite_glyph_string_foreground (struct glyph_string *s) +{ + int i, j, x; + struct font *font = s->font; + void *view = FRAME_HAIKU_VIEW (s->f); + struct face *face = s->face; + + /* If first glyph of S has a left box line, start drawing the text + of S to the right of that box line. */ + if (face && face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p) + x = s->x + max (face->box_vertical_line_width, 0); + else + x = s->x; + + /* S is a glyph string for a composition. S->cmp_from is the index + of the first character drawn for glyphs of this composition. + S->cmp_from == 0 means we are drawing the very first character of + this composition. */ + + /* Draw a rectangle for the composition if the font for the very + first character of the composition could not be loaded. */ + + if (s->font_not_found_p && !s->cmp_from) + { + if (s->hl == DRAW_CURSOR) + BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + else + BView_SetHighColor (view, s->face->foreground); + BView_StrokeRectangle (view, s->x, s->y, s->width - 1, s->height - 1); + } + else if (!s->first_glyph->u.cmp.automatic) + { + int y = s->ybase; + + for (i = 0, j = s->cmp_from; i < s->nchars; i++, j++) + /* TAB in a composition means display glyphs with padding + space on the left or right. */ + if (COMPOSITION_GLYPH (s->cmp, j) != '\t') + { + int xx = x + s->cmp->offsets[j * 2]; + int yy = y - s->cmp->offsets[j * 2 + 1]; + + font->driver->draw (s, j, j + 1, xx, yy, false); + if (face->overstrike) + font->driver->draw (s, j, j + 1, xx + 1, yy, false); + } + } + else + { + Lisp_Object gstring = composition_gstring_from_id (s->cmp_id); + Lisp_Object glyph; + int y = s->ybase; + int width = 0; + + for (i = j = s->cmp_from; i < s->cmp_to; i++) + { + glyph = LGSTRING_GLYPH (gstring, i); + if (NILP (LGLYPH_ADJUSTMENT (glyph))) + width += LGLYPH_WIDTH (glyph); + else + { + int xoff, yoff, wadjust; + + if (j < i) + { + font->driver->draw (s, j, i, x, y, false); + if (s->face->overstrike) + font->driver->draw (s, j, i, x + 1, y, false); + x += width; + } + xoff = LGLYPH_XOFF (glyph); + yoff = LGLYPH_YOFF (glyph); + wadjust = LGLYPH_WADJUST (glyph); + font->driver->draw (s, i, i + 1, x + xoff, y + yoff, false); + if (face->overstrike) + font->driver->draw (s, i, i + 1, x + xoff + 1, y + yoff, + false); + x += wadjust; + j = i + 1; + width = 0; + } + } + if (j < i) + { + font->driver->draw (s, j, i, x, y, false); + if (face->overstrike) + font->driver->draw (s, j, i, x + 1, y, false); + } + } +} + +static void +haiku_draw_image_relief (struct glyph_string *s) +{ + int x1, y1, thick; + bool raised_p, top_p, bot_p, left_p, right_p; + int extra_x, extra_y; + struct haiku_rect r; + int x = s->x; + int y = s->ybase - image_ascent (s->img, s->face, &s->slice); + + struct face *face = s->face; + + /* If first glyph of S has a left box line, start drawing it to the + right of that line. */ + if (face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p + && s->slice.x == 0) + x += max (face->box_vertical_line_width, 0); + + /* If there is a margin around the image, adjust x- and y-position + by that margin. */ + if (s->slice.x == 0) + x += s->img->hmargin; + if (s->slice.y == 0) + y += s->img->vmargin; + + if (s->hl == DRAW_IMAGE_SUNKEN + || s->hl == DRAW_IMAGE_RAISED) + { + 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 + { + thick = eabs (s->img->relief); + raised_p = s->img->relief > 0; + } + + x1 = x + s->slice.width - 1; + y1 = y + s->slice.height - 1; + + extra_x = extra_y = 0; + + if (s->face->id == TAB_BAR_FACE_ID) + { + if (CONSP (Vtab_bar_button_margin) + && FIXNUMP (XCAR (Vtab_bar_button_margin)) + && FIXNUMP (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) - thick; + } + + if (s->face->id == TOOL_BAR_FACE_ID) + { + if (CONSP (Vtool_bar_button_margin) + && FIXNUMP (XCAR (Vtool_bar_button_margin)) + && FIXNUMP (XCDR (Vtool_bar_button_margin))) + { + extra_x = XFIXNUM (XCAR (Vtool_bar_button_margin)); + extra_y = XFIXNUM (XCDR (Vtool_bar_button_margin)); + } + else if (FIXNUMP (Vtool_bar_button_margin)) + extra_x = extra_y = XFIXNUM (Vtool_bar_button_margin); + } + + top_p = bot_p = left_p = right_p = 0; + + if (s->slice.x == 0) + x -= thick + extra_x, left_p = 1; + if (s->slice.y == 0) + y -= thick + extra_y, top_p = 1; + if (s->slice.x + s->slice.width == s->img->width) + x1 += thick + extra_x, right_p = 1; + if (s->slice.y + s->slice.height == s->img->height) + y1 += thick + extra_y, bot_p = 1; + + get_glyph_string_clip_rect (s, &r); + haiku_draw_relief_rect (s, x, y, x1, y1, thick, thick, raised_p, + top_p, bot_p, left_p, right_p, &r, 0); +} + +static void +haiku_draw_image_glyph_string (struct glyph_string *s) +{ + struct face *face = s->face; + + int box_line_hwidth = max (face->box_vertical_line_width, 0); + int box_line_vwidth = max (face->box_horizontal_line_width, 0); + + int x, y; + int height, width; + + height = s->height; + if (s->slice.y == 0) + height -= box_line_vwidth; + if (s->slice.y + s->slice.height >= s->img->height) + height -= box_line_vwidth; + + width = s->background_width; + x = s->x; + if (s->first_glyph->left_box_line_p + && s->slice.x == 0) + { + x += box_line_hwidth; + width -= box_line_hwidth; + } + + y = s->y; + if (s->slice.y == 0) + y += box_line_vwidth; + + void *view = FRAME_HAIKU_VIEW (s->f); + void *bitmap = s->img->pixmap; + + s->stippled_p = face->stipple != 0; + + BView_SetHighColor (view, face->background); + BView_FillRectangle (view, x, y, width, height); + + if (bitmap) + { + struct haiku_rect nr; + Emacs_Rectangle cr, ir, r; + + get_glyph_string_clip_rect (s, &nr); + CONVERT_TO_EMACS_RECT (cr, nr); + x = s->x; + y = s->ybase - image_ascent (s->img, face, &s->slice); + + if (s->slice.x == 0) + x += s->img->hmargin; + if (s->slice.y == 0) + y += s->img->vmargin; + + if (face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p + && s->slice.x == 0) + x += max (face->box_vertical_line_width, 0); + + ir.x = x; + ir.y = y; + ir.width = s->slice.width; + ir.height = s->slice.height; + r = ir; + + void *mask = s->img->mask; + + if (gui_intersect_rectangles (&cr, &ir, &r)) + { + if (s->img->have_be_transforms_p) + { + bitmap = BBitmap_transform_bitmap (bitmap, + s->img->mask, + face->background, + s->img->be_rotate, + s->img->width, + s->img->height); + mask = NULL; + } + + BView_DrawBitmap (view, bitmap, + s->slice.x + r.x - x, + s->slice.y + r.y - y, + r.width, r.height, + r.x, r.y, r.width, r.height); + if (mask) + { + BView_DrawMask (mask, view, + s->slice.x + r.x - x, + s->slice.y + r.y - y, + r.width, r.height, + r.x, r.y, r.width, r.height, + face->background); + } + + if (s->img->have_be_transforms_p) + BBitmap_free (bitmap); + } + + if (s->hl == DRAW_CURSOR) + { + BView_SetPenSize (view, 1); + BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel); + BView_StrokeRectangle (view, r.x, r.y, r.width, r.height); + } + } + + if (s->img->relief + || s->hl == DRAW_IMAGE_RAISED + || s->hl == DRAW_IMAGE_SUNKEN) + haiku_draw_image_relief (s); +} + +static void +haiku_draw_glyph_string (struct glyph_string *s) +{ + void *view; + + block_input (); + view = FRAME_HAIKU_VIEW (s->f); + BView_draw_lock (view, false, 0, 0, 0, 0); + prepare_face_for_display (s->f, s->face); + + struct face *face = s->face; + if (face != s->face) + prepare_face_for_display (s->f, face); + + if (s->next && s->right_overhang && !s->for_overlaps) + { + int width; + struct glyph_string *next; + + for (width = 0, next = s->next; + next && width < s->right_overhang; + width += next->width, next = next->next) + if (next->first_glyph->type != IMAGE_GLYPH) + { + prepare_face_for_display (s->f, s->next->face); + haiku_start_clip (s->next); + haiku_clip_to_string (s->next); + if (next->first_glyph->type != STRETCH_GLYPH) + haiku_maybe_draw_background (s->next, 1); + else + haiku_draw_stretch_glyph_string (s->next); + haiku_end_clip (s); + } + } + + haiku_start_clip (s); + + int box_filled_p = 0; + + if (!s->for_overlaps && face->box != FACE_NO_BOX + && (s->first_glyph->type == CHAR_GLYPH + || s->first_glyph->type == COMPOSITE_GLYPH)) + { + haiku_clip_to_string (s); + haiku_maybe_draw_background (s, 1); + box_filled_p = 1; + haiku_draw_string_box (s); + } + else 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))) + /* We must clip just this glyph. left_overhang part has already + drawn when s->prev was drawn, and right_overhang part will be + drawn later when s->next is drawn. */ + haiku_clip_to_string_exactly (s, s); + else + haiku_clip_to_string (s); + + if (s->for_overlaps) + s->background_filled_p = 1; + + switch (s->first_glyph->type) + { + case COMPOSITE_GLYPH: + if (s->for_overlaps || (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic)) + s->background_filled_p = 1; + else + haiku_maybe_draw_background (s, 1); + haiku_draw_composite_glyph_string_foreground (s); + break; + case CHAR_GLYPH: + if (s->for_overlaps) + s->background_filled_p = 1; + else + haiku_maybe_draw_background (s, 0); + haiku_draw_glyph_string_foreground (s); + break; + case STRETCH_GLYPH: + haiku_draw_stretch_glyph_string (s); + break; + case IMAGE_GLYPH: + haiku_draw_image_glyph_string (s); + break; + case GLYPHLESS_GLYPH: + if (s->for_overlaps) + s->background_filled_p = 1; + else + haiku_maybe_draw_background (s, 1); + haiku_draw_glyphless_glyph_string_foreground (s); + break; + default: + emacs_abort (); + } + + if (!s->for_overlaps) + { + if (!box_filled_p && face->box != FACE_NO_BOX) + haiku_draw_string_box (s); + else + haiku_draw_text_decoration (s, face, s->width, s->x); + + if (s->prev) + { + 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; + + prev->hl = s->hl; + haiku_start_clip (s); + haiku_clip_to_string (s); + haiku_clip_to_string_exactly (s, prev); + if (prev->first_glyph->type == CHAR_GLYPH) + haiku_draw_glyph_string_foreground (prev); + else + haiku_draw_composite_glyph_string_foreground (prev); + haiku_end_clip (s); + prev->hl = save; + } + } + + if (s->next) + { + 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; + + next->hl = s->hl; + haiku_start_clip (s); + haiku_clip_to_string (s); + haiku_clip_to_string_exactly (s, next); + if (next->first_glyph->type == CHAR_GLYPH) + haiku_draw_glyph_string_foreground (next); + else + haiku_draw_composite_glyph_string_foreground (next); + haiku_end_clip (s); + + next->hl = save; + next->clip_head = s->next; + } + } + } + haiku_end_clip (s); + BView_draw_unlock (view); + unblock_input (); +} + +static void +haiku_after_update_window_line (struct window *w, + struct glyph_row *desired_row) +{ + eassert (w); + struct frame *f; + int width, height; + + if (!desired_row->mode_line_p && !w->pseudo_window_p) + desired_row->redraw_fringe_bitmaps_p = true; + + if (windows_or_buffers_changed + && desired_row->full_width_p + && (f = XFRAME (w->frame), + width = FRAME_INTERNAL_BORDER_WIDTH (f), + width != 0) + && (height = desired_row->visible_height, + height > 0)) + { + int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y)); + int face_id = + !NILP (Vface_remapping_alist) + ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID) + : INTERNAL_BORDER_FACE_ID; + struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); + + block_input (); + if (face) + { + void *view = FRAME_HAIKU_VIEW (f); + BView_draw_lock (view, false, 0, 0, 0, 0); + BView_StartClip (view); + BView_SetHighColor (view, face->background_defaulted_p ? + FRAME_BACKGROUND_PIXEL (f) : face->background); + BView_FillRectangle (view, 0, y, width, height); + BView_FillRectangle (view, FRAME_PIXEL_WIDTH (f) - width, + y, width, height); + BView_invalidate_region (FRAME_HAIKU_VIEW (f), + 0, y, width, height); + BView_invalidate_region (view, FRAME_PIXEL_WIDTH (f) - width, + y, width, height); + BView_EndClip (view); + BView_draw_unlock (view); + } + else + { + haiku_clear_frame_area (f, 0, y, width, height); + haiku_clear_frame_area (f, FRAME_PIXEL_WIDTH (f) - width, + y, width, height); + } + unblock_input (); + } +} + +static void +haiku_set_window_size (struct frame *f, bool change_gravity, + int width, int height) +{ + Lisp_Object frame; + + /* On X Windows, window managers typically disallow resizing a + window when it is fullscreen. Do the same here. */ + + XSETFRAME (frame, f); + if (!NILP (Fframe_parameter (frame, Qfullscreen)) + /* Only do this if the fullscreen status has actually been + applied. */ + && f->want_fullscreen == FULLSCREEN_NONE + /* And if the configury during frame completion has been + completed. Otherwise, there will be no valid "old size" to + go back to. */ + && FRAME_OUTPUT_DATA (f)->configury_done) + return; + + haiku_update_size_hints (f); + + if (FRAME_HAIKU_WINDOW (f)) + { + block_input (); + BWindow_resize (FRAME_HAIKU_WINDOW (f), width, height); + unblock_input (); + } +} + +static void +haiku_draw_window_cursor (struct window *w, + struct glyph_row *glyph_row, + int x, int y, + enum text_cursor_kinds cursor_type, + int cursor_width, bool on_p, bool active_p) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + struct face *face; + struct glyph *phys_cursor_glyph; + struct glyph *cursor_glyph; + + void *view = FRAME_HAIKU_VIEW (f); + + int fx, fy, h, cursor_height; + + if (!on_p) + return; + + if (cursor_type == NO_CURSOR) + { + w->phys_cursor_width = 0; + return; + } + + w->phys_cursor_on_p = true; + w->phys_cursor_type = cursor_type; + + phys_cursor_glyph = get_phys_cursor_glyph (w); + + if (!phys_cursor_glyph) + { + if (glyph_row->exact_window_width_line_p + && w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA]) + { + glyph_row->cursor_in_fringe_p = 1; + draw_fringe_bitmap (w, glyph_row, 0); + } + return; + } + + get_phys_cursor_geometry (w, glyph_row, phys_cursor_glyph, &fx, &fy, &h); + + if (cursor_type == BAR_CURSOR) + { + if (cursor_width < 1) + cursor_width = max (FRAME_CURSOR_WIDTH (f), 1); + if (cursor_width < w->phys_cursor_width) + w->phys_cursor_width = cursor_width; + } + else if (cursor_type == HBAR_CURSOR) + { + cursor_height = (cursor_width < 1) ? lrint (0.25 * h) : cursor_width; + if (cursor_height > glyph_row->height) + cursor_height = glyph_row->height; + if (h > cursor_height) + fy += h - cursor_height; + h = cursor_height; + } + + BView_draw_lock (view, false, 0, 0, 0, 0); + BView_StartClip (view); + + if (cursor_type == BAR_CURSOR) + { + cursor_glyph = get_phys_cursor_glyph (w); + face = FACE_FROM_ID (f, cursor_glyph->face_id); + } + + /* If the glyph's background equals the color we normally draw the + bar cursor in, our cursor in its normal color is invisible. Use + the glyph's foreground color instead in this case, on the + assumption that the glyph's colors are chosen so that the glyph + is legible. */ + + /* xterm.c only does this for bar cursors, and nobody has + complained, so it would be best to do that here as well. */ + if (cursor_type == BAR_CURSOR + && face->background == FRAME_CURSOR_COLOR (f).pixel) + BView_SetHighColor (view, face->foreground); + else + BView_SetHighColor (view, FRAME_CURSOR_COLOR (f).pixel); + haiku_clip_to_row (w, glyph_row, TEXT_AREA); + + switch (cursor_type) + { + default: + case DEFAULT_CURSOR: + case NO_CURSOR: + break; + case HBAR_CURSOR: + BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); + BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); + break; + case BAR_CURSOR: + if (cursor_glyph->resolved_level & 1) + { + BView_FillRectangle (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, + fy, w->phys_cursor_width, h); + BView_invalidate_region (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, + fy, w->phys_cursor_width, h); + } + else + BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); + + BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); + break; + case HOLLOW_BOX_CURSOR: + if (phys_cursor_glyph->type != IMAGE_GLYPH) + { + BView_SetPenSize (view, 1); + BView_StrokeRectangle (view, fx, fy, w->phys_cursor_width, h); + } + else + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + + BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); + break; + case FILLED_BOX_CURSOR: + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + } + BView_EndClip (view); + BView_draw_unlock (view); +} + +static void +haiku_show_hourglass (struct frame *f) +{ + if (FRAME_OUTPUT_DATA (f)->hourglass_p) + return; + + block_input (); + FRAME_OUTPUT_DATA (f)->hourglass_p = 1; + + if (FRAME_HAIKU_VIEW (f)) + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), + FRAME_OUTPUT_DATA (f)->hourglass_cursor); + unblock_input (); +} + +static void +haiku_hide_hourglass (struct frame *f) +{ + if (!FRAME_OUTPUT_DATA (f)->hourglass_p) + return; + + block_input (); + FRAME_OUTPUT_DATA (f)->hourglass_p = 0; + + if (FRAME_HAIKU_VIEW (f)) + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), + FRAME_OUTPUT_DATA (f)->current_cursor); + unblock_input (); +} + +static void +haiku_compute_glyph_string_overhangs (struct glyph_string *s) +{ + if (s->cmp == NULL + && (s->first_glyph->type == CHAR_GLYPH + || s->first_glyph->type == COMPOSITE_GLYPH)) + { + struct font_metrics metrics; + + 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 if (s->cmp) + { + s->right_overhang = s->cmp->rbearing - s->cmp->pixel_width; + s->left_overhang = - s->cmp->lbearing; + } +} + +static void +haiku_draw_vertical_window_border (struct window *w, + int x, int y_0, int y_1) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + struct face *face; + + face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID); + void *view = FRAME_HAIKU_VIEW (f); + BView_draw_lock (view, true, x, y_0, 1, y_1); + BView_StartClip (view); + if (face) + BView_SetHighColor (view, face->foreground); + BView_StrokeLine (view, x, y_0, x, y_1); + BView_EndClip (view); + BView_draw_unlock (view); +} + +static void +haiku_set_scroll_bar_default_width (struct frame *f) +{ + int unit = FRAME_COLUMN_WIDTH (f); + FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = BScrollBar_default_size (0) + 1; + FRAME_CONFIG_SCROLL_BAR_COLS (f) = + (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + unit - 1) / unit; +} + +static void +haiku_set_scroll_bar_default_height (struct frame *f) +{ + int height = FRAME_LINE_HEIGHT (f); + FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = BScrollBar_default_size (1) + 1; + FRAME_CONFIG_SCROLL_BAR_LINES (f) = + (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) + height - 1) / height; +} + +static void +haiku_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + struct face *face = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FACE_ID); + struct face *face_first + = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID); + struct face *face_last + = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_LAST_PIXEL_FACE_ID); + unsigned long color = face ? face->foreground : FRAME_FOREGROUND_PIXEL (f); + unsigned long color_first = (face_first + ? face_first->foreground + : FRAME_FOREGROUND_PIXEL (f)); + unsigned long color_last = (face_last + ? face_last->foreground + : FRAME_FOREGROUND_PIXEL (f)); + void *view = FRAME_HAIKU_VIEW (f); + + BView_draw_lock (view, true, x0, y0, x1 - x0 + 1, y1 - y0 + 1); + BView_StartClip (view); + + if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) + /* A vertical divider, at least three pixels wide: Draw first and + last pixels differently. */ + { + BView_SetHighColor (view, color_first); + BView_StrokeLine (view, x0, y0, x0, y1 - 1); + BView_SetHighColor (view, color); + BView_FillRectangle (view, x0 + 1, y0, x1 - x0 - 2, y1 - y0); + BView_SetHighColor (view, color_last); + BView_StrokeLine (view, x1 - 1, y0, x1 - 1, y1 - 1); + } + else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) + /* A horizontal divider, at least three pixels high: Draw first and + last pixels differently. */ + { + BView_SetHighColor (view, color_first); + BView_StrokeLine (view, x0, y0, x1 - 1, y0); + BView_SetHighColor (view, color); + BView_FillRectangle (view, x0, y0 + 1, x1 - x0, y1 - y0 - 2); + BView_SetHighColor (view, color_last); + BView_FillRectangle (view, x0, y1 - 1, x1 - x0, 1); + } + else + { + BView_SetHighColor (view, color); + BView_FillRectangleAbs (view, x0, y0, x1, y1); + } + BView_EndClip (view); + BView_draw_unlock (view); +} + +static void +haiku_condemn_scroll_bars (struct frame *frame) +{ + if (!NILP (FRAME_SCROLL_BARS (frame))) + { + if (!NILP (FRAME_CONDEMNED_SCROLL_BARS (frame))) + { + /* Prepend scrollbars to already condemned ones. */ + Lisp_Object last = FRAME_SCROLL_BARS (frame); + + while (!NILP (XSCROLL_BAR (last)->next)) + last = XSCROLL_BAR (last)->next; + + XSCROLL_BAR (last)->next = FRAME_CONDEMNED_SCROLL_BARS (frame); + XSCROLL_BAR (FRAME_CONDEMNED_SCROLL_BARS (frame))->prev = last; + } + + fset_condemned_scroll_bars (frame, FRAME_SCROLL_BARS (frame)); + fset_scroll_bars (frame, Qnil); + } +} + +static void +haiku_redeem_scroll_bar (struct window *w) +{ + struct scroll_bar *bar; + Lisp_Object barobj; + struct frame *f; + + if (!NILP (w->vertical_scroll_bar) && WINDOW_HAS_VERTICAL_SCROLL_BAR (w)) + { + bar = XSCROLL_BAR (w->vertical_scroll_bar); + /* Unlink it from the condemned list. */ + f = XFRAME (WINDOW_FRAME (w)); + if (NILP (bar->prev)) + { + /* If the prev pointer is nil, it must be the first in one of + the lists. */ + if (EQ (FRAME_SCROLL_BARS (f), w->vertical_scroll_bar)) + /* It's not condemned. Everything's fine. */ + goto horizontal; + else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f), + w->vertical_scroll_bar)) + fset_condemned_scroll_bars (f, bar->next); + else + /* If its prev pointer is nil, it must be at the front of + one or the other! */ + emacs_abort (); + } + else + XSCROLL_BAR (bar->prev)->next = bar->next; + + if (! NILP (bar->next)) + XSCROLL_BAR (bar->next)->prev = bar->prev; + + bar->next = FRAME_SCROLL_BARS (f); + bar->prev = Qnil; + XSETVECTOR (barobj, bar); + fset_scroll_bars (f, barobj); + if (! NILP (bar->next)) + XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); + } + horizontal: + if (!NILP (w->horizontal_scroll_bar) && WINDOW_HAS_HORIZONTAL_SCROLL_BAR (w)) + { + bar = XSCROLL_BAR (w->horizontal_scroll_bar); + /* Unlink it from the condemned list. */ + f = XFRAME (WINDOW_FRAME (w)); + if (NILP (bar->prev)) + { + /* If the prev pointer is nil, it must be the first in one of + the lists. */ + if (EQ (FRAME_SCROLL_BARS (f), w->horizontal_scroll_bar)) + /* It's not condemned. Everything's fine. */ + return; + else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f), + w->horizontal_scroll_bar)) + fset_condemned_scroll_bars (f, bar->next); + else + /* If its prev pointer is nil, it must be at the front of + one or the other! */ + emacs_abort (); + } + else + XSCROLL_BAR (bar->prev)->next = bar->next; + + if (! NILP (bar->next)) + XSCROLL_BAR (bar->next)->prev = bar->prev; + + bar->next = FRAME_SCROLL_BARS (f); + bar->prev = Qnil; + XSETVECTOR (barobj, bar); + fset_scroll_bars (f, barobj); + if (! NILP (bar->next)) + XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); + } +} + +static void +haiku_judge_scroll_bars (struct frame *f) +{ + Lisp_Object bar, next; + + bar = FRAME_CONDEMNED_SCROLL_BARS (f); + + /* Clear out the condemned list now so we won't try to process any + more events on the hapless scroll bars. */ + fset_condemned_scroll_bars (f, Qnil); + + for (; ! NILP (bar); bar = next) + { + struct scroll_bar *b = XSCROLL_BAR (bar); + + haiku_scroll_bar_remove (b); + + next = b->next; + b->next = b->prev = Qnil; + } + + /* Now there should be no references to the condemned scroll bars, + and they should get garbage-collected. */ +} + +static struct scroll_bar * +haiku_scroll_bar_create (struct window *w, int left, int top, + int width, int height, bool horizontal_p) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + Lisp_Object barobj; + + void *sb = NULL; + void *vw = FRAME_HAIKU_VIEW (f); + + block_input (); + struct scroll_bar *bar + = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, prev, PVEC_OTHER); + + XSETWINDOW (bar->window, w); + bar->top = top; + bar->left = left; + bar->width = width; + bar->height = height; + bar->position = 0; + bar->total = 0; + bar->dragging = 0; + bar->update = -1; + bar->horizontal = horizontal_p; + + sb = BScrollBar_make_for_view (vw, horizontal_p, + left, top, left + width - 1, + top + height - 1, bar); + + BView_publish_scroll_bar (vw, left, top, width, height); + + bar->next = FRAME_SCROLL_BARS (f); + bar->prev = Qnil; + bar->scroll_bar = sb; + XSETVECTOR (barobj, bar); + fset_scroll_bars (f, barobj); + + if (!NILP (bar->next)) + XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); + + unblock_input (); + return bar; +} + +static void +haiku_set_horizontal_scroll_bar (struct window *w, int portion, int whole, int position) +{ + eassert (WINDOW_HAS_HORIZONTAL_SCROLL_BAR (w)); + Lisp_Object barobj; + struct scroll_bar *bar; + int top, height, left, width; + int window_x, window_width; + + /* Get window dimensions. */ + window_box (w, ANY_AREA, &window_x, 0, &window_width, 0); + left = window_x; + width = window_width; + top = WINDOW_SCROLL_BAR_AREA_Y (w); + height = WINDOW_CONFIG_SCROLL_BAR_HEIGHT (w); + + block_input (); + + if (NILP (w->horizontal_scroll_bar)) + { + bar = haiku_scroll_bar_create (w, left, top, width, height, true); + bar->update = position; + bar->position = position; + bar->total = whole; + } + else + { + bar = XSCROLL_BAR (w->horizontal_scroll_bar); + + if (bar->left != left || bar->top != top || + bar->width != width || bar->height != height) + { + void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w)); + BView_forget_scroll_bar (view, bar->left, bar->top, + bar->width, bar->height); + BView_move_frame (bar->scroll_bar, left, top, + left + width - 1, top + height - 1); + BView_publish_scroll_bar (view, left, top, width, height); + bar->left = left; + bar->top = top; + bar->width = width; + bar->height = height; + } + } + + haiku_set_horizontal_scroll_bar_thumb (bar, portion, position, whole); + bar->position = position; + bar->total = whole; + XSETVECTOR (barobj, bar); + wset_horizontal_scroll_bar (w, barobj); + unblock_input (); +} + +static void +haiku_set_vertical_scroll_bar (struct window *w, + int portion, int whole, int position) +{ + eassert (WINDOW_HAS_VERTICAL_SCROLL_BAR (w)); + Lisp_Object barobj; + struct scroll_bar *bar; + int top, height, left, width; + int window_y, window_height; + + /* Get window dimensions. */ + window_box (w, ANY_AREA, 0, &window_y, 0, &window_height); + top = window_y; + height = window_height; + + /* Compute the left edge and the width of the scroll bar area. */ + left = WINDOW_SCROLL_BAR_AREA_X (w); + width = WINDOW_SCROLL_BAR_AREA_WIDTH (w); + block_input (); + + if (NILP (w->vertical_scroll_bar)) + { + bar = haiku_scroll_bar_create (w, left, top, width, height, false); + bar->position = position; + bar->total = whole; + } + else + { + bar = XSCROLL_BAR (w->vertical_scroll_bar); + + if (bar->left != left || bar->top != top || + bar->width != width || bar->height != height) + { + void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (w)); + BView_forget_scroll_bar (view, bar->left, bar->top, + bar->width, bar->height); + BView_move_frame (bar->scroll_bar, left, top, + left + width - 1, top + height - 1); + BView_publish_scroll_bar (view, left, top, width, height); + bar->left = left; + bar->top = top; + bar->width = width; + bar->height = height; + } + } + + haiku_set_scroll_bar_thumb (bar, portion, position, whole); + bar->position = position; + bar->total = whole; + + XSETVECTOR (barobj, bar); + wset_vertical_scroll_bar (w, barobj); + unblock_input (); +} + +static void +haiku_draw_fringe_bitmap (struct window *w, struct glyph_row *row, + struct draw_fringe_bitmap_params *p) +{ + void *view = FRAME_HAIKU_VIEW (XFRAME (WINDOW_FRAME (w))); + struct face *face = p->face; + + block_input (); + BView_draw_lock (view, true, p->x, p->y, p->wd, p->h); + BView_StartClip (view); + + haiku_clip_to_row (w, row, ANY_AREA); + if (p->bx >= 0 && !p->overlay_p) + { + BView_SetHighColor (view, face->background); + BView_FillRectangle (view, p->bx, p->by, p->nx, p->ny); + } + + if (p->which + && p->which < max_fringe_bmp + && p->which < max_used_fringe_bitmap) + { + void *bitmap = fringe_bmps[p->which]; + + if (!bitmap) + { + /* This fringe bitmap is known to fringe.c, but lacks the + BBitmap which shadows that bitmap. This is typical to + define-fringe-bitmap being called when the selected frame + was not a GUI frame, for example, when packages that + define fringe bitmaps are loaded by a daemon Emacs. + Create the missing pattern now. */ + gui_define_fringe_bitmap (WINDOW_XFRAME (w), p->which); + bitmap = fringe_bmps[p->which]; + } + + uint32_t col; + + if (!p->cursor_p) + col = face->foreground; + else if (p->overlay_p) + col = face->background; + else + col = FRAME_CURSOR_COLOR (XFRAME (WINDOW_FRAME (w))).pixel; + + if (!p->overlay_p) + { + BView_SetHighColor (view, face->background); + BView_FillRectangle (view, p->x, p->y, p->wd, p->h); + } + + BView_SetLowColor (view, col); + BView_DrawBitmapWithEraseOp (view, bitmap, p->x, p->y, p->wd, p->h); + } + BView_EndClip (view); + BView_draw_unlock (view); + unblock_input (); +} + +static void +haiku_define_fringe_bitmap (int which, unsigned short *bits, + int h, int wd) +{ + if (which >= max_fringe_bmp) + { + int i = max_fringe_bmp; + max_fringe_bmp = which + 20; + fringe_bmps = !i ? xmalloc (max_fringe_bmp * sizeof (void *)) : + xrealloc (fringe_bmps, max_fringe_bmp * sizeof (void *)); + + while (i < max_fringe_bmp) + fringe_bmps[i++] = NULL; + } + + block_input (); + fringe_bmps[which] = BBitmap_new (wd, h, 1); + if (!fringe_bmps[which]) + memory_full (SIZE_MAX); + BBitmap_import_fringe_bitmap (fringe_bmps[which], bits, wd, h); + unblock_input (); +} + +static void +haiku_destroy_fringe_bitmap (int which) +{ + if (which >= max_fringe_bmp) + return; + + if (fringe_bmps[which]) + BBitmap_free (fringe_bmps[which]); + fringe_bmps[which] = NULL; +} + +static void +haiku_scroll_run (struct window *w, struct run *run) +{ + struct frame *f = XFRAME (w->frame); + void *view = FRAME_HAIKU_VIEW (f); + int x, y, width, height, from_y, to_y, bottom_y; + window_box (w, ANY_AREA, &x, &y, &width, &height); + + from_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->current_y); + to_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->desired_y); + bottom_y = y + height; + + if (to_y < from_y) + { + /* Scrolling up. Make sure we don't copy part of the mode + line at the bottom. */ + if (from_y + run->height > bottom_y) + height = bottom_y - from_y; + else + height = run->height; + } + else + { + /* Scrolling down. Make sure we don't copy over the mode line. + at the bottom. */ + if (to_y + run->height > bottom_y) + height = bottom_y - to_y; + else + height = run->height; + } + + block_input (); + gui_clear_cursor (w); + + BView_draw_lock (view, true, x, to_y, width, height); + BView_StartClip (view); + BView_CopyBits (view, x, from_y, width, height, + x, to_y, width, height); + BView_EndClip (view); + BView_draw_unlock (view); + + unblock_input (); +} + +/* Haiku doesn't provide any way to get the frame actually underneath + the pointer, so we typically return dpyinfo->last_mouse_frame if + the display is grabbed and `track-mouse' is not `dropping' or + `drag-source'; failing that, we return the selected frame, and + finally a random window system frame (as long as `track-mouse' is + not `drag-source') if that didn't work either. */ +static void +haiku_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, + enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, + Time *timestamp) +{ + Lisp_Object frame, tail; + struct frame *f1; + int screen_x, screen_y; + void *view; + + if (!fp) + return; + + f1 = NULL; + block_input (); + + FOR_EACH_FRAME (tail, frame) + { + if (FRAME_HAIKU_P (XFRAME (frame))) + XFRAME (frame)->mouse_moved = false; + } + + if (gui_mouse_grabbed (x_display_list) + && !EQ (track_mouse, Qdropping) + && !EQ (track_mouse, Qdrag_source)) + f1 = x_display_list->last_mouse_frame; + else + f1 = x_display_list->last_mouse_motion_frame; + + if (!f1 && FRAME_HAIKU_P (SELECTED_FRAME ())) + f1 = SELECTED_FRAME (); + + if (!f1 || (!FRAME_HAIKU_P (f1) && (insist > 0))) + FOR_EACH_FRAME (tail, frame) + if (FRAME_HAIKU_P (XFRAME (frame)) && + !FRAME_TOOLTIP_P (XFRAME (frame))) + f1 = XFRAME (frame); + + if (f1 && FRAME_TOOLTIP_P (f1)) + f1 = NULL; + + if (f1 && FRAME_HAIKU_P (f1)) + { + view = FRAME_HAIKU_VIEW (f1); + + if (view) + { + BView_get_mouse (view, &screen_x, &screen_y); + remember_mouse_glyph (f1, screen_x, screen_y, + &x_display_list->last_mouse_glyph); + x_display_list->last_mouse_glyph_frame = f1; + + *bar_window = Qnil; + *part = scroll_bar_above_handle; + + /* If track-mouse is `drag-source' and the mouse pointer is + certain to not be actually under the chosen frame, return + NULL in FP to at least try being consistent with X. */ + if (EQ (track_mouse, Qdrag_source) + && (screen_x < 0 || screen_y < 0 + || screen_x >= FRAME_PIXEL_WIDTH (f1) + || screen_y >= FRAME_PIXEL_HEIGHT (f1))) + *fp = NULL; + else + *fp = f1; + + *timestamp = x_display_list->last_mouse_movement_time; + XSETINT (*x, screen_x); + XSETINT (*y, screen_y); + } + } + + unblock_input (); +} + +static void +haiku_flush (struct frame *f) +{ + /* This is needed for tooltip frames to work properly with double + buffering. */ + if (FRAME_DIRTY_P (f) && !buffer_flipping_blocked_p ()) + haiku_flip_buffers (f); + + if (FRAME_VISIBLE_P (f) && !FRAME_TOOLTIP_P (f)) + BWindow_Flush (FRAME_HAIKU_WINDOW (f)); +} + +static void +haiku_define_frame_cursor (struct frame *f, Emacs_Cursor cursor) +{ + if (f->tooltip) + return; + block_input (); + if (!f->pointer_invisible && FRAME_HAIKU_VIEW (f) + && !FRAME_OUTPUT_DATA (f)->hourglass_p) + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), cursor); + unblock_input (); + FRAME_OUTPUT_DATA (f)->current_cursor = cursor; +} + +static void +haiku_update_window_end (struct window *w, bool cursor_on_p, + bool mouse_face_overwritten_p) +{ + +} + +static void +haiku_default_font_parameter (struct frame *f, Lisp_Object parms) +{ + struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + Lisp_Object font_param = gui_display_get_arg (dpyinfo, parms, Qfont, NULL, NULL, + RES_TYPE_STRING); + Lisp_Object font = Qnil; + if (EQ (font_param, Qunbound)) + font_param = Qnil; + + if (NILP (font_param)) + { + /* System font should take precedence over X resources. We suggest this + regardless of font-use-system-font because .emacs may not have been + read yet. */ + struct haiku_font_pattern ptn; + ptn.specified = 0; + + BFont_populate_fixed_family (&ptn); + + if (ptn.specified & FSPEC_FAMILY) + font = font_open_by_name (f, build_unibyte_string (ptn.family)); + } + + if (NILP (font)) + font = !NILP (font_param) ? font_param + : gui_display_get_arg (dpyinfo, parms, Qfont, "font", "Font", + RES_TYPE_STRING); + + if (! FONTP (font) && ! STRINGP (font)) + { + const char **names = (const char *[]) { "monospace-12", + "Noto Sans Mono-12", + "Source Code Pro-12", + NULL }; + int i; + + for (i = 0; names[i]; i++) + { + font + = font_open_by_name (f, build_unibyte_string (names[i])); + if (!NILP (font)) + break; + } + if (NILP (font)) + error ("No suitable font was found"); + } + else if (!NILP (font_param)) + { + /* Remember the explicit font parameter, so we can re-apply it + after we've applied the `default' face settings. */ + AUTO_FRAME_ARG (arg, Qfont_parameter, font_param); + gui_set_frame_parameters (f, arg); + } + + gui_default_parameter (f, parms, Qfont, font, "font", "Font", + RES_TYPE_STRING); +} + +static struct redisplay_interface haiku_redisplay_interface = + { + haiku_frame_parm_handlers, + gui_produce_glyphs, + gui_write_glyphs, + gui_insert_glyphs, + gui_clear_end_of_line, + haiku_scroll_run, + haiku_after_update_window_line, + NULL, + haiku_update_window_end, + haiku_flush, + gui_clear_window_mouse_face, + gui_get_glyph_overhangs, + gui_fix_overlapping_area, + haiku_draw_fringe_bitmap, + haiku_define_fringe_bitmap, + haiku_destroy_fringe_bitmap, + haiku_compute_glyph_string_overhangs, + haiku_draw_glyph_string, + haiku_define_frame_cursor, + haiku_clear_frame_area, + haiku_clear_under_internal_border, + haiku_draw_window_cursor, + haiku_draw_vertical_window_border, + haiku_draw_window_divider, + 0, /* shift glyphs for insert */ + haiku_show_hourglass, + haiku_hide_hourglass, + haiku_default_font_parameter, + }; + +static void +haiku_make_fullscreen_consistent (struct frame *f) +{ + Lisp_Object lval = get_frame_param (f, Qfullscreen); + + if (!EQ (lval, Qmaximized) && FRAME_OUTPUT_DATA (f)->zoomed_p) + lval = Qmaximized; + else if (EQ (lval, Qmaximized) && !FRAME_OUTPUT_DATA (f)->zoomed_p) + lval = Qnil; + + store_frame_param (f, Qfullscreen, lval); +} + +static void +flush_dirty_back_buffers (void) +{ + block_input (); + Lisp_Object tail, frame; + FOR_EACH_FRAME (tail, frame) + { + struct frame *f = XFRAME (frame); + if (FRAME_LIVE_P (f) && + FRAME_HAIKU_P (f) && + FRAME_HAIKU_WINDOW (f) && + !FRAME_GARBAGED_P (f) && + !buffer_flipping_blocked_p () && + FRAME_DIRTY_P (f)) + haiku_flip_buffers (f); + } + unblock_input (); +} + +static int +haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) +{ + int message_count; + static void *buf; + ssize_t b_size; + struct unhandled_event *unhandled_events = NULL; + int button_or_motion_p, need_flush, do_help; + enum haiku_event_type type; + struct input_event inev, inev2; + + message_count = 0; + need_flush = 0; + button_or_motion_p = 0; + do_help = 0; + buf = NULL; + + block_input (); + if (!buf) + buf = xmalloc (200); + haiku_read_size (&b_size, false); + while (b_size >= 0) + { + if (b_size > 200) + emacs_abort (); + + EVENT_INIT (inev); + EVENT_INIT (inev2); + inev.kind = NO_EVENT; + inev2.kind = NO_EVENT; + inev.arg = Qnil; + inev2.arg = Qnil; + + button_or_motion_p = 0; + haiku_read (&type, buf, b_size); + + switch (type) + { + case QUIT_REQUESTED: + { + struct haiku_quit_requested_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + inev.kind = DELETE_WINDOW_EVENT; + XSETFRAME (inev.frame_or_window, f); + break; + } + case FRAME_RESIZED: + { + struct haiku_resize_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + int width = lrint (b->px_widthf); + int height = lrint (b->px_heightf); + + if (FRAME_TOOLTIP_P (f)) + { + if (FRAME_PIXEL_WIDTH (f) != width + || FRAME_PIXEL_HEIGHT (f) != height) + SET_FRAME_GARBAGED (f); + + FRAME_PIXEL_WIDTH (f) = width; + FRAME_PIXEL_HEIGHT (f) = height; + + haiku_clear_under_internal_border (f); + continue; + } + + BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0); + BView_resize_to (FRAME_HAIKU_VIEW (f), width, height); + BView_draw_unlock (FRAME_HAIKU_VIEW (f)); + + if (width != FRAME_PIXEL_WIDTH (f) + || height != FRAME_PIXEL_HEIGHT (f) + || (f->new_size_p + && ((f->new_width >= 0 && width != f->new_width) + || (f->new_height >= 0 && height != f->new_height)))) + { + change_frame_size (f, width, height, false, true, false); + SET_FRAME_GARBAGED (f); + cancel_mouse_face (f); + haiku_clear_under_internal_border (f); + } + break; + } + case FRAME_EXPOSED: + { + struct haiku_expose_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + expose_frame (f, b->x, b->y, b->width, b->height); + haiku_clear_under_internal_border (f); + break; + } + case KEY_DOWN: + { + struct haiku_key_event *b = buf; + Mouse_HLInfo *hlinfo = &x_display_list->mouse_highlight; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + /* If mouse-highlight is an integer, input clears out + mouse highlighting. */ + if (!hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight) + && (f == 0 + || !EQ (f->tool_bar_window, hlinfo->mouse_face_window) + || !EQ (f->tab_bar_window, hlinfo->mouse_face_window))) + { + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = true; + need_flush = 1; + } + + inev.code = b->keysym ? b->keysym : b->multibyte_char; + + if (b->keysym) + inev.kind = NON_ASCII_KEYSTROKE_EVENT; + else + inev.kind = inev.code > 127 ? MULTIBYTE_CHAR_KEYSTROKE_EVENT : + ASCII_KEYSTROKE_EVENT; + + inev.timestamp = b->time / 1000; + inev.modifiers = (haiku_modifiers_to_emacs (b->modifiers) + | (extra_keyboard_modifiers + & (meta_modifier + | hyper_modifier + | ctrl_modifier + | alt_modifier + | shift_modifier))); + + XSETFRAME (inev.frame_or_window, f); + break; + } + case ACTIVATION: + { + struct haiku_activation_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + if ((x_display_list->focus_event_frame != f && b->activated_p) + || (x_display_list->focus_event_frame == f && !b->activated_p)) + { + haiku_new_focus_frame (b->activated_p ? f : NULL); + if (b->activated_p) + x_display_list->focus_event_frame = f; + else + x_display_list->focus_event_frame = NULL; + inev.kind = b->activated_p ? FOCUS_IN_EVENT : FOCUS_OUT_EVENT; + XSETFRAME (inev.frame_or_window, f); + } + + break; + } + case MENU_BAR_LEFT: + { + struct haiku_menu_bar_left_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + if (b->y > 0 && b->y <= FRAME_PIXEL_HEIGHT (f) + && b->x > 0 && b->x <= FRAME_PIXEL_WIDTH (f)) + break; + + if (f->auto_lower && !popup_activated_p) + haiku_frame_raise_lower (f, 0); + + break; + } + case MOUSE_MOTION: + { + struct haiku_mouse_motion_event *b = buf; + struct frame *f = haiku_mouse_or_wdesc_frame (b->window, true); + Mouse_HLInfo *hlinfo = &x_display_list->mouse_highlight; + Lisp_Object frame; + + if (!f) + continue; + + if (FRAME_TOOLTIP_P (f)) + { + /* Dismiss the tooltip if the mouse moves onto a + tooltip frame. FIXME: for some reason we don't get + leave notification events for this. */ + + if (any_help_event_p) + do_help = -1; + break; + } + + XSETFRAME (frame, f); + + x_display_list->last_mouse_movement_time = b->time / 1000; + button_or_motion_p = 1; + + if (hlinfo->mouse_face_hidden) + { + hlinfo->mouse_face_hidden = false; + clear_mouse_face (hlinfo); + need_flush = 1; + } + + if (b->just_exited_p) + { + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); + if (f == hlinfo->mouse_face_mouse_frame) + { + /* If we move outside the frame, then we're + certainly no longer on any text in the frame. */ + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = 0; + + need_flush = 1; + } + + if (f->auto_lower && !popup_activated_p + /* Don't do this if the mouse entered a scroll bar. */ + && !BView_inside_scroll_bar (FRAME_HAIKU_VIEW (f), + b->x, b->y)) + { + /* If we're leaving towards the menu bar, don't + auto-lower here, and wait for a exit + notification from the menu bar instead. */ + if (b->x > FRAME_PIXEL_WIDTH (f) + || b->y >= FRAME_MENU_BAR_HEIGHT (f) + || b->x < 0 + || b->y < 0) + haiku_frame_raise_lower (f, 0); + } + + haiku_new_focus_frame (x_display_list->focused_frame); + + if (any_help_event_p) + do_help = -1; + } + else + { + struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + struct haiku_rect r = dpyinfo->last_mouse_glyph; + + /* For an unknown reason Haiku sends phantom motion events when a + tooltip frame is visible. FIXME */ + if (FRAMEP (tip_frame) + && FRAME_LIVE_P (XFRAME (tip_frame)) + && FRAME_VISIBLE_P (XFRAME (tip_frame)) + && f == dpyinfo->last_mouse_motion_frame + && b->x == dpyinfo->last_mouse_motion_x + && b->y == dpyinfo->last_mouse_motion_y) + continue; + + dpyinfo->last_mouse_motion_x = b->x; + dpyinfo->last_mouse_motion_y = b->y; + dpyinfo->last_mouse_motion_frame = f; + + previous_help_echo_string = help_echo_string; + help_echo_string = Qnil; + + /* A LeaveNotify event (well, the closest equivalent on Haiku, which + is a B_MOUSE_MOVED event with `transit' set to B_EXITED_VIEW) might + be sent out-of-order with regards to motion events from other + windows, such as when the mouse pointer rapidly moves from an + undecorated child frame to its parent. This can cause a failure to + clear the mouse face on the former if an event for the latter is + read by Emacs first and ends up showing the mouse face there. + + In case the `movement_locker' (also see the comment + there) doesn't take care of the problem, work + around it by clearing the mouse face now, if it is + currently shown on a different frame. */ + + if (hlinfo->mouse_face_hidden + || (f != hlinfo->mouse_face_mouse_frame + && !NILP (hlinfo->mouse_face_window))) + { + hlinfo->mouse_face_hidden = 0; + clear_mouse_face (hlinfo); + } + + if (f != dpyinfo->last_mouse_glyph_frame + || b->x < r.x || b->x >= r.x + r.width + || b->y < r.y || b->y >= r.y + r.height) + { + f->mouse_moved = true; + dpyinfo->last_mouse_scroll_bar = NULL; + note_mouse_highlight (f, b->x, b->y); + remember_mouse_glyph (f, b->x, b->y, + &FRAME_DISPLAY_INFO (f)->last_mouse_glyph); + dpyinfo->last_mouse_glyph_frame = f; + } + else + help_echo_string = previous_help_echo_string; + + if (!NILP (Vmouse_autoselect_window)) + { + static Lisp_Object last_mouse_window; + Lisp_Object window = window_from_coordinates (f, b->x, b->y, 0, 0, 0); + + if (WINDOWP (window) + && !EQ (window, last_mouse_window) + && !EQ (window, selected_window) + && !popup_activated_p + && !MINI_WINDOW_P (XWINDOW (selected_window)) + && (!NILP (focus_follows_mouse) + || f == SELECTED_FRAME ())) + { + inev2.kind = SELECT_WINDOW_EVENT; + inev2.frame_or_window = window; + } + + last_mouse_window = window; + } + + if (f->auto_raise) + { + if (!BWindow_is_active (FRAME_HAIKU_WINDOW (f))) + haiku_frame_raise_lower (f, 1); + } + + if (!NILP (help_echo_string) + || !NILP (previous_help_echo_string)) + do_help = 1; + + if (b->dnd_message) + { + /* It doesn't make sense to show tooltips when + another program is dragging stuff over us. */ + + do_help = -1; + + if (!be_drag_and_drop_in_progress ()) + { + inev.kind = DRAG_N_DROP_EVENT; + inev.arg = Qlambda; + + XSETINT (inev.x, b->x); + XSETINT (inev.y, b->y); + XSETFRAME (inev.frame_or_window, f); + } + else + haiku_note_drag_motion (); + + break; + } + } + + if (FRAME_DIRTY_P (f)) + need_flush = 1; + break; + } + case BUTTON_UP: + case BUTTON_DOWN: + { + struct haiku_button_event *b = buf; + struct frame *f = haiku_mouse_or_wdesc_frame (b->window, false); + Lisp_Object tab_bar_arg = Qnil; + int tab_bar_p = 0, tool_bar_p = 0; + bool up_okay_p = false; + + if (popup_activated_p || !f) + continue; + + struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + + inev.modifiers = haiku_modifiers_to_emacs (b->modifiers); + + x_display_list->last_mouse_glyph_frame = 0; + x_display_list->last_mouse_movement_time = b->time / 1000; + button_or_motion_p = 1; + + /* Is this in the tab-bar? */ + if (WINDOWP (f->tab_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tab_bar_window))) + { + Lisp_Object window; + int x = b->x; + int y = b->y; + + window = window_from_coordinates (f, x, y, 0, true, true); + tab_bar_p = EQ (window, f->tab_bar_window); + + if (tab_bar_p) + { + tab_bar_arg = handle_tab_bar_click + (f, x, y, type == BUTTON_DOWN, inev.modifiers); + need_flush = 1; + } + } + + if (WINDOWP (f->tool_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window))) + { + Lisp_Object window; + int x = b->x; + int y = b->y; + + window = window_from_coordinates (f, x, y, 0, true, true); + tool_bar_p = (EQ (window, f->tool_bar_window) + && (type != BUTTON_UP + || f->last_tool_bar_item != -1)); + + if (tool_bar_p) + { + handle_tool_bar_click + (f, x, y, type == BUTTON_DOWN, inev.modifiers); + need_flush = 1; + } + } + + if (type == BUTTON_UP) + { + inev.modifiers |= up_modifier; + up_okay_p = (dpyinfo->grabbed & (1 << b->btn_no)); + dpyinfo->grabbed &= ~(1 << b->btn_no); + } + else + { + up_okay_p = true; + inev.modifiers |= down_modifier; + dpyinfo->last_mouse_frame = f; + dpyinfo->grabbed |= (1 << b->btn_no); + if (f && !tab_bar_p) + f->last_tab_bar_item = -1; + if (f && !tool_bar_p) + f->last_tool_bar_item = -1; + } + + if (up_okay_p + && !(tab_bar_p && NILP (tab_bar_arg)) + && !tool_bar_p) + inev.kind = MOUSE_CLICK_EVENT; + inev.arg = tab_bar_arg; + inev.code = b->btn_no; + + f->mouse_moved = false; + + XSETINT (inev.x, b->x); + XSETINT (inev.y, b->y); + + XSETFRAME (inev.frame_or_window, f); + break; + } + case ICONIFICATION: + { + struct haiku_iconification_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + if (!b->iconified_p) + { + SET_FRAME_VISIBLE (f, 1); + SET_FRAME_ICONIFIED (f, 0); + inev.kind = DEICONIFY_EVENT; + + + /* Haiku doesn't expose frames on deiconification, but + if we are double-buffered, the previous screen + contents should have been preserved. */ + if (!EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f))) + { + SET_FRAME_GARBAGED (f); + expose_frame (f, 0, 0, 0, 0); + } + } + else + { + SET_FRAME_VISIBLE (f, 0); + SET_FRAME_ICONIFIED (f, 1); + inev.kind = ICONIFY_EVENT; + } + + XSETFRAME (inev.frame_or_window, f); + break; + } + case MOVE_EVENT: + { + struct haiku_move_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + if (FRAME_PARENT_FRAME (f)) + haiku_coords_from_parent (f, &b->x, &b->y); + + if (b->x != f->left_pos || b->y != f->top_pos) + { + inev.kind = MOVE_FRAME_EVENT; + + XSETINT (inev.x, b->x); + XSETINT (inev.y, b->y); + + f->left_pos = b->x; + f->top_pos = b->y; + + struct frame *p; + + if ((p = FRAME_PARENT_FRAME (f))) + { + void *window = FRAME_HAIKU_WINDOW (p); + EmacsWindow_move_weak_child (window, b->window, b->x, b->y); + } + + XSETFRAME (inev.frame_or_window, f); + } + + haiku_make_fullscreen_consistent (f); + break; + } + case SCROLL_BAR_VALUE_EVENT: + { + struct haiku_scroll_bar_value_event *b = buf; + struct scroll_bar *bar + = haiku_scroll_bar_from_widget (b->scroll_bar, b->window); + int portion, whole; + + if (!bar) + continue; + + struct window *w = XWINDOW (bar->window); + + if (bar->update != -1) + { + bar->update = -1; + break; + } + + if (bar->position != b->position) + { + inev.kind = (bar->horizontal + ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT : + SCROLL_BAR_CLICK_EVENT); + inev.part = bar->horizontal ? + scroll_bar_horizontal_handle : scroll_bar_handle; + + if (bar->horizontal) + { + portion = bar->total * ((float) b->position + / BE_SB_MAX); + whole = (bar->total + * ((float) (BE_SB_MAX - bar->page_size) + / BE_SB_MAX)); + portion = min (portion, whole); + } + else + { + whole = BE_SB_MAX - bar->page_size; + portion = min (b->position, whole); + } + + XSETINT (inev.x, portion); + XSETINT (inev.y, whole); + XSETWINDOW (inev.frame_or_window, w); + } + break; + } + case SCROLL_BAR_PART_EVENT: + { + struct haiku_scroll_bar_part_event *b = buf; + struct scroll_bar *bar + = haiku_scroll_bar_from_widget (b->scroll_bar, b->window); + + if (!bar) + continue; + + inev.kind = (bar->horizontal ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT + : SCROLL_BAR_CLICK_EVENT); + + bar->dragging = 0; + + switch (b->part) + { + case HAIKU_SCROLL_BAR_UP_BUTTON: + inev.part = (bar->horizontal + ? scroll_bar_left_arrow + : scroll_bar_up_arrow); + break; + case HAIKU_SCROLL_BAR_DOWN_BUTTON: + inev.part = (bar->horizontal + ? scroll_bar_right_arrow + : scroll_bar_down_arrow); + break; + } + + XSETINT (inev.x, 0); + XSETINT (inev.y, 0); + inev.frame_or_window = bar->window; + + break; + } + case SCROLL_BAR_DRAG_EVENT: + { + struct haiku_scroll_bar_drag_event *b = buf; + struct scroll_bar *bar + = haiku_scroll_bar_from_widget (b->scroll_bar, b->window); + + if (!bar) + continue; + + bar->dragging = b->dragging_p; + if (!b->dragging_p && bar->horizontal) + set_horizontal_scroll_bar (XWINDOW (bar->window)); + else if (!b->dragging_p) + set_vertical_scroll_bar (XWINDOW (bar->window)); + break; + } + case WHEEL_MOVE_EVENT: + { + struct haiku_wheel_move_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + int x, y, scroll_width, scroll_height; + static float px = 0.0f, py = 0.0f; + Lisp_Object wheel_window; + + if (!f) + continue; + + BView_get_mouse (FRAME_HAIKU_VIEW (f), &x, &y); + + wheel_window = window_from_coordinates (f, x, y, 0, false, false); + + if (NILP (wheel_window)) + { + scroll_width = FRAME_PIXEL_WIDTH (f); + scroll_height = FRAME_PIXEL_HEIGHT (f); + } + else + { + scroll_width = XWINDOW (wheel_window)->pixel_width; + scroll_height = XWINDOW (wheel_window)->pixel_height; + } + + inev.modifiers = haiku_modifiers_to_emacs (b->modifiers); + + inev2.modifiers = inev.modifiers; + + if (signbit (px) != signbit (b->delta_x)) + px = 0; + + if (signbit (py) != signbit (b->delta_y)) + py = 0; + + px += (b->delta_x + * powf (scroll_width, 2.0f / 3.0f)); + py += (b->delta_y + * powf (scroll_height, 2.0f / 3.0f)); + + if (fabsf (py) >= FRAME_LINE_HEIGHT (f) + || fabsf (px) >= FRAME_COLUMN_WIDTH (f) + || !mwheel_coalesce_scroll_events) + { + inev.kind = (fabsf (px) > fabsf (py) + ? HORIZ_WHEEL_EVENT + : WHEEL_EVENT); + inev.code = 0; + + XSETINT (inev.x, x); + XSETINT (inev.y, y); + inev.arg = list3 (Qnil, make_float (-px), + make_float (-py)); + XSETFRAME (inev.frame_or_window, f); + + inev.modifiers |= (signbit (inev.kind == HORIZ_WHEEL_EVENT + ? px : py) + ? up_modifier + : down_modifier); + py = 0.0f; + px = 0.0f; + } + + break; + } + + case MENU_BAR_RESIZE: + { + struct haiku_menu_bar_resize_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) + continue; + + int old_height = FRAME_MENU_BAR_HEIGHT (f); + + FRAME_MENU_BAR_HEIGHT (f) = b->height + 1; + FRAME_MENU_BAR_LINES (f) = + (b->height + FRAME_LINE_HEIGHT (f)) / FRAME_LINE_HEIGHT (f); + + if (old_height != b->height) + { + adjust_frame_size (f, -1, -1, 3, true, Qmenu_bar_lines); + haiku_clear_under_internal_border (f); + } + break; + } + case MENU_BAR_OPEN: + case MENU_BAR_CLOSE: + { + struct haiku_menu_bar_state_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + int was_waiting_for_input_p; + + if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) + continue; + + if (type == MENU_BAR_OPEN) + { + was_waiting_for_input_p = waiting_for_input; + if (waiting_for_input) + waiting_for_input = 0; + + set_frame_menubar (f, 1); + waiting_for_input = was_waiting_for_input_p; + + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; + popup_activated_p += 1; + + EmacsWindow_signal_menu_update_complete (b->window); + } + else + { + if (!popup_activated_p) + emacs_abort (); + if (FRAME_OUTPUT_DATA (f)->menu_bar_open_p) + { + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 0; + popup_activated_p -= 1; + } + } + break; + } + case MENU_BAR_SELECT_EVENT: + { + struct haiku_menu_bar_select_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) + continue; + + if (FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) + find_and_call_menu_selection (f, f->menu_bar_items_used, + f->menu_bar_vector, b->ptr); + break; + } + case FILE_PANEL_EVENT: + { + if (!popup_activated_p) + continue; + + struct unhandled_event *ev = xmalloc (sizeof *ev); + ev->next = unhandled_events; + ev->type = type; + memcpy (&ev->buffer, buf, 200); + + unhandled_events = ev; + break; + } + case MENU_BAR_HELP_EVENT: + { + struct haiku_menu_bar_help_event *b = buf; + + if (!popup_activated_p) + continue; + + struct frame *f = haiku_window_to_frame (b->window); + if (!f || !FRAME_EXTERNAL_MENU_BAR (f) || + !FRAME_OUTPUT_DATA (f)->menu_bar_open_p) + continue; + + run_menu_bar_help_event (f, b->mb_idx); + + break; + } + case ZOOM_EVENT: + { + struct haiku_zoom_event *b = buf; + + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + FRAME_OUTPUT_DATA (f)->zoomed_p = b->zoomed; + haiku_make_fullscreen_consistent (f); + break; + } + case DRAG_AND_DROP_EVENT: + { + struct haiku_drag_and_drop_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + { + BMessage_delete (b->message); + continue; + } + + inev.kind = DRAG_N_DROP_EVENT; + inev.arg = haiku_message_to_lisp (b->message); + + XSETINT (inev.x, b->x); + XSETINT (inev.y, b->y); + XSETFRAME (inev.frame_or_window, f); + + BMessage_delete (b->message); + break; + } + case APP_QUIT_REQUESTED_EVENT: + case KEY_UP: + case DUMMY_EVENT: + default: + break; + } + + haiku_read_size (&b_size, false); + + if (inev.kind != NO_EVENT) + { + if (inev.kind != HELP_EVENT && !inev.timestamp) + inev.timestamp = (button_or_motion_p + ? x_display_list->last_mouse_movement_time + : system_time () / 1000); + kbd_buffer_store_event_hold (&inev, hold_quit); + ++message_count; + } + + if (inev2.kind != NO_EVENT) + { + if (inev2.kind != HELP_EVENT && !inev.timestamp) + inev2.timestamp = (button_or_motion_p + ? x_display_list->last_mouse_movement_time + : system_time () / 1000); + kbd_buffer_store_event_hold (&inev2, hold_quit); + ++message_count; + } + } + + for (struct unhandled_event *ev = unhandled_events; ev;) + { + haiku_write_without_signal (ev->type, &ev->buffer, false); + struct unhandled_event *old = ev; + ev = old->next; + xfree (old); + } + + if (do_help && !(hold_quit && hold_quit->kind != NO_EVENT)) + { + Lisp_Object help_frame = Qnil; + + if (x_display_list->last_mouse_frame) + XSETFRAME (help_frame, + x_display_list->last_mouse_frame); + + if (do_help > 0) + { + any_help_event_p = true; + gen_help_event (help_echo_string, help_frame, + help_echo_window, help_echo_object, + help_echo_pos); + } + else + { + help_echo_string = Qnil; + gen_help_event (Qnil, help_frame, Qnil, Qnil, 0); + } + } + + if (need_flush) + flush_dirty_back_buffers (); + + unblock_input (); + + return message_count; +} + +static void +haiku_frame_rehighlight (struct frame *frame) +{ + haiku_rehighlight (); +} + +static void +haiku_delete_window (struct frame *f) +{ + check_window_system (f); + haiku_free_frame_resources (f); +} + +static void +haiku_free_pixmap (struct frame *f, Emacs_Pixmap pixmap) +{ + BBitmap_free (pixmap); +} + +static void +haiku_flash (struct frame *f) +{ + /* Get the height not including a menu bar widget. */ + int height = FRAME_PIXEL_HEIGHT (f); + /* Height of each line to flash. */ + int flash_height = FRAME_LINE_HEIGHT (f); + /* These will be the left and right margins of the rectangles. */ + int flash_left = FRAME_INTERNAL_BORDER_WIDTH (f); + int flash_right = FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f); + int width = flash_right - flash_left; + void *view = FRAME_HAIKU_VIEW (f); + object_wait_info info; + bigtime_t wakeup; + + info.object = port_application_to_emacs; + info.type = B_OBJECT_TYPE_PORT; + info.events = B_EVENT_READ; + wakeup = system_time () + 150000; + + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + BView_StartClip (view); + /* If window is tall, flash top and bottom line. */ + if (height > 3 * FRAME_LINE_HEIGHT (f)) + { + BView_InvertRect (view, flash_left, + (FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_TOP_MARGIN_HEIGHT (f)), + width, flash_height); + + BView_InvertRect (view, flash_left, + (height - flash_height + - FRAME_INTERNAL_BORDER_WIDTH (f)), + width, flash_height); + } + else + /* If it is short, flash it all. */ + BView_InvertRect (view, flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), + width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + BView_EndClip (view); + BView_draw_unlock (view); + + flush_frame (f); + + if (EmacsView_double_buffered_p (view)) + haiku_flip_buffers (f); + + /* Keep waiting until past the time wakeup or any input gets + available. */ + while (!detect_input_pending ()) + { + /* Break if result would not be positive. */ + if (wakeup < system_time ()) + break; + + /* Try to wait that long--but we might wake up sooner. */ + wait_for_objects_etc (&info, 1, B_ABSOLUTE_TIMEOUT, wakeup); + + if (info.events & B_EVENT_READ) + break; + + info.events = B_EVENT_READ; + } + + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + BView_StartClip (view); + /* If window is tall, flash top and bottom line. */ + if (height > 3 * FRAME_LINE_HEIGHT (f)) + { + BView_InvertRect (view, flash_left, + (FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_TOP_MARGIN_HEIGHT (f)), + width, flash_height); + + BView_InvertRect (view, flash_left, + (height - flash_height + - FRAME_INTERNAL_BORDER_WIDTH (f)), + width, flash_height); + } + else + /* If it is short, flash it all. */ + BView_InvertRect (view, flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), + width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + BView_EndClip (view); + BView_draw_unlock (view); + + flush_frame (f); + if (EmacsView_double_buffered_p (view)) + haiku_flip_buffers (f); +} + +static void +haiku_beep (struct frame *f) +{ + if (visible_bell) + { + void *view = FRAME_HAIKU_VIEW (f); + if (view) + { + block_input (); + haiku_flash (f); + unblock_input (); + } + } + else + haiku_ring_bell (); +} + +static void +haiku_toggle_invisible_pointer (struct frame *f, bool invisible_p) +{ + void *view = FRAME_HAIKU_VIEW (f); + + if (view) + { + block_input (); + BView_set_view_cursor (view, invisible_p ? + FRAME_OUTPUT_DATA (f)->no_cursor : + FRAME_OUTPUT_DATA (f)->current_cursor); + f->pointer_invisible = invisible_p; + unblock_input (); + } +} + +static void +haiku_fullscreen (struct frame *f) +{ + /* When FRAME_OUTPUT_DATA (f)->configury_done is false, the frame is + being created, and its regular width and height have not yet been + set. This function will be called again by haiku_create_frame, + so do nothing. */ + if (!FRAME_OUTPUT_DATA (f)->configury_done) + return; + + if (f->want_fullscreen == FULLSCREEN_MAXIMIZED) + BWindow_zoom (FRAME_HAIKU_WINDOW (f)); + else if (f->want_fullscreen == FULLSCREEN_BOTH) + EmacsWindow_make_fullscreen (FRAME_HAIKU_WINDOW (f), 1); + else + { + EmacsWindow_make_fullscreen (FRAME_HAIKU_WINDOW (f), 0); + EmacsWindow_unzoom (FRAME_HAIKU_WINDOW (f)); + } + + f->want_fullscreen = FULLSCREEN_NONE; + + haiku_update_size_hints (f); +} + +static struct terminal * +haiku_create_terminal (struct haiku_display_info *dpyinfo) +{ + struct terminal *terminal; + + terminal = create_terminal (output_haiku, &haiku_redisplay_interface); + + terminal->display_info.haiku = dpyinfo; + dpyinfo->terminal = terminal; + terminal->kboard = allocate_kboard (Qhaiku); + + terminal->iconify_frame_hook = haiku_iconify_frame; + terminal->focus_frame_hook = haiku_focus_frame; + terminal->ring_bell_hook = haiku_beep; + terminal->popup_dialog_hook = haiku_popup_dialog; + terminal->frame_visible_invisible_hook = haiku_set_frame_visible_invisible; + terminal->set_frame_offset_hook = haiku_set_offset; + terminal->delete_terminal_hook = haiku_delete_terminal; + terminal->get_string_resource_hook = get_string_resource; + terminal->set_new_font_hook = haiku_new_font; + terminal->defined_color_hook = haiku_defined_color; + terminal->set_window_size_hook = haiku_set_window_size; + terminal->read_socket_hook = haiku_read_socket; + terminal->implicit_set_name_hook = haiku_implicitly_set_name; + terminal->mouse_position_hook = haiku_mouse_position; + terminal->delete_frame_hook = haiku_delete_window; + terminal->frame_up_to_date_hook = haiku_frame_up_to_date; + terminal->buffer_flipping_unblocked_hook = haiku_buffer_flipping_unblocked_hook; + terminal->clear_frame_hook = haiku_clear_frame; + terminal->change_tab_bar_height_hook = haiku_change_tab_bar_height; + terminal->change_tool_bar_height_hook = haiku_change_tool_bar_height; + terminal->set_vertical_scroll_bar_hook = haiku_set_vertical_scroll_bar; + terminal->set_horizontal_scroll_bar_hook = haiku_set_horizontal_scroll_bar; + terminal->set_scroll_bar_default_height_hook = haiku_set_scroll_bar_default_height; + terminal->set_scroll_bar_default_width_hook = haiku_set_scroll_bar_default_width; + terminal->judge_scroll_bars_hook = haiku_judge_scroll_bars; + terminal->condemn_scroll_bars_hook = haiku_condemn_scroll_bars; + terminal->redeem_scroll_bar_hook = haiku_redeem_scroll_bar; + terminal->update_begin_hook = haiku_update_begin; + terminal->update_end_hook = haiku_update_end; + terminal->frame_rehighlight_hook = haiku_frame_rehighlight; + terminal->query_frame_background_color = haiku_query_frame_background_color; + terminal->free_pixmap = haiku_free_pixmap; + terminal->frame_raise_lower_hook = haiku_frame_raise_lower; + terminal->menu_show_hook = haiku_menu_show; + terminal->toggle_invisible_pointer_hook = haiku_toggle_invisible_pointer; + terminal->fullscreen_hook = haiku_fullscreen; + terminal->toolkit_position_hook = haiku_toolkit_position; + + return terminal; +} + +struct haiku_display_info * +haiku_term_init (void) +{ + struct haiku_display_info *dpyinfo; + struct terminal *terminal; + + Lisp_Object color_file, color_map; + + block_input (); + Fset_input_interrupt_mode (Qt); + + baud_rate = 19200; + + dpyinfo = xzalloc (sizeof *dpyinfo); + + haiku_io_init (); + + if (port_application_to_emacs < B_OK) + emacs_abort (); + + color_file = Fexpand_file_name (build_string ("rgb.txt"), + Fsymbol_value (intern ("data-directory"))); + + color_map = Fx_load_color_file (color_file); + if (NILP (color_map)) + fatal ("Could not read %s.\n", SDATA (color_file)); + + dpyinfo->color_map = color_map; + + dpyinfo->display = BApplication_setup (); + + BScreen_res (&dpyinfo->resx, &dpyinfo->resy); + + dpyinfo->next = x_display_list; + dpyinfo->n_planes = be_get_display_planes (); + x_display_list = dpyinfo; + + terminal = haiku_create_terminal (dpyinfo); + if (current_kboard == initial_kboard) + current_kboard = terminal->kboard; + + terminal->kboard->reference_count++; + /* Never delete haiku displays -- there can only ever be one, + anyhow. */ + terminal->reference_count++; + terminal->name = xstrdup ("be"); + + dpyinfo->name_list_element = Fcons (build_string ("be"), Qnil); + dpyinfo->smallest_font_height = 1; + dpyinfo->smallest_char_width = 1; + + gui_init_fringe (terminal->rif); + +#define ASSIGN_CURSOR(cursor, be_cursor) (dpyinfo->cursor = be_cursor) + ASSIGN_CURSOR (text_cursor, BCursor_create_i_beam ()); + ASSIGN_CURSOR (nontext_cursor, BCursor_create_default ()); + ASSIGN_CURSOR (modeline_cursor, BCursor_create_modeline ()); + ASSIGN_CURSOR (hand_cursor, BCursor_create_grab ()); + ASSIGN_CURSOR (hourglass_cursor, BCursor_create_progress_cursor ()); + ASSIGN_CURSOR (horizontal_drag_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_EAST_WEST)); + ASSIGN_CURSOR (vertical_drag_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_NORTH_SOUTH)); + ASSIGN_CURSOR (left_edge_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_WEST)); + ASSIGN_CURSOR (top_left_corner_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_NORTH_WEST)); + ASSIGN_CURSOR (top_edge_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_NORTH)); + ASSIGN_CURSOR (top_right_corner_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_NORTH_EAST)); + ASSIGN_CURSOR (right_edge_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_EAST)); + ASSIGN_CURSOR (bottom_right_corner_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_SOUTH_EAST)); + ASSIGN_CURSOR (bottom_edge_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_SOUTH)); + ASSIGN_CURSOR (bottom_left_corner_cursor, + BCursor_from_id (CURSOR_ID_RESIZE_SOUTH_WEST)); + ASSIGN_CURSOR (no_cursor, + BCursor_from_id (CURSOR_ID_NO_CURSOR)); +#undef ASSIGN_CURSOR + + unblock_input (); + + return dpyinfo; +} + +void +put_xrm_resource (Lisp_Object name, Lisp_Object val) +{ + eassert (STRINGP (name)); + eassert (STRINGP (val) || NILP (val)); + + Lisp_Object lval = assoc_no_quit (name, rdb); + if (!NILP (lval)) + Fsetcdr (lval, val); + else + rdb = Fcons (Fcons (name, val), rdb); +} + +void +haiku_clear_under_internal_border (struct frame *f) +{ + if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0 + /* This is needed because tooltip frames set up the internal + border before init_frame_faces. */ + && FRAME_FACE_CACHE (f)) + { + 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) + ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID) + : CHILD_FRAME_BORDER_FACE_ID) + : (!NILP (Vface_remapping_alist) + ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID) + : INTERNAL_BORDER_FACE_ID)); + struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); + void *view = FRAME_HAIKU_VIEW (f); + block_input (); + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + BView_StartClip (view); + BView_ClipToRect (view, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + + if (face) + BView_SetHighColor (view, face->background); + else + BView_SetHighColor (view, FRAME_BACKGROUND_PIXEL (f)); + + BView_FillRectangle (view, 0, margin, width, border); + BView_FillRectangle (view, 0, 0, border, height); + BView_FillRectangle (view, 0, margin, width, border); + BView_FillRectangle (view, width - border, 0, border, height); + BView_FillRectangle (view, 0, height - border, width, border); + BView_EndClip (view); + BView_draw_unlock (view); + unblock_input (); + } +} + +void +mark_haiku_display (void) +{ + if (x_display_list) + mark_object (x_display_list->color_map); +} + +void +haiku_scroll_bar_remove (struct scroll_bar *bar) +{ + block_input (); + void *view = FRAME_HAIKU_VIEW (WINDOW_XFRAME (XWINDOW (bar->window))); + BView_forget_scroll_bar (view, bar->left, bar->top, bar->width, bar->height); + BScrollBar_delete (bar->scroll_bar); + expose_frame (WINDOW_XFRAME (XWINDOW (bar->window)), + bar->left, bar->top, bar->width, bar->height); + + if (bar->horizontal) + wset_horizontal_scroll_bar (XWINDOW (bar->window), Qnil); + else + wset_vertical_scroll_bar (XWINDOW (bar->window), Qnil); + + unblock_input (); +}; + +void +haiku_set_offset (struct frame *frame, int x, int y, + int change_gravity) +{ + if (change_gravity > 0) + { + frame->top_pos = y; + frame->left_pos = x; + frame->size_hint_flags &= ~ (XNegative | YNegative); + if (x < 0) + frame->size_hint_flags |= XNegative; + if (y < 0) + frame->size_hint_flags |= YNegative; + frame->win_gravity = NorthWestGravity; + } + + haiku_update_size_hints (frame); + + block_input (); + if (change_gravity) + BWindow_set_offset (FRAME_HAIKU_WINDOW (frame), x, y); + unblock_input (); +} + +#ifdef USE_BE_CAIRO +cairo_t * +haiku_begin_cr_clip (struct frame *f, struct glyph_string *s) +{ + cairo_t *cr = FRAME_CR_CONTEXT (f); + + if (!cr) + return NULL; + + cairo_save (cr); + return cr; +} + +void +haiku_end_cr_clip (cairo_t *cr) +{ + if (!cr) + return; + + cairo_restore (cr); +} +#endif + +void +haiku_merge_cursor_foreground (struct glyph_string *s, + unsigned long *foreground_out, + unsigned long *background_out) +{ + unsigned long background = FRAME_CURSOR_COLOR (s->f).pixel; + unsigned long foreground = s->face->background; + + if (background == foreground) + foreground = s->face->background; + if (background == foreground) + foreground = FRAME_OUTPUT_DATA (s->f)->cursor_fg; + if (background == foreground) + foreground = s->face->foreground; + + if (background == s->face->background + || foreground == s->face->foreground) + { + background = s->face->foreground; + foreground = s->face->background; + } + + if (foreground_out) + *foreground_out = foreground; + if (background_out) + *background_out = background; +} + +void +syms_of_haikuterm (void) +{ + DEFVAR_BOOL ("haiku-initialized", haiku_initialized, + doc: /* Non-nil if the Haiku terminal backend has been initialized. */); + + DEFVAR_BOOL ("x-use-underline-position-properties", + x_use_underline_position_properties, + doc: /* SKIP: real doc in xterm.c. */); + x_use_underline_position_properties = 1; + + DEFVAR_BOOL ("x-underline-at-descent-line", + x_underline_at_descent_line, + doc: /* SKIP: real doc in xterm.c. */); + x_underline_at_descent_line = 0; + + DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars, + doc: /* SKIP: real doc in xterm.c. */); + Vx_toolkit_scroll_bars = Qt; + + DEFVAR_BOOL ("haiku-debug-on-fatal-error", haiku_debug_on_fatal_error, + doc: /* If non-nil, Emacs will launch the system debugger upon a fatal error. */); + haiku_debug_on_fatal_error = 1; + + DEFSYM (Qshift, "shift"); + DEFSYM (Qcontrol, "control"); + DEFSYM (Qoption, "option"); + DEFSYM (Qcommand, "command"); + + DEFVAR_LISP ("haiku-meta-keysym", Vhaiku_meta_keysym, + doc: /* Which key Emacs uses as the meta modifier. +This is either one of the symbols `shift', `control', `command', and +`option', or nil, in which case it is treated as `command'. + +Setting it to any other value is equivalent to `command'. */); + Vhaiku_meta_keysym = Qnil; + + DEFVAR_LISP ("haiku-control-keysym", Vhaiku_control_keysym, + doc: /* Which key Emacs uses as the control modifier. +This is either one of the symbols `shift', `control', `command', and +`option', or nil, in which case it is treated as `control'. + +Setting it to any other value is equivalent to `control'. */); + Vhaiku_control_keysym = Qnil; + + DEFVAR_LISP ("haiku-super-keysym", Vhaiku_super_keysym, + doc: /* Which key Emacs uses as the super modifier. +This is either one of the symbols `shift', `control', `command', and +`option', or nil, in which case it is treated as `option'. + +Setting it to any other value is equivalent to `option'. */); + Vhaiku_super_keysym = Qnil; + + DEFVAR_LISP ("haiku-shift-keysym", Vhaiku_shift_keysym, + doc: /* Which key Emacs uses as the shift modifier. +This is either one of the symbols `shift', `control', `command', and +`option', or nil, in which case it is treated as `shift'. + +Setting it to any other value is equivalent to `shift'. */); + Vhaiku_shift_keysym = Qnil; + + + DEFSYM (Qx_use_underline_position_properties, + "x-use-underline-position-properties"); + + DEFSYM (Qx_underline_at_descent_line, "x-underline-at-descent-line"); + + rdb = Qnil; + staticpro (&rdb); + + Fprovide (Qhaiku, Qnil); +#ifdef USE_BE_CAIRO + Fprovide (intern_c_string ("cairo"), Qnil); +#endif +} diff --git a/src/haikuterm.h b/src/haikuterm.h new file mode 100644 index 00000000000..7022ea77dec --- /dev/null +++ b/src/haikuterm.h @@ -0,0 +1,316 @@ +/* Haiku window system support + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#ifndef _HAIKU_TERM_H_ +#define _HAIKU_TERM_H_ + +#include <pthread.h> + +#ifdef USE_BE_CAIRO +#include <cairo.h> +#endif + +#include "haikugui.h" +#include "frame.h" +#include "character.h" +#include "dispextern.h" +#include "font.h" +#include "systime.h" + +#define HAVE_CHAR_CACHE_MAX 65535 + +extern int popup_activated_p; + +struct haikufont_info +{ + struct font font; + haiku be_font; + struct font_metrics **metrics; + short metrics_nrows; + + unsigned short **glyphs; +}; + +struct haiku_bitmap_record +{ + haiku img; + char *file; + int refcount; + int height, width, depth; +}; + +struct haiku_display_info +{ + /* Chain of all haiku_display_info structures. */ + struct haiku_display_info *next; + struct terminal *terminal; + + Lisp_Object name_list_element; + Lisp_Object color_map; + + int n_fonts; + + int smallest_char_width; + int smallest_font_height; + + struct frame *focused_frame; + struct frame *focus_event_frame; + struct frame *last_mouse_glyph_frame; + + struct haiku_bitmap_record *bitmaps; + ptrdiff_t bitmaps_size; + ptrdiff_t bitmaps_last; + + int grabbed; + int n_planes; + int color_p; + + Lisp_Object rdb; + + Emacs_Cursor vertical_scroll_bar_cursor; + Emacs_Cursor horizontal_scroll_bar_cursor; + + Mouse_HLInfo mouse_highlight; + + struct frame *highlight_frame; + struct frame *last_mouse_frame; + struct frame *last_mouse_motion_frame; + + int last_mouse_motion_x; + int last_mouse_motion_y; + + struct haiku_rect last_mouse_glyph; + + void *last_mouse_scroll_bar; + + haiku display; + + double resx, resy; + + Time last_mouse_movement_time; + + Window root_window; + + Emacs_Cursor text_cursor; + Emacs_Cursor nontext_cursor; + Emacs_Cursor modeline_cursor; + Emacs_Cursor hand_cursor; + Emacs_Cursor hourglass_cursor; + Emacs_Cursor horizontal_drag_cursor; + Emacs_Cursor vertical_drag_cursor; + Emacs_Cursor left_edge_cursor; + Emacs_Cursor top_left_corner_cursor; + Emacs_Cursor top_edge_cursor; + Emacs_Cursor top_right_corner_cursor; + Emacs_Cursor right_edge_cursor; + Emacs_Cursor bottom_right_corner_cursor; + Emacs_Cursor bottom_edge_cursor; + Emacs_Cursor bottom_left_corner_cursor; + Emacs_Cursor no_cursor; +}; + +struct haiku_output +{ + struct haiku_display_info *display_info; + + Emacs_Cursor text_cursor; + Emacs_Cursor nontext_cursor; + Emacs_Cursor modeline_cursor; + Emacs_Cursor hand_cursor; + Emacs_Cursor hourglass_cursor; + Emacs_Cursor horizontal_drag_cursor; + Emacs_Cursor vertical_drag_cursor; + Emacs_Cursor left_edge_cursor; + Emacs_Cursor top_left_corner_cursor; + Emacs_Cursor top_edge_cursor; + Emacs_Cursor top_right_corner_cursor; + Emacs_Cursor right_edge_cursor; + Emacs_Cursor bottom_right_corner_cursor; + Emacs_Cursor bottom_edge_cursor; + Emacs_Cursor bottom_left_corner_cursor; + Emacs_Cursor no_cursor; + Emacs_Cursor current_cursor; + + Emacs_Color cursor_color; + + Window parent_desc; + + haiku window; + haiku view; + haiku menubar; + + int menu_up_to_date_p; + int zoomed_p; + int hourglass_p; + int menu_bar_open_p; + int fontset; + int baseline_offset; + + /* Whether or not there is data in a back buffer that hasn't been + displayed yet. */ + bool dirty_p; + + struct font *font; + + /* The pending position we're waiting for. */ + int pending_top, pending_left; + + /* Whether or not adjust_frame_size and haiku_set_offset have yet + been called by haiku_create_frame. */ + bool configury_done; + + /* The default cursor foreground color. */ + uint32_t cursor_fg; +}; + +struct x_output +{ + /* Unused, makes term.c happy. */ +}; + +extern struct haiku_display_info *x_display_list; +extern struct font_driver const haikufont_driver; + +extern Lisp_Object tip_frame; +extern struct frame *haiku_dnd_frame; + +struct scroll_bar +{ + /* These fields are shared by all vectors. */ + union vectorlike_header header; + + /* The window we're a scroll bar for. */ + Lisp_Object window; + + /* The next and previous in the chain of scroll bars in this frame. */ + Lisp_Object next, prev; + + /* Fields after 'prev' are not traced by the GC. */ + + /* The position and size of the scroll bar in pixels, relative to the + frame. */ + int top, left, width, height; + + /* The actual scrollbar. */ + void *scroll_bar; + + /* Non-nil if the scroll bar handle is currently being dragged by + the user. */ + int dragging; + + /* The update position if we are waiting for a scrollbar update, or + -1. */ + int update; + + /* The last known position of this scrollbar. */ + int position; + + /* The total number of units inside this scrollbar. */ + int total; + + /* True if the scroll bar is horizontal. */ + bool horizontal; + + /* The amount of units taken up by the thumb, which represents the + portion of the buffer currently on screen. */ + int page_size; +}; + +#define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) + +#define FRAME_DIRTY_P(f) (FRAME_OUTPUT_DATA (f)->dirty_p) +#define MAKE_FRAME_DIRTY(f) (FRAME_DIRTY_P (f) = 1) +#define FRAME_OUTPUT_DATA(f) ((f)->output_data.haiku) +#define FRAME_HAIKU_WINDOW(f) (FRAME_OUTPUT_DATA (f)->window) +#define FRAME_HAIKU_VIEW(f) ((MAKE_FRAME_DIRTY (f)), FRAME_OUTPUT_DATA (f)->view) +#define FRAME_HAIKU_MENU_BAR(f) (FRAME_OUTPUT_DATA (f)->menubar) +#define FRAME_DISPLAY_INFO(f) (FRAME_OUTPUT_DATA (f)->display_info) +#define FRAME_FONT(f) (FRAME_OUTPUT_DATA (f)->font) +#define FRAME_FONTSET(f) (FRAME_OUTPUT_DATA (f)->fontset) +#define FRAME_NATIVE_WINDOW(f) (FRAME_OUTPUT_DATA (f)->window) +#define FRAME_BASELINE_OFFSET(f) (FRAME_OUTPUT_DATA (f)->baseline_offset) +#define FRAME_CURSOR_COLOR(f) (FRAME_OUTPUT_DATA (f)->cursor_color) + +#ifdef USE_BE_CAIRO +#define FRAME_CR_CONTEXT(f) \ + (FRAME_HAIKU_VIEW (f) \ + ? EmacsView_cairo_context (FRAME_HAIKU_VIEW (f)) \ + : NULL) +#endif + +extern void syms_of_haikuterm (void); +extern void syms_of_haikufns (void); +extern void syms_of_haikumenu (void); +extern void syms_of_haikufont (void); +extern void syms_of_haikuselect (void); +extern void init_haiku_select (void); + +extern void haiku_iconify_frame (struct frame *); +extern void haiku_visualize_frame (struct frame *); +extern void haiku_unvisualize_frame (struct frame *); +extern void haiku_set_offset (struct frame *, int, int, int); +extern void haiku_set_frame_visible_invisible (struct frame *, bool); +extern void haiku_free_frame_resources (struct frame *); +extern void haiku_scroll_bar_remove (struct scroll_bar *); +extern void haiku_clear_under_internal_border (struct frame *); +extern void haiku_set_name (struct frame *, Lisp_Object, bool); +extern Lisp_Object haiku_message_to_lisp (void *); + +extern struct haiku_display_info *haiku_term_init (void); + +extern void mark_haiku_display (void); + +extern int haiku_get_color (const char *, Emacs_Color *); +extern void haiku_set_background_color (struct frame *, Lisp_Object, Lisp_Object); +extern void haiku_set_cursor_color (struct frame *, Lisp_Object, Lisp_Object); +extern void haiku_set_cursor_type (struct frame *, Lisp_Object, Lisp_Object); +extern void haiku_set_internal_border_width (struct frame *, Lisp_Object, Lisp_Object); +extern void haiku_change_tab_bar_height (struct frame *, int); +extern void haiku_change_tool_bar_height (struct frame *, int); + +extern void haiku_query_color (uint32_t, Emacs_Color *); + +extern unsigned long haiku_get_pixel (haiku, int, int); +extern void haiku_put_pixel (haiku, int, int, unsigned long); + +extern Lisp_Object haiku_menu_show (struct frame *, int, int, int, + Lisp_Object, const char **); +extern Lisp_Object haiku_popup_dialog (struct frame *, Lisp_Object, Lisp_Object); +extern void haiku_note_drag_motion (void); + +extern void initialize_frame_menubar (struct frame *); + +extern void run_menu_bar_help_event (struct frame *, int); +extern void put_xrm_resource (Lisp_Object, Lisp_Object); + +#ifdef HAVE_NATIVE_IMAGE_API +extern bool haiku_can_use_native_image_api (Lisp_Object); +extern int haiku_load_image (struct frame *, struct image *, + Lisp_Object, Lisp_Object); +extern void syms_of_haikuimage (void); +#endif + +#ifdef USE_BE_CAIRO +extern cairo_t *haiku_begin_cr_clip (struct frame *, struct glyph_string *); + +extern void haiku_end_cr_clip (cairo_t *); +#endif + +extern void haiku_merge_cursor_foreground (struct glyph_string *, unsigned long *, + unsigned long *); +#endif /* _HAIKU_TERM_H_ */ diff --git a/src/image.c b/src/image.c index c2e76d5bfcd..e4b56e29cff 100644 --- a/src/image.c +++ b/src/image.c @@ -20,6 +20,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> #include <fcntl.h> +#include <math.h> #include <unistd.h> /* Include this before including <setjmp.h> to work around bugs with @@ -30,6 +31,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <setjmp.h> +#include <math.h> #include <stdint.h> #include <c-ctype.h> #include <flexmember.h> @@ -78,27 +80,40 @@ typedef struct x_bitmap_record Bitmap_Record; #endif /* !USE_CAIRO */ #endif /* HAVE_X_WINDOWS */ -#ifdef USE_CAIRO -#define GET_PIXEL image_pix_context_get_pixel -#define PUT_PIXEL image_pix_container_put_pixel -#define NO_PIXMAP 0 - -#define PIX_MASK_RETAIN 0 -#define PIX_MASK_DRAW 255 - +#if defined(USE_CAIRO) || defined(HAVE_NS) #define RGB_TO_ULONG(r, g, b) (((r) << 16) | ((g) << 8) | (b)) +#ifndef HAVE_NS #define ARGB_TO_ULONG(a, r, g, b) (((a) << 24) | ((r) << 16) | ((g) << 8) | (b)) +#endif #define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) #define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) #define BLUE_FROM_ULONG(color) ((color) & 0xff) #define RED16_FROM_ULONG(color) (RED_FROM_ULONG (color) * 0x101) #define GREEN16_FROM_ULONG(color) (GREEN_FROM_ULONG (color) * 0x101) #define BLUE16_FROM_ULONG(color) (BLUE_FROM_ULONG (color) * 0x101) +#endif + +#ifdef USE_CAIRO +#define GET_PIXEL image_pix_context_get_pixel +#define PUT_PIXEL image_pix_container_put_pixel +#define NO_PIXMAP 0 + +#define PIX_MASK_RETAIN 0 +#define PIX_MASK_DRAW 255 static unsigned long image_alloc_image_color (struct frame *, struct image *, Lisp_Object, unsigned long); #endif /* USE_CAIRO */ +#if defined HAVE_PGTK && defined HAVE_IMAGEMAGICK +/* In pgtk, we don't want to create scaled image. If we create scaled + * image on scale=2.0 environment, the created image is half size and + * Gdk scales it back, and the result is blurry. To avoid this, we + * hold original size image as far as we can, and let Gdk to scale it + * when it is shown. */ +# define DONT_CREATE_TRANSFORMED_IMAGEMAGICK_IMAGE +#endif + #ifdef HAVE_NTGUI /* We need (or want) w32.h only when we're _not_ compiling for Cygwin. */ @@ -129,12 +144,37 @@ typedef struct ns_bitmap_record Bitmap_Record; #endif /* HAVE_NS */ +#ifdef HAVE_PGTK +typedef struct pgtk_bitmap_record Bitmap_Record; +#endif /* HAVE_PGTK */ + #if (defined HAVE_X_WINDOWS \ && ! (defined HAVE_NTGUI || defined USE_CAIRO || defined HAVE_NS)) /* W32_TODO : Color tables on W32. */ # define COLOR_TABLE_SUPPORT 1 #endif +#ifdef HAVE_HAIKU +#include "haiku_support.h" +typedef struct haiku_bitmap_record Bitmap_Record; + +#define GET_PIXEL(ximg, x, y) haiku_get_pixel (ximg, x, y) +#define PUT_PIXEL haiku_put_pixel +#define NO_PIXMAP 0 + +#define PIX_MASK_RETAIN 0 +#define PIX_MASK_DRAW 1 + +#define RGB_TO_ULONG(r, g, b) (((r) << 16) | ((g) << 8) | (b)) +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) +#define RED16_FROM_ULONG(color) (RED_FROM_ULONG (color) * 0x101) +#define GREEN16_FROM_ULONG(color) (GREEN_FROM_ULONG (color) * 0x101) +#define BLUE16_FROM_ULONG(color) (BLUE_FROM_ULONG (color) * 0x101) + +#endif + static void image_disable_image (struct frame *, struct image *); static void image_edge_detection (struct frame *, struct image *, Lisp_Object, Lisp_Object); @@ -396,6 +436,34 @@ image_reference_bitmap (struct frame *f, ptrdiff_t id) ++FRAME_DISPLAY_INFO (f)->bitmaps[id - 1].refcount; } +#ifdef HAVE_PGTK +static cairo_pattern_t * +image_create_pattern_from_pixbuf (struct frame *f, GdkPixbuf * pixbuf) +{ + GdkPixbuf *pb = gdk_pixbuf_add_alpha (pixbuf, TRUE, 255, 255, 255); + cairo_surface_t *surface = + cairo_surface_create_similar_image (cairo_get_target + (f->output_data.pgtk->cr_context), + CAIRO_FORMAT_A1, + gdk_pixbuf_get_width (pb), + gdk_pixbuf_get_height (pb)); + + cairo_t *cr = cairo_create (surface); + gdk_cairo_set_source_pixbuf (cr, pb, 0, 0); + cairo_set_operator (cr, CAIRO_OPERATOR_SOURCE); + cairo_paint (cr); + cairo_destroy (cr); + + cairo_pattern_t *pat = cairo_pattern_create_for_surface (surface); + cairo_pattern_set_extend (pat, CAIRO_EXTEND_REPEAT); + + cairo_surface_destroy (surface); + g_object_unref (pb); + + return pat; +} +#endif + /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */ ptrdiff_t @@ -430,6 +498,58 @@ image_create_bitmap_from_data (struct frame *f, char *bits, return -1; #endif +#ifdef HAVE_PGTK + GdkPixbuf *pixbuf = gdk_pixbuf_new (GDK_COLORSPACE_RGB, + FALSE, + 8, + width, + height); + { + char *sp = bits; + int mask = 0x01; + unsigned char *buf = gdk_pixbuf_get_pixels (pixbuf); + int rowstride = gdk_pixbuf_get_rowstride (pixbuf); + for (int y = 0; y < height; y++) + { + unsigned char *dp = buf + rowstride * y; + for (int x = 0; x < width; x++) + { + if (*sp & mask) + { + *dp++ = 0xff; + *dp++ = 0xff; + *dp++ = 0xff; + } + else + { + *dp++ = 0x00; + *dp++ = 0x00; + *dp++ = 0x00; + } + if ((mask <<= 1) >= 0x100) + { + mask = 0x01; + sp++; + } + } + if (mask != 0x01) + { + mask = 0x01; + sp++; + } + } + } +#endif /* HAVE_PGTK */ + +#ifdef HAVE_HAIKU + void *bitmap = BBitmap_new (width, height, 1); + + if (!bitmap) + return -1; + + BBitmap_import_mono_bits (bitmap, bits, width, height); +#endif + id = image_allocate_bitmap_record (f); #ifdef HAVE_NS @@ -437,6 +557,18 @@ image_create_bitmap_from_data (struct frame *f, char *bits, dpyinfo->bitmaps[id - 1].depth = 1; #endif +#ifdef HAVE_PGTK + dpyinfo->bitmaps[id - 1].img = pixbuf; + dpyinfo->bitmaps[id - 1].depth = 1; + dpyinfo->bitmaps[id - 1].pattern = + image_create_pattern_from_pixbuf (f, pixbuf); +#endif + +#ifdef HAVE_HAIKU + dpyinfo->bitmaps[id - 1].img = bitmap; + dpyinfo->bitmaps[id - 1].depth = 1; +#endif + dpyinfo->bitmaps[id - 1].file = NULL; dpyinfo->bitmaps[id - 1].height = height; dpyinfo->bitmaps[id - 1].width = width; @@ -465,7 +597,7 @@ image_create_bitmap_from_data (struct frame *f, char *bits, ptrdiff_t image_create_bitmap_from_file (struct frame *f, Lisp_Object file) { -#ifdef HAVE_NTGUI +#if defined (HAVE_NTGUI) || defined (HAVE_HAIKU) return -1; /* W32_TODO : bitmap support */ #else Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); @@ -489,6 +621,30 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) return id; #endif +#ifdef HAVE_PGTK + GError *err = NULL; + ptrdiff_t id; + void * bitmap = gdk_pixbuf_new_from_file (SSDATA (file), &err); + + if (!bitmap) + { + g_error_free (err); + return -1; + } + + id = image_allocate_bitmap_record (f); + + dpyinfo->bitmaps[id - 1].img = bitmap; + dpyinfo->bitmaps[id - 1].refcount = 1; + dpyinfo->bitmaps[id - 1].file = xlispstrdup (file); + //dpyinfo->bitmaps[id - 1].depth = 1; + dpyinfo->bitmaps[id - 1].height = gdk_pixbuf_get_width (bitmap); + dpyinfo->bitmaps[id - 1].width = gdk_pixbuf_get_height (bitmap); + dpyinfo->bitmaps[id - 1].pattern + = image_create_pattern_from_pixbuf (f, bitmap); + return id; +#endif + #ifdef HAVE_X_WINDOWS unsigned int width, height; Pixmap bitmap; @@ -561,6 +717,15 @@ free_bitmap_record (Display_Info *dpyinfo, Bitmap_Record *bm) ns_release_object (bm->img); #endif +#ifdef HAVE_PGTK + if (bm->pattern != NULL) + cairo_pattern_destroy (bm->pattern); +#endif + +#ifdef HAVE_HAIKU + BBitmap_free (bm->img); +#endif + if (bm->file) { xfree (bm->file); @@ -1016,7 +1181,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, return false; maybe_done: - if (EQ (XCDR (plist), Qnil)) + if (NILP (XCDR (plist))) { /* Check that all mandatory fields are present. */ for (i = 0; i < nkeywords; ++i) @@ -1321,7 +1486,6 @@ image_ascent (struct image *img, struct face *face, struct glyph_slice *slice) return ascent; } - /* Image background colors. */ @@ -1345,6 +1509,7 @@ four_corners_best (Emacs_Pix_Context pimg, int *corners, corner_pixels[3] = GET_PIXEL (pimg, corners[LEFT_CORNER], corners[BOT_CORNER] - 1); } else + { /* Get the colors at the corner_pixels of pimg. */ corner_pixels[0] = GET_PIXEL (pimg, 0, 0); @@ -1631,13 +1796,50 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash, } +/* Filter out image elements that don't affect display, but will + disrupt finding the image in the cache. This should perhaps be + user-configurable, but for now it's hard-coded (but new elements + can be added at will). */ +static Lisp_Object +filter_image_spec (Lisp_Object spec) +{ + Lisp_Object out = Qnil; + + /* Skip past the `image' element. */ + if (CONSP (spec)) + spec = XCDR (spec); + + while (CONSP (spec)) + { + Lisp_Object key = XCAR (spec); + spec = XCDR (spec); + if (CONSP (spec)) + { + Lisp_Object value = XCAR (spec); + spec = XCDR (spec); + + /* Some animation-related data doesn't affect display, but + breaks the image cache. Filter those out. */ + if (!(EQ (key, QCanimate_buffer) + || EQ (key, QCanimate_tardiness) + || EQ (key, QCanimate_position) + || EQ (key, QCanimate_multi_frame_data))) + { + out = Fcons (value, out); + out = Fcons (key, out); + } + } + } + return out; +} + /* Search frame F for an image with spec SPEC, and free it. */ static void uncache_image (struct frame *f, Lisp_Object spec) { struct image *img; - EMACS_UINT hash = sxhash (spec); + EMACS_UINT hash = sxhash (filter_image_spec (spec)); /* Because the background colors are based on the current face, we can have multiple copies of an image with the same spec. We want @@ -1834,6 +2036,11 @@ image_size_in_bytes (struct image *img) if (img->mask) size += w32_image_size (img->mask); +#elif defined HAVE_HAIKU + if (img->pixmap) + size += BBitmap_bytes_length (img->pixmap); + if (img->mask) + size += BBitmap_bytes_length (img->mask); #endif return size; @@ -1975,14 +2182,16 @@ postprocess_image (struct frame *f, struct image *img) safely rounded and clipped to int range. */ static int -scale_image_size (int size, size_t divisor, size_t multiplier) +scale_image_size (int size, double divisor, double multiplier) { if (divisor != 0) { - double s = size; - double scaled = s * multiplier / divisor + 0.5; + double scaled = size * multiplier / divisor; if (scaled < INT_MAX) - return scaled; + { + /* Use ceil, as rounding can discard fractional SVG pixels. */ + return ceil (scaled); + } } return INT_MAX; } @@ -2003,84 +2212,77 @@ image_get_dimension (struct image *img, Lisp_Object symbol) if (FIXNATP (value)) return min (XFIXNAT (value), INT_MAX); if (CONSP (value) && NUMBERP (CAR (value)) && EQ (Qem, CDR (value))) - return min (img->face_font_size * XFLOATINT (CAR (value)), INT_MAX); + return scale_image_size (img->face_font_size, 1, XFLOATINT (CAR (value))); return -1; } /* Compute the desired size of an image with native size WIDTH x HEIGHT. - Use SPEC to deduce the size. Store the desired size into + Use IMG to deduce the size. Store the desired size into *D_WIDTH x *D_HEIGHT. Store -1 x -1 if the native size is OK. */ static void -compute_image_size (size_t width, size_t height, +compute_image_size (double width, double height, struct image *img, int *d_width, int *d_height) { - Lisp_Object value; - int int_value; - int desired_width = -1, desired_height = -1, max_width = -1, max_height = -1; double scale = 1; - - value = image_spec_value (img->spec, QCscale, NULL); + Lisp_Object value = image_spec_value (img->spec, QCscale, NULL); if (NUMBERP (value)) - scale = XFLOATINT (value); - - int_value = image_get_dimension (img, QCmax_width); - if (int_value >= 0) - max_width = int_value; - - int_value = image_get_dimension (img, QCmax_height); - if (int_value >= 0) - max_height = int_value; + { + double dval = XFLOATINT (value); + if (0 <= dval) + scale = dval; + } /* If width and/or height is set in the display spec assume we want to scale to those values. If either h or w is unspecified, the unspecified should be calculated from the specified to preserve aspect ratio. */ - int_value = image_get_dimension (img, QCwidth); - if (int_value >= 0) + int desired_width = image_get_dimension (img, QCwidth), max_width; + if (desired_width < 0) + max_width = image_get_dimension (img, QCmax_width); + else { - desired_width = int_value * scale; + desired_width = scale_image_size (desired_width, 1, scale); /* :width overrides :max-width. */ max_width = -1; } - int_value = image_get_dimension (img, QCheight); - if (int_value >= 0) + int desired_height = image_get_dimension (img, QCheight), max_height; + if (desired_height < 0) + max_height = image_get_dimension (img, QCmax_height); + else { - desired_height = int_value * scale; + desired_height = scale_image_size (desired_height, 1, scale); /* :height overrides :max-height. */ max_height = -1; } /* If we have both width/height set explicitly, we skip past all the aspect ratio-preserving computations below. */ - if (desired_width != -1 && desired_height != -1) + if (0 <= desired_width && 0 <= desired_height) goto out; - width = width * scale; - height = height * scale; - - if (desired_width != -1) + if (0 <= desired_width) /* Width known, calculate height. */ desired_height = scale_image_size (desired_width, width, height); - else if (desired_height != -1) + else if (0 <= desired_height) /* Height known, calculate width. */ desired_width = scale_image_size (desired_height, height, width); else { - desired_width = width; - desired_height = height; + desired_width = scale_image_size (width, 1, scale); + desired_height = scale_image_size (height, 1, scale); } - if (max_width != -1 && desired_width > max_width) + if (0 <= max_width && max_width < desired_width) { /* The image is wider than :max-width. */ desired_width = max_width; desired_height = scale_image_size (desired_width, width, height); } - if (max_height != -1 && desired_height > max_height) + if (0 <= max_height && max_height < desired_height) { /* The image is higher than :max-height. */ desired_height = max_height; @@ -2173,6 +2375,7 @@ compute_image_size (size_t width, size_t height, single step, but the maths for each element is much more complex and performing the steps separately makes for more readable code. */ +#ifndef HAVE_HAIKU typedef double matrix3x3[3][3]; static void @@ -2187,6 +2390,7 @@ matrix3x3_mult (matrix3x3 a, matrix3x3 b, matrix3x3 result) result[i][j] = sum; } } +#endif /* not HAVE_HAIKU */ static void compute_image_rotation (struct image *img, double *rotation) @@ -2211,7 +2415,8 @@ compute_image_rotation (struct image *img, double *rotation) static void image_set_transform (struct frame *f, struct image *img) { -# ifdef HAVE_IMAGEMAGICK +# if (defined HAVE_IMAGEMAGICK \ + && !defined DONT_CREATE_TRANSFORMED_IMAGEMAGICK_IMAGE) /* ImageMagick images already have the correct transform. */ if (EQ (image_spec_value (img->spec, QCtype, NULL), Qimagemagick)) return; @@ -2244,6 +2449,7 @@ image_set_transform (struct frame *f, struct image *img) double rotation = 0.0; compute_image_rotation (img, &rotation); +#ifndef HAVE_HAIKU # if defined USE_CAIRO || defined HAVE_XRENDER || defined HAVE_NS /* We want scale up operations to use a nearest neighbor filter to show real pixels instead of munging them, but scale down @@ -2414,6 +2620,34 @@ image_set_transform (struct frame *f, struct image *img) img->xform.eDx = matrix[2][0]; img->xform.eDy = matrix[2][1]; # endif +#else + if (rotation != 0 && + rotation != 90 && + rotation != 180 && + rotation != 270 && + rotation != 360) + { + image_error ("No native support for rotation by %g degrees", + make_float (rotation)); + return; + } + + rotation = fmod (rotation, 360.0); + + if (rotation == 90 || rotation == 270) + { + int w = width; + width = height; + height = w; + } + + img->have_be_transforms_p = rotation != 0 || (img->width != width) || (img->height != height); + img->be_rotate = rotation; + img->be_scale_x = 1.0 / (img->width / (double) width); + img->be_scale_y = 1.0 / (img->height / (double) height); + img->width = width; + img->height = height; +#endif /* not HAVE_HAIKU */ } #endif /* HAVE_IMAGEMAGICK || HAVE_NATIVE_TRANSFORMS */ @@ -2435,8 +2669,8 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id) face_id = DEFAULT_FACE_ID; struct face *face = FACE_FROM_ID (f, face_id); - unsigned long foreground = FACE_COLOR_TO_PIXEL (face->foreground, f); - unsigned long background = FACE_COLOR_TO_PIXEL (face->background, f); + unsigned long foreground = face->foreground; + unsigned long background = face->background; int font_size = face->font->pixel_size; char *font_family = SSDATA (face->lface[LFACE_FAMILY_INDEX]); @@ -2446,7 +2680,7 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id) eassert (valid_image_p (spec)); /* Look up SPEC in the hash table of the image cache. */ - hash = sxhash (spec); + hash = sxhash (filter_image_spec (spec)); img = search_image_cache (f, spec, hash, foreground, background, font_size, font_family, false); if (img && img->load_failed_p) @@ -2585,6 +2819,92 @@ cache_image (struct frame *f, struct image *img) } +#if defined (HAVE_WEBP) || defined (HAVE_GIF) + +/* To speed animations up, we keep a cache (based on EQ-ness of the + image spec/object) where we put the animator iterator. */ + +struct anim_cache +{ + Lisp_Object spec; + /* For webp, this will be an iterator, and for libgif, a gif handle. */ + void *handle; + /* If we need to maintain temporary data of some sort. */ + void *temp; + /* A function to call to free the handle. */ + void (*destructor) (void *); + int index, width, height, frames; + struct timespec update_time; + struct anim_cache *next; +}; + +static struct anim_cache *anim_cache = NULL; + +static struct anim_cache * +anim_create_cache (Lisp_Object spec) +{ + struct anim_cache *cache = xmalloc (sizeof (struct anim_cache)); + cache->handle = NULL; + cache->temp = NULL; + + cache->index = -1; + cache->next = NULL; + cache->spec = spec; + return cache; +} + +/* Discard cached images that haven't been used for a minute. */ +static void +anim_prune_animation_cache (void) +{ + struct anim_cache **pcache = &anim_cache; + struct timespec old = timespec_sub (current_timespec (), + make_timespec (60, 0)); + + while (*pcache) + { + struct anim_cache *cache = *pcache; + if (timespec_cmp (old, cache->update_time) <= 0) + pcache = &cache->next; + else + { + if (cache->handle) + cache->destructor (cache); + if (cache->temp) + xfree (cache->temp); + *pcache = cache->next; + xfree (cache); + } + } +} + +static struct anim_cache * +anim_get_animation_cache (Lisp_Object spec) +{ + struct anim_cache *cache; + struct anim_cache **pcache = &anim_cache; + + anim_prune_animation_cache (); + + while (1) + { + cache = *pcache; + if (! cache) + { + *pcache = cache = anim_create_cache (spec); + break; + } + if (EQ (spec, cache->spec)) + break; + pcache = &cache->next; + } + + cache->update_time = current_timespec (); + return cache; +} + +#endif /* HAVE_WEBP || HAVE_GIF */ + /* Call FN on every image in the image cache of frame F. Used to mark Lisp Objects in the image cache. */ @@ -2611,6 +2931,11 @@ mark_image_cache (struct image_cache *c) if (c->images[i]) mark_image (c->images[i]); } + +#if defined HAVE_WEBP || defined HAVE_GIF + for (struct anim_cache *cache = anim_cache; cache; cache = cache->next) + mark_object (cache->spec); +#endif } @@ -2655,13 +2980,12 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, { Display *display = FRAME_X_DISPLAY (f); Drawable drawable = FRAME_X_DRAWABLE (f); - Screen *screen = FRAME_X_SCREEN (f); eassert (input_blocked_p ()); if (depth <= 0) - depth = DefaultDepthOfScreen (screen); - *ximg = XCreateImage (display, DefaultVisualOfScreen (screen), + depth = FRAME_DISPLAY_INFO (f)->n_planes; + *ximg = XCreateImage (display, FRAME_X_VISUAL (f), depth, ZPixmap, 0, NULL, width, height, depth > 16 ? 32 : depth > 8 ? 16 : 8, 0); if (*ximg == NULL) @@ -2713,12 +3037,11 @@ x_create_xrender_picture (struct frame *f, Emacs_Pixmap pixmap, int depth) { Picture p; Display *display = FRAME_X_DISPLAY (f); - int event_basep, error_basep; - if (XRenderQueryExtension (display, &event_basep, &error_basep)) + if (FRAME_DISPLAY_INFO (f)->xrender_supported_p) { if (depth <= 0) - depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f)); + depth = FRAME_DISPLAY_INFO (f)->n_planes; if (depth == 32 || depth == 24 || depth == 8 || depth == 4 || depth == 1) { /* FIXME: Do we need to handle all possible bit depths? @@ -2820,6 +3143,30 @@ image_create_x_image_and_pixmap_1 (struct frame *f, int width, int height, int d return 1; #endif /* HAVE_X_WINDOWS */ +#ifdef HAVE_HAIKU + if (depth == 0) + depth = 24; + + if (depth != 24 && depth != 1) + { + *pimg = NULL; + image_error ("Invalid image bit depth specified"); + return 0; + } + + *pixmap = BBitmap_new (width, height, depth == 1); + + if (*pixmap == NO_PIXMAP) + { + *pimg = NULL; + image_error ("Unable to create pixmap", Qnil, Qnil); + return 0; + } + + *pimg = *pixmap; + return 1; +#endif + #ifdef HAVE_NTGUI BITMAPINFOHEADER *header; @@ -2960,7 +3307,7 @@ static void gui_put_x_image (struct frame *f, Emacs_Pix_Container pimg, Emacs_Pixmap pixmap, int width, int height) { -#ifdef USE_CAIRO +#if defined USE_CAIRO || defined HAVE_HAIKU eassert (pimg == pixmap); #elif defined HAVE_X_WINDOWS GC gc; @@ -2972,14 +3319,6 @@ gui_put_x_image (struct frame *f, Emacs_Pix_Container pimg, XFreeGC (FRAME_X_DISPLAY (f), gc); #endif /* HAVE_X_WINDOWS */ -#ifdef HAVE_NTGUI -#if 0 /* I don't think this is necessary looking at where it is used. */ - HDC hdc = get_frame_dc (f); - SetDIBits (hdc, pixmap, 0, height, pimg->data, &(pimg->info), DIB_RGB_COLORS); - release_frame_dc (f, hdc); -#endif -#endif /* HAVE_NTGUI */ - #ifdef HAVE_NS eassert (pimg == pixmap); ns_retain_object (pimg); @@ -3087,7 +3426,7 @@ image_unget_x_image_or_dc (struct image *img, bool mask_p, static Emacs_Pix_Container image_get_x_image (struct frame *f, struct image *img, bool mask_p) { -#ifdef USE_CAIRO +#if defined USE_CAIRO || defined (HAVE_HAIKU) return !mask_p ? img->pixmap : img->mask; #elif defined HAVE_X_WINDOWS XImage *ximg_in_img = !mask_p ? img->ximg : img->mask_img; @@ -3194,7 +3533,7 @@ slurp_file (int fd, ptrdiff_t *size) if (fp) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_ptr (fclose_unwind, fp); if (fstat (fileno (fp), &st) == 0 @@ -3470,6 +3809,48 @@ xbm_scan (char **s, char *end, char *sval, int *ival) *ival = value; return overflow ? XBM_TK_OVERFLOW : XBM_TK_NUMBER; } + /* Character literal. XBM images typically contain hex escape + sequences and not actual characters, so we only try to handle + that here. */ + else if (c == '\'') + { + int value = 0, digit; + bool overflow = false; + + if (*s == end) + return 0; + + c = *(*s)++; + + if (c != '\\' || *s == end) + return 0; + + c = *(*s)++; + + if (c == 'x') + { + while (*s < end) + { + c = *(*s)++; + + if (c == '\'') + { + *ival = value; + return overflow ? XBM_TK_OVERFLOW : XBM_TK_NUMBER; + } + + digit = char_hexdigit (c); + + if (digit < 0) + return 0; + + overflow |= INT_MULTIPLY_WRAPV (value, 16, &value); + value += digit; + } + } + + return 0; + } else if (c_isalpha (c) || c == '_') { *sval++ = c; @@ -3547,10 +3928,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); @@ -3595,7 +3974,7 @@ Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data, data, img->width, img->height, fg, bg, - DefaultDepthOfScreen (FRAME_X_SCREEN (f))); + FRAME_DISPLAY_INFO (f)->n_planes); # if !defined USE_CAIRO && defined HAVE_XRENDER if (img->pixmap) img->picture = x_create_xrender_picture (f, img->pixmap, 0); @@ -3610,6 +3989,21 @@ Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data, convert_mono_to_color_image (f, img, fg, bg); #elif defined HAVE_NS img->pixmap = ns_image_from_XBM (data, img->width, img->height, fg, bg); +#elif defined HAVE_HAIKU + img->pixmap = BBitmap_new (img->width, img->height, 0); + + if (img->pixmap) + { + int bytes_per_line = (img->width + 7) / 8; + + for (int y = 0; y < img->height; y++) + { + for (int x = 0; x < img->width; x++) + PUT_PIXEL (img->pixmap, x, y, + (data[x / 8] >> (x % 8)) & 1 ? fg : bg); + data += bytes_per_line; + } + } #endif } @@ -3794,6 +4188,7 @@ xbm_load_image (struct frame *f, struct image *img, char *contents, char *end) rc = xbm_read_bitmap_data (f, contents, end, &img->width, &img->height, &data, 0); + if (rc) { unsigned long foreground = img->face_foreground; @@ -4015,6 +4410,13 @@ xbm_load (struct frame *f, struct image *img) XPM images ***********************************************************************/ +#if defined (HAVE_XPM) || defined (HAVE_NS) || defined (HAVE_PGTK) + +static bool xpm_image_p (Lisp_Object object); +static bool xpm_load (struct frame *f, struct image *img); + +#endif /* HAVE_XPM || HAVE_NS */ + #ifdef HAVE_XPM #ifdef HAVE_NTGUI /* Indicate to xpm.h that we don't have Xlib. */ @@ -4038,7 +4440,7 @@ xbm_load (struct frame *f, struct image *img) #endif /* not HAVE_NTGUI */ #endif /* HAVE_XPM */ -#if defined HAVE_XPM || defined USE_CAIRO || defined HAVE_NS +#if defined HAVE_XPM || defined USE_CAIRO || defined HAVE_NS || defined HAVE_HAIKU /* Indices of image specification fields in xpm_format, below. */ @@ -4058,7 +4460,7 @@ enum xpm_keyword_index XPM_LAST }; -#if defined HAVE_XPM || defined HAVE_NS +#if defined HAVE_XPM || defined HAVE_NS || defined HAVE_HAIKU || defined HAVE_PGTK /* Vector of image_keyword structures describing the format of valid XPM image specifications. */ @@ -4076,7 +4478,7 @@ static const struct image_keyword xpm_format[XPM_LAST] = {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, {":background", IMAGE_STRING_OR_NIL_VALUE, 0} }; -#endif /* HAVE_XPM || HAVE_NS */ +#endif /* HAVE_XPM || HAVE_NS || HAVE_HAIKU || HAVE_PGTK */ #if defined HAVE_X_WINDOWS && !defined USE_CAIRO @@ -4116,9 +4518,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. */ @@ -4300,7 +4702,7 @@ init_xpm_functions (void) #endif /* WINDOWSNT */ -#if defined HAVE_XPM || defined HAVE_NS +#if defined HAVE_XPM || defined HAVE_NS || defined HAVE_HAIKU || defined HAVE_PGTK /* Value is true if COLOR_SYMBOLS is a valid color symbols list for XPM images. Such a list must consist of conses whose car and cdr are strings. */ @@ -4336,9 +4738,9 @@ xpm_image_p (Lisp_Object object) && (! fmt[XPM_COLOR_SYMBOLS].count || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))); } -#endif /* HAVE_XPM || HAVE_NS */ +#endif /* HAVE_XPM || HAVE_NS || HAVE_HAIKU || HAVE_PGTK */ -#endif /* HAVE_XPM || USE_CAIRO || HAVE_NS */ +#endif /* HAVE_XPM || USE_CAIRO || HAVE_NS || HAVE_HAIKU */ #if defined HAVE_XPM && defined HAVE_X_WINDOWS && !defined USE_GTK ptrdiff_t @@ -4419,8 +4821,10 @@ xpm_load (struct frame *f, struct image *img) #ifndef HAVE_NTGUI attrs.visual = FRAME_X_VISUAL (f); attrs.colormap = FRAME_X_COLORMAP (f); + attrs.depth = FRAME_DISPLAY_INFO (f)->n_planes; attrs.valuemask |= XpmVisual; attrs.valuemask |= XpmColormap; + attrs.valuemask |= XpmDepth; #endif /* HAVE_NTGUI */ #ifdef ALLOC_XPM_COLORS @@ -4707,9 +5111,11 @@ xpm_load (struct frame *f, struct image *img) #endif /* HAVE_XPM && !USE_CAIRO */ #if (defined USE_CAIRO && defined HAVE_XPM) \ - || (defined HAVE_NS && !defined HAVE_XPM) + || (defined HAVE_NS && !defined HAVE_XPM) \ + || (defined HAVE_HAIKU && !defined HAVE_XPM) \ + || (defined HAVE_PGTK && !defined HAVE_XPM) -/* XPM support functions for NS where libxpm is not available, and for +/* XPM support functions for NS and Haiku where libxpm is not available, and for Cairo. Only XPM version 3 (without any extensions) is supported. */ static void xpm_put_color_table_v (Lisp_Object, const char *, @@ -4906,7 +5312,7 @@ xpm_load_image (struct frame *f, Lisp_Object (*get_color_table) (Lisp_Object, const char *, int); Lisp_Object frame, color_symbols, color_table; int best_key; -#ifndef HAVE_NS +#if !defined (HAVE_NS) bool have_mask = false; #endif Emacs_Pix_Container ximg = NULL, mask_img = NULL; @@ -5446,7 +5852,7 @@ lookup_rgb_color (struct frame *f, int r, int g, int b) { #ifdef HAVE_NTGUI return PALETTERGB (r >> 8, g >> 8, b >> 8); -#elif defined USE_CAIRO || defined HAVE_NS +#elif defined USE_CAIRO || defined HAVE_NS || defined HAVE_HAIKU return RGB_TO_ULONG (r >> 8, g >> 8, b >> 8); #else xsignal1 (Qfile_error, @@ -5519,7 +5925,7 @@ image_to_emacs_colors (struct frame *f, struct image *img, bool rgb_p) p = colors; for (y = 0; y < img->height; ++y) { -#if !defined USE_CAIRO && !defined HAVE_NS +#if !defined USE_CAIRO && !defined HAVE_NS && !defined HAVE_HAIKU Emacs_Color *row = p; for (x = 0; x < img->width; ++x, ++p) p->pixel = GET_PIXEL (ximg, x, y); @@ -5527,7 +5933,7 @@ image_to_emacs_colors (struct frame *f, struct image *img, bool rgb_p) { FRAME_TERMINAL (f)->query_colors (f, row, img->width); } -#else /* USE_CAIRO || HAVE_NS */ +#else /* USE_CAIRO || HAVE_NS || HAVE_HAIKU */ for (x = 0; x < img->width; ++x, ++p) { p->pixel = GET_PIXEL (ximg, x, y); @@ -5841,6 +6247,7 @@ image_disable_image (struct frame *f, struct image *img) { #ifndef HAVE_NTGUI #ifndef HAVE_NS /* TODO: NS support, however this not needed for toolbars */ +#ifndef HAVE_HAIKU #ifndef USE_CAIRO #define CrossForeground(f) BLACK_PIX_DEFAULT (f) @@ -5858,6 +6265,7 @@ image_disable_image (struct frame *f, struct image *img) if (img->mask) image_pixmap_draw_cross (f, img->mask, 0, 0, img->width, img->height, MaskForeground (f)); +#endif /* !HAVE_HAIKU */ #endif /* !HAVE_NS */ #else HDC hdc, bmpdc; @@ -6415,15 +6823,16 @@ image_can_use_native_api (Lisp_Object type) return w32_can_use_native_image_api (type); # elif defined HAVE_NS return ns_can_use_native_image_api (type); +# elif defined HAVE_HAIKU + return haiku_can_use_native_image_api (type); # else return false; # endif } /* - * These functions are actually defined in the OS-native implementation - * file. Currently, for Windows GDI+ interface, w32image.c, but other - * operating systems can follow suit. + * 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. */ @@ -6489,6 +6898,9 @@ native_image_load (struct frame *f, struct image *img) # elif defined HAVE_NS return ns_load_image (f, img, image_file, image_spec_value (img->spec, QCdata, NULL)); +# elif defined HAVE_HAIKU + return haiku_load_image (f, img, image_file, + image_spec_value (img->spec, QCdata, NULL)); # else return 0; # endif @@ -8233,24 +8645,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 @@ -8273,6 +8691,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)); @@ -8290,6 +8710,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 @@ -8300,12 +8723,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 */ @@ -8364,120 +8793,191 @@ static const int interlace_increment[] = {8, 8, 4, 2}; #define GIF_LOCAL_DESCRIPTOR_EXTENSION 249 +static void +gif_destroy (struct anim_cache* cache) +{ + int gif_err; + gif_close (cache->handle, &gif_err); +} + static bool gif_load (struct frame *f, struct image *img) { int rc, width, height, x, y, i, j; ColorMapObject *gif_color_map; - GifFileType *gif; + GifFileType *gif = NULL; gif_memory_source memsrc; Lisp_Object specified_bg = image_spec_value (img->spec, QCbackground, NULL); Lisp_Object specified_file = image_spec_value (img->spec, QCfile, NULL); Lisp_Object specified_data = image_spec_value (img->spec, QCdata, NULL); - EMACS_INT idx; + unsigned long *pixmap = NULL; + EMACS_INT idx = -1; int gif_err; + struct anim_cache* cache = NULL; + /* Which sub-image are we to display? */ + Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL); - if (NILP (specified_data)) + idx = FIXNUMP (image_number) ? XFIXNAT (image_number) : 0; + + if (!NILP (image_number)) { - Lisp_Object file = image_find_image_file (specified_file); - if (!STRINGP (file)) + /* If this is an animated image, create a cache for it. */ + cache = anim_get_animation_cache (img->spec); + /* We have an old cache entry, so use it. */ + if (cache->handle) { - image_error ("Cannot find image file `%s'", specified_file); - return 0; + gif = cache->handle; + pixmap = cache->temp; + /* We're out of sync, so start from the beginning. */ + if (cache->index != idx - 1) + cache->index = -1; } + } - Lisp_Object encoded_file = ENCODE_FILE (file); + /* If we don't have a cached entry, read the image. */ + if (! gif) + { + if (NILP (specified_data)) + { + Lisp_Object file = image_find_image_file (specified_file); + if (!STRINGP (file)) + { + image_error ("Cannot find image file `%s'", specified_file); + return false; + } + + Lisp_Object encoded_file = ENCODE_FILE (file); #ifdef WINDOWSNT - encoded_file = ansi_encode_filename (encoded_file); + encoded_file = ansi_encode_filename (encoded_file); #endif - /* Open the GIF file. */ + /* Open the GIF file. */ #if GIFLIB_MAJOR < 5 - gif = DGifOpenFileName (SSDATA (encoded_file)); + gif = DGifOpenFileName (SSDATA (encoded_file)); #else - gif = DGifOpenFileName (SSDATA (encoded_file), &gif_err); + gif = DGifOpenFileName (SSDATA (encoded_file), &gif_err); #endif - if (gif == NULL) - { + if (gif == NULL) + { #if HAVE_GIFERRORSTRING - const char *errstr = GifErrorString (gif_err); - if (errstr) - image_error ("Cannot open `%s': %s", file, build_string (errstr)); - else + const char *errstr = GifErrorString (gif_err); + if (errstr) + image_error ("Cannot open `%s': %s", file, + build_string (errstr)); + else #endif - image_error ("Cannot open `%s'", file); - - return 0; + image_error ("Cannot open `%s'", file); + return false; + } } - } - else - { - if (!STRINGP (specified_data)) + else { - image_error ("Invalid image data `%s'", specified_data); - return 0; - } + if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data); + return false; + } - /* Read from memory! */ - current_gif_memory_src = &memsrc; - memsrc.bytes = SDATA (specified_data); - memsrc.len = SBYTES (specified_data); - memsrc.index = 0; + /* Read from memory! */ + current_gif_memory_src = &memsrc; + memsrc.bytes = SDATA (specified_data); + memsrc.len = SBYTES (specified_data); + memsrc.index = 0; #if GIFLIB_MAJOR < 5 - gif = DGifOpen (&memsrc, gif_read_from_memory); + gif = DGifOpen (&memsrc, gif_read_from_memory); #else - gif = DGifOpen (&memsrc, gif_read_from_memory, &gif_err); + gif = DGifOpen (&memsrc, gif_read_from_memory, &gif_err); #endif - if (!gif) + if (!gif) + { +#if HAVE_GIFERRORSTRING + const char *errstr = GifErrorString (gif_err); + if (errstr) + image_error ("Cannot open memory source `%s': %s", + img->spec, build_string (errstr)); + else +#endif + image_error ("Cannot open memory source `%s'", img->spec); + return false; + } + } + + /* Before reading entire contents, check the declared image size. */ + if (!check_image_size (f, gif->SWidth, gif->SHeight)) + { + image_size_error (); + goto gif_error; + } + + /* Read entire contents. */ + rc = DGifSlurp (gif); + if (rc == GIF_ERROR || gif->ImageCount <= 0) { #if HAVE_GIFERRORSTRING - const char *errstr = GifErrorString (gif_err); + const char *errstr = GifErrorString (gif->Error); if (errstr) - image_error ("Cannot open memory source `%s': %s", - img->spec, build_string (errstr)); + if (NILP (specified_data)) + image_error ("Error reading `%s' (%s)", img->spec, + build_string (errstr)); + else + image_error ("Error reading GIF data: %s", + build_string (errstr)); else #endif - image_error ("Cannot open memory source `%s'", img->spec); - return 0; + if (NILP (specified_data)) + image_error ("Error reading `%s'", img->spec); + else + image_error ("Error reading GIF data"); + goto gif_error; + } + + width = img->width = gif->SWidth; + height = img->height = gif->SHeight; + + /* Check that the selected subimages fit. It's not clear whether + the GIF spec requires this, but Emacs can crash if they don't fit. */ + for (j = 0; j < gif->ImageCount; ++j) + { + struct SavedImage *subimage = gif->SavedImages + j; + int subimg_width = subimage->ImageDesc.Width; + int subimg_height = subimage->ImageDesc.Height; + int subimg_top = subimage->ImageDesc.Top; + int subimg_left = subimage->ImageDesc.Left; + if (subimg_width < 0 + || subimg_height < 0 + || subimg_top < 0 + || subimg_left < 0 + || subimg_top + subimg_height > height + || subimg_left + subimg_width > width) + { + image_error ("Subimage does not fit in image"); + goto gif_error; + } } } - - /* Before reading entire contents, check the declared image size. */ - if (!check_image_size (f, gif->SWidth, gif->SHeight)) + else { - image_size_error (); - gif_close (gif, NULL); - return 0; + /* Cached image; set data. */ + width = img->width = gif->SWidth; + height = img->height = gif->SHeight; } - /* Read entire contents. */ - rc = DGifSlurp (gif); - if (rc == GIF_ERROR || gif->ImageCount <= 0) + if (idx < 0 || idx >= gif->ImageCount) { - if (NILP (specified_data)) - image_error ("Error reading `%s'", img->spec); - else - image_error ("Error reading GIF data"); - gif_close (gif, NULL); - return 0; + image_error ("Invalid image number `%s' in image `%s'", + make_fixnum (idx), img->spec); + goto gif_error; } - /* Which sub-image are we to display? */ - { - Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL); - idx = FIXNUMP (image_number) ? XFIXNAT (image_number) : 0; - if (idx < 0 || idx >= gif->ImageCount) - { - image_error ("Invalid image number `%s' in image `%s'", - image_number, img->spec); - gif_close (gif, NULL); - return 0; - } - } - - width = img->width = gif->SWidth; - height = img->height = gif->SHeight; + /* It's an animated image, so initalize the cache. */ + if (cache && !cache->handle) + { + cache->handle = gif; + cache->destructor = (void (*)(void *)) &gif_destroy; + cache->width = width; + cache->height = height; + } img->corners[TOP_CORNER] = gif->SavedImages[0].ImageDesc.Top; img->corners[LEFT_CORNER] = gif->SavedImages[0].ImageDesc.Left; @@ -8489,35 +8989,21 @@ gif_load (struct frame *f, struct image *img) if (!check_image_size (f, width, height)) { image_size_error (); - gif_close (gif, NULL); - return 0; - } - - /* Check that the selected subimages fit. It's not clear whether - the GIF spec requires this, but Emacs can crash if they don't fit. */ - for (j = 0; j <= idx; ++j) - { - struct SavedImage *subimage = gif->SavedImages + j; - int subimg_width = subimage->ImageDesc.Width; - int subimg_height = subimage->ImageDesc.Height; - int subimg_top = subimage->ImageDesc.Top; - int subimg_left = subimage->ImageDesc.Left; - if (! (subimg_width >= 0 && subimg_height >= 0 - && 0 <= subimg_top && subimg_top <= height - subimg_height - && 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)) + goto gif_error; + + /* We construct the (possibly composited animated) image in this + buffer. */ + if (!pixmap) { - gif_close (gif, NULL); - return 0; + pixmap = xmalloc (width * height * sizeof (unsigned long)); + if (cache) + cache->temp = pixmap; } /* Clear the part of the screen image not covered by the image. @@ -8534,29 +9020,25 @@ gif_load (struct frame *f, struct image *img) frame_bg = lookup_rgb_color (f, color.red, color.green, color.blue); } #endif /* USE_CAIRO */ + for (y = 0; y < img->corners[TOP_CORNER]; ++y) for (x = 0; x < width; ++x) - PUT_PIXEL (ximg, x, y, frame_bg); + *(pixmap + x + y * width) = frame_bg; for (y = img->corners[BOT_CORNER]; y < height; ++y) for (x = 0; x < width; ++x) - PUT_PIXEL (ximg, x, y, frame_bg); + *(pixmap + x + y * width) = frame_bg; for (y = img->corners[TOP_CORNER]; y < img->corners[BOT_CORNER]; ++y) { for (x = 0; x < img->corners[LEFT_CORNER]; ++x) - PUT_PIXEL (ximg, x, y, frame_bg); + *(pixmap + x + y * width) = frame_bg; for (x = img->corners[RIGHT_CORNER]; x < width; ++x) - PUT_PIXEL (ximg, x, y, frame_bg); + *(pixmap + x + y * width) = frame_bg; } /* Read the GIF image into the X image. */ - /* FIXME: With the current implementation, loading an animated gif - is quadratic in the number of animation frames, since each frame - is a separate struct image. We must provide a way for a single - gif_load call to construct and save all animation frames. */ - init_color_table (); unsigned long bgcolor UNINIT; @@ -8571,19 +9053,34 @@ gif_load (struct frame *f, struct image *img) #endif } - for (j = 0; j <= idx; ++j) + int start_frame = 0; + + /* We have animation data in the cache. */ + if (cache && cache->temp) + { + start_frame = cache->index + 1; + if (start_frame > idx) + start_frame = 0; + cache->index = idx; + } + + for (j = start_frame; j <= idx; ++j) { /* We use a local variable `raster' here because RasterBits is a 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++) @@ -8594,24 +9091,37 @@ 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; + + /* This is not quite correct -- the specification is unclear, + but I think we're supposed to restore to the frame before the + previous frame? And we don't have that data at this point. + But DISPOSE_DO_NOT is less wrong than substituting the + background, so do that for now. */ + if (disposal == DISPOSE_PREVIOUS) + disposal = DISPOSE_DO_NOT; gif_color_map = subimage->ImageDesc.ColorMap; if (!gif_color_map) @@ -8650,10 +9160,10 @@ 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]); + *(pixmap + x + subimg_left + (y + subimg_top) * width) = + pixel_colors[c]; } } } @@ -8664,15 +9174,21 @@ 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]); + *(pixmap + x + subimg_left + (y + subimg_top) * width) = + pixel_colors[c]; } } } } + /* We now have the complete image (possibly composed from a series + of animated frames) in pixmap. Put it into ximg. */ + for (y = 0; y < height; ++y) + for (x = 0; x < width; ++x) + PUT_PIXEL (ximg, x, y, *(pixmap + x + y * width)); + #ifdef COLOR_TABLE_SUPPORT img->colors = colors_in_color_table (&img->ncolors); free_color_table (); @@ -8701,11 +9217,11 @@ gif_load (struct frame *f, struct image *img) } } img->lisp_data = list2 (Qextension_data, img->lisp_data); - if (delay) - img->lisp_data - = Fcons (Qdelay, - Fcons (make_float (delay / 100.0), - img->lisp_data)); + img->lisp_data + = Fcons (Qdelay, + /* Default GIF delay is 1/15th of a second. */ + Fcons (make_float (delay? delay / 100.0: 1.0 / 15), + img->lisp_data)); } if (gif->ImageCount > 1) @@ -8713,17 +9229,22 @@ gif_load (struct frame *f, struct image *img) Fcons (make_fixnum (gif->ImageCount), img->lisp_data)); - if (gif_close (gif, &gif_err) == GIF_ERROR) + if (!cache) { + if (pixmap) + xfree (pixmap); + if (gif_close (gif, &gif_err) == GIF_ERROR) + { #if HAVE_GIFERRORSTRING - char const *error_text = GifErrorString (gif_err); + char const *error_text = GifErrorString (gif_err); - if (error_text) - image_error ("Error closing `%s': %s", - img->spec, build_string (error_text)); - else + if (error_text) + image_error ("Error closing `%s': %s", + img->spec, build_string (error_text)); + else #endif - image_error ("Error closing `%s'", img->spec); + image_error ("Error closing `%s'", img->spec); + } } /* Maybe fill in the background field while we have ximg handy. */ @@ -8734,14 +9255,453 @@ 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: + if (pixmap) + xfree (pixmap); + gif_close (gif, NULL); + if (cache) + { + cache->handle = NULL; + cache->temp = NULL; + } + return false; } #endif /* HAVE_GIF */ +#ifdef HAVE_WEBP + + +/*********************************************************************** + WebP + ***********************************************************************/ + +#include "webp/decode.h" +#include "webp/demux.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_INDEX, + 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}, + {":index", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 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 *)); +DEF_DLL_FN (uint32_t, WebPDemuxGetI, (const WebPDemuxer *, WebPFormatFeature)); +DEF_DLL_FN (WebPDemuxer *, WebPDemuxInternal, + (const WebPData *, int, WebPDemuxState *, int)); +DEF_DLL_FN (void, WebPDemuxDelete, (WebPDemuxer *)); +DEF_DLL_FN (int, WebPAnimDecoderGetNext, + (WebPAnimDecoder *, uint8_t **, int *)); +DEF_DLL_FN (WebPAnimDecoder *, WebPAnimDecoderNewInternal, + (const WebPData *, const WebPAnimDecoderOptions *, int)); +DEF_DLL_FN (int, WebPAnimDecoderOptionsInitInternal, + (WebPAnimDecoderOptions *, int)); +DEF_DLL_FN (int, WebPAnimDecoderHasMoreFrames, (const WebPAnimDecoder *)); +DEF_DLL_FN (void, WebPAnimDecoderDelete, (WebPAnimDecoder *)); + +static bool +init_webp_functions (void) +{ + HMODULE library1, library2; + + if (!((library1 = w32_delayed_load (Qwebp)) + && (library2 = w32_delayed_load (Qwebpdemux)))) + return false; + + LOAD_DLL_FN (library1, WebPGetInfo); + LOAD_DLL_FN (library1, WebPGetFeaturesInternal); + LOAD_DLL_FN (library1, WebPDecodeRGBA); + LOAD_DLL_FN (library1, WebPDecodeRGB); + LOAD_DLL_FN (library1, WebPFree); + LOAD_DLL_FN (library2, WebPDemuxGetI); + LOAD_DLL_FN (library2, WebPDemuxInternal); + LOAD_DLL_FN (library2, WebPDemuxDelete); + LOAD_DLL_FN (library2, WebPAnimDecoderGetNext); + LOAD_DLL_FN (library2, WebPAnimDecoderNewInternal); + LOAD_DLL_FN (library2, WebPAnimDecoderOptionsInitInternal); + LOAD_DLL_FN (library2, WebPAnimDecoderHasMoreFrames); + LOAD_DLL_FN (library2, WebPAnimDecoderDelete); + return true; +} + +#undef WebPGetInfo +#undef WebPGetFeatures +#undef WebPDecodeRGBA +#undef WebPDecodeRGB +#undef WebPFree +#undef WebPDemuxGetI +#undef WebPDemux +#undef WebPDemuxDelete +#undef WebPAnimDecoderGetNext +#undef WebPAnimDecoderNew +#undef WebPAnimDecoderOptionsInit +#undef WebPAnimDecoderHasMoreFrames +#undef WebPAnimDecoderDelete + +#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 +#define WebPDemuxGetI fn_WebPDemuxGetI +#define WebPDemux(d) \ + fn_WebPDemuxInternal(d,0,NULL,WEBP_DEMUX_ABI_VERSION) +#define WebPDemuxDelete fn_WebPDemuxDelete +#define WebPAnimDecoderGetNext fn_WebPAnimDecoderGetNext +#define WebPAnimDecoderNew(d,o) \ + fn_WebPAnimDecoderNewInternal(d,o,WEBP_DEMUX_ABI_VERSION) +#define WebPAnimDecoderOptionsInit(o) \ + fn_WebPAnimDecoderOptionsInitInternal(o,WEBP_DEMUX_ABI_VERSION) +#define WebPAnimDecoderHasMoreFrames fn_WebPAnimDecoderHasMoreFrames +#define WebPAnimDecoderDelete fn_WebPAnimDecoderDelete + +#endif /* WINDOWSNT */ + +static void +webp_destroy (struct anim_cache* cache) +{ + WebPAnimDecoderDelete (cache->handle); +} + +/* 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 = Qnil; + int frames = 0; + double delay = 0; + WebPAnimDecoder* anim = NULL; + + /* 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 (file)) + image_error ("Not a WebP file: `%s'", file); + else + image_error ("Invalid header in WebP image data"); + goto webp_error1; + } + + Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL); + ptrdiff_t idx = FIXNUMP (image_number) ? XFIXNAT (image_number) : 0; + + /* 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 (file)) + image_error ("Error when interpreting WebP image data: `%s'", file); + else + image_error ("Error when interpreting WebP image data"); + goto webp_error1; + } + + uint8_t *decoded = NULL; + int width, height; + + if (features.has_animation) + { + /* Animated image. */ + int timestamp; + + struct anim_cache* cache = anim_get_animation_cache (img->spec); + /* Get the next frame from the animation cache. */ + if (cache->handle && cache->index == idx - 1) + { + WebPAnimDecoderGetNext (cache->handle, &decoded, ×tamp); + delay = timestamp; + cache->index++; + anim = cache->handle; + width = cache->width; + height = cache->height; + frames = cache->frames; + } + else + { + /* Start a new cache entry. */ + if (cache->handle) + WebPAnimDecoderDelete (cache->handle); + + WebPData webp_data; + if (NILP (specified_data)) + /* If we got the data from a file, then we don't need to + copy the data. */ + webp_data.bytes = cache->temp = contents; + else + /* We got the data from a string, so copy it over so that + it doesn't get garbage-collected. */ + { + webp_data.bytes = xmalloc (size); + memcpy ((void*) webp_data.bytes, contents, size); + } + /* In any case, we release the allocated memory when we + purge the anim cache. */ + webp_data.size = size; + + /* Get the width/height of the total image. */ + WebPDemuxer* demux = WebPDemux (&webp_data); + cache->width = width = WebPDemuxGetI (demux, WEBP_FF_CANVAS_WIDTH); + cache->height = height = WebPDemuxGetI (demux, + WEBP_FF_CANVAS_HEIGHT); + cache->frames = frames = WebPDemuxGetI (demux, WEBP_FF_FRAME_COUNT); + cache->destructor = (void (*)(void *)) webp_destroy; + WebPDemuxDelete (demux); + + WebPAnimDecoderOptions dec_options; + WebPAnimDecoderOptionsInit (&dec_options); + anim = WebPAnimDecoderNew (&webp_data, &dec_options); + + cache->handle = anim; + cache->index = idx; + + while (WebPAnimDecoderHasMoreFrames (anim)) { + WebPAnimDecoderGetNext (anim, &decoded, ×tamp); + /* Each frame has its own delay, but we don't really support + that. So just use the delay from the first frame. */ + if (delay == 0) + delay = timestamp; + /* Stop when we get to the desired index. */ + if (idx-- == 0) + break; + } + } + } + else + { + /* Non-animated image. */ + 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 (!decoded) + { + image_error ("Error when decoding WebP image data"); + goto webp_error1; + } + + 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 = NULL; + 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 (); + + img->corners[TOP_CORNER] = 0; + img->corners[LEFT_CORNER] = 0; + img->corners[BOT_CORNER] + = img->corners[TOP_CORNER] + height; + img->corners[RIGHT_CORNER] + = img->corners[LEFT_CORNER] + width; + + 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 || anim) + { + 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; + + /* Return animation data. */ + img->lisp_data = Fcons (Qcount, + Fcons (make_fixnum (frames), + img->lisp_data)); + img->lisp_data = Fcons (Qdelay, + Fcons (make_float (delay / 1000), + img->lisp_data)); + + /* Clean up. */ + if (!anim) + WebPFree (decoded); + if (NILP (specified_data) && !anim) + xfree (contents); + return true; + + webp_error2: + if (!anim) + WebPFree (decoded); + + webp_error1: + if (NILP (specified_data)) + xfree (contents); + return false; +} + +#endif /* HAVE_WEBP */ + + #ifdef HAVE_IMAGEMAGICK + /*********************************************************************** ImageMagick ***********************************************************************/ @@ -8895,7 +9855,7 @@ imagemagick_filename_hint (Lisp_Object spec, char hint_buffer[MaxTextExtent]) (which is the first one, and then there's a number of images that follow. If following images have non-transparent colors, these are composed "on top" of the master image. So, in general, one has to - compute ann the preceding images to be able to display a particular + compute all the preceding images to be able to display a particular sub-image. Computing all the preceding images is too slow, so we maintain a @@ -9117,11 +10077,15 @@ imagemagick_load_image (struct frame *f, struct image *img, PixelWand **pixels, *bg_wand = NULL; MagickPixelPacket pixel; Lisp_Object image; +#ifndef DONT_CREATE_TRANSFORMED_IMAGEMAGICK_IMAGE Lisp_Object value; +#endif Lisp_Object crop; EMACS_INT ino; int desired_width, desired_height; +#ifndef DONT_CREATE_TRANSFORMED_IMAGEMAGICK_IMAGE double rotation; +#endif char hint_buffer[MaxTextExtent]; char *filename_hint = NULL; imagemagick_initialize (); @@ -9238,9 +10202,13 @@ imagemagick_load_image (struct frame *f, struct image *img, PixelSetBlue (bg_wand, (double) bgcolor.blue / 65535); } +#ifndef DONT_CREATE_TRANSFORMED_IMAGEMAGICK_IMAGE compute_image_size (MagickGetImageWidth (image_wand), MagickGetImageHeight (image_wand), img, &desired_width, &desired_height); +#else + desired_width = desired_height = -1; +#endif if (desired_width != -1 && desired_height != -1) { @@ -9284,6 +10252,7 @@ imagemagick_load_image (struct frame *f, struct image *img, } } +#ifndef DONT_CREATE_TRANSFORMED_IMAGEMAGICK_IMAGE /* Furthermore :rotation. we need background color and angle for rotation. */ /* @@ -9302,6 +10271,7 @@ imagemagick_load_image (struct frame *f, struct image *img, goto imagemagick_error; } } +#endif /* Set the canvas background color to the frame or specified background, and flatten the image. Note: as of ImageMagick @@ -9339,7 +10309,8 @@ imagemagick_load_image (struct frame *f, struct image *img, init_color_table (); -#if defined (HAVE_MAGICKEXPORTIMAGEPIXELS) && ! defined (HAVE_NS) +#if defined (HAVE_MAGICKEXPORTIMAGEPIXELS) && \ + ! defined (HAVE_NS) && ! defined (HAVE_HAIKU) if (imagemagick_render_type != 0) { /* Magicexportimage is normally faster than pixelpushing. This @@ -9432,8 +10403,8 @@ imagemagick_load_image (struct frame *f, struct image *img, color_scale * pixel.red, color_scale * pixel.green, color_scale * pixel.blue)); - } - } + } + } DestroyPixelIterator (iterator); } @@ -9669,6 +10640,10 @@ DEF_DLL_FN (gboolean, rsvg_handle_close, (RsvgHandle *, GError **)); DEF_DLL_FN (void, rsvg_handle_set_dpi_x_y, (RsvgHandle * handle, double dpi_x, double dpi_y)); +# if LIBRSVG_CHECK_VERSION (2, 52, 1) +DEF_DLL_FN (gboolean, rsvg_handle_get_intrinsic_size_in_pixels, + (RsvgHandle *, gdouble *, gdouble *)); +# endif # if LIBRSVG_CHECK_VERSION (2, 46, 0) DEF_DLL_FN (void, rsvg_handle_get_intrinsic_dimensions, (RsvgHandle *, gboolean *, RsvgLength *, gboolean *, @@ -9676,14 +10651,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 *)); @@ -9731,14 +10707,18 @@ init_svg_functions (void) LOAD_DLL_FN (library, rsvg_handle_close); #endif LOAD_DLL_FN (library, rsvg_handle_set_dpi_x_y); +#if LIBRSVG_CHECK_VERSION (2, 52, 1) + LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_size_in_pixels); +#endif #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); @@ -9773,11 +10753,15 @@ init_svg_functions (void) # undef g_clear_error # undef g_object_unref # undef g_type_init +# if LIBRSVG_CHECK_VERSION (2, 52, 1) +# undef rsvg_handle_get_intrinsic_size_in_pixels +# endif # 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 @@ -9807,13 +10791,18 @@ init_svg_functions (void) # if ! GLIB_CHECK_VERSION (2, 36, 0) # define g_type_init fn_g_type_init # endif +# if LIBRSVG_CHECK_VERSION (2, 52, 1) +# define rsvg_handle_get_intrinsic_size_in_pixels \ + fn_rsvg_handle_get_intrinsic_size_in_pixels +# endif # if LIBRSVG_CHECK_VERSION (2, 46, 0) # define rsvg_handle_get_intrinsic_dimensions \ 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 @@ -10043,72 +11032,90 @@ svg_load_image (struct frame *f, struct image *img, char *contents, /* Get the image dimensions. */ #if LIBRSVG_CHECK_VERSION (2, 46, 0) - RsvgRectangle zero_rect, viewbox, out_logical_rect; - - /* Try the intrinsic dimensions first. */ - gboolean has_width, has_height, has_viewbox; - RsvgLength iwidth, iheight; - double dpi = FRAME_DISPLAY_INFO (f)->resx; - - rsvg_handle_get_intrinsic_dimensions (rsvg_handle, - &has_width, &iwidth, - &has_height, &iheight, - &has_viewbox, &viewbox); + gdouble gviewbox_width = 0, gviewbox_height = 0; + gboolean has_viewbox = FALSE; +# if LIBRSVG_CHECK_VERSION (2, 52, 1) + has_viewbox = rsvg_handle_get_intrinsic_size_in_pixels (rsvg_handle, + &gviewbox_width, + &gviewbox_height); +# endif - if (has_width && has_height) - { - /* Success! We can use these values directly. */ - viewbox_width = svg_css_length_to_pixels (iwidth, dpi, img->face_font_size); - viewbox_height = svg_css_length_to_pixels (iheight, dpi, img->face_font_size); - } - else if (has_width && has_viewbox) + if (has_viewbox) { - viewbox_width = svg_css_length_to_pixels (iwidth, dpi, img->face_font_size); - viewbox_height = svg_css_length_to_pixels (iwidth, dpi, img->face_font_size) - * viewbox.height / viewbox.width; - } - else if (has_height && has_viewbox) - { - viewbox_height = svg_css_length_to_pixels (iheight, dpi, img->face_font_size); - viewbox_width = svg_css_length_to_pixels (iheight, dpi, img->face_font_size) - * viewbox.width / viewbox.height; - } - else if (has_viewbox) - { - viewbox_width = viewbox.width; - viewbox_height = viewbox.height; + viewbox_width = gviewbox_width; + viewbox_height = gviewbox_height; } else { - /* 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, - &out_logical_rect, NULL); - viewbox_width = viewbox.x + viewbox.width; - viewbox_height = viewbox.y + viewbox.height; - } + RsvgRectangle zero_rect, viewbox, out_logical_rect; - if (viewbox_width == 0 || viewbox_height == 0) -#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; + /* Try the intrinsic dimensions first. */ + gboolean has_width, has_height; + RsvgLength iwidth, iheight; + double dpi = FRAME_DISPLAY_INFO (f)->resx; - rsvg_handle_get_dimensions (rsvg_handle, &dimension_data); + rsvg_handle_get_intrinsic_dimensions (rsvg_handle, + &has_width, &iwidth, + &has_height, &iheight, + &has_viewbox, &viewbox); - viewbox_width = dimension_data.width; - viewbox_height = dimension_data.height; - } + if (has_width && has_height) + { + /* Success! We can use these values directly. */ + viewbox_width = svg_css_length_to_pixels (iwidth, dpi, + img->face_font_size); + viewbox_height = svg_css_length_to_pixels (iheight, dpi, + img->face_font_size); + } + else if (has_width && has_viewbox) + { + viewbox_width = svg_css_length_to_pixels (iwidth, dpi, + img->face_font_size); + viewbox_height = viewbox_width * viewbox.height / viewbox.width; + } + else if (has_height && has_viewbox) + { + viewbox_height = svg_css_length_to_pixels (iheight, dpi, + img->face_font_size); + viewbox_width = viewbox_height * viewbox.width / viewbox.height; + } + else if (has_viewbox) + { + viewbox_width = viewbox.width; + viewbox_height = viewbox.height; + } + else + viewbox_width = viewbox_height = 0; + if (! (0 < viewbox_width && 0 < viewbox_height)) + { + /* 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, + &out_logical_rect, NULL); + viewbox_width = viewbox.x + viewbox.width; + viewbox_height = viewbox.y + viewbox.height; + } + } +#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 + +#ifdef HAVE_NATIVE_TRANSFORMS compute_image_size (viewbox_width, viewbox_height, img, &width, &height); - width *= FRAME_SCALE_FACTOR (f); - height *= FRAME_SCALE_FACTOR (f); + width = scale_image_size (width, 1, FRAME_SCALE_FACTOR (f)); + height = scale_image_size (height, 1, FRAME_SCALE_FACTOR (f)); +#else + width = viewbox_width; + height = viewbox_height; +#endif if (! check_image_size (f, width, height)) { @@ -10309,7 +11316,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, #endif /* FIXME: Use error->message so the user knows what is the actual problem with the image. */ - image_error ("Error parsing SVG image `%s'", img->spec); + image_error ("Error parsing SVG image"); g_clear_error (&err); return 0; } @@ -10451,7 +11458,7 @@ gs_load (struct frame *f, struct image *img) block_input (); img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), img->width, img->height, - DefaultDepthOfScreen (FRAME_X_SCREEN (f))); + FRAME_DISPLAY_INFO (f)->n_planes); unblock_input (); } @@ -10524,7 +11531,7 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f) /* On displays with a mutable colormap, figure out the colors allocated for the image by looking at the pixels of an XImage for img->pixmap. */ - if (x_mutable_colormap (FRAME_X_VISUAL (f))) + if (x_mutable_colormap (FRAME_X_VISUAL_INFO (f))) { XImage *ximg; @@ -10555,16 +11562,6 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f) free_color_table (); #endif XDestroyImage (ximg); - -#if 0 /* This doesn't seem to be the case. If we free the colors - here, we get a BadAccess later in image_clear_image when - freeing the colors. */ - /* We have allocated colors once, but Ghostscript has also - allocated colors on behalf of us. So, to get the - reference counts right, free them once. */ - if (img->ncolors) - x_free_colors (f, img->colors, img->ncolors); -#endif } else image_error ("Cannot get X image of `%s'; colors will not be freed", @@ -10633,13 +11630,11 @@ The list of capabilities can include one or more of the following: if (FRAME_WINDOW_P (f)) { #ifdef HAVE_NATIVE_TRANSFORMS -# if defined HAVE_IMAGEMAGICK || defined (USE_CAIRO) || defined (HAVE_NS) +# if defined HAVE_IMAGEMAGICK || defined (USE_CAIRO) || defined (HAVE_NS) \ + || defined (HAVE_HAIKU) return list2 (Qscale, Qrotate90); # elif defined (HAVE_X_WINDOWS) && defined (HAVE_XRENDER) - int event_basep, error_basep; - - if (XRenderQueryExtension (FRAME_X_DISPLAY (f), - &event_basep, &error_basep)) + if (FRAME_DISPLAY_INFO (f)->xrender_supported_p) return list2 (Qscale, Qrotate90); # elif defined (HAVE_NTGUI) return (w32_image_rotations_p () @@ -10723,10 +11718,14 @@ static struct image_type const image_types[] = { SYMBOL_INDEX (Qjpeg), jpeg_image_p, jpeg_load, image_clear_image, IMAGE_TYPE_INIT (init_jpeg_functions) }, #endif -#if defined HAVE_XPM || defined HAVE_NS +#if defined HAVE_XPM || defined HAVE_NS || defined HAVE_HAIKU || defined HAVE_PGTK { 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 }, }; @@ -10867,7 +11866,8 @@ non-numeric, there is no explicit limit on the size of images. */); DEFSYM (Qxbm, "xbm"); add_image_type (Qxbm); -#if defined (HAVE_XPM) || defined (HAVE_NS) +#if defined (HAVE_XPM) || defined (HAVE_NS) \ + || defined (HAVE_HAIKU) || defined (HAVE_PGTK) DEFSYM (Qxpm, "xpm"); add_image_type (Qxpm); #endif @@ -10892,6 +11892,13 @@ non-numeric, there is no explicit limit on the size of images. */); add_image_type (Qpng); #endif +#if defined (HAVE_WEBP) || (defined (HAVE_NATIVE_IMAGE_API) \ + && defined (HAVE_HAIKU)) + DEFSYM (Qwebp, "webp"); + DEFSYM (Qwebpdemux, "webpdemux"); + add_image_type (Qwebp); +#endif + #if defined (HAVE_IMAGEMAGICK) DEFSYM (Qimagemagick, "imagemagick"); add_image_type (Qimagemagick); @@ -10913,8 +11920,19 @@ non-numeric, there is no explicit limit on the size of images. */); #endif /* HAVE_NTGUI */ #endif /* HAVE_RSVG */ +#ifdef HAVE_NS + DEFSYM (Qheic, "heic"); + add_image_type (Qheic); +#endif + #if HAVE_NATIVE_IMAGE_API DEFSYM (Qnative_image, "native-image"); + +# if defined HAVE_NTGUI || defined HAVE_HAIKU + DEFSYM (Qbmp, "bmp"); + add_image_type (Qbmp); +# endif + # ifdef HAVE_NTGUI DEFSYM (Qgdiplus, "gdiplus"); DEFSYM (Qshlwapi, "shlwapi"); @@ -10937,6 +11955,11 @@ non-numeric, there is no explicit limit on the size of images. */); defsubr (&Slookup_image); #endif + DEFSYM (QCanimate_buffer, ":animate-buffer"); + DEFSYM (QCanimate_tardiness, ":animate-tardiness"); + DEFSYM (QCanimate_position, ":animate-position"); + DEFSYM (QCanimate_multi_frame_data, ":animate-multi-frame-data"); + defsubr (&Simage_transforms_p); DEFVAR_BOOL ("cross-disabled-images", cross_disabled_images, diff --git a/src/indent.c b/src/indent.c index 9f1a448a73a..d5ad02ae3af 100644 --- a/src/indent.c +++ b/src/indent.c @@ -468,31 +468,40 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos) { Lisp_Object val, overlay; - if (CONSP (val = get_char_property_and_overlay - (make_fixnum (pos), Qdisplay, Qnil, &overlay)) - && EQ (Qspace, XCAR (val))) - { /* FIXME: Use calc_pixel_width_or_height. */ - Lisp_Object plist = XCDR (val), prop; + if (!NILP (val = get_char_property_and_overlay (make_fixnum (pos), Qdisplay, + Qnil, &overlay))) + { int width = -1; - EMACS_INT align_to_max = - (col < MOST_POSITIVE_FIXNUM - INT_MAX - ? (EMACS_INT) INT_MAX + col - : MOST_POSITIVE_FIXNUM); - - if ((prop = Fplist_get (plist, QCwidth), - RANGED_FIXNUMP (0, prop, INT_MAX)) - || (prop = Fplist_get (plist, QCrelative_width), - RANGED_FIXNUMP (0, prop, INT_MAX))) - width = XFIXNUM (prop); - else if (FLOATP (prop) && 0 <= XFLOAT_DATA (prop) - && XFLOAT_DATA (prop) <= INT_MAX) - width = (int)(XFLOAT_DATA (prop) + 0.5); - else if ((prop = Fplist_get (plist, QCalign_to), - RANGED_FIXNUMP (col, prop, align_to_max))) - width = XFIXNUM (prop) - col; - else if (FLOATP (prop) && col <= XFLOAT_DATA (prop) - && (XFLOAT_DATA (prop) <= align_to_max)) - width = (int)(XFLOAT_DATA (prop) + 0.5) - col; + Lisp_Object plist = Qnil; + + /* Handle '(space ...)' display specs. */ + if (CONSP (val) && EQ (Qspace, XCAR (val))) + { /* FIXME: Use calc_pixel_width_or_height. */ + Lisp_Object prop; + EMACS_INT align_to_max = + (col < MOST_POSITIVE_FIXNUM - INT_MAX + ? (EMACS_INT) INT_MAX + col + : MOST_POSITIVE_FIXNUM); + + plist = XCDR (val); + if ((prop = Fplist_get (plist, QCwidth), + RANGED_FIXNUMP (0, prop, INT_MAX)) + || (prop = Fplist_get (plist, QCrelative_width), + RANGED_FIXNUMP (0, prop, INT_MAX))) + width = XFIXNUM (prop); + else if (FLOATP (prop) && 0 <= XFLOAT_DATA (prop) + && XFLOAT_DATA (prop) <= INT_MAX) + width = (int)(XFLOAT_DATA (prop) + 0.5); + else if ((prop = Fplist_get (plist, QCalign_to), + RANGED_FIXNUMP (col, prop, align_to_max))) + width = XFIXNUM (prop) - col; + else if (FLOATP (prop) && col <= XFLOAT_DATA (prop) + && (XFLOAT_DATA (prop) <= align_to_max)) + width = (int)(XFLOAT_DATA (prop) + 0.5) - col; + } + /* Handle 'display' strings. */ + else if (STRINGP (val)) + width = XFIXNUM (Fstring_width (val, Qnil, Qnil)); if (width >= 0) { @@ -504,7 +513,8 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos) /* For :relative-width, we need to multiply by the column width of the character at POS, if it is greater than 1. */ - if (!NILP (Fplist_get (plist, QCrelative_width)) + if (!NILP (plist) + && !NILP (Fplist_get (plist, QCrelative_width)) && !NILP (BVAR (current_buffer, enable_multibyte_characters))) { int b, wd; @@ -516,6 +526,7 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos) return width; } } + return -1; } @@ -1968,7 +1979,7 @@ line_number_display_width (struct window *w, int *width, int *pixel_width) struct text_pos startpos; bool saved_restriction = false; struct buffer *old_buf = current_buffer; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); SET_TEXT_POS_FROM_MARKER (startpos, w->start); void *itdata = bidi_shelve_cache (); @@ -2051,6 +2062,7 @@ window_column_x (struct window *w, Lisp_Object window, /* Restore window's buffer and point. */ +/* FIXME: Merge with `with_echo_area_buffer_unwind_data`? */ static void restore_window_buffer (Lisp_Object list) { @@ -2104,7 +2116,7 @@ whether or not it is currently displayed in some window. */) struct window *w; Lisp_Object lcols = Qnil; void *itdata = NULL; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Allow LINES to be of the form (HPOS . VPOS) aka (COLUMNS . LINES). */ if (CONSP (lines)) diff --git a/src/insdel.c b/src/insdel.c index d9ba222b1d1..6f180ac5800 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -2134,7 +2134,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, Lisp_Object start, end; Lisp_Object start_marker, end_marker; Lisp_Object preserve_marker; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct rvoe_arg rvoe_arg; start = make_fixnum (start_int); @@ -2201,7 +2201,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, void signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct rvoe_arg rvoe_arg; Lisp_Object tmp, save_insert_behind_hooks, save_insert_in_from_hooks; @@ -2298,7 +2298,7 @@ DEFUN ("combine-after-change-execute", Fcombine_after_change_execute, doc: /* This function is for use internally in the function `combine-after-change-calls'. */) (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t beg, end, change; ptrdiff_t begpos, endpos; Lisp_Object tail; diff --git a/src/intervals.c b/src/intervals.c index 189308e8e30..687b237b9ea 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. @@ -2170,7 +2180,7 @@ get_local_map (ptrdiff_t position, struct buffer *buffer, Lisp_Object type) { Lisp_Object prop, lispy_position, lispy_buffer; ptrdiff_t old_begv, old_zv, old_begv_byte, old_zv_byte; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); position = clip_to_bounds (BUF_BEGV (buffer), position, BUF_ZV (buffer)); @@ -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/json.c b/src/json.c index 21a6df67857..db1be07f196 100644 --- a/src/json.c +++ b/src/json.c @@ -337,7 +337,7 @@ lisp_to_json_nonscalar_1 (Lisp_Object lisp, const struct json_configuration *conf) { json_t *json; - ptrdiff_t count; + specpdl_ref count; if (VECTORP (lisp)) { @@ -584,7 +584,7 @@ any JSON false values. usage: (json-serialize OBJECT &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef WINDOWSNT if (!json_initialized) @@ -693,7 +693,7 @@ OBJECT. usage: (json-insert OBJECT &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef WINDOWSNT if (!json_initialized) @@ -950,7 +950,7 @@ represent a JSON false value. It defaults to `:false'. usage: (json-parse-string STRING &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef WINDOWSNT if (!json_initialized) @@ -1047,7 +1047,7 @@ represent a JSON false value. It defaults to `:false'. usage: (json-parse-buffer &rest args) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef WINDOWSNT if (!json_initialized) diff --git a/src/keyboard.c b/src/keyboard.c index 9865bc9add3..e569f8f34c9 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -65,6 +65,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <sys/types.h> #include <unistd.h> #include <fcntl.h> +#include <math.h> #include <ignore-value.h> @@ -335,6 +336,11 @@ static struct timespec timer_idleness_start_time; static struct timespec timer_last_idleness_start_time; +/* Predefined strings for core device names. */ + +static Lisp_Object virtual_core_pointer_name; +static Lisp_Object virtual_core_keyboard_name; + /* Global variable declarations. */ @@ -375,6 +381,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. */ @@ -680,13 +687,15 @@ add_command_key (Lisp_Object key) Lisp_Object recursive_edit_1 (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; if (command_loop_level > 0) { specbind (Qstandard_output, Qt); specbind (Qstandard_input, Qt); + specbind (Qsymbols_with_pos_enabled, Qnil); + specbind (Qprint_symbols_bare, Qnil); } #ifdef HAVE_WINDOW_SYSTEM @@ -772,7 +781,7 @@ throwing to \\='exit: This function is called by the editor initialization to begin editing. */) (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object buffer; /* If we enter while input is blocked, don't lock up here. @@ -935,7 +944,7 @@ static Lisp_Object cmd_error (Lisp_Object data) { Lisp_Object old_level, old_length; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object conditions; char macroerror[sizeof "After..kbd macro iterations: " + INT_STRLEN_BOUND (EMACS_INT)]; @@ -1228,7 +1237,7 @@ DEFUN ("internal--track-mouse", Finternal_track_mouse, Sinternal_track_mouse, doc: /* Call BODYFUN with mouse movement events enabled. */) (Lisp_Object bodyfun) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; record_unwind_protect (tracking_off, track_mouse); @@ -1351,7 +1360,7 @@ command_loop_1 (void) { /* Bind inhibit-quit to t so that C-g gets read in rather than quitting back to the minibuffer. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); sit_for (Vminibuffer_message_timeout, 0, 2); @@ -1483,7 +1492,7 @@ command_loop_1 (void) /* Here for a command that isn't executed directly. */ #ifdef HAVE_WINDOW_SYSTEM - ptrdiff_t scount = SPECPDL_INDEX (); + specpdl_ref scount = SPECPDL_INDEX (); if (display_hourglass_p && NILP (Vexecuting_kbd_macro)) @@ -1599,23 +1608,33 @@ command_loop_1 (void) if (current_buffer == prev_buffer && XBUFFER (XWINDOW (selected_window)->contents) == current_buffer - && last_point_position != PT - && NILP (Vdisable_point_adjustment) - && NILP (Vglobal_disable_point_adjustment)) + && last_point_position != PT) { - if (last_point_position > BEGV - && last_point_position < ZV - && (composition_adjust_point (last_point_position, - last_point_position) - != last_point_position)) - /* The last point was temporarily set within a grapheme - cluster to prevent automatic composition. To recover - the automatic composition, we must update the - display. */ - windows_or_buffers_changed = 21; - if (!already_adjusted) - adjust_point_for_property (last_point_position, - MODIFF != prev_modiff); + if (NILP (Vdisable_point_adjustment) + && NILP (Vglobal_disable_point_adjustment) + && !composition_break_at_point) + { + if (last_point_position > BEGV + && last_point_position < ZV + && (composition_adjust_point (last_point_position, + last_point_position) + != last_point_position)) + /* The last point was temporarily set within a grapheme + cluster to prevent automatic composition. To recover + the automatic composition, we must update the + display. */ + windows_or_buffers_changed = 21; + if (!already_adjusted) + adjust_point_for_property (last_point_position, + MODIFF != prev_modiff); + } + else if (PT > BEGV && PT < ZV + && (composition_adjust_point (last_point_position, PT) + != PT)) + /* Now point is within a grapheme cluster. We must update + the display so that this cluster is de-composed on the + screen and the cursor is correctly placed at point. */ + windows_or_buffers_changed = 39; } /* Install chars successfully executed in kbd macro. */ @@ -1629,7 +1648,7 @@ command_loop_1 (void) Lisp_Object read_menu_command (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* We don't want to echo the keystrokes while navigating the menus. */ @@ -1874,7 +1893,7 @@ safe_run_hook_funcall (ptrdiff_t nargs, Lisp_Object *args) void safe_run_hooks (Lisp_Object hook) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); run_hook_with_args (2, ((Lisp_Object []) {hook, hook}), safe_run_hook_funcall); @@ -1893,6 +1912,9 @@ int poll_suppress_count; static struct atimer *poll_timer; +/* The poll period that constructed this timer. */ +static Lisp_Object poll_timer_time; + #if defined CYGWIN || defined DOS_NT /* Poll for input, so that we catch a C-g if it comes in. */ void @@ -1934,17 +1956,18 @@ start_polling (void) /* If poll timer doesn't exist, or we need one with a different interval, start a new one. */ - if (poll_timer == NULL - || poll_timer->interval.tv_sec != polling_period) + if (NUMBERP (Vpolling_period) + && (poll_timer == NULL + || NILP (Fequal (Vpolling_period, poll_timer_time)))) { - time_t period = max (1, min (polling_period, TYPE_MAXIMUM (time_t))); - struct timespec interval = make_timespec (period, 0); + struct timespec interval = dtotimespec (XFLOATINT (Vpolling_period)); if (poll_timer) cancel_atimer (poll_timer); poll_timer = start_atimer (ATIMER_CONTINUOUS, interval, poll_for_input, NULL); + poll_timer_time = Vpolling_period; } /* Let the timer's callback function poll for input @@ -2012,14 +2035,28 @@ void bind_polling_period (int n) { #ifdef POLL_FOR_INPUT - intmax_t new = polling_period; + if (FIXNUMP (Vpolling_period)) + { + intmax_t new = XFIXNUM (Vpolling_period); + + if (n > new) + new = n; - if (n > new) - new = n; + stop_other_atimers (poll_timer); + stop_polling (); + specbind (Qpolling_period, make_int (new)); + } + else if (FLOATP (Vpolling_period)) + { + double new = XFLOAT_DATA (Vpolling_period); + + stop_other_atimers (poll_timer); + stop_polling (); + specbind (Qpolling_period, (n > new + ? make_int (n) + : Vpolling_period)); + } - stop_other_atimers (poll_timer); - stop_polling (); - specbind (Qpolling_period, make_int (new)); /* Start a new alarm with the new period. */ start_polling (); #endif @@ -2189,7 +2226,7 @@ read_event_from_main_queue (struct timespec *end_time, return c; /* Actually read a character, waiting if necessary. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); save_getcjmp (save_jump); record_unwind_protect_ptr (restore_getcjmp, save_jump); restore_getcjmp (local_getcjmp); @@ -2391,7 +2428,6 @@ read_char (int commandflag, Lisp_Object map, bool *used_mouse_menu, struct timespec *end_time) { Lisp_Object c; - ptrdiff_t jmpcount; sys_jmp_buf local_getcjmp; sys_jmp_buf save_jump; Lisp_Object tem, save; @@ -2429,6 +2465,7 @@ read_char (int commandflag, Lisp_Object map, else reread = false; + Vlast_event_device = Qnil; if (CONSP (Vunread_command_events)) { @@ -2633,7 +2670,7 @@ read_char (int commandflag, Lisp_Object map, around any call to sit_for or kbd_buffer_get_event; it *must not* be in effect when we call redisplay. */ - jmpcount = SPECPDL_INDEX (); + specpdl_ref jmpcount = SPECPDL_INDEX (); if (sys_setjmp (local_getcjmp)) { /* Handle quits while reading the keyboard. */ @@ -2716,7 +2753,7 @@ read_char (int commandflag, Lisp_Object map, { Lisp_Object tem0; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); save_getcjmp (save_jump); record_unwind_protect_ptr (restore_getcjmp, save_jump); restore_getcjmp (local_getcjmp); @@ -2793,7 +2830,7 @@ read_char (int commandflag, Lisp_Object map, timeout = min (timeout, MOST_POSITIVE_FIXNUM / delay_level * 4); timeout = delay_level * timeout / 4; - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); save_getcjmp (save_jump); record_unwind_protect_ptr (restore_getcjmp, save_jump); restore_getcjmp (local_getcjmp); @@ -2943,20 +2980,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 @@ -3088,7 +3113,7 @@ read_char (int commandflag, Lisp_Object map, Lisp_Object keys; ptrdiff_t key_count; ptrdiff_t command_key_start; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Save the echo status. */ bool saved_immediate_echo = current_kboard->immediate_echo; @@ -3213,7 +3238,7 @@ read_char (int commandflag, Lisp_Object map, /* Process the help character specially if enabled. */ if (!NILP (Vhelp_form) && help_char_p (c)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); help_form_saved_window_configs = Fcons (Fcurrent_window_configuration (Qnil), @@ -3458,8 +3483,13 @@ 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 @@ -3478,8 +3508,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 @@ -3661,29 +3694,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; } @@ -3752,6 +3766,7 @@ gen_help_event (Lisp_Object help, Lisp_Object frame, Lisp_Object window, Lisp_Object object, ptrdiff_t pos) { struct input_event event; + EVENT_INIT (event); event.kind = HELP_EVENT; event.frame_or_window = frame; @@ -3769,6 +3784,7 @@ void kbd_buffer_store_help_event (Lisp_Object frame, Lisp_Object help) { struct input_event event; + EVENT_INIT (event); event.kind = HELP_EVENT; event.frame_or_window = frame; @@ -3827,6 +3843,26 @@ clear_event (struct input_event *event) event->kind = NO_EVENT; } +static Lisp_Object +kbd_buffer_get_event_1 (Lisp_Object arg) +{ + Lisp_Object coding_system = Fget_text_property (make_fixnum (0), + Qcoding, arg); + + if (EQ (coding_system, Qt)) + return arg; + + return code_convert_string (arg, (!NILP (coding_system) + ? coding_system + : Vlocale_coding_system), + Qnil, 0, false, 0); +} + +static Lisp_Object +kbd_buffer_get_event_2 (Lisp_Object val) +{ + return Qnil; +} /* Read one event from the event buffer, waiting if necessary. The value is a Lisp object representing the event. @@ -3839,7 +3875,7 @@ kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu, struct timespec *end_time) { - Lisp_Object obj; + Lisp_Object obj, str; #ifdef subprocesses if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE / 4) @@ -3865,6 +3901,8 @@ kbd_buffer_get_event (KBOARD **kbp, } #endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED */ + *kbp = current_kboard; + /* Wait until there is input available. */ for (;;) { @@ -3887,7 +3925,7 @@ kbd_buffer_get_event (KBOARD **kbp, /* One way or another, wait until input is available; then, if interrupt handlers have not read it, read it now. */ -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) gobble_input (); #endif if (kbd_fetch_ptr != kbd_store_ptr) @@ -3976,6 +4014,41 @@ kbd_buffer_get_event (KBOARD **kbp, } break; +#ifdef HAVE_X_WINDOWS + case UNSUPPORTED_DROP_EVENT: + { + struct frame *f; + + kbd_fetch_ptr = next_kbd_event (event); + input_pending = readable_events (0); + + f = XFRAME (event->ie.frame_or_window); + + if (!FRAME_LIVE_P (f)) + break; + + if (!NILP (Vx_dnd_unsupported_drop_function)) + { + if (!NILP (call6 (Vx_dnd_unsupported_drop_function, + XCAR (XCDR (event->ie.arg)), event->ie.x, + event->ie.y, XCAR (XCDR (XCDR (event->ie.arg))), + make_uint (event->ie.code), + event->ie.frame_or_window))) + break; + } + + x_dnd_do_unsupported_drop (FRAME_DISPLAY_INFO (f), + event->ie.frame_or_window, + XCAR (event->ie.arg), + XCAR (XCDR (event->ie.arg)), + (Window) event->ie.code, + XFIXNUM (event->ie.x), + XFIXNUM (event->ie.y), + event->ie.timestamp); + break; + } +#endif + #ifdef HAVE_EXT_MENU_BAR case MENU_BAR_ACTIVATE_EVENT: { @@ -3994,6 +4067,7 @@ kbd_buffer_get_event (KBOARD **kbp, *used_mouse_menu = true; FALLTHROUGH; #endif + case PREEDIT_TEXT_EVENT: #ifdef HAVE_NTGUI case END_SESSION_EVENT: case LANGUAGE_CHANGE_EVENT: @@ -4015,6 +4089,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: @@ -4051,10 +4126,119 @@ kbd_buffer_get_event (KBOARD **kbp, obj = make_lispy_switch_frame (frame); internal_last_event_frame = frame; + if (EQ (event->ie.device, Qt)) + Vlast_event_device = ((event->ie.kind == ASCII_KEYSTROKE_EVENT + || event->ie.kind == MULTIBYTE_CHAR_KEYSTROKE_EVENT + || event->ie.kind == NON_ASCII_KEYSTROKE_EVENT) + ? virtual_core_keyboard_name + : virtual_core_pointer_name); + else + Vlast_event_device = event->ie.device; + /* If we didn't decide to make a switch-frame event, go ahead and build a real event from the queue entry. */ if (NILP (obj)) { + double pinch_dx, pinch_dy, pinch_angle; + + /* Pinch events are often sent in rapid succession, so + large amounts of such events have the potential to + queue up inside the keyboard buffer. In that case, + find the last pinch event in succession on the same + frame with the same modifiers, and send that instead. */ + + if (event->ie.kind == PINCH_EVENT + /* Ignore if this is the start of a pinch sequence. + These events should always be sent so that we + never miss a sequence starting, and they don't + have the potential to queue up. */ + && ((pinch_dx + = XFLOAT_DATA (XCAR (event->ie.arg))) != 0.0 + || XFLOAT_DATA (XCAR (XCDR (event->ie.arg))) != 0.0 + || XFLOAT_DATA (Fnth (make_fixnum (3), event->ie.arg)) != 0.0)) + { + union buffered_input_event *maybe_event = next_kbd_event (event); + + pinch_dy = XFLOAT_DATA (XCAR (XCDR (event->ie.arg))); + pinch_angle = XFLOAT_DATA (Fnth (make_fixnum (3), event->ie.arg)); + + while (maybe_event != kbd_store_ptr + && maybe_event->ie.kind == PINCH_EVENT + /* Make sure we never miss an event that has + different modifiers. */ + && maybe_event->ie.modifiers == event->ie.modifiers + /* Make sure that the event is for the same + frame. */ + && EQ (maybe_event->ie.frame_or_window, + event->ie.frame_or_window) + /* Make sure that the event isn't the start + of a new pinch gesture sequence. */ + && (XFLOAT_DATA (XCAR (maybe_event->ie.arg)) != 0.0 + || XFLOAT_DATA (XCAR (XCDR (maybe_event->ie.arg))) != 0.0 + || XFLOAT_DATA (Fnth (make_fixnum (3), + maybe_event->ie.arg)) != 0.0)) + { + event = maybe_event; + /* Add up relative deltas inside events we skip. */ + pinch_dx += XFLOAT_DATA (XCAR (maybe_event->ie.arg)); + pinch_dy += XFLOAT_DATA (XCAR (XCDR (maybe_event->ie.arg))); + pinch_angle += XFLOAT_DATA (Fnth (make_fixnum (3), + maybe_event->ie.arg)); + + XSETCAR (maybe_event->ie.arg, make_float (pinch_dx)); + XSETCAR (XCDR (maybe_event->ie.arg), make_float (pinch_dy)); + XSETCAR (Fnthcdr (make_fixnum (3), + maybe_event->ie.arg), + make_float (fmod (pinch_angle, 360.0))); + + if (!EQ (maybe_event->ie.device, Qt)) + Vlast_event_device = maybe_event->ie.device; + + maybe_event = next_kbd_event (event); + } + } + + if (event->kind == MULTIBYTE_CHAR_KEYSTROKE_EVENT + /* This string has to be decoded. */ + && STRINGP (event->ie.arg)) + { + str = internal_condition_case_1 (kbd_buffer_get_event_1, + event->ie.arg, Qt, + kbd_buffer_get_event_2); + + /* Decoding the string failed, so use the original, + where at least ASCII text will work. */ + if (NILP (str)) + str = event->ie.arg; + + if (!SCHARS (str)) + { + kbd_fetch_ptr = next_kbd_event (event); + obj = Qnil; + break; + } + + /* car is the index of the next character in the + string that will be sent and cdr is the string + itself. */ + event->ie.arg = Fcons (make_fixnum (0), str); + } + + if (event->kind == MULTIBYTE_CHAR_KEYSTROKE_EVENT + && CONSP (event->ie.arg)) + { + eassert (FIXNUMP (XCAR (event->ie.arg))); + eassert (STRINGP (XCDR (event->ie.arg))); + eassert (XFIXNUM (XCAR (event->ie.arg)) + < SCHARS (XCDR (event->ie.arg))); + + event->ie.code = XFIXNUM (Faref (XCDR (event->ie.arg), + XCAR (event->ie.arg))); + + XSETCAR (event->ie.arg, + make_fixnum (XFIXNUM (XCAR (event->ie.arg)) + 1)); + } + obj = make_lispy_event (&event->ie); #ifdef HAVE_EXT_MENU_BAR @@ -4077,9 +4261,15 @@ kbd_buffer_get_event (KBOARD **kbp, *used_mouse_menu = true; #endif - /* Wipe out this event, to catch bugs. */ - clear_event (&event->ie); - kbd_fetch_ptr = next_kbd_event (event); + if (event->kind != MULTIBYTE_CHAR_KEYSTROKE_EVENT + || !CONSP (event->ie.arg) + || (XFIXNUM (XCAR (event->ie.arg)) + >= SCHARS (XCDR (event->ie.arg)))) + { + /* Wipe out this event, to catch bugs. */ + clear_event (&event->ie); + kbd_fetch_ptr = next_kbd_event (event); + } } } } @@ -4087,12 +4277,13 @@ kbd_buffer_get_event (KBOARD **kbp, /* Try generating a mouse motion event. */ else if (some_mouse_moved ()) { - struct frame *f = some_mouse_moved (); + struct frame *f, *movement_frame = some_mouse_moved (); Lisp_Object bar_window; enum scroll_bar_part part; Lisp_Object x, y; Time t; + f = movement_frame; *kbp = current_kboard; /* Note that this uses F to determine which terminal to look at. If there is no valid info, it does not store anything @@ -4127,6 +4318,11 @@ kbd_buffer_get_event (KBOARD **kbp, return a mouse-motion event. */ if (!NILP (x) && NILP (obj)) obj = make_lispy_movement (f, bar_window, part, x, y, t); + + if (!NILP (obj)) + Vlast_event_device = (STRINGP (movement_frame->last_mouse_device) + ? movement_frame->last_mouse_device + : virtual_core_pointer_name); } else /* We were promised by the above while loop that there was @@ -4383,7 +4579,7 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers) { if (NILP (AREF (chosen_timer, 0))) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object old_deactivate_mark = Vdeactivate_mark; /* Mark the timer as triggered to prevent problems if the lisp @@ -4484,6 +4680,7 @@ static Lisp_Object func_key_syms; static Lisp_Object mouse_syms; static Lisp_Object wheel_syms; static Lisp_Object drag_n_drop_syms; +static Lisp_Object pinch_syms; /* This is a list of keysym codes for special "accent" characters. It parallels lispy_accent_keys. */ @@ -4919,7 +5116,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 */ @@ -5112,17 +5309,19 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, Lisp_Object window_or_frame = f ? window_from_coordinates (f, mx, my, &part, true, true) : Qnil; +#ifdef HAVE_WINDOW_SYSTEM + bool tool_bar_p = false; + bool menu_bar_p = false; /* 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)) + if (f && ((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)) + || (WINDOWP (f->tool_bar_window) + && EQ (window_or_frame, f->tool_bar_window)) #endif - ) + )) { /* While 'track-mouse' is neither nil nor t, do not report this event as something that happened on the tool or tab bar since @@ -5145,6 +5344,20 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, coordinates. FIXME! */ window_or_frame = Qnil; } + + if (f && FRAME_TERMINAL (f)->toolkit_position_hook) + { + FRAME_TERMINAL (f)->toolkit_position_hook (f, mx, my, &menu_bar_p, + &tool_bar_p); + + if (NILP (track_mouse) || EQ (track_mouse, Qt)) + { + if (menu_bar_p) + posn = Qmenu_bar; + else if (tool_bar_p) + posn = Qtool_bar; + } + } #endif if (f && !FRAME_WINDOW_P (f) @@ -5373,9 +5586,16 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, } #endif } - else - window_or_frame = Qnil; + { + if (EQ (track_mouse, Qdrag_source)) + { + xret = mx; + yret = my; + } + + window_or_frame = Qnil; + } return Fcons (window_or_frame, Fcons (posn, @@ -6002,7 +6222,11 @@ make_lispy_event (struct input_event *event) ASIZE (wheel_syms)); } - if (NUMBERP (event->arg)) + if (CONSP (event->arg)) + return list5 (head, position, make_fixnum (double_click_count), + XCAR (event->arg), Fcons (XCAR (XCDR (event->arg)), + XCAR (XCDR (XCDR (event->arg))))); + else if (NUMBERP (event->arg)) return list4 (head, position, make_fixnum (double_click_count), event->arg); else if (event->modifiers & (double_modifier | triple_modifier)) @@ -6011,6 +6235,77 @@ make_lispy_event (struct input_event *event) return list2 (head, position); } + case TOUCH_END_EVENT: + { + Lisp_Object position; + + /* Build the position as appropriate for this mouse click. */ + struct frame *f = XFRAME (event->frame_or_window); + + if (! FRAME_LIVE_P (f)) + return Qnil; + + position = make_lispy_position (f, event->x, event->y, + event->timestamp); + + return list2 (Qtouch_end, position); + } + + case TOUCHSCREEN_BEGIN_EVENT: + case TOUCHSCREEN_END_EVENT: + { + Lisp_Object x, y, id, position; + struct frame *f = XFRAME (event->frame_or_window); + + id = event->arg; + x = event->x; + y = event->y; + + position = make_lispy_position (f, x, y, event->timestamp); + + return list2 (((event->kind + == TOUCHSCREEN_BEGIN_EVENT) + ? Qtouchscreen_begin + : Qtouchscreen_end), + Fcons (id, position)); + } + + case PINCH_EVENT: + { + Lisp_Object x, y, position; + struct frame *f = XFRAME (event->frame_or_window); + + x = event->x; + y = event->y; + + position = make_lispy_position (f, x, y, event->timestamp); + + return Fcons (modify_event_symbol (0, event->modifiers, Qpinch, + Qnil, (const char *[]) {"pinch"}, + &pinch_syms, 1), + Fcons (position, event->arg)); + } + + case TOUCHSCREEN_UPDATE_EVENT: + { + Lisp_Object x, y, id, position, tem, it, evt; + struct frame *f = XFRAME (event->frame_or_window); + evt = Qnil; + + for (tem = event->arg; CONSP (tem); tem = XCDR (tem)) + { + it = XCAR (tem); + + x = XCAR (it); + y = XCAR (XCDR (it)); + id = XCAR (XCDR (XCDR (it))); + + position = make_lispy_position (f, x, y, event->timestamp); + evt = Fcons (Fcons (id, position), evt); + } + + return list2 (Qtouchscreen_update, evt); + } #ifdef USE_TOOLKIT_SCROLL_BARS @@ -6145,23 +6440,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 Fcons (Qxwidget_display_event, event->arg); #endif #ifdef USE_FILE_NOTIFY @@ -6178,6 +6470,9 @@ make_lispy_event (struct input_event *event) return list3 (Qconfig_changed_event, event->arg, event->frame_or_window); + case PREEDIT_TEXT_EVENT: + return list2 (Qpreedit_text, event->arg); + /* The 'kind' field of the event is something we don't recognize. */ default: emacs_abort (); @@ -7205,7 +7500,7 @@ tty_read_avail_input (struct terminal *terminal, static void handle_async_input (void) { -#ifdef USABLE_SIGIO +#ifndef DOS_NT while (1) { int nread = gobble_input (); @@ -7268,7 +7563,7 @@ totally_unblock_input (void) unblock_input_to (0); } -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) void handle_input_available_signal (int sig) @@ -7284,7 +7579,7 @@ deliver_input_available_signal (int sig) { deliver_process_signal (sig, handle_input_available_signal); } -#endif /* USABLE_SIGIO */ +#endif /* defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) */ /* User signal events. */ @@ -7354,7 +7649,7 @@ handle_user_signal (int sig) } p->npending++; -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) if (interrupt_input) handle_input_available_signal (sig); else @@ -7720,7 +8015,7 @@ eval_dyn (Lisp_Object form) Lisp_Object menu_item_eval_property (Lisp_Object sexpr) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; specbind (Qinhibit_redisplay, Qt); val = internal_condition_case_1 (eval_dyn, sexpr, Qerror, @@ -7857,7 +8152,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))) @@ -9385,7 +9682,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, bool dont_downcase_last, bool can_return_switch_frame, bool fix_current_buffer, bool prevent_redisplay) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* How many keys there are in the current key sequence. */ int t; @@ -10185,7 +10482,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); @@ -10237,12 +10535,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 @@ -10318,7 +10618,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop, bool allow_string) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (!NILP (prompt)) CHECK_STRING (prompt); @@ -10786,7 +11086,7 @@ Some operating systems cannot stop the Emacs process and resume it later. On such systems, Emacs starts a subshell instead of suspending. */) (Lisp_Object stuffstring) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); int old_height, old_width; int width, height; @@ -11119,7 +11419,7 @@ See also `current-input-mode'. */) (Lisp_Object interrupt) { bool new_interrupt_input; -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) #ifdef HAVE_X_WINDOWS if (x_display_list != NULL) { @@ -11130,9 +11430,9 @@ See also `current-input-mode'. */) else #endif /* HAVE_X_WINDOWS */ new_interrupt_input = !NILP (interrupt); -#else /* not USABLE_SIGIO */ +#else /* not USABLE_SIGIO || USABLE_SIGPOLL */ new_interrupt_input = false; -#endif /* not USABLE_SIGIO */ +#endif /* not USABLE_SIGIO || USABLE_SIGPOLL */ if (new_interrupt_input != interrupt_input) { @@ -11532,6 +11832,10 @@ init_keyboard (void) interrupt_input_blocked = 0; pending_signals = false; + virtual_core_pointer_name = build_string ("Virtual core pointer"); + virtual_core_keyboard_name = build_string ("Virtual core keyboard"); + Vlast_event_device = Qnil; + /* This means that command_loop_1 won't try to select anything the first time through. */ internal_last_event_frame = Qnil; @@ -11561,12 +11865,16 @@ init_keyboard (void) sigaction (SIGQUIT, &action, 0); #endif /* not DOS_NT */ } -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) if (!noninteractive) { struct sigaction action; emacs_sigaction_init (&action, deliver_input_available_signal); +#ifdef USABLE_SIGIO sigaction (SIGIO, &action, 0); +#else + sigaction (SIGPOLL, &action, 0); +#endif } #endif @@ -11618,6 +11926,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 @@ -11704,12 +12058,15 @@ syms_of_keyboard (void) #ifdef HAVE_XWIDGETS DEFSYM (Qxwidget_event, "xwidget-event"); + DEFSYM (Qxwidget_display_event, "xwidget-display-event"); #endif #ifdef USE_FILE_NOTIFY DEFSYM (Qfile_notify, "file-notify"); #endif /* USE_FILE_NOTIFY */ + DEFSYM (Qtouch_end, "touch-end"); + /* Menu and tool bar item parts. */ DEFSYM (QCenable, ":enable"); DEFSYM (QCvisible, ":visible"); @@ -11829,6 +12186,8 @@ syms_of_keyboard (void) DEFSYM (Qno_record, "no-record"); DEFSYM (Qencoded, "encoded"); + DEFSYM (Qpreedit_text, "preedit-text"); + button_down_location = make_nil_vector (5); staticpro (&button_down_location); staticpro (&frame_relative_event_pos); @@ -11869,6 +12228,9 @@ syms_of_keyboard (void) drag_n_drop_syms = Qnil; staticpro (&drag_n_drop_syms); + pinch_syms = Qnil; + staticpro (&pinch_syms); + unread_switch_frame = Qnil; staticpro (&unread_switch_frame); @@ -11889,6 +12251,17 @@ syms_of_keyboard (void) help_form_saved_window_configs = Qnil; staticpro (&help_form_saved_window_configs); +#ifdef POLL_FOR_INPUT + poll_timer_time = Qnil; + staticpro (&poll_timer_time); +#endif + + virtual_core_pointer_name = Qnil; + staticpro (&virtual_core_pointer_name); + + virtual_core_keyboard_name = Qnil; + staticpro (&virtual_core_keyboard_name); + defsubr (&Scurrent_idle_time); defsubr (&Sevent_symbol_parse_modifiers); defsubr (&Sevent_convert_list); @@ -12046,12 +12419,12 @@ The value may be integer or floating point. If the value is zero, don't echo at all. */); Vecho_keystrokes = make_fixnum (1); - DEFVAR_INT ("polling-period", polling_period, + DEFVAR_LISP ("polling-period", Vpolling_period, doc: /* Interval between polling for input during Lisp execution. The reason for polling is to make C-g work to stop a running program. Polling is needed only when using X windows and SIGIO does not work. Polling is automatically disabled in all other cases. */); - polling_period = 2; + Vpolling_period = make_float (2.0); DEFVAR_LISP ("double-click-time", Vdouble_click_time, doc: /* Maximum time between mouse clicks to make a double-click. @@ -12087,6 +12460,17 @@ This does not include events generated by keyboard macros. */); If the last event came from a keyboard macro, this is set to `macro'. */); Vlast_event_frame = Qnil; + DEFVAR_LISP ("last-event-device", Vlast_event_device, + doc: /* The name of the input device of the most recently read event. +When the input extension is being used on X, this is the name of the X +Input Extension device from which the last event was generated as a +string. Otherwise, this is "Virtual core keyboard" for keyboard input +events, and "Virtual core pointer" for other events. + +It is nil if the last event did not come from an input device (i.e. it +came from `unread-command-events' instead). */); + Vlast_event_device = Qnil; + /* This variable is set up in sysdep.c. */ DEFVAR_LISP ("tty-erase-char", Vtty_erase_char, doc: /* The ERASE character as set by the user with stty. */); @@ -12205,6 +12589,13 @@ See also `pre-command-hook'. */); doc: /* Normal hook run when clearing the echo area. */); #endif DEFSYM (Qecho_area_clear_hook, "echo-area-clear-hook"); + DEFSYM (Qtouchscreen_begin, "touchscreen-begin"); + DEFSYM (Qtouchscreen_end, "touchscreen-end"); + DEFSYM (Qtouchscreen_update, "touchscreen-update"); + DEFSYM (Qpinch, "pinch"); + + DEFSYM (Qcoding, "coding"); + Fset (Qecho_area_clear_hook, Qnil); DEFVAR_LISP ("lucid-menu-bar-dirty-flag", Vlucid_menu_bar_dirty_flag, @@ -12262,12 +12653,15 @@ and the minor mode maps regardless of `overriding-local-map'. */); doc: /* Non-nil means generate motion events for mouse motion. The special values `dragging' and `dropping' assert that the mouse cursor retains its appearance during mouse motion. Any non-nil value -but `dropping' asserts that motion events always relate to the frame -where the mouse movement started. The value `dropping' asserts -that motion events relate to the frame where the mouse cursor is seen -when generating the event. If there's no such frame, such motion -events relate to the frame where the mouse movement started. */); - +but `dropping' or `drag-source' asserts that motion events always +relate to the frame where the mouse movement started. The value +`dropping' asserts that motion events relate to the frame where the +mouse cursor is seen when generating the event. If there's no such +frame, such motion events relate to the frame where the mouse movement +started. The value `drag-source' is like `dropping', but the +`posn-window' will be nil in mouse position lists inside mouse +movement events if there is no frame directly visible underneath the +mouse pointer. */); DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist, doc: /* Alist of system-specific X windows key symbols. Each element should have the form (N . SYMBOL) where N is the @@ -12512,7 +12906,35 @@ 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; + + DEFVAR_BOOL ("mwheel-coalesce-scroll-events", mwheel_coalesce_scroll_events, + doc: /* Non-nil means send a wheel event only for scrolling at least one screen line. +Otherwise, a wheel event will be sent every time the mouse wheel is +moved. */); + mwheel_coalesce_scroll_events = true; pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper); } @@ -12669,6 +13091,12 @@ mark_kboards (void) mark_object (event->ie.y); mark_object (event->ie.frame_or_window); mark_object (event->ie.arg); + + /* This should never be allocated for a single event, but + mark it anyway in the situation where the list of devices + changed but an event with an old device is still present + in the queue. */ + mark_object (event->ie.device); } } } diff --git a/src/keyboard.h b/src/keyboard.h index 03aa96ad4b0..cd5f677b963 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -486,12 +486,10 @@ extern bool kbd_buffer_events_waiting (void); extern void add_user_signal (int, const char *); extern int tty_read_avail_input (struct terminal *, struct input_event *); -extern bool volatile pending_signals; -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 || defined HAVE_PGTK extern const char *const lispy_function_keys[]; #endif diff --git a/src/keymap.c b/src/keymap.c index 6bfe54f5d2a..83c54e26300 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -65,12 +65,16 @@ 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. */ static Lisp_Object where_is_cache_keymaps; -static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object); +static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object, + bool); static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object); static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object, @@ -127,7 +131,8 @@ in case you use it as a menu with `x-popup-menu'. */) void initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname) { - store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname)); + store_in_keymap (keymap, intern_c_string (keyname), + intern_c_string (defname), false); } DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0, @@ -726,7 +731,8 @@ get_keyelt (Lisp_Object object, bool autoload) } static Lisp_Object -store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) +store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, + Lisp_Object def, bool remove) { /* Flush any reverse-map cache. */ where_is_cache = Qnil; @@ -802,21 +808,26 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) } else if (CHAR_TABLE_P (elt)) { + Lisp_Object sdef = def; + if (remove) + sdef = Qnil; + /* nil has a special meaning for char-tables, so + we use something else to record an explicitly + unbound entry. */ + else if (NILP (sdef)) + sdef = Qt; + /* Character codes with modifiers are not included in a char-table. All character codes without modifiers are included. */ if (FIXNATP (idx) && !(XFIXNAT (idx) & CHAR_MODIFIER_MASK)) { - Faset (elt, idx, - /* nil has a special meaning for char-tables, so - we use something else to record an explicitly - unbound entry. */ - NILP (def) ? Qt : def); + Faset (elt, idx, sdef); return def; } else if (CONSP (idx) && CHARACTERP (XCAR (idx))) { - Fset_char_table_range (elt, idx, NILP (def) ? Qt : def); + Fset_char_table_range (elt, idx, sdef); return def; } insertion_point = tail; @@ -835,7 +846,12 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) else if (EQ (idx, XCAR (elt))) { CHECK_IMPURE (elt, XCONS (elt)); - XSETCDR (elt, def); + if (remove) + /* Remove the element. */ + insertion_point = Fdelq (elt, insertion_point); + else + /* Just set the definition. */ + XSETCDR (elt, def); return def; } else if (CONSP (idx) @@ -848,7 +864,10 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) if (from <= XFIXNAT (XCAR (elt)) && to >= XFIXNAT (XCAR (elt))) { - XSETCDR (elt, def); + if (remove) + insertion_point = Fdelq (elt, insertion_point); + else + XSETCDR (elt, def); if (from == to) return def; } @@ -1027,10 +1046,35 @@ 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 (Qkey_valid_p))) + xsignal2 (Qerror, + build_string ("`key-valid-p' is not defined, so this syntax can't be used: %s"), + key); + if (NILP (call1 (Qkey_valid_p, AREF (key, 0)))) + xsignal2 (Qerror, build_string ("Invalid `key-parse' syntax: %S"), key); + key = call1 (Qkey_parse, AREF (key, 0)); + *length = CHECK_VECTOR_OR_STRING (key); + if (*length == 0) + xsignal2 (Qerror, build_string ("Invalid `key-parse' 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, +DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 4, 0, doc: /* In KEYMAP, define key sequence KEY as DEF. +This is a legacy function; see `keymap-set' for the recommended +function to use instead. + KEYMAP is a keymap. KEY is a string or a vector of symbols and characters, representing a @@ -1050,15 +1094,23 @@ 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'.) +If REMOVE is non-nil, the definition will be removed. This is almost +the same as setting the definition to nil, but makes a difference if +the KEYMAP has a parent, and KEY is shadowing the same binding in the +parent. With REMOVE, subsequent lookups will return the binding in +the parent, and with a nil DEF, the lookups will return nil. + If KEYMAP is a sparse keymap with a binding for KEY, the existing binding is altered. If there is no binding for KEY, the new pair binding KEY to DEF is added at the front of KEYMAP. */) - (Lisp_Object keymap, Lisp_Object key, Lisp_Object def) + (Lisp_Object keymap, Lisp_Object key, Lisp_Object def, Lisp_Object remove) { bool metized = false; @@ -1085,6 +1137,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) { @@ -1126,7 +1180,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) message_with_string ("Key sequence contains invalid event %s", c, 1); if (idx == length) - return store_in_keymap (keymap, c, def); + return store_in_keymap (keymap, c, def, !NILP (remove)); Lisp_Object cmd = access_keymap (keymap, c, 0, 1, 1); @@ -1195,6 +1249,8 @@ lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) if (length == 0) return keymap; + key = possibly_translate_key_sequence (key, &length); + ptrdiff_t idx = 0; while (1) { @@ -1229,6 +1285,9 @@ lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, doc: /* Look up key sequence KEY in KEYMAP. Return the definition. +This is a legacy function; see `keymap-lookup' for the recommended +function to use instead. + A value of nil means undefined. See doc of `define-key' for kinds of definitions. @@ -1251,39 +1310,126 @@ recognize the default bindings, just as `read-key-sequence' does. */) return found; /* Menu definitions might use mixed case symbols (notably in old - versions of `easy-menu-define'). We accept this variation for - backwards-compatibility. (Bug#50752) */ - ptrdiff_t key_len = VECTORP (key) ? ASIZE (key) : 0; - if (key_len > 0 && EQ (AREF (key, 0), Qmenu_bar)) + 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++) { - Lisp_Object new_key = make_vector (key_len, Qnil); - for (int i = 0; i < key_len; ++i) + /* 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 sym = Fsymbol_name (item); - USE_SAFE_ALLOCA; - unsigned char *dst = SAFE_ALLOCA (SBYTES (sym) + 1); - memcpy (dst, SSDATA (sym), SBYTES (sym)); - /* 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. */ - for (int j = 0; j < SBYTES (sym); ++j) - if (dst[j] >= 'A' && dst[j] <= 'Z') - dst[j] += 'a' - 'A'; /* Convert to lower case. */ - ASET (new_key, i, Fintern (make_multibyte_string ((char *) dst, - SCHARS (sym), - SBYTES (sym)), - Qnil)); - SAFE_FREE (); + 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; } @@ -1295,7 +1441,7 @@ static Lisp_Object define_as_prefix (Lisp_Object keymap, Lisp_Object c) { Lisp_Object cmd = Fmake_sparse_keymap (Qnil); - store_in_keymap (keymap, c, cmd); + store_in_keymap (keymap, c, cmd, false); return cmd; } @@ -1504,7 +1650,7 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and like in the respective argument of `key-binding'. */) (Lisp_Object olp, Lisp_Object position) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object keymaps = list1 (current_global_map); @@ -2815,7 +2961,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, @@ -2882,7 +3031,7 @@ This is text showing the elements of vector matched against indices. DESCRIBER is the output function used; nil means use `princ'. */) (Lisp_Object vector, Lisp_Object describer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (NILP (describer)) describer = intern ("princ"); specbind (Qstandard_output, Fcurrent_buffer ()); @@ -2928,7 +3077,7 @@ the one in this keymap, we ignore this one. */) Lisp_Object partial, Lisp_Object shadow, Lisp_Object entire_map, Lisp_Object mention_shadow) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qstandard_output, Fcurrent_buffer ()); CHECK_VECTOR_OR_CHAR_TABLE (vector); @@ -3308,4 +3457,7 @@ that describe key bindings. That is why the default is nil. */); defsubr (&Stext_char_description); defsubr (&Swhere_is_internal); defsubr (&Sdescribe_buffer_bindings); + + DEFSYM (Qkey_parse, "key-parse"); + DEFSYM (Qkey_valid_p, "key-valid-p"); } diff --git a/src/lisp.h b/src/lisp.h index ab0be3b281b..f723876634a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -31,6 +31,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <inttypes.h> #include <limits.h> +#include <attribute.h> #include <intprops.h> #include <verify.h> @@ -137,17 +138,9 @@ verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1); /* Use pD to format ptrdiff_t values, which suffice for indexes into buffers and strings. Emacs never allocates objects larger than PTRDIFF_MAX bytes, as they cause problems with pointer subtraction. - In C99, pD can always be "t"; configure it here for the sake of - pre-C99 libraries such as glibc 2.0 and Solaris 8. */ -#if PTRDIFF_MAX == INT_MAX -# define pD "" -#elif PTRDIFF_MAX == LONG_MAX -# define pD "l" -#elif PTRDIFF_MAX == LLONG_MAX -# define pD "ll" -#else -# define pD "t" -#endif + In C99, pD can always be "t", as we no longer need to worry about + pre-C99 libraries such as glibc 2.0 (1997) and Solaris 8 (2000). */ +#define pD "t" /* Convenience macro for rarely-used functions that do not return. */ #define AVOID _Noreturn ATTRIBUTE_COLD void @@ -251,6 +244,11 @@ DEFINE_GDB_SYMBOL_BEGIN (EMACS_INT, VALMASK) # define VALMASK (USE_LSB_TAG ? - (1 << GCTYPEBITS) : VAL_MAX) DEFINE_GDB_SYMBOL_END (VALMASK) +/* Ignore 'alignas' on compilers lacking it. */ +#if !defined alignas && !defined __alignas_is_defined +# define alignas(a) +#endif + /* Minimum alignment requirement for Lisp objects, imposed by the internal representation of tagged pointers. It is 2**GCTYPEBITS if USE_LSB_TAG, 1 otherwise. It must be a literal integer constant, @@ -356,18 +354,41 @@ typedef EMACS_INT Lisp_Word; # endif #endif +#define lisp_h_PSEUDOVECTORP(a,code) \ + (lisp_h_VECTORLIKEP((a)) && \ + ((XUNTAG ((a), Lisp_Vectorlike, union vectorlike_header)->size \ + & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \ + == (PSEUDOVECTOR_FLAG | ((code) << PSEUDOVECTOR_AREA_BITS)))) + #define lisp_h_CHECK_FIXNUM(x) CHECK_TYPE (FIXNUMP (x), Qfixnump, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) -#define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) +#define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) + +/* FIXME: Do we really need to inline the whole thing? + * What about keeping the part after `symbols_with_pos_enabled` in + * a separate function? */ +#define lisp_h_EQ(x, y) \ + ((XLI ((x)) == XLI ((y))) \ + || (symbols_with_pos_enabled \ + && (SYMBOL_WITH_POS_P ((x)) \ + ? (BARE_SYMBOL_P ((y)) \ + ? XLI (XSYMBOL_WITH_POS((x))->sym) == XLI (y) \ + : SYMBOL_WITH_POS_P((y)) \ + && (XLI (XSYMBOL_WITH_POS((x))->sym) \ + == XLI (XSYMBOL_WITH_POS((y))->sym))) \ + : (SYMBOL_WITH_POS_P ((y)) \ + && BARE_SYMBOL_P ((x)) \ + && (XLI (x) == XLI ((XSYMBOL_WITH_POS ((y)))->sym)))))) + #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ - (unsigned) (Lisp_Int0 >> !USE_LSB_TAG)) \ & ((1 << INTTYPEBITS) - 1))) #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) -#define lisp_h_NILP(x) EQ (x, Qnil) +#define lisp_h_NILP(x) BASE_EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ (sym)->u.s.val.value = (v)) @@ -376,7 +397,10 @@ typedef EMACS_INT Lisp_Word; #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write) #define lisp_h_SYMBOL_VAL(sym) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) -#define lisp_h_SYMBOLP(x) TAGGEDP (x, Lisp_Symbol) +#define lisp_h_SYMBOL_WITH_POS_P(x) PSEUDOVECTORP ((x), PVEC_SYMBOL_WITH_POS) +#define lisp_h_BARE_SYMBOL_P(x) TAGGEDP ((x), Lisp_Symbol) +#define lisp_h_SYMBOLP(x) ((BARE_SYMBOL_P ((x)) || \ + (symbols_with_pos_enabled && (SYMBOL_WITH_POS_P ((x)))))) #define lisp_h_TAGGEDP(a, tag) \ (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \ - (unsigned) (tag)) \ @@ -421,11 +445,12 @@ typedef EMACS_INT Lisp_Word; # define XLI(o) lisp_h_XLI (o) # define XIL(i) lisp_h_XIL (i) # define XLP(o) lisp_h_XLP (o) +# define BARE_SYMBOL_P(x) lisp_h_BARE_SYMBOL_P (x) # define CHECK_FIXNUM(x) lisp_h_CHECK_FIXNUM (x) # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) # define CONSP(x) lisp_h_CONSP (x) -# define EQ(x, y) lisp_h_EQ (x, y) +# define BASE_EQ(x, y) lisp_h_BASE_EQ (x, y) # define FLOATP(x) lisp_h_FLOATP (x) # define FIXNUMP(x) lisp_h_FIXNUMP (x) # define NILP(x) lisp_h_NILP (x) @@ -433,7 +458,7 @@ typedef EMACS_INT Lisp_Word; # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym) # define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym) # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym) -# define SYMBOLP(x) lisp_h_SYMBOLP (x) +/* # define SYMBOLP(x) lisp_h_SYMBOLP (x) */ /* X is accessed more than once. */ # define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag) # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x) # define XCAR(c) lisp_h_XCAR (c) @@ -592,9 +617,12 @@ extern Lisp_Object char_table_ref (Lisp_Object, int) ATTRIBUTE_PURE; extern void char_table_set (Lisp_Object, int, Lisp_Object); /* Defined in data.c. */ +extern bool symbols_with_pos_enabled; extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object); extern Lisp_Object default_value (Lisp_Object symbol); +extern void defalias (Lisp_Object symbol, Lisp_Object definition); +extern char *fixnum_to_string (EMACS_INT number, char *buffer, char *end); /* Defined in emacs.c. */ @@ -941,7 +969,7 @@ typedef EMACS_UINT Lisp_Word_tag; ? ((y) - 1 + (x)) & ~ ((y) - 1) \ : ((y) - 1 + (x)) - ((y) - 1 + (x)) % (y)) -#include "globals.h" +#include <globals.h> /* Header of vector-like objects. This documents the layout constraints on vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents @@ -976,57 +1004,12 @@ union vectorlike_header ptrdiff_t size; }; -INLINE bool -(SYMBOLP) (Lisp_Object x) -{ - return lisp_h_SYMBOLP (x); -} - -INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED -XSYMBOL (Lisp_Object a) -{ - eassert (SYMBOLP (a)); - intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol); - void *p = (char *) lispsym + i; - return p; -} - -INLINE Lisp_Object -make_lisp_symbol (struct Lisp_Symbol *sym) -{ - /* GCC 7 x86-64 generates faster code if lispsym is - cast to char * rather than to intptr_t. */ - char *symoffset = (char *) ((char *) sym - (char *) lispsym); - Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); - eassert (XSYMBOL (a) == sym); - return a; -} - -INLINE Lisp_Object -builtin_lisp_symbol (int index) +struct Lisp_Symbol_With_Pos { - return make_lisp_symbol (&lispsym[index]); -} - -INLINE bool -c_symbol_p (struct Lisp_Symbol *sym) -{ - char *bp = (char *) lispsym; - char *sp = (char *) sym; - if (PTRDIFF_MAX < INTPTR_MAX) - return bp <= sp && sp < bp + sizeof lispsym; - else - { - ptrdiff_t offset = sp - bp; - return 0 <= offset && offset < sizeof lispsym; - } -} - -INLINE void -(CHECK_SYMBOL) (Lisp_Object x) -{ - lisp_h_CHECK_SYMBOL (x); -} + union vectorlike_header header; + Lisp_Object sym; /* A symbol */ + Lisp_Object pos; /* A fixnum */ +} GCALIGNED_STRUCT; /* In the size word of a vector, this bit means the vector has been marked. */ @@ -1051,6 +1034,7 @@ enum pvec_type PVEC_MARKER, PVEC_OVERLAY, PVEC_FINALIZER, + PVEC_SYMBOL_WITH_POS, PVEC_MISC_PTR, PVEC_USER_PTR, PVEC_PROCESS, @@ -1070,6 +1054,7 @@ enum pvec_type PVEC_CONDVAR, PVEC_MODULE_FUNCTION, PVEC_NATIVE_COMP_UNIT, + PVEC_SQLITE, /* These should be last, for internal_equal and sxhash_obj. */ PVEC_COMPILED, @@ -1109,6 +1094,92 @@ enum More_Lisp_Bits values. They are macros for use in #if and static initializers. */ #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) + +INLINE bool +PSEUDOVECTORP (Lisp_Object a, int code) +{ + return lisp_h_PSEUDOVECTORP (a, code); +} + +INLINE bool +(BARE_SYMBOL_P) (Lisp_Object x) +{ + return lisp_h_BARE_SYMBOL_P (x); +} + +INLINE bool +(SYMBOL_WITH_POS_P) (Lisp_Object x) +{ + return lisp_h_SYMBOL_WITH_POS_P (x); +} + +INLINE bool +(SYMBOLP) (Lisp_Object x) +{ + return lisp_h_SYMBOLP (x); +} + +INLINE struct Lisp_Symbol_With_Pos * +XSYMBOL_WITH_POS (Lisp_Object a) +{ + eassert (SYMBOL_WITH_POS_P (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos); +} + +INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED +(XBARE_SYMBOL) (Lisp_Object a) +{ + eassert (BARE_SYMBOL_P (a)); + intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol); + void *p = (char *) lispsym + i; + return p; +} + +INLINE struct Lisp_Symbol * ATTRIBUTE_NO_SANITIZE_UNDEFINED +(XSYMBOL) (Lisp_Object a) +{ + eassert (SYMBOLP ((a))); + if (!symbols_with_pos_enabled || BARE_SYMBOL_P (a)) + return XBARE_SYMBOL (a); + return XBARE_SYMBOL (XSYMBOL_WITH_POS (a)->sym); +} + +INLINE Lisp_Object +make_lisp_symbol (struct Lisp_Symbol *sym) +{ + /* GCC 7 x86-64 generates faster code if lispsym is + cast to char * rather than to intptr_t. */ + char *symoffset = (char *) ((char *) sym - (char *) lispsym); + Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); + eassert (XSYMBOL (a) == sym); + return a; +} + +INLINE Lisp_Object +builtin_lisp_symbol (int index) +{ + return make_lisp_symbol (&lispsym[index]); +} + +INLINE bool +c_symbol_p (struct Lisp_Symbol *sym) +{ + char *bp = (char *) lispsym; + char *sp = (char *) sym; + if (PTRDIFF_MAX < INTPTR_MAX) + return bp <= sp && sp < bp + sizeof lispsym; + else + { + ptrdiff_t offset = sp - bp; + return 0 <= offset && offset < sizeof lispsym; + } +} + +INLINE void +(CHECK_SYMBOL) (Lisp_Object x) +{ + lisp_h_CHECK_SYMBOL (x); +} /* True if the possibly-unsigned integer I doesn't fit in a fixnum. */ @@ -1240,7 +1311,14 @@ make_fixed_natnum (EMACS_INT n) } /* Return true if X and Y are the same object. */ +INLINE bool +(BASE_EQ) (Lisp_Object x, Lisp_Object y) +{ + return lisp_h_BASE_EQ (x, y); +} +/* Return true if X and Y are the same object, reckoning a symbol with + position as being the same as the bare symbol. */ INLINE bool (EQ) (Lisp_Object x, Lisp_Object y) { @@ -1482,7 +1560,9 @@ struct Lisp_String struct { ptrdiff_t size; /* MSB is used as the markbit. */ - ptrdiff_t size_byte; /* Set to -1 for unibyte strings. */ + ptrdiff_t size_byte; /* Set to -1 for unibyte strings, + -2 for data in rodata, + -3 for immovable unibyte strings. */ INTERVAL intervals; /* Text properties in this string. */ unsigned char *data; } s; @@ -1630,6 +1710,13 @@ CHECK_STRING_NULL_BYTES (Lisp_Object string) Qfilenamep, string); } +/* True if STR is immovable (whose data won't move during GC). */ +INLINE bool +string_immovable_p (Lisp_Object str) +{ + return XSTRING (str)->u.s.size_byte == -3; +} + /* A regular vector is just a header plus an array of Lisp_Objects. */ struct Lisp_Vector @@ -1706,21 +1793,6 @@ PSEUDOVECTOR_TYPEP (const union vectorlike_header *a, enum pvec_type code) == (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS))); } -/* True if A is a pseudovector whose code is CODE. */ -INLINE bool -PSEUDOVECTORP (Lisp_Object a, int code) -{ - if (! VECTORLIKEP (a)) - return false; - else - { - /* Converting to union vectorlike_header * avoids aliasing issues. */ - return PSEUDOVECTOR_TYPEP (XUNTAG (a, Lisp_Vectorlike, - union vectorlike_header), - code); - } -} - /* A boolvector is a kind of vectorlike, with contents like a string. */ struct Lisp_Bool_Vector @@ -2082,6 +2154,7 @@ struct Lisp_Subr const char *intspec; Lisp_Object native_intspec; }; + Lisp_Object command_modes; EMACS_INT doc; #ifdef HAVE_NATIVE_COMP Lisp_Object native_comp_u; @@ -2557,6 +2630,17 @@ xmint_pointer (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer; } +struct Lisp_Sqlite +{ + union vectorlike_header header; + void *db; + void *stmt; + char *name; + void (*finalizer) (void *); + bool eof; + bool is_statement; +} GCALIGNED_STRUCT; + struct Lisp_User_Ptr { union vectorlike_header header; @@ -2621,6 +2705,22 @@ XOVERLAY (Lisp_Object a) return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Overlay); } +INLINE Lisp_Object +SYMBOL_WITH_POS_SYM (Lisp_Object a) +{ + if (!SYMBOL_WITH_POS_P (a)) + wrong_type_argument (Qsymbol_with_pos_p, a); + return XSYMBOL_WITH_POS (a)->sym; +} + +INLINE Lisp_Object +SYMBOL_WITH_POS_POS (Lisp_Object a) +{ + if (!SYMBOL_WITH_POS_P (a)) + wrong_type_argument (Qsymbol_with_pos_p, a); + return XSYMBOL_WITH_POS (a)->pos; +} + INLINE bool USER_PTRP (Lisp_Object x) { @@ -2635,6 +2735,31 @@ XUSER_PTR (Lisp_Object a) } INLINE bool +SQLITEP (Lisp_Object x) +{ + return PSEUDOVECTORP (x, PVEC_SQLITE); +} + +INLINE bool +SQLITE (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_SQLITE); +} + +INLINE void +CHECK_SQLITE (Lisp_Object x) +{ + CHECK_TYPE (SQLITE (x), Qsqlitep, x); +} + +INLINE struct Lisp_Sqlite * +XSQLITE (Lisp_Object a) +{ + eassert (SQLITEP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Sqlite); +} + +INLINE bool BIGNUMP (Lisp_Object x) { return PSEUDOVECTORP (x, PVEC_BIGNUM); @@ -3077,6 +3202,76 @@ enum maxargs 'Finsert (1, &text);'. */ #define CALLN(f, ...) CALLMANY (f, ((Lisp_Object []) {__VA_ARGS__})) +/* Call function fn on no arguments. */ +INLINE Lisp_Object +call0 (Lisp_Object fn) +{ + return Ffuncall (1, &fn); +} + +/* Call function fn with 1 argument arg1. */ +INLINE Lisp_Object +call1 (Lisp_Object fn, Lisp_Object arg1) +{ + return CALLN (Ffuncall, fn, arg1); +} + +/* Call function fn with 2 arguments arg1, arg2. */ +INLINE Lisp_Object +call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) +{ + return CALLN (Ffuncall, fn, arg1, arg2); +} + +/* Call function fn with 3 arguments arg1, arg2, arg3. */ +INLINE Lisp_Object +call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) +{ + return CALLN (Ffuncall, fn, arg1, arg2, arg3); +} + +/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */ +INLINE Lisp_Object +call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, + Lisp_Object arg4) +{ + return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4); +} + +/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */ +INLINE Lisp_Object +call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, + Lisp_Object arg4, Lisp_Object arg5) +{ + return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5); +} + +/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */ +INLINE Lisp_Object +call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, + Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6) +{ + return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6); +} + +/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */ +INLINE Lisp_Object +call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, + Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7) +{ + return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7); +} + +/* Call function fn with 8 arguments arg1, arg2, arg3, arg4, arg5, + arg6, arg7, arg8. */ +INLINE Lisp_Object +call8 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, + Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7, + Lisp_Object arg8) +{ + return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); +} + extern void defvar_lisp (struct Lisp_Objfwd const *, char const *); extern void defvar_lisp_nopro (struct Lisp_Objfwd const *, char const *); extern void defvar_bool (struct Lisp_Boolfwd const *, char const *); @@ -3162,6 +3357,7 @@ enum specbind_tag { SPECPDL_UNWIND_EXCURSION, /* Likewise, on an excursion. */ SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */ SPECPDL_BACKTRACE, /* An element of the backtrace. */ + SPECPDL_NOP, /* A filler. */ #ifdef HAVE_MODULES SPECPDL_MODULE_RUNTIME, /* A live module runtime. */ SPECPDL_MODULE_ENVIRONMENT, /* A live module environment. */ @@ -3190,8 +3386,9 @@ union specbinding } unwind_array; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; - void (*func) (void *); + void (*func) (void *); /* Unwind function. */ void *arg; + void (*mark) (void *); /* GC mark function (if non-null). */ } unwind_ptr; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; @@ -3215,9 +3412,6 @@ union specbinding ENUM_BF (specbind_tag) kind : CHAR_BIT; /* `where' is not used in the case of SPECPDL_LET. */ Lisp_Object symbol, old_value, where; - /* Normally this is unused; but it is set to the symbol's - current value when a thread is swapped out. */ - Lisp_Object saved_value; } let; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; @@ -3228,10 +3422,144 @@ union specbinding } bt; }; +/* We use 64-bit platforms as a proxy for ones with ABIs that treat + small structs efficiently. */ +#if SIZE_MAX > 0xffffffff +#define WRAP_SPECPDL_REF 1 +#endif + +/* Abstract reference to to a specpdl entry. + The number is always a multiple of sizeof (union specbinding). */ +#ifdef WRAP_SPECPDL_REF +/* Use a proper type for specpdl_ref if it does not make the code slower, + since the type checking is quite useful. */ +typedef struct { ptrdiff_t bytes; } specpdl_ref; +#else +typedef ptrdiff_t specpdl_ref; +#endif + +/* Internal use only. */ +INLINE specpdl_ref +wrap_specpdl_ref (ptrdiff_t bytes) +{ +#ifdef WRAP_SPECPDL_REF + return (specpdl_ref){.bytes = bytes}; +#else + return bytes; +#endif +} + +/* Internal use only. */ +INLINE ptrdiff_t +unwrap_specpdl_ref (specpdl_ref ref) +{ +#ifdef WRAP_SPECPDL_REF + return ref.bytes; +#else + return ref; +#endif +} + +INLINE specpdl_ref +specpdl_count_to_ref (ptrdiff_t count) +{ + return wrap_specpdl_ref (count * sizeof (union specbinding)); +} + INLINE ptrdiff_t +specpdl_ref_to_count (specpdl_ref ref) +{ + return unwrap_specpdl_ref (ref) / sizeof (union specbinding); +} + +/* Whether two `specpdl_ref' refer to the same entry. */ +INLINE bool +specpdl_ref_eq (specpdl_ref a, specpdl_ref b) +{ + return unwrap_specpdl_ref (a) == unwrap_specpdl_ref (b); +} + +/* Whether `a' refers to an earlier entry than `b'. */ +INLINE bool +specpdl_ref_lt (specpdl_ref a, specpdl_ref b) +{ + return unwrap_specpdl_ref (a) < unwrap_specpdl_ref (b); +} + +INLINE bool +specpdl_ref_valid_p (specpdl_ref ref) +{ + return unwrap_specpdl_ref (ref) >= 0; +} + +INLINE specpdl_ref +make_invalid_specpdl_ref (void) +{ + return wrap_specpdl_ref (-1); +} + +/* Return a reference that is `delta' steps more recent than `ref'. + `delta' may be negative or zero. */ +INLINE specpdl_ref +specpdl_ref_add (specpdl_ref ref, ptrdiff_t delta) +{ + return wrap_specpdl_ref (unwrap_specpdl_ref (ref) + + delta * sizeof (union specbinding)); +} + +INLINE union specbinding * +specpdl_ref_to_ptr (specpdl_ref ref) +{ + return (union specbinding *)((char *)specpdl + unwrap_specpdl_ref (ref)); +} + +/* Return a reference to the most recent specpdl entry. */ +INLINE specpdl_ref SPECPDL_INDEX (void) { - return specpdl_ptr - specpdl; + return wrap_specpdl_ref ((char *)specpdl_ptr - (char *)specpdl); +} + +INLINE bool +backtrace_debug_on_exit (union specbinding *pdl) +{ + eassert (pdl->kind == SPECPDL_BACKTRACE); + return pdl->bt.debug_on_exit; +} + +void grow_specpdl_allocation (void); + +/* Grow the specpdl stack by one entry. + The caller should have already initialized the entry. + Signal an error on stack overflow. + + Make sure that there is always one unused entry past the top of the + stack, so that the just-initialized entry is safely unwound if + memory exhausted and an error is signaled here. Also, allocate a + never-used entry just before the bottom of the stack; sometimes its + address is taken. */ +INLINE void +grow_specpdl (void) +{ + specpdl_ptr++; + if (specpdl_ptr == specpdl_end) + grow_specpdl_allocation (); +} + +INLINE specpdl_ref +record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) +{ + specpdl_ref count = SPECPDL_INDEX (); + + eassert (nargs >= UNEVALLED); + specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; + specpdl_ptr->bt.debug_on_exit = false; + specpdl_ptr->bt.function = function; + current_thread->stack_top = specpdl_ptr->bt.args = args; + specpdl_ptr->bt.nargs = nargs; + grow_specpdl (); + + return count; } /* This structure helps implement the `catch/throw' and `condition-case/signal' @@ -3290,19 +3618,42 @@ struct handler but a few others are handled by storing their value here. */ sys_jmp_buf jmp; EMACS_INT f_lisp_eval_depth; - ptrdiff_t pdlcount; + specpdl_ref pdlcount; + struct bc_frame *act_rec; int poll_suppress_count; int interrupt_input_blocked; }; extern Lisp_Object memory_signal_data; -extern void maybe_quit (void); - /* True if ought to quit now. */ #define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) +extern bool volatile pending_signals; +extern void process_pending_signals (void); +extern void probably_quit (void); + +/* Check quit-flag and quit if it is non-nil. Typing C-g does not + directly cause a quit; it only sets Vquit_flag. So the program + needs to call maybe_quit at times when it is safe to quit. Every + loop that might run for a long time or might not exit ought to call + maybe_quit at least once, at a safe place. Unless that is + impossible, of course. But it is very desirable to avoid creating + loops where maybe_quit is impossible. + + If quit-flag is set to `kill-emacs' the SIGINT handler has received + a request to exit Emacs when it is safe to do. + + When not quitting, process any pending signals. */ + +INLINE void +maybe_quit (void) +{ + if (!NILP (Vquit_flag) || pending_signals) + probably_quit (); +} + /* Process a quit rarely, based on a counter COUNT, for efficiency. "Rarely" means once per USHRT_MAX + 1 times; this is somewhat arbitrary, but efficient. */ @@ -3332,7 +3683,7 @@ struct frame; /* Define if the windowing system provides a menu bar. */ #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \ - || defined (HAVE_NS) || defined (USE_GTK) + || defined (HAVE_NS) || defined (USE_GTK) || defined (HAVE_HAIKU) #define HAVE_EXT_MENU_BAR true #endif @@ -3630,8 +3981,6 @@ extern void hexbuf_digest (char *, void const *, int); extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); -Lisp_Object hashfn_eql (Lisp_Object, struct Lisp_Hash_Table *); -Lisp_Object hashfn_equal (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, Lisp_Object, bool); @@ -3647,7 +3996,6 @@ extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object merge_c (Lisp_Object, Lisp_Object, bool (*) (Lisp_Object, Lisp_Object)); extern Lisp_Object do_yes_or_no_p (Lisp_Object); -extern int string_version_cmp (Lisp_Object, Lisp_Object); extern Lisp_Object concat2 (Lisp_Object, Lisp_Object); extern Lisp_Object concat3 (Lisp_Object, Lisp_Object, Lisp_Object); extern bool equal_no_quit (Lisp_Object, Lisp_Object); @@ -3661,6 +4009,9 @@ extern Lisp_Object string_to_multibyte (Lisp_Object); extern Lisp_Object string_make_unibyte (Lisp_Object); extern void syms_of_fns (void); +/* Defined in sort.c */ +extern void tim_sort (Lisp_Object, Lisp_Object *, const ptrdiff_t); + /* Defined in floatfns.c. */ verify (FLT_RADIX == 2 || FLT_RADIX == 16); enum { LOG2_FLT_RADIX = FLT_RADIX == 2 ? 1 : 4 }; @@ -3780,6 +4131,9 @@ extern Lisp_Object safe_eval (Lisp_Object); extern bool pos_visible_p (struct window *, ptrdiff_t, int *, int *, int *, int *, int *, int *); +/* Defined in sqlite.c. */ +extern void syms_of_sqlite (void); + /* Defined in xsettings.c. */ extern void syms_of_xsettings (void); @@ -3805,8 +4159,9 @@ extern void refill_memory_reserve (void); #endif extern void alloc_unexec_pre (void); extern void alloc_unexec_post (void); -extern void mark_stack (char const *, char const *); +extern void mark_c_stack (char const *, char const *); extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg); +extern void mark_memory (void const *start, void const *end); /* Force callee-saved registers and register windows onto the stack, so that conservative garbage collection can see their values. */ @@ -3929,6 +4284,7 @@ extern Lisp_Object make_specified_string (const char *, ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t); +extern void pin_string (Lisp_Object string); /* Make a string allocated in pure space, use STR as string data. */ @@ -3949,7 +4305,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 @@ -3962,7 +4319,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) @@ -3994,7 +4352,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. */ @@ -4020,13 +4379,14 @@ extern struct Lisp_Vector *allocate_pseudovector (int, int, int, extern bool gc_in_progress; extern Lisp_Object make_float (double); extern void display_malloc_warning (void); -extern ptrdiff_t inhibit_garbage_collection (void); +extern specpdl_ref inhibit_garbage_collection (void); +extern Lisp_Object build_symbol_with_pos (Lisp_Object, Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); 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. */ @@ -4163,51 +4523,44 @@ extern bool FUNCTIONP (Lisp_Object); extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector); extern Lisp_Object eval_sub (Lisp_Object form); extern Lisp_Object apply1 (Lisp_Object, Lisp_Object); -extern Lisp_Object call0 (Lisp_Object); -extern Lisp_Object call1 (Lisp_Object, Lisp_Object); -extern Lisp_Object call2 (Lisp_Object, Lisp_Object, Lisp_Object); -extern Lisp_Object call3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); -extern Lisp_Object call4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); -extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); -extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); -extern Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); -extern Lisp_Object call8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object); extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object)); extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); -extern Lisp_Object internal_condition_case_3 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); -extern Lisp_Object internal_condition_case_4 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); -extern Lisp_Object internal_condition_case_5 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); 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); extern void record_unwind_protect_array (Lisp_Object *, ptrdiff_t); extern void record_unwind_protect_ptr (void (*) (void *), void *); +extern void record_unwind_protect_ptr_mark (void (*function) (void *), + void *arg, void (*mark) (void *)); extern void record_unwind_protect_int (void (*) (int), int); extern void record_unwind_protect_intmax (void (*) (intmax_t), intmax_t); extern void record_unwind_protect_void (void (*) (void)); extern void record_unwind_protect_excursion (void); extern void record_unwind_protect_nothing (void); extern void record_unwind_protect_module (enum specbind_tag, void *); -extern void clear_unwind_protect (ptrdiff_t); -extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object); -extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *); -extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object); -extern void rebind_for_thread_switch (void); -extern void unbind_for_thread_switch (struct thread_state *); +extern void clear_unwind_protect (specpdl_ref); +extern void set_unwind_protect (specpdl_ref, void (*) (Lisp_Object), + Lisp_Object); +extern void set_unwind_protect_ptr (specpdl_ref, void (*) (void *), void *); +extern Lisp_Object unbind_to (specpdl_ref, Lisp_Object); +void specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only); extern AVOID error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); extern AVOID verror (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); extern Lisp_Object vformat_string (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); -extern void un_autoload (Lisp_Object); +extern Lisp_Object load_with_autoload_queue + (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, + Lisp_Object nosuffix, Lisp_Object must_suffix); extern Lisp_Object call_debugger (Lisp_Object arg); extern void init_eval_once (void); extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); @@ -4216,11 +4569,13 @@ extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); extern void init_eval (void); extern void syms_of_eval (void); extern void prog_ignore (Lisp_Object); -extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t); extern void mark_specpdl (union specbinding *first, union specbinding *ptr); extern void get_backtrace (Lisp_Object array); Lisp_Object backtrace_top_function (void); extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); +void do_debug_on_call (Lisp_Object code, specpdl_ref count); +Lisp_Object funcall_general (Lisp_Object fun, + ptrdiff_t numargs, Lisp_Object *args); /* Defined in unexmacosx.c. */ #if defined DARWIN_OS && defined HAVE_UNEXEC @@ -4325,9 +4680,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, @@ -4426,7 +4782,7 @@ extern Lisp_Object menu_bar_items (Lisp_Object); extern Lisp_Object tab_bar_items (Lisp_Object, int *); extern Lisp_Object tool_bar_items (Lisp_Object, int *); extern void discard_mouse_events (void); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) void handle_input_available_signal (int); #endif extern Lisp_Object pending_funcalls; @@ -4481,7 +4837,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. */ @@ -4547,7 +4903,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); @@ -4561,9 +4917,24 @@ extern int read_bytecode_char (bool); /* Defined in bytecode.c. */ extern void syms_of_bytecode (void); -extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object, ptrdiff_t, Lisp_Object *); +extern Lisp_Object exec_byte_code (Lisp_Object, ptrdiff_t, + ptrdiff_t, Lisp_Object *); extern Lisp_Object get_byte_code_arity (Lisp_Object); +extern void init_bc_thread (struct bc_thread_state *bc); +extern void free_bc_thread (struct bc_thread_state *bc); +extern void mark_bytecode (struct bc_thread_state *bc); + +INLINE struct bc_frame * +get_act_rec (struct thread_state *th) +{ + return th->bc.fp; +} + +INLINE void +set_act_rec (struct thread_state *th, struct bc_frame *act_rec) +{ + th->bc.fp = act_rec; +} /* Defined in macros.c. */ extern void init_macros (void); @@ -4618,6 +4989,7 @@ extern void child_setup_tty (int); extern void setup_pty (int); extern int set_window_size (int, int, int); extern EMACS_INT get_random (void); +extern unsigned long int get_random_ulong (void); extern void seed_random (void *, ptrdiff_t); extern void init_random (void); extern void emacs_backtrace (int); @@ -4816,17 +5188,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 @@ -4876,11 +5255,12 @@ 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; \ - ptrdiff_t sa_count = SPECPDL_INDEX () + specpdl_ref sa_count = SPECPDL_INDEX () #define AVAIL_ALLOCA(size) (sa_avail -= (size), alloca (size)) @@ -4918,9 +5298,9 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1)); #define SAFE_FREE() safe_free (sa_count) INLINE void -safe_free (ptrdiff_t sa_count) +safe_free (specpdl_ref sa_count) { - while (specpdl_ptr != specpdl + sa_count) + while (specpdl_ptr != specpdl_ref_to_ptr (sa_count)) { specpdl_ptr--; if (specpdl_ptr->kind == SPECPDL_UNWIND_PTR) @@ -4946,9 +5326,9 @@ safe_free (ptrdiff_t sa_count) safe_free_unbind_to (count, sa_count, val) INLINE Lisp_Object -safe_free_unbind_to (ptrdiff_t count, ptrdiff_t sa_count, Lisp_Object val) +safe_free_unbind_to (specpdl_ref count, specpdl_ref sa_count, Lisp_Object val) { - eassert (count <= sa_count); + eassert (!specpdl_ref_lt (sa_count, count)); return unbind_to (count, val); } diff --git a/src/lread.c b/src/lread.c index d3e0a63ccdc..2538851bac6 100644 --- a/src/lread.c +++ b/src/lread.c @@ -128,9 +128,8 @@ static ptrdiff_t read_from_string_index; static ptrdiff_t read_from_string_index_byte; static ptrdiff_t read_from_string_limit; -/* Number of characters read in the current call to Fread or - Fread_from_string. */ -static EMACS_INT readchar_count; +/* Position in object from which characters are being read by `readchar'. */ +static EMACS_INT readchar_offset; /* This contains the last string skipped with #@. */ static char *saved_doc_string; @@ -213,7 +212,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte) if (multibyte) *multibyte = 0; - readchar_count++; + readchar_offset++; if (BUFFERP (readcharfun)) { @@ -424,7 +423,7 @@ skip_dyn_eof (Lisp_Object readcharfun) static void unreadchar (Lisp_Object readcharfun, int c) { - readchar_count--; + readchar_offset--; if (c == -1) /* Don't back up the pointer if we're unreading the end-of-input mark, since readchar didn't advance it when we read it. */ @@ -551,13 +550,21 @@ invalid_syntax_lisp (Lisp_Object s, Lisp_Object readcharfun) { if (BUFFERP (readcharfun)) { + ptrdiff_t line, column; + + /* Get the line/column in the readcharfun buffer. */ + { + specpdl_ref count = SPECPDL_INDEX (); + + record_unwind_protect_excursion (); + set_buffer_internal (XBUFFER (readcharfun)); + line = count_lines (BEGV_BYTE, PT_BYTE) + 1; + column = current_column (); + unbind_to (count, Qnil); + } + xsignal (Qinvalid_read_syntax, - list3 (s, - /* We should already be in the readcharfun - buffer when this error is called, so no need - to switch to it first. */ - make_fixnum (count_lines (BEGV_BYTE, PT_BYTE) + 1), - make_fixnum (current_column ()))); + list3 (s, make_fixnum (line), make_fixnum (column))); } else xsignal1 (Qinvalid_read_syntax, s); @@ -647,12 +654,12 @@ struct subst }; static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object, - Lisp_Object); -static Lisp_Object read0 (Lisp_Object); -static Lisp_Object read1 (Lisp_Object, int *, bool); + Lisp_Object, bool); +static Lisp_Object read0 (Lisp_Object, bool); +static Lisp_Object read1 (Lisp_Object, int *, bool, bool); -static Lisp_Object read_list (bool, Lisp_Object); -static Lisp_Object read_vector (Lisp_Object, bool); +static Lisp_Object read_list (bool, Lisp_Object, bool); +static Lisp_Object read_vector (Lisp_Object, bool, bool); static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object); static void substitute_in_interval (INTERVAL, void *); @@ -1045,12 +1052,18 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) safe to load. Only files compiled with Emacs can be loaded. */ static int -safe_to_load_version (int fd) +safe_to_load_version (Lisp_Object file, int fd) { + struct stat st; char buf[512]; int nbytes, i; int version = 1; + /* If the file is not regular, then we cannot safely seek it. + Assume that it is not safe to load as a compiled file. */ + if (fstat (fd, &st) == 0 && !S_ISREG (st.st_mode)) + return 0; + /* Read the first few bytes from the file, and look for a line specifying the byte compiler version used. */ nbytes = emacs_read_quit (fd, buf, sizeof buf); @@ -1068,7 +1081,9 @@ safe_to_load_version (int fd) version = 0; } - lseek (fd, 0, SEEK_SET); + if (lseek (fd, 0, SEEK_SET) < 0) + report_file_error ("Seeking to start of file", file); + return version; } @@ -1162,6 +1177,13 @@ compute_found_effective (Lisp_Object found) return concat2 (src_name, build_string ("c")); } +static void +loadhist_initialize (Lisp_Object filename) +{ + eassert (STRINGP (filename) || NILP (filename)); + specbind (Qcurrent_load_list, Fcons (filename, Qnil)); +} + DEFUN ("load", Fload, Sload, 1, 5, 0, doc: /* Execute a file of Lisp code named FILE. First try FILE with `.elc' appended, then try with `.el', then try @@ -1212,8 +1234,8 @@ Return t if the file exists and loads successfully. */) { FILE *stream UNINIT; int fd; - int fd_index UNINIT; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref fd_index UNINIT; + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object found, efound, hist_file_name; /* True means we printed the ".el is newer" message. */ bool newer = 0; @@ -1407,7 +1429,7 @@ Return t if the file exists and loads successfully. */) if (is_elc /* version = 1 means the file is empty, in which case we can treat it as not byte-compiled. */ - || (fd >= 0 && (version = safe_to_load_version (fd)) > 1)) + || (fd >= 0 && (version = safe_to_load_version (file, fd)) > 1)) /* Load .elc files directly, but not when they are remote and have no handler! */ { @@ -1416,11 +1438,8 @@ Return t if the file exists and loads successfully. */) struct stat s1, s2; int result; - if (version < 0 - && ! (version = safe_to_load_version (fd))) - { - error ("File `%s' was not compiled in Emacs", SDATA (found)); - } + if (version < 0 && !(version = safe_to_load_version (file, fd))) + error ("File `%s' was not compiled in Emacs", SDATA (found)); compiled = 1; @@ -1540,7 +1559,7 @@ Return t if the file exists and loads successfully. */) message_with_string ("Loading %s...", file, 1); } - specbind (Qload_file_name, found_eff); + specbind (Qload_file_name, hist_file_name); specbind (Qload_true_file_name, found); specbind (Qinhibit_file_name_operation, Qnil); specbind (Qload_in_progress, Qt); @@ -1548,8 +1567,7 @@ Return t if the file exists and loads successfully. */) if (is_module) { #ifdef HAVE_MODULES - specbind (Qcurrent_load_list, Qnil); - LOADHIST_ATTACH (found); + loadhist_initialize (found); Fmodule_load (found); build_load_history (found, true); #else @@ -1560,8 +1578,7 @@ Return t if the file exists and loads successfully. */) else if (is_native_elisp) { #ifdef HAVE_NATIVE_COMP - specbind (Qcurrent_load_list, Qnil); - LOADHIST_ATTACH (hist_file_name); + loadhist_initialize (hist_file_name); Fnative_elisp_load (found, Qnil); build_load_history (hist_file_name, true); #else @@ -1624,7 +1641,7 @@ save_match_data_load (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_save_match_data (); Lisp_Object result = Fload (file, noerror, nomessage, nosuffix, must_suffix); return unbind_to (count, result); @@ -1652,7 +1669,7 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate) { Lisp_Object file; - int fd = openp (path, filename, suffixes, &file, predicate, false, false); + int fd = openp (path, filename, suffixes, &file, predicate, false, true); if (NILP (predicate) && fd >= 0) emacs_close (fd); return file; @@ -2160,7 +2177,7 @@ readevalloop (Lisp_Object readcharfun, { int c; Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct buffer *b = 0; bool continue_reading_p; Lisp_Object lex_bound; @@ -2170,6 +2187,9 @@ readevalloop (Lisp_Object readcharfun, bool first_sexp = 1; Lisp_Object macroexpand = intern ("internal-macroexpand-for-load"); + if (!NILP (sourcename)) + CHECK_STRING (sourcename); + if (NILP (Ffboundp (macroexpand)) || (STRINGP (sourcename) && suffix_p (sourcename, ".elc"))) /* Don't macroexpand before the corresponding function is defined @@ -2193,7 +2213,6 @@ readevalloop (Lisp_Object readcharfun, emacs_abort (); specbind (Qstandard_input, readcharfun); - specbind (Qcurrent_load_list, Qnil); record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte); load_convert_to_unibyte = !NILP (unibyte); @@ -2204,18 +2223,19 @@ readevalloop (Lisp_Object readcharfun, specbind (Qinternal_interpreter_environment, (NILP (lex_bound) || EQ (lex_bound, Qunbound) ? Qnil : list1 (Qt))); + specbind (Qmacroexp__dynvars, Vmacroexp__dynvars); /* Ensure sourcename is absolute, except whilst preloading. */ if (!will_dump_p () && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))) sourcename = Fexpand_file_name (sourcename, Qnil); - LOADHIST_ATTACH (sourcename); + loadhist_initialize (sourcename); continue_reading_p = 1; while (continue_reading_p) { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); if (b != 0 && !BUFFER_LIVE_P (b)) error ("Reading from killed buffer"); @@ -2281,7 +2301,7 @@ readevalloop (Lisp_Object readcharfun, Qnil, false); if (!NILP (Vpurify_flag) && c == '(') { - val = read_list (0, readcharfun); + val = read_list (0, readcharfun, false); } else { @@ -2303,7 +2323,7 @@ readevalloop (Lisp_Object readcharfun, else if (! NILP (Vload_read_function)) val = call1 (Vload_read_function, readcharfun); else - val = read_internal_start (readcharfun, Qnil, Qnil); + val = read_internal_start (readcharfun, Qnil, Qnil, false); } /* Empty hashes can be reused; otherwise, reset on next call. */ if (HASH_TABLE_P (read_objects_map) @@ -2370,7 +2390,7 @@ will be evaluated without lexical binding. This function preserves the position of point. */) (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object tem, buf; if (NILP (buffer)) @@ -2415,7 +2435,7 @@ This function does not move point. */) (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function) { /* FIXME: Do the eval-sexp-add-defvars dance! */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object tem, cbuf; cbuf = Fcurrent_buffer (); @@ -2461,7 +2481,35 @@ STREAM or the value of `standard-input' may be: return call1 (intern ("read-minibuffer"), build_string ("Lisp expression: ")); - return read_internal_start (stream, Qnil, Qnil); + return read_internal_start (stream, Qnil, Qnil, false); +} + +DEFUN ("read-positioning-symbols", Fread_positioning_symbols, + Sread_positioning_symbols, 0, 1, 0, + doc: /* Read one Lisp expression as text from STREAM, return as Lisp object. +Convert each occurrence of a symbol into a "symbol with pos" object. + +If STREAM is nil, use the value of `standard-input' (which see). +STREAM or the value of `standard-input' may be: + a buffer (read from point and advance it) + a marker (read from where it points and advance it) + a function (call it with no arguments for each character, + call it with a char as argument to push a char back) + a string (takes text from string, starting at the beginning) + t (read text line using minibuffer and use it, or read from + standard input in batch mode). */) + (Lisp_Object stream) +{ + if (NILP (stream)) + stream = Vstandard_input; + if (EQ (stream, Qt)) + stream = Qread_char; + if (EQ (stream, Qread_char)) + /* FIXME: ?! When is this used !? */ + return call1 (intern ("read-minibuffer"), + build_string ("Lisp expression: ")); + + return read_internal_start (stream, Qnil, Qnil, true); } DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0, @@ -2477,18 +2525,21 @@ the end of STRING. */) Lisp_Object ret; CHECK_STRING (string); /* `read_internal_start' sets `read_from_string_index'. */ - ret = read_internal_start (string, start, end); + ret = read_internal_start (string, start, end, false); return Fcons (ret, make_fixnum (read_from_string_index)); } /* Function to set up the global context we need in toplevel read - calls. START and END only used when STREAM is a string. */ + calls. START and END only used when STREAM is a string. + LOCATE_SYMS true means read symbol occurrences as symbols with + position. */ static Lisp_Object -read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) +read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end, + bool locate_syms) { Lisp_Object retval; - readchar_count = 0; + readchar_offset = BUFFERP (stream) ? XBUFFER (stream)->pt : 0; /* We can get called from readevalloop which may have set these already. */ if (! HASH_TABLE_P (read_objects_map) @@ -2501,9 +2552,6 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) read_objects_completed = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, Qnil, false); - if (EQ (Vread_with_symbol_positions, Qt) - || EQ (Vread_with_symbol_positions, stream)) - Vread_symbol_positions_list = Qnil; if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream))))) @@ -2524,11 +2572,7 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) read_from_string_limit = endval; } - retval = read0 (stream); - if (EQ (Vread_with_symbol_positions, Qt) - || EQ (Vread_with_symbol_positions, stream)) - Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list); - /* Empty hashes can be reused; otherwise, reset on next call. */ + retval = read0 (stream, locate_syms); if (HASH_TABLE_P (read_objects_map) && XHASH_TABLE (read_objects_map)->count > 0) read_objects_map = Qnil; @@ -2543,12 +2587,12 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) are not allowed. */ static Lisp_Object -read0 (Lisp_Object readcharfun) +read0 (Lisp_Object readcharfun, bool locate_syms) { register Lisp_Object val; int c; - val = read1 (readcharfun, &c, 0); + val = read1 (readcharfun, &c, 0, locate_syms); if (!c) return val; @@ -2566,7 +2610,7 @@ read0 (Lisp_Object readcharfun) static char * grow_read_buffer (char *buf, ptrdiff_t offset, - char **buf_addr, ptrdiff_t *buf_size, ptrdiff_t count) + char **buf_addr, ptrdiff_t *buf_size, specpdl_ref count) { char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1); if (!*buf_addr) @@ -2710,7 +2754,7 @@ read_escape (Lisp_Object readcharfun, bool stringp) c = read_escape (readcharfun, 0); if ((c & ~CHAR_MODIFIER_MASK) == '?') return 0177 | (c & CHAR_MODIFIER_MASK); - else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) + else if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) return c | ctrl_modifier; /* ASCII control chars are made from letters (both cases), as well as the non-letters within 0100...0137. */ @@ -2919,7 +2963,7 @@ read_integer (Lisp_Object readcharfun, int radix, char *p = read_buffer; char *heapbuf = NULL; int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); int c = READCHAR; if (c == '-' || c == '+') @@ -2972,10 +3016,12 @@ read_integer (Lisp_Object readcharfun, int radix, in *PCH and the return value is not interesting. Else, we store zero in *PCH and we read and return one lisp object. - FIRST_IN_LIST is true if this is the first element of a list. */ + FIRST_IN_LIST is true if this is the first element of a list. + LOCATE_SYMS true means read symbol occurrences as symbols with + position. */ static Lisp_Object -read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) +read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms) { int c; bool uninterned_symbol = false; @@ -2995,10 +3041,10 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) switch (c) { case '(': - return read_list (0, readcharfun); + return read_list (0, readcharfun, locate_syms); case '[': - return read_vector (readcharfun, 0); + return read_vector (readcharfun, 0, locate_syms); case ')': case ']': @@ -3017,7 +3063,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* Accept extended format for hash tables (extensible to other types), e.g. #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ - Lisp_Object tmp = read_list (0, readcharfun); + Lisp_Object tmp = read_list (0, readcharfun, false); Lisp_Object head = CAR_SAFE (tmp); Lisp_Object data = Qnil; Lisp_Object val = Qnil; @@ -3106,7 +3152,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == '[') { Lisp_Object tmp; - tmp = read_vector (readcharfun, 0); + tmp = read_vector (readcharfun, 0, false); if (ASIZE (tmp) < CHAR_TABLE_STANDARD_SLOTS) error ("Invalid size char-table"); XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE); @@ -3119,7 +3165,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) { /* Sub char-table can't be read as a regular vector because of a two C integer fields. */ - Lisp_Object tbl, tmp = read_list (1, readcharfun); + Lisp_Object tbl, tmp = read_list (1, readcharfun, false); ptrdiff_t size = list_length (tmp); int i, depth, min_char; struct Lisp_Cons *cell; @@ -3157,7 +3203,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == '&') { Lisp_Object length; - length = read1 (readcharfun, pch, first_in_list); + length = read1 (readcharfun, pch, first_in_list, false); c = READCHAR; if (c == '"') { @@ -3166,7 +3212,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) unsigned char *data; UNREAD (c); - tmp = read1 (readcharfun, pch, first_in_list); + tmp = read1 (readcharfun, pch, first_in_list, false); if (STRING_MULTIBYTE (tmp) || (size_in_chars != SCHARS (tmp) /* We used to print 1 char too many @@ -3194,7 +3240,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) build them using function calls. */ Lisp_Object tmp; struct Lisp_Vector *vec; - tmp = read_vector (readcharfun, 1); + tmp = read_vector (readcharfun, 1, false); vec = XVECTOR (tmp); if (! (COMPILED_STACK_DEPTH < ASIZE (tmp) && (FIXNUMP (AREF (tmp, COMPILED_ARGLIST)) @@ -3206,33 +3252,20 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) && FIXNATP (AREF (tmp, COMPILED_STACK_DEPTH)))) invalid_syntax ("Invalid byte-code object", readcharfun); - if (STRINGP (AREF (tmp, COMPILED_BYTECODE)) - && STRING_MULTIBYTE (AREF (tmp, COMPILED_BYTECODE))) - { - /* BYTESTR must have been produced by Emacs 20.2 or earlier - because it produced a raw 8-bit string for byte-code and - now such a byte-code string is loaded as multibyte with - raw 8-bit characters converted to multibyte form. - Convert them back to the original unibyte form. */ - ASET (tmp, COMPILED_BYTECODE, - Fstring_as_unibyte (AREF (tmp, COMPILED_BYTECODE))); - } - - if (COMPILED_DOC_STRING < ASIZE (tmp) - && EQ (AREF (tmp, COMPILED_DOC_STRING), make_fixnum (0))) + if (STRINGP (AREF (tmp, COMPILED_BYTECODE))) { - /* read_list found a docstring like '(#$ . 5521)' and treated it - as 0. This placeholder 0 would lead to accidental sharing in - purecopy's hash-consing, so replace it with a (hopefully) - unique integer placeholder, which is negative so that it is - not confused with a DOC file offset (the USE_LSB_TAG shift - relies on the fact that VALMASK is one bit narrower than - INTMASK). Eventually Snarf-documentation should replace the - placeholder with the actual docstring. */ - verify (INTMASK & ~VALMASK); - EMACS_UINT hash = ((XHASH (tmp) >> USE_LSB_TAG) - | (INTMASK - INTMASK / 2)); - ASET (tmp, COMPILED_DOC_STRING, make_ufixnum (hash)); + if (STRING_MULTIBYTE (AREF (tmp, COMPILED_BYTECODE))) + { + /* BYTESTR must have been produced by Emacs 20.2 or earlier + because it produced a raw 8-bit string for byte-code and + now such a byte-code string is loaded as multibyte with + raw 8-bit characters converted to multibyte form. + Convert them back to the original unibyte form. */ + ASET (tmp, COMPILED_BYTECODE, + Fstring_as_unibyte (AREF (tmp, COMPILED_BYTECODE))); + } + // Bytecode must be immovable. + pin_string (AREF (tmp, COMPILED_BYTECODE)); } XSETPVECTYPE (vec, PVEC_COMPILED); @@ -3244,7 +3277,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) int ch; /* Read the string itself. */ - tmp = read1 (readcharfun, &ch, 0); + tmp = read1 (readcharfun, &ch, 0, false); if (ch != 0 || !STRINGP (tmp)) invalid_syntax ("#", readcharfun); /* Read the intervals and their properties. */ @@ -3252,14 +3285,14 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) { Lisp_Object beg, end, plist; - beg = read1 (readcharfun, &ch, 0); + beg = read1 (readcharfun, &ch, 0, false); end = plist = Qnil; if (ch == ')') break; if (ch == 0) - end = read1 (readcharfun, &ch, 0); + end = read1 (readcharfun, &ch, 0, false); if (ch == 0) - plist = read1 (readcharfun, &ch, 0); + plist = read1 (readcharfun, &ch, 0, false); if (ch) invalid_syntax ("Invalid string property list", readcharfun); Fset_text_properties (beg, end, plist, tmp); @@ -3370,7 +3403,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == '$') return Vload_file_name; if (c == '\'') - return list2 (Qfunction, read0 (readcharfun)); + return list2 (Qfunction, read0 (readcharfun, locate_syms)); /* #:foo is the uninterned symbol named foo. */ if (c == ':') { @@ -3453,7 +3486,30 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) hash_put (h, number, placeholder, hash); /* Read the object itself. */ - Lisp_Object tem = read0 (readcharfun); + Lisp_Object tem = read0 (readcharfun, locate_syms); + + if (CONSP (tem)) + { + if (BASE_EQ (tem, placeholder)) + /* Catch silly games like #1=#1# */ + invalid_syntax ("nonsensical self-reference", + readcharfun); + + /* Optimisation: since the placeholder is already + a cons, repurpose it as the actual value. + This allows us to skip the substition below, + since the placeholder is already referenced + inside TEM at the appropriate places. */ + Fsetcar (placeholder, XCAR (tem)); + Fsetcdr (placeholder, XCDR (tem)); + + struct Lisp_Hash_Table *h2 + = XHASH_TABLE (read_objects_completed); + ptrdiff_t i = hash_lookup (h2, placeholder, &hash); + eassert (i < 0); + hash_put (h2, placeholder, Qnil, hash); + return placeholder; + } /* If it can be recursive, remember it for future substitutions. */ @@ -3469,24 +3525,15 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } /* Now put it everywhere the placeholder was... */ - if (CONSP (tem)) - { - Fsetcar (placeholder, XCAR (tem)); - Fsetcdr (placeholder, XCDR (tem)); - return placeholder; - } - else - { - Flread__substitute_object_in_subtree - (tem, placeholder, read_objects_completed); + Flread__substitute_object_in_subtree + (tem, placeholder, read_objects_completed); - /* ...and #n# will use the real value from now on. */ - i = hash_lookup (h, number, &hash); - eassert (i >= 0); - set_hash_value_slot (h, i, tem); + /* ...and #n# will use the real value from now on. */ + i = hash_lookup (h, number, &hash); + eassert (i >= 0); + set_hash_value_slot (h, i, tem); - return tem; - } + return tem; } /* #n# returns a previously read object. */ @@ -3509,6 +3556,9 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) else if (c == 'b' || c == 'B') return read_integer (readcharfun, 2, stackbuf); + char acm_buf[15]; /* FIXME!!! 2021-11-27. */ + sprintf (acm_buf, "#%c", c); + invalid_syntax (acm_buf, readcharfun); UNREAD (c); invalid_syntax ("#", readcharfun); @@ -3517,10 +3567,10 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) goto retry; case '\'': - return list2 (Qquote, read0 (readcharfun)); + return list2 (Qquote, read0 (readcharfun, locate_syms)); case '`': - return list2 (Qbackquote, read0 (readcharfun)); + return list2 (Qbackquote, read0 (readcharfun, locate_syms)); case ',': { @@ -3536,7 +3586,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) comma_type = Qcomma; } - value = read0 (readcharfun); + value = read0 (readcharfun, locate_syms); return list2 (comma_type, value); } case '?': @@ -3587,7 +3637,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) case '"': { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); char *read_buffer = stackbuf; ptrdiff_t read_buffer_size = sizeof stackbuf; char *heapbuf = NULL; @@ -3731,14 +3781,14 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) read_symbol: { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); char *read_buffer = stackbuf; ptrdiff_t read_buffer_size = sizeof stackbuf; char *heapbuf = NULL; char *p = read_buffer; char *end = read_buffer + read_buffer_size; bool quoted = false; - EMACS_INT start_position = readchar_count - 1; + EMACS_INT start_position = readchar_offset - 1; do { @@ -3843,12 +3893,12 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) result = intern_driver (name, obarray, tem); } } + if (locate_syms + && !NILP (result) + ) + result = build_symbol_with_pos (result, + make_fixnum (start_position)); - if (EQ (Vread_with_symbol_positions, Qt) - || EQ (Vread_with_symbol_positions, readcharfun)) - Vread_symbol_positions_list - = Fcons (Fcons (result, make_fixnum (start_position)), - Vread_symbol_positions_list); return unbind_to (count, result); } } @@ -4101,9 +4151,9 @@ string_to_number (char const *string, int base, ptrdiff_t *plen) static Lisp_Object -read_vector (Lisp_Object readcharfun, bool bytecodeflag) +read_vector (Lisp_Object readcharfun, bool bytecodeflag, bool locate_syms) { - Lisp_Object tem = read_list (1, readcharfun); + Lisp_Object tem = read_list (1, readcharfun, locate_syms); ptrdiff_t size = list_length (tem); Lisp_Object vector = make_nil_vector (size); @@ -4175,10 +4225,12 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag) return vector; } -/* FLAG means check for ']' to terminate rather than ')' and '.'. */ +/* FLAG means check for ']' to terminate rather than ')' and '.'. + LOCATE_SYMS true means read symbol occurrencess as symbols with + position. */ static Lisp_Object -read_list (bool flag, Lisp_Object readcharfun) +read_list (bool flag, Lisp_Object readcharfun, bool locate_syms) { Lisp_Object val, tail; Lisp_Object elt, tem; @@ -4196,37 +4248,19 @@ read_list (bool flag, Lisp_Object readcharfun) while (1) { int ch; - elt = read1 (readcharfun, &ch, first_in_list); + elt = read1 (readcharfun, &ch, first_in_list, locate_syms); first_in_list = 0; /* While building, if the list starts with #$, treat it specially. */ if (EQ (elt, Vload_file_name) - && ! NILP (elt) - && !NILP (Vpurify_flag)) + && ! NILP (elt)) { - if (NILP (Vdoc_file_name)) - /* We have not yet called Snarf-documentation, so assume - this file is described in the DOC file - and Snarf-documentation will fill in the right value later. - For now, replace the whole list with 0. */ - doc_reference = 1; - else - /* We have already called Snarf-documentation, so make a relative - file name for this file, so it can be found properly - in the installed Lisp directory. - We don't use Fexpand_file_name because that would make - the directory absolute now. */ - { - AUTO_STRING (dot_dot_lisp, "../lisp/"); - elt = concat2 (dot_dot_lisp, Ffile_name_nondirectory (elt)); - } + if (!NILP (Vpurify_flag)) + doc_reference = 0; + else if (load_force_doc_strings) + doc_reference = 2; } - else if (EQ (elt, Vload_file_name) - && ! NILP (elt) - && load_force_doc_strings) - doc_reference = 2; - if (ch) { if (flag > 0) @@ -4240,15 +4274,13 @@ read_list (bool flag, Lisp_Object readcharfun) if (ch == '.') { if (!NILP (tail)) - XSETCDR (tail, read0 (readcharfun)); + XSETCDR (tail, read0 (readcharfun, locate_syms)); else - val = read0 (readcharfun); - read1 (readcharfun, &ch, 0); + val = read0 (readcharfun, locate_syms); + read1 (readcharfun, &ch, 0, locate_syms); if (ch == ')') { - if (doc_reference == 1) - return make_fixnum (0); if (doc_reference == 2 && FIXNUMP (XCDR (val))) { char *saved = NULL; @@ -4623,7 +4655,9 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff if (EQ (bucket, make_fixnum (0))) ; else if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); /* Like CADR error message. */ + /* Like CADR error message. */ + xsignal2 (Qwrong_type_argument, Qobarrayp, + build_string ("Bad data in guts of obarray")); else for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next)) { @@ -5121,6 +5155,7 @@ void syms_of_lread (void) { defsubr (&Sread); + defsubr (&Sread_positioning_symbols); defsubr (&Sread_from_string); defsubr (&Slread__substitute_object_in_subtree); defsubr (&Sintern); @@ -5154,35 +5189,6 @@ This variable is obsolete as of Emacs 28.1 and should not be used. */); See documentation of `read' for possible values. */); Vstandard_input = Qt; - DEFVAR_LISP ("read-with-symbol-positions", Vread_with_symbol_positions, - doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'. - -If this variable is a buffer, then only forms read from that buffer -will be added to `read-symbol-positions-list'. -If this variable is t, then all read forms will be added. -The effect of all other values other than nil are not currently -defined, although they may be in the future. - -The positions are relative to the last call to `read' or -`read-from-string'. It is probably a bad idea to set this variable at -the toplevel; bind it instead. */); - Vread_with_symbol_positions = Qnil; - - DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list, - doc: /* A list mapping read symbols to their positions. -This variable is modified during calls to `read' or -`read-from-string', but only when `read-with-symbol-positions' is -non-nil. - -Each element of the list looks like (SYMBOL . CHAR-POSITION), where -CHAR-POSITION is an integer giving the offset of that occurrence of the -symbol from the position where `read' or `read-from-string' started. - -Note that a symbol will appear multiple times in this list, if it was -read multiple times. The list is in the same order as the symbols -were read in. */); - Vread_symbol_positions_list = Qnil; - DEFVAR_LISP ("read-circle", Vread_circle, doc: /* Non-nil means read recursive structures using #N= and #N# syntax. */); Vread_circle = Qt; @@ -5265,12 +5271,9 @@ for symbols and features not associated with any file. The remaining ENTRIES in the alist element describe the functions and variables defined in that file, the features provided, and the features required. Each entry has the form `(provide . FEATURE)', -`(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)', -`(defface . SYMBOL)', `(define-type . SYMBOL)', -`(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'. -Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry, -and mean that SYMBOL was an autoload before this file redefined it -as a function. In addition, entries may also be single symbols, +`(require . FEATURE)', `(defun . FUNCTION)', `(defface . SYMBOL)', + `(define-type . SYMBOL)', or `(cl-defmethod METHOD SPECIALIZERS)'. +In addition, entries may also be single symbols, which means that symbol was defined by `defvar' or `defconst'. During preloading, the file name recorded is relative to the main Lisp @@ -5303,7 +5306,9 @@ of the file, regardless of whether or not it has the `.elc' extension. */); Vcurrent_load_list = Qnil; DEFVAR_LISP ("load-read-function", Vload_read_function, - doc: /* Function used by `load' and `eval-region' for reading expressions. + doc: /* Function used for reading expressions. +It is used by `load' and `eval-region'. + Called with a single argument (the stream from which to read). The default is to use the function `read'. */); DEFSYM (Qread, "read"); @@ -5464,4 +5469,11 @@ 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"); + DEFSYM (Qobarrayp, "obarrayp"); + + DEFSYM (Qmacroexp__dynvars, "macroexp--dynvars"); + DEFVAR_LISP ("macroexp--dynvars", Vmacroexp__dynvars, + doc: /* List of variables declared dynamic in the current scope. +Only valid during macro-expansion. Internal use only. */); + Vmacroexp__dynvars = Qnil; } diff --git a/src/macfont.m b/src/macfont.m index e3dab1c42e0..34e48afb98f 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -598,9 +598,9 @@ mac_screen_font_shape (ScreenFontRef font, CFStringRef string, } static CGColorRef -get_cgcolor(unsigned long idx, struct frame *f) +get_cgcolor(unsigned long color) { - NSColor *nsColor = ns_lookup_indexed_color (idx, f); + NSColor *nsColor = [NSColor colorWithUnsignedLong:color]; [nsColor set]; CGColorSpaceRef colorSpace = [[nsColor colorSpace] CGColorSpace]; NSInteger noc = [nsColor numberOfComponents]; @@ -613,21 +613,36 @@ get_cgcolor(unsigned long idx, struct frame *f) return cgColor; } -#define CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND(context, face, f) \ +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) \ do { \ - CGColorRef refcol_ = get_cgcolor (NS_FACE_FOREGROUND (face), f); \ + CGColorRef refcol_ = get_cgcolor (NS_FACE_FOREGROUND (face)); \ CGContextSetFillColorWithColor (context, refcol_) ; \ CGColorRelease (refcol_); \ } while (0) -#define CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND(context, face, f) \ +#define CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND(context, face) \ do { \ - CGColorRef refcol_ = get_cgcolor (NS_FACE_BACKGROUND (face), f); \ + CGColorRef refcol_ = get_cgcolor (NS_FACE_BACKGROUND (face)); \ CGContextSetFillColorWithColor (context, refcol_); \ CGColorRelease (refcol_); \ } while (0) -#define CG_SET_STROKE_COLOR_WITH_FACE_FOREGROUND(context, face, f) \ +#define CG_SET_STROKE_COLOR_WITH_FACE_FOREGROUND(context, face) \ do { \ - CGColorRef refcol_ = get_cgcolor (NS_FACE_FOREGROUND (face), f); \ + CGColorRef refcol_ = get_cgcolor (NS_FACE_FOREGROUND (face)); \ CGContextSetStrokeColorWithColor (context, refcol_); \ CGColorRelease (refcol_); \ } while (0) @@ -2911,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); CGContextFillRects (context, &background_rect, 1); } @@ -2927,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); if (macfont_info->synthetic_italic_p) atfm = synthetic_italic_atfm; else @@ -2956,7 +2978,7 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y, #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 CGContextSetLineWidth (context, synthetic_bold_factor * font_size); #endif - CG_SET_STROKE_COLOR_WITH_FACE_FOREGROUND (context, face, f); + CG_SET_STROKE_COLOR_WITH_FACE_FOREGROUND (context, face); } if (no_antialias_p) CGContextSetShouldAntialias (context, false); @@ -3548,7 +3570,10 @@ mac_font_create_preferred_family_for_attributes (CFDictionaryRef attributes) if (languages && CFArrayGetCount (languages) > 0) { - if (CTGetCoreTextVersion () >= kCTVersionNumber10_9) + if ([[NSProcessInfo processInfo] + isOperatingSystemAtLeastVersion: + ((NSOperatingSystemVersion){ + .majorVersion = 10, .minorVersion = 9})]) values[num_values++] = CFArrayGetValueAtIndex (languages, 0); else { diff --git a/src/macros.c b/src/macros.c index 3d00c28838d..6b6865d9298 100644 --- a/src/macros.c +++ b/src/macros.c @@ -273,9 +273,15 @@ pop_kbd_macro (Lisp_Object info) } DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 3, 0, - doc: /* Execute MACRO as string of editor command characters. -MACRO can also be a vector of keyboard events. If MACRO is a symbol, -its function definition is used. + doc: /* Execute MACRO as a sequence of events. +If MACRO is a string or vector, then the events in it are executed +exactly as if they had been input by the user. + +If MACRO is a symbol, its function definition is used. If that is +another symbol, this process repeats. Eventually the result should be +a string or vector. If the result is not a symbol, string, or vector, +an error is signaled. + COUNT is a repeat count, or nil for once, or 0 for infinite loop. Optional third arg LOOPFUNC may be a function that is called prior to @@ -287,7 +293,7 @@ buffer before the macro is executed. */) { Lisp_Object final; Lisp_Object tem; - ptrdiff_t pdlcount = SPECPDL_INDEX (); + specpdl_ref pdlcount = SPECPDL_INDEX (); EMACS_INT repeat = 1; EMACS_INT success_count = 0; diff --git a/src/menu.c b/src/menu.c index 7b6fdf812c5..398bf9329ff 100644 --- a/src/menu.c +++ b/src/menu.c @@ -50,7 +50,8 @@ extern AppendMenuW_Proc unicode_append_menu; static bool have_boxes (void) { -#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || defined(HAVE_NS) +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NTGUI) || defined (HAVE_NS) \ + || defined (HAVE_HAIKU) if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame))) return 1; #endif @@ -422,7 +423,8 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk AREF (item_properties, ITEM_PROPERTY_SELECTED), AREF (item_properties, ITEM_PROPERTY_HELP)); -#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI) +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) \ + || defined (HAVE_NTGUI) || defined (HAVE_HAIKU) || defined (HAVE_PGTK) /* Display a submenu using the toolkit. */ if (FRAME_WINDOW_P (XFRAME (Vmenu_updating_frame)) && ! (NILP (map) || NILP (enabled))) @@ -872,6 +874,10 @@ update_submenu_strings (widget_value *first_wv) } } +#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */ +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) \ + || defined (HAVE_NTGUI) || defined (HAVE_HAIKU) + /* Find the menu selection and store it in the keyboard buffer. F is the frame the menu is on. MENU_BAR_ITEMS_USED is the length of VECTOR. @@ -959,7 +965,7 @@ find_and_call_menu_selection (struct frame *f, int menu_bar_items_used, SAFE_FREE (); } -#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI */ +#endif /* USE_X_TOOLKIT || USE_GTK || HAVE_NS || HAVE_NTGUI || HAVE_HAIKU */ #ifdef HAVE_NS /* As above, but return the menu selection instead of storing in kb buffer. @@ -1107,7 +1113,7 @@ into menu items. */) Lisp_Object x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) { - Lisp_Object keymap, tem, tem2; + Lisp_Object keymap, tem, tem2 = Qnil; int xpos = 0, ypos = 0; Lisp_Object title; const char *error_name = NULL; @@ -1115,7 +1121,7 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) struct frame *f = NULL; Lisp_Object x, y, window; int menuflags = 0; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); if (NILP (position)) /* This is an obsolete call, which wants us to precompute the @@ -1246,8 +1252,21 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) CHECK_LIVE_WINDOW (window); f = XFRAME (WINDOW_FRAME (win)); - xpos = WINDOW_LEFT_EDGE_X (win); - ypos = WINDOW_TOP_EDGE_Y (win); + if (FIXNUMP (tem2)) + { + /* Clicks in the text area, where TEM2 is a buffer + position, are relative to the top-left edge of the text + area, see keyboard.c:make_lispy_position. */ + xpos = window_box_left (win, TEXT_AREA); + ypos = (WINDOW_TOP_EDGE_Y (win) + + WINDOW_TAB_LINE_HEIGHT (win) + + WINDOW_HEADER_LINE_HEIGHT (win)); + } + else + { + xpos = WINDOW_LEFT_EDGE_X (win); + ypos = WINDOW_TOP_EDGE_Y (win); + } } else /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, @@ -1372,9 +1391,9 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) } #endif -#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */ record_unwind_protect_void (discard_menu_items); -#endif + + run_hook (Qx_pre_popup_menu_hook); /* Display them in a menu, but not if F is the initial frame that doesn't have its hooks set (e.g., in a batch session), because @@ -1383,13 +1402,13 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) selection = FRAME_TERMINAL (f)->menu_show_hook (f, xpos, ypos, menuflags, title, &error_name); -#ifdef HAVE_NS unbind_to (specpdl_count, Qnil); -#else - discard_menu_items (); -#endif -#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */ +#ifdef HAVE_NTGUI /* W32 specific because other terminals clear + the grab inside their `menu_show_hook's if + it's actually required (i.e. there isn't a + way to query the buttons currently held down + after XMenuActivate). */ if (FRAME_W32_P (f)) FRAME_DISPLAY_INFO (f)->grabbed = 0; #endif @@ -1583,6 +1602,14 @@ syms_of_menu (void) staticpro (&menu_items); DEFSYM (Qhide, "hide"); + DEFSYM (Qx_pre_popup_menu_hook, "x-pre-popup-menu-hook"); + + DEFVAR_LISP ("x-pre-popup-menu-hook", Vx_pre_popup_menu_hook, + doc: /* Hook run before `x-popup-menu' displays a popup menu. +It is only run before the menu is really going to be displayed. It +won't be run if `x-popup-menu' fails or returns for some other reason +(such as the keymap is invalid). */); + Vx_pre_popup_menu_hook = Qnil; defsubr (&Sx_popup_menu); defsubr (&Sx_popup_dialog); diff --git a/src/menu.h b/src/menu.h index 9f32d0c262b..836172b58f2 100644 --- a/src/menu.h +++ b/src/menu.h @@ -59,6 +59,12 @@ extern Lisp_Object ns_menu_show (struct frame *, int, int, int, Lisp_Object, const char **); extern void ns_activate_menubar (struct frame *); #endif +#ifdef HAVE_PGTK +extern Lisp_Object pgtk_menu_show (struct frame *, int, int, int, + Lisp_Object, const char **); +extern void pgtk_activate_menubar (struct frame *); +#endif + extern Lisp_Object tty_menu_show (struct frame *, int, int, int, Lisp_Object, const char **); extern ptrdiff_t menu_item_width (const unsigned char *); diff --git a/src/minibuf.c b/src/minibuf.c index 847e7be5ad4..97a6ec69011 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -41,7 +41,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ minibuffer recursions are encountered. */ Lisp_Object Vminibuffer_list; -Lisp_Object Vcommand_loop_level_list; +static Lisp_Object Vcommand_loop_level_list; /* Data to remember during recursive minibuffer invocations. */ @@ -578,7 +578,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, bool allow_props, bool inherit_input_method) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object mini_frame, ambient_dir, minibuffer, input_method; Lisp_Object calling_frame = selected_frame; Lisp_Object calling_window = selected_window; @@ -833,7 +833,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* Erase the buffer. */ { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -991,7 +991,7 @@ nth_minibuffer (EMACS_INT depth) static void set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); Fset_buffer (buf); @@ -1005,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); } @@ -1155,7 +1155,7 @@ read_minibuf_unwind (void) /* Erase the minibuffer we were using at this level. */ { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Prevent error in erase-buffer. */ specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); @@ -1292,8 +1292,9 @@ 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 t, history - is not recorded. + starting from 1 at the beginning of the list. If HIST is nil, the + default history list `minibuffer-history' is used. 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'. @@ -1384,7 +1385,7 @@ Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits (Lisp_Object prompt, Lisp_Object initial_input, Lisp_Object history, Lisp_Object default_value, Lisp_Object inherit_input_method) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Just in case we're in a recursive minibuffer, make it clear that the previous minibuffer's completion table does not apply to the new @@ -1483,7 +1484,7 @@ function, instead of the usual behavior. */) Lisp_Object result; char *s; ptrdiff_t len; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (BUFFERP (def)) def = BVAR (XBUFFER (def), name); @@ -1545,6 +1546,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 @@ -1578,6 +1600,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; @@ -1591,7 +1614,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); @@ -1670,27 +1692,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. */ @@ -1701,11 +1706,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), @@ -1787,9 +1787,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, @@ -1849,7 +1846,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); @@ -1934,27 +1930,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. */ @@ -1965,11 +1944,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)) @@ -1982,9 +1956,6 @@ with a space are ignored unless STRING itself starts with a space. */) } } - if (bindcount >= 0) - unbind_to (bindcount, Qnil); - return Fnreverse (allmatches); } @@ -2068,7 +2039,7 @@ 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); @@ -2154,20 +2125,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)) 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 29b1a9fc0d7..1608245904c 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 @@ -2725,7 +2725,8 @@ dos_rawgetc (void) event.x = make_fixnum (x); event.y = make_fixnum (y); event.frame_or_window = selected_frame; - event.arg = Qnil; + event.arg = tty_handle_tab_bar_click (SELECTED_FRAME (), + x, y, press, &event); event.timestamp = event_timestamp (); kbd_buffer_store_event (&event); } diff --git a/src/nsfns.m b/src/nsfns.m index b1f8bad0ec0..720ed3f88e5 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -236,7 +236,6 @@ static void ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { NSColor *col; - EmacsCGFloat r, g, b, alpha; /* Must block_input, because ns_lisp_to_color does block/unblock_input which means that col may be deallocated in its unblock_input if there @@ -253,12 +252,7 @@ ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) [f->output_data.ns->foreground_color release]; f->output_data.ns->foreground_color = col; - [col getRed: &r green: &g blue: &b alpha: &alpha]; - FRAME_FOREGROUND_PIXEL (f) = - ARGB_TO_ULONG ((unsigned long) (alpha * 0xff), - (unsigned long) (r * 0xff), - (unsigned long) (g * 0xff), - (unsigned long) (b * 0xff)); + FRAME_FOREGROUND_PIXEL (f) = [col unsignedLong]; if (FRAME_NS_VIEW (f)) { @@ -277,7 +271,7 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) struct face *face; NSColor *col; NSView *view = FRAME_NS_VIEW (f); - EmacsCGFloat r, g, b, alpha; + EmacsCGFloat alpha; block_input (); if (ns_lisp_to_color (arg, &col)) @@ -291,12 +285,8 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) [f->output_data.ns->background_color release]; f->output_data.ns->background_color = col; - [col getRed: &r green: &g blue: &b alpha: &alpha]; - FRAME_BACKGROUND_PIXEL (f) = - ARGB_TO_ULONG ((unsigned long) (alpha * 0xff), - (unsigned long) (r * 0xff), - (unsigned long) (g * 0xff), - (unsigned long) (b * 0xff)); + FRAME_BACKGROUND_PIXEL (f) = [col unsignedLong]; + alpha = [col alphaComponent]; if (view != nil) { @@ -310,9 +300,9 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) face = FRAME_DEFAULT_FACE (f); if (face) { - col = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f); - face->background = ns_index_color - ([col colorWithAlphaComponent: alpha], f); + col = [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)]; + face->background = [[col colorWithAlphaComponent: alpha] + unsignedLong]; update_face_from_frame_parameter (f, Qbackground_color, arg); } @@ -1014,6 +1004,7 @@ frame_parm_handler ns_frame_parm_handlers[] = ns_set_z_group, 0, /* x_set_override_redirect */ gui_set_no_special_glyphs, + gui_set_alpha_background, #ifdef NS_IMPL_COCOA ns_set_appearance, ns_set_transparent_titlebar, @@ -1115,12 +1106,13 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, Lisp_Object name; int minibuffer_only = 0; long window_prompting = 0; - ptrdiff_t count = specpdl_ptr - specpdl; + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object display; struct ns_display_info *dpyinfo = NULL; Lisp_Object parent, parent_frame; struct kboard *kb; static int desc_ctr = 1; + NSWindow *main_window = [NSApp mainWindow]; /* gui_display_get_arg modifies parms. */ parms = Fcopy_alist (parms); @@ -1236,6 +1228,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, @@ -1250,6 +1243,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 (); @@ -1359,6 +1357,10 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, NILP (Vmenu_bar_mode) ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qtab_bar_lines, + NILP (Vtab_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qtool_bar_lines, NILP (Vtool_bar_mode) ? make_fixnum (0) : make_fixnum (1), @@ -1436,6 +1438,8 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qfullscreen, Qnil, "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); @@ -1480,8 +1484,27 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) fset_param_alist (f, Fcons (XCAR (tem), f->param_alist)); - if (window_prompting & USPosition) + /* This cascading behavior (which is the job of the window manager + on X-based systems) is something NS applications are expected to + implement themselves. At least one person tells me he used + Carbon Emacs solely for this behavior. */ + if (window_prompting & (USPosition | PPosition) || FRAME_PARENT_FRAME (f)) ns_set_offset (f, f->left_pos, f->top_pos, 1); + else + { + NSWindow *frame_window = [FRAME_NS_VIEW (f) window]; + NSPoint top_left; + + if (main_window) + { + top_left = NSMakePoint (NSMinX ([main_window frame]), + NSMaxY ([main_window frame])); + top_left = [frame_window cascadeTopLeftFromPoint: top_left]; + [frame_window cascadeTopLeftFromPoint: top_left]; + } + else + [frame_window center]; + } /* Make sure windows on this frame appear in calls to next-window and similar functions. */ @@ -2352,6 +2375,47 @@ ns_get_string_resource (void *_rdb, const char *name, const char *class) ========================================================================== */ +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1080 +/* Moving files to the system recycle bin. + Used by `move-file-to-trash' instead of the default moving to ~/.Trash */ +DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash, + Ssystem_move_file_to_trash, 1, 1, 0, + doc: /* Move file or directory named FILENAME to the recycle bin. */) + (Lisp_Object filename) +{ + Lisp_Object handler; + Lisp_Object operation; + + operation = Qdelete_file; + if (!NILP (Ffile_directory_p (filename)) + && NILP (Ffile_symlink_p (filename))) + { + operation = intern ("delete-directory"); + filename = Fdirectory_file_name (filename); + } + + /* Must have fully qualified file names for moving files to Trash. */ + filename = Fexpand_file_name (filename, Qnil); + + handler = Ffind_file_name_handler (filename, operation); + if (!NILP (handler)) + return call2 (handler, operation, filename); + else + { + NSFileManager *fm = [NSFileManager defaultManager]; + BOOL result = NO; + NSURL *fileURL = [NSURL fileURLWithPath:[NSString stringWithLispString:filename] + isDirectory:!NILP (Ffile_directory_p (filename))]; + if ([fm respondsToSelector:@selector(trashItemAtURL:resultingItemURL:error:)]) + result = [fm trashItemAtURL:fileURL resultingItemURL:nil error:nil]; + + if (!result) + report_file_error ("Removing old name", list1 (filename)); + } + return Qnil; +} +#endif + DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object color, Lisp_Object frame) @@ -2779,7 +2843,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy) { int root_x, root_y; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct frame *f; char *str; NSSize size; @@ -3099,6 +3163,9 @@ all_nonzero_ascii (unsigned char *str, ptrdiff_t n) encoded form (e.g. UTF-8). */ + (NSString *)stringWithLispString:(Lisp_Object)string { + if (!STRINGP (string)) + return nil; + /* Shortcut for the common case. */ if (all_nonzero_ascii (SDATA (string), SBYTES (string))) return [NSString stringWithCString: SSDATA (string) @@ -3233,6 +3300,10 @@ Default is t. */); defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1080 + defsubr (&Ssystem_move_file_to_trash); +#endif + as_status = 0; as_script = Qnil; staticpro (&as_script); diff --git a/src/nsfont.m b/src/nsfont.m index fc1a4455d09..f3c8a82930b 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-2022 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; +}; -/* Replace spaces w/another character so emacs core font parsing routines - aren't thrown off. */ +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; +}; + 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) +{ + 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) { - for (; *name; name++) - if (*name == '_') - *name = ' '; + 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); + + 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); + } - xfree (escapedFamily); - return 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,145 +1183,409 @@ 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); + NSRect br = NSMakeRect (x, y - FONT_BASE (s->font), + s->width, FONT_HEIGHT (s->font)); - if (s->row->full_width_p) + if (!s->face->stipple) + { + if (s->hl != DRAW_CURSOR) + [(NS_FACE_BACKGROUND (face) != 0 + ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] + : FRAME_BACKGROUND_COLOR (s->f)) set]; + else + [FRAME_CURSOR_COLOR (s->f) set]; + } + else { - 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; + struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); + [[dpyinfo->bitmaps[face->stipple-1].img stippleMask] set]; } - if (s->face->box == FACE_NO_BOX) + NSRectFill (br); + } + + /* set up for character rendering */ + r.origin.y = y; + + if (s->hl == DRAW_CURSOR) + col = FRAME_BACKGROUND_COLOR (s->f); + else + col = (NS_FACE_FOREGROUND (face) != 0 + ? [NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)] + : FRAME_FOREGROUND_COLOR (s->f)); + + /* render under GNUstep using DPS */ + { + NSGraphicsContext *context = [NSGraphicsContext currentContext]; + [font->nsfont set]; + [col set]; + DPSmoveto (context, r.origin.x, r.origin.y); + GSShowGlyphs (context, c, len); + } + + unblock_input (); + 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++) { - /* Expand unboxed top row over internal border. */ - if (br.origin.y <= fibw + 1 + mbox_line_width) + struct ns_glyph_layout *gl = glyph_layouts + NSMaxRange (range); + NSUInteger characterIndex = + [layoutManager characterIndexForGlyphAtIndex:glyphIndex]; + + gl->string_index = characterIndex; + + if (characterIndex >= NSMaxRange (compRange)) { - br.size.height += br.origin.y; - br.origin.y = 0; + 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 { - 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; + NSUInteger nrects; + NSRect *glyphRects = + [layoutManager + rectArrayForGlyphRange:(NSMakeRange (0, numberOfGlyphs)) + withinSelectedGlyphRange:(NSMakeRange (NSNotFound, 0)) + inTextContainer:textContainer rectCount:&nrects]; + + totalAdvance = NSMaxX (glyphRects[0]); } - 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]; - else + for (i = 0; i < used; i++) { - struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); - [[dpyinfo->bitmaps[face->stipple-1].img stippleMask] set]; + 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; } - NSRectFill (br); + + if (RIGHT_TO_LEFT_P) + xfree (permutation); + +#undef RIGHT_TO_LEFT_P + + result = used; } + [textStorage release]; + return result; +} - /* set up for character rendering */ - r.origin.y = y; +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; - col = (NS_FACE_FOREGROUND (face) != 0 - ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f) - : FRAME_FOREGROUND_COLOR (s->f)); + glyph_len = LGSTRING_GLYPH_LEN (lgstring); + for (i = 0; i < glyph_len; ++i) + { + tem = LGSTRING_GLYPH (lgstring, i); - 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 (NILP (tem)) + break; + } - /* render under GNUstep using DPS */ - { - NSGraphicsContext *context = GSCurrentContext (); + len = i; - DPSgsave (context); - [font->nsfont set]; + 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 (); - /* do erase if "foreground" mode */ - if (bgCol != nil) + 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. */ { - [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 */ - } + UTF32Char c; - [col set]; + 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]; - /* draw with DPSxshow () */ - DPSmoveto (context, r.origin.x, r.origin.y); - DPSxshow (context, (const char *) cbuf, advances, len); - DPSstroke (context); + LGLYPH_SET_CHAR (lglyph, c); + } - DPSgrestore (context); - } + { + 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 to-from; -} + return make_fixnum (used); +} /* ========================================================================== @@ -1134,6 +1594,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 +1645,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 +1653,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 +1670,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 +1680,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 +1715,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 +1758,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 +1767,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/nsgui.h b/src/nsgui.h index eae1b70dcd9..0ba1fce80bd 100644 --- a/src/nsgui.h +++ b/src/nsgui.h @@ -58,9 +58,6 @@ typedef struct _XCharStruct int descent; } XCharStruct; -/* Used in xdisp.c when comparing faces and frame colors. */ -extern unsigned long ns_color_index_to_rgba(int idx, struct frame *f); - #ifdef __OBJC__ typedef id Emacs_Pixmap; #else diff --git a/src/nsimage.m b/src/nsimage.m index 38b27e847ad..2fff987f9fc 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -76,6 +76,8 @@ ns_can_use_native_image_api (Lisp_Object type) imageType = @"public.tiff"; else if (EQ (type, Qsvg)) imageType = @"public.svg-image"; + else if (EQ (type, Qheic)) + imageType = @"public.heic"; /* NSImage also supports a host of other types such as PDF and BMP, but we don't yet support these in image.c. */ diff --git a/src/nsmenu.m b/src/nsmenu.m index 891b6ee1504..81d7cd2da13 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,17 +158,13 @@ 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. */ struct buffer *prev = current_buffer; Lisp_Object buffer; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = alloca (previous_menu_items_used * sizeof *previous_items); @@ -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 } @@ -725,6 +759,32 @@ prettify_key (const char *key) } #ifdef NS_IMPL_GNUSTEP +/* The code below doesn't work on Mac OS X, because it runs a nested + Carbon-related event loop to track menu bar movement. + + But it works fine aside from that, so it will work on GNUstep if + they start to call `willHighlightItem'. */ +- (void) menu: (NSMenu *) menu willHighlightItem: (NSMenuItem *) item +{ + NSInteger idx = [item tag]; + struct frame *f = SELECTED_FRAME (); + Lisp_Object vec = f->menu_bar_vector; + Lisp_Object help, frame; + + if (idx >= ASIZE (vec)) + return; + + XSETFRAME (frame, f); + help = AREF (vec, idx + MENU_ITEMS_ITEM_HELP); + + if (STRINGP (help) || NILP (help)) + kbd_buffer_store_help_event (frame, help); + + raise (SIGIO); +} +#endif + +#ifdef NS_IMPL_GNUSTEP - (void) close { /* Close all the submenus. This has the unfortunate side-effect of @@ -743,6 +803,25 @@ prettify_key (const char *key) /* GNUstep seems to have a number of required methods in NSMenuDelegate that are optional in Cocoa. */ +- (BOOL) menu: (NSMenu*) menu updateItem: (NSMenuItem*) item + atIndex: (NSInteger) index shouldCancel: (BOOL) shouldCancel +{ + return YES; +} + +- (BOOL) menuHasKeyEquivalent: (NSMenu*) menu + forEvent: (NSEvent*) event + target: (id*) target + action: (SEL*) action +{ + return NO; +} + +- (NSInteger) numberOfItemsInMenu: (NSMenu*) menu +{ + return [super numberOfItemsInMenu: menu]; +} + - (void) menuWillOpen:(NSMenu *)menu { } @@ -756,10 +835,6 @@ prettify_key (const char *key) { return NSZeroRect; } - -- (void)menu:(NSMenu *)menu willHighlightItem:(NSMenuItem *)item -{ -} #endif @end /* EmacsMenu */ @@ -779,7 +854,7 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags, EmacsMenu *pmenu; NSPoint p; Lisp_Object tem; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); widget_value *wv, *first_wv = 0; bool keymaps = (menuflags & MENU_KEYMAPS); @@ -789,6 +864,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; @@ -960,15 +1038,17 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags, pmenu = [[EmacsMenu alloc] initWithTitle: 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; } @@ -1019,6 +1099,15 @@ update_frame_tool_bar_1 (struct frame *f, EmacsToolbar *toolbar) [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. */ @@ -1033,9 +1122,7 @@ update_frame_tool_bar_1 (struct frame *f, EmacsToolbar *toolbar) struct image *img; Lisp_Object image; Lisp_Object labelObj; - const char *labelText; Lisp_Object helpObj; - const char *helpText; /* Check if this is a separator. */ if (EQ (TOOLPROP (TOOL_BAR_ITEM_TYPE), Qt)) @@ -1061,11 +1148,9 @@ update_frame_tool_bar_1 (struct frame *f, EmacsToolbar *toolbar) 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); - helpText = NILP (helpObj) ? "" : SSDATA (helpObj); /* Ignore invalid image specifications. */ if (!valid_image_p (image)) @@ -1087,8 +1172,8 @@ update_frame_tool_bar_1 (struct frame *f, EmacsToolbar *toolbar) [toolbar addDisplayItemWithImage: img->pixmap idx: k++ tag: i - labelText: labelText - helpText: helpText + labelText: [NSString stringWithLispString:labelObj] + helpText: [NSString stringWithLispString:helpObj] enabled: enabled_p]; #undef TOOLPROP } @@ -1204,15 +1289,15 @@ 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 + labelText: (NSString *)label + helpText: (NSString *)help enabled: (BOOL)enabled { NSTRACE ("[EmacsToolbar addDisplayItemWithImage: ...]"); /* 1) come up w/identifier */ - NSString *identifier - = [NSString stringWithFormat: @"%lu", (unsigned long)[img hash]]; + NSString *identifier = [NSString stringWithFormat: @"%lu%@", + (unsigned long)[img hash], label]; [activeIdentifiers addObject: identifier]; /* 2) create / reuse item */ @@ -1222,8 +1307,8 @@ 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 setLabel: label]; + [item setToolTip: help]; [item setTarget: emacsView]; [item setAction: @selector (toolbarClicked:)]; [identifierToItem setObject: item forKey: identifier]; @@ -1467,7 +1552,7 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) isQuestion: isQ]; { - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect_ptr (pop_down_menu, dialog); popup_activated_flag = 1; diff --git a/src/nsselect.m b/src/nsselect.m index 62c67e7a13e..a7ef9df0e0e 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -215,9 +215,78 @@ ns_get_local_selection (Lisp_Object selection_name, static Lisp_Object ns_get_foreign_selection (Lisp_Object symbol, Lisp_Object target) { + NSDictionary *typeLookup; id pb; pb = ns_symbol_to_pb (symbol); - return pb != nil ? ns_string_from_pasteboard (pb) : Qnil; + + /* Dictionary for looking up NS types from MIME types, and vice versa. */ + typeLookup + = [NSDictionary + dictionaryWithObjectsAndKeys: + @"text/plain", NSPasteboardTypeURL, +#if NS_USE_NSPasteboardTypeFileURL + @"text/plain", NSPasteboardTypeFileURL, +#else + @"text/plain", NSFilenamesPboardType, +#endif +#ifdef NS_IMPL_COCOA + /* FIXME: I believe these are actually available in recent + versions of GNUstep. */ + @"text/plain", NSPasteboardTypeMultipleTextSelection, + @"image/png", NSPasteboardTypePNG, +#endif + @"text/html", NSPasteboardTypeHTML, + @"application/pdf", NSPasteboardTypePDF, + @"application/rtf", NSPasteboardTypeRTF, + @"application/rtfd", NSPasteboardTypeRTFD, + @"STRING", NSPasteboardTypeString, + @"text/plain", NSPasteboardTypeTabularText, + @"image/tiff", NSPasteboardTypeTIFF, + nil]; + + if (EQ (target, QTARGETS)) + { + NSMutableArray *types = [NSMutableArray arrayWithCapacity:3]; + + NSString *type; + NSEnumerator *e = [[pb types] objectEnumerator]; + while ((type = [e nextObject])) + { + NSString *val = [typeLookup valueForKey:type]; + if (val && ! [types containsObject:val]) + [types addObject:val]; + } + + Lisp_Object v = Fmake_vector (make_fixnum ([types count]+1), Qnil); + ASET (v, 0, QTARGETS); + + for (int i = 0 ; i < [types count] ; i++) + ASET (v, i+1, intern ([[types objectAtIndex:i] UTF8String])); + + return v; + } + else + { + NSData *d; + NSArray *availableTypes; + NSString *result, *t; + + if (!NILP (target)) + availableTypes + = [typeLookup allKeysForObject: + [NSString stringWithLispString:SYMBOL_NAME (target)]]; + else + availableTypes = [NSArray arrayWithObject:NSPasteboardTypeString]; + + t = [pb availableTypeFromArray:availableTypes]; + + result = [pb stringForType:t]; + if (result) + return [result lispString]; + + d = [pb dataForType:t]; + return make_string ([d bytes], [d length]); + } } @@ -234,8 +303,6 @@ Lisp_Object ns_string_from_pasteboard (id pb) { NSString *type, *str; - const char *utfStr; - int length; type = [pb availableTypeFromArray: ns_return_types]; if (type == nil) @@ -260,6 +327,14 @@ ns_string_from_pasteboard (id pb) } } + /* FIXME: Is the below EOL conversion even needed? I've removed it + for now so we can see if it causes problems. */ + return [str lispString]; + +#if 0 + const char *utfStr; + int length; + /* assume UTF8 */ NS_DURING { @@ -294,6 +369,7 @@ ns_string_from_pasteboard (id pb) NS_ENDHANDLER return make_string (utfStr, length); +#endif } @@ -491,6 +567,8 @@ syms_of_nsselect (void) DEFSYM (QTEXT, "TEXT"); DEFSYM (QFILE_NAME, "FILE_NAME"); + DEFSYM (QTARGETS, "TARGETS"); + defsubr (&Sns_disown_selection_internal); defsubr (&Sns_get_selection); defsubr (&Sns_own_selection_internal); diff --git a/src/nsterm.h b/src/nsterm.h index 911539844a0..4cba5c0be8f 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -357,8 +357,9 @@ typedef id instancetype; @interface NSColor (EmacsColor) + (NSColor *)colorForEmacsRed:(CGFloat)red green:(CGFloat)green blue:(CGFloat)blue alpha:(CGFloat)alpha; ++ (NSColor *)colorWithUnsignedLong:(unsigned long)c; - (NSColor *)colorUsingDefaultColorSpace; - +- (unsigned long)unsignedLong; @end @@ -486,7 +487,7 @@ typedef id instancetype; #endif - (int)fullscreenState; -#ifdef NS_IMPL_COCOA +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 - (void)lockFocus; - (void)unlockFocus; #endif @@ -550,8 +551,8 @@ typedef id instancetype; - (void) addDisplayItemWithImage: (EmacsImage *)img idx: (int)idx tag: (int)tag - labelText: (const char *)label - helpText: (const char *)help + labelText: (NSString *)label + helpText: (NSString *)help enabled: (BOOL)enabled; /* delegate methods */ @@ -697,7 +698,7 @@ typedef id instancetype; + (CGFloat)scrollerWidth; @end -#ifdef NS_IMPL_COCOA +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 @interface EmacsLayer : CALayer { NSMutableArray *cache; @@ -766,35 +767,6 @@ struct ns_bitmap_record int height, width, depth; }; -/* This maps between emacs color indices and NSColor objects. */ -struct ns_color_table -{ - ptrdiff_t size; - ptrdiff_t avail; -#ifdef __OBJC__ - NSColor **colors; - NSMutableSet *empty_indices; -#else - void **items; - void *availIndices; -#endif -}; -#define NS_COLOR_CAPACITY 256 - -#define RGB_TO_ULONG(r, g, b) (((r) << 16) | ((g) << 8) | (b)) -#define ARGB_TO_ULONG(a, r, g, b) (((a) << 24) | ((r) << 16) | ((g) << 8) | (b)) - -#define ALPHA_FROM_ULONG(color) ((color) >> 24) -#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) -#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) -#define BLUE_FROM_ULONG(color) ((color) & 0xff) - -/* Do not change `* 0x101' in the following lines to `<< 8'. If - changed, image masks in 1-bit depth will not work. */ -#define RED16_FROM_ULONG(color) (RED_FROM_ULONG(color) * 0x101) -#define GREEN16_FROM_ULONG(color) (GREEN_FROM_ULONG(color) * 0x101) -#define BLUE16_FROM_ULONG(color) (BLUE_FROM_ULONG(color) * 0x101) - #ifdef NS_IMPL_GNUSTEP /* this extends font backend font */ struct nsfont_info @@ -820,7 +792,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 @@ -850,8 +822,6 @@ struct ns_display_info ptrdiff_t bitmaps_size; ptrdiff_t bitmaps_last; - struct ns_color_table *color_table; - /* DPI resolution of this screen */ double resx, resy; @@ -978,6 +948,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. */ @@ -1121,13 +1097,9 @@ ns_defined_color (struct frame *f, const char *name, Emacs_Color *color_def, bool alloc, bool makeIndex); -extern void -ns_query_color (void *col, Emacs_Color *color_def, bool setPixel); #ifdef __OBJC__ extern int ns_lisp_to_color (Lisp_Object color, NSColor **col); -extern NSColor *ns_lookup_indexed_color (unsigned long idx, struct frame *f); -extern unsigned long ns_index_color (NSColor *color, struct frame *f); extern const char *ns_get_pending_menu_title (void); #endif @@ -1340,9 +1312,16 @@ enum NSWindowTabbingMode #if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_14) /* Deprecated in macOS 10.14. */ +/* FIXME: Some of these new names, if not all, are actually available + in some recent version of GNUstep. */ #define NSPasteboardTypeString NSStringPboardType #define NSPasteboardTypeTabularText NSTabularTextPboardType #define NSPasteboardTypeURL NSURLPboardType +#define NSPasteboardTypeHTML NSHTMLPboardType +#define NSPasteboardTypePDF NSPDFPboardType +#define NSPasteboardTypeRTF NSRTFPboardType +#define NSPasteboardTypeRTFD NSRTFDPboardType +#define NSPasteboardTypeTIFF NSTIFFPboardType #define NSControlStateValueOn NSOnState #define NSControlStateValueOff NSOffState #define NSBezelStyleRounded NSRoundedBezelStyle diff --git a/src/nsterm.m b/src/nsterm.m index 40540c47be1..550f29212e9 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -65,6 +65,7 @@ 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 @@ -165,6 +166,27 @@ char const * nstrace_fullscreen_type_name (int fs_type) return [self colorUsingColorSpace: [NSColorSpace deviceRGBColorSpace]]; } ++ (NSColor *)colorWithUnsignedLong:(unsigned long)c +{ + EmacsCGFloat a = (double)((c >> 24) & 0xff) / 255.0; + EmacsCGFloat r = (double)((c >> 16) & 0xff) / 255.0; + EmacsCGFloat g = (double)((c >> 8) & 0xff) / 255.0; + EmacsCGFloat b = (double)(c & 0xff) / 255.0; + + return [NSColor colorForEmacsRed:r green:g blue:b alpha:a]; +} + +- (unsigned long)unsignedLong +{ + EmacsCGFloat r, g, b, a; + [self getRed:&r green:&g blue:&b alpha:&a]; + + return (((unsigned long) (a * 255)) << 24) + | (((unsigned long) (r * 255)) << 16) + | (((unsigned long) (g * 255)) << 8) + | ((unsigned long) (b * 255)); +} + @end /* ========================================================================== @@ -431,14 +453,6 @@ ev_modifiers_helper (unsigned int flags, unsigned int left_mask, } -/* These flags will be OR'd or XOR'd with the NSWindow's styleMask - property depending on what we're doing. */ -#define FRAME_DECORATED_FLAGS (NSWindowStyleMaskTitled \ - | NSWindowStyleMaskResizable \ - | NSWindowStyleMaskMiniaturizable \ - | NSWindowStyleMaskClosable) -#define FRAME_UNDECORATED_FLAGS NSWindowStyleMaskBorderless - /* TODO: Get rid of need for these forward declarations. */ static void ns_condemn_scroll_bars (struct frame *f); static void ns_judge_scroll_bars (struct frame *f); @@ -534,8 +548,11 @@ ns_init_locale (void) NSTRACE ("ns_init_locale"); - @try + /* If we were run from a terminal then assume an unset LANG variable + is intentional and don't try to "fix" it. */ + if (!isatty (STDIN_FILENO)) { + char *oldLocale = setlocale (LC_ALL, NULL); /* It seems macOS should probably use UTF-8 everywhere. 'localeIdentifier' does not specify the encoding, and I can't find any way to get the OS to tell us which encoding to use, @@ -543,12 +560,12 @@ ns_init_locale (void) NSString *localeID = [NSString stringWithFormat:@"%@.UTF-8", [locale localeIdentifier]]; - /* Set LANG to locale, but not if LANG is already set. */ - setenv("LANG", [localeID UTF8String], 0); - } - @catch (NSException *e) - { - NSLog (@"Locale detection failed: %@: %@", [e name], [e reason]); + /* Check the locale ID is valid and if so set LANG, but not if + it is already set. */ + if (setlocale (LC_ALL, [localeID UTF8String])) + setenv("LANG", [localeID UTF8String], 0); + + setlocale (LC_ALL, oldLocale); } } @@ -1043,7 +1060,7 @@ ns_update_end (struct frame *f) block_input (); [view unlockFocus]; -#if defined (NS_IMPL_GNUSTEP) +#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 [[view window] flushWindow]; #endif @@ -1077,11 +1094,16 @@ ns_focus (struct frame *f, NSRect *r, int n) /* 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; } } @@ -1105,7 +1127,7 @@ ns_unfocus (struct frame *f) { EmacsView *view = FRAME_NS_VIEW (f); [view unlockFocus]; -#if defined (NS_IMPL_GNUSTEP) +#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 [[view window] flushWindow]; #endif } @@ -1595,10 +1617,17 @@ ns_destroy_window (struct frame *f) /* If this frame has a parent window, detach it as not doing so can cause a crash in GNUStep. */ - if (FRAME_PARENT_FRAME (f) != NULL) + if (FRAME_PARENT_FRAME (f)) { NSWindow *child = [FRAME_NS_VIEW (f) window]; - NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window]; + NSWindow *parent; + + /* Pacify a incorrect GCC warning about FRAME_PARENT_FRAME (f) + being NULL. */ + if (FRAME_PARENT_FRAME (f)) + parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window]; + else + emacs_abort (); [parent removeChildWindow: child]; } @@ -1940,59 +1969,6 @@ ns_fullscreen_hook (struct frame *f) ========================================================================== */ -NSColor * -ns_lookup_indexed_color (unsigned long idx, struct frame *f) -{ - struct ns_color_table *color_table = FRAME_DISPLAY_INFO (f)->color_table; - if (idx < 1 || idx >= color_table->avail) - return nil; - return color_table->colors[idx]; -} - - -unsigned long -ns_index_color (NSColor *color, struct frame *f) -{ - struct ns_color_table *color_table = FRAME_DISPLAY_INFO (f)->color_table; - ptrdiff_t idx; - ptrdiff_t i; - - if (!color_table->colors) - { - color_table->size = NS_COLOR_CAPACITY; - color_table->avail = 1; /* skip idx=0 as marker */ - color_table->colors = xmalloc (color_table->size * sizeof (NSColor *)); - color_table->colors[0] = nil; - color_table->empty_indices = [[NSMutableSet alloc] init]; - } - - /* Do we already have this color? */ - for (i = 1; i < color_table->avail; i++) - if (color_table->colors[i] && [color_table->colors[i] isEqual: color]) - return i; - - if ([color_table->empty_indices count] > 0) - { - NSNumber *index = [color_table->empty_indices anyObject]; - [color_table->empty_indices removeObject: index]; - idx = [index unsignedLongValue]; - } - else - { - if (color_table->avail == color_table->size) - color_table->colors = - xpalloc (color_table->colors, &color_table->size, 1, - min (ULONG_MAX, PTRDIFF_MAX), sizeof *color_table->colors); - idx = color_table->avail++; - } - - color_table->colors[idx] = color; - [color retain]; - /* fprintf(stderr, "color_table: allocated %d\n",idx); */ - return idx; -} - - static int ns_get_color (const char *name, NSColor **col) /* -------------------------------------------------------------------------- @@ -2117,31 +2093,11 @@ ns_lisp_to_color (Lisp_Object color, NSColor **col) return 1; } -/* Convert an index into the color table into an RGBA value. Used in - xdisp.c:extend_face_to_end_of_line when comparing faces and frame - color values. */ - -unsigned long -ns_color_index_to_rgba(int idx, struct frame *f) -{ - NSColor *col; - col = ns_lookup_indexed_color (idx, f); - - EmacsCGFloat r, g, b, a; - [col getRed: &r green: &g blue: &b alpha: &a]; - - return ARGB_TO_ULONG((unsigned long) (a * 255), - (unsigned long) (r * 255), - (unsigned long) (g * 255), - (unsigned long) (b * 255)); -} - -void -ns_query_color(void *col, Emacs_Color *color_def, bool setPixel) +static void +ns_query_color (void *col, Emacs_Color *color_def) /* -------------------------------------------------------------------------- - Get ARGB values out of NSColor col and put them into color_def. - If setPixel, set the pixel to a concatenated version. - and set color_def pixel to the resulting index. + Get ARGB values out of NSColor col and put them into color_def + and set color_def pixel to the ARGB color. -------------------------------------------------------------------------- */ { EmacsCGFloat r, g, b, a; @@ -2151,12 +2107,7 @@ ns_query_color(void *col, Emacs_Color *color_def, bool setPixel) color_def->green = g * 65535; color_def->blue = b * 65535; - if (setPixel == YES) - color_def->pixel - = ARGB_TO_ULONG((unsigned long) (a * 255), - (unsigned long) (r * 255), - (unsigned long) (g * 255), - (unsigned long) (b * 255)); + color_def->pixel = [(NSColor *)col unsignedLong]; } bool @@ -2164,12 +2115,9 @@ ns_defined_color (struct frame *f, const char *name, Emacs_Color *color_def, bool alloc, - bool makeIndex) + bool _makeIndex) /* -------------------------------------------------------------------------- Return true if named color found, and set color_def rgb accordingly. - If makeIndex and alloc are nonzero put the color in the color_table, - and set color_def pixel to the resulting index. - If makeIndex is zero, set color_def pixel to ARGB. Return false if not found. -------------------------------------------------------------------------- */ { @@ -2182,9 +2130,7 @@ ns_defined_color (struct frame *f, unblock_input (); return 0; } - if (makeIndex && alloc) - color_def->pixel = ns_index_color (col, f); - ns_query_color (col, color_def, !makeIndex); + ns_query_color (col, color_def); unblock_input (); return 1; } @@ -2195,7 +2141,7 @@ ns_query_frame_background_color (struct frame *f, Emacs_Color *bgcolor) External (hook): Store F's background color into *BGCOLOR -------------------------------------------------------------------------- */ { - ns_query_color (FRAME_BACKGROUND_COLOR (f), bgcolor, true); + ns_query_color (FRAME_BACKGROUND_COLOR (f), bgcolor); } static void @@ -2249,13 +2195,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 } @@ -2318,6 +2270,7 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, Lisp_Object frame, tail; struct frame *f = NULL; struct ns_display_info *dpyinfo; + bool return_no_frame_flag = false; NSTRACE ("ns_mouse_position"); @@ -2361,15 +2314,25 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, #endif if (!f) - f = dpyinfo->ns_focus_frame ? dpyinfo->ns_focus_frame : SELECTED_FRAME (); + { + f = (dpyinfo->ns_focus_frame + ? dpyinfo->ns_focus_frame : SELECTED_FRAME ()); + return_no_frame_flag = EQ (track_mouse, Qdrag_source); + } + + if (!FRAME_NS_P (f)) + f = NULL; /* While dropping, use the last mouse frame only if there is no currently focused frame. */ - if (!f - && EQ (track_mouse, Qdropping) + if (!f && (EQ (track_mouse, Qdropping) + || EQ (track_mouse, Qdrag_source)) && dpyinfo->last_mouse_frame && FRAME_LIVE_P (dpyinfo->last_mouse_frame)) - f = dpyinfo->last_mouse_frame; + { + f = dpyinfo->last_mouse_frame; + return_no_frame_flag = EQ (track_mouse, Qdrag_source); + } if (f && FRAME_NS_P (f)) { @@ -2388,7 +2351,7 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, if (y) XSETINT (*y, lrint (view_position.y)); if (time) *time = dpyinfo->last_mouse_movement_time; - *fp = f; + *fp = return_no_frame_flag ? NULL : f; } unblock_input (); @@ -2433,9 +2396,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); } } @@ -2571,8 +2531,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) { @@ -2612,15 +2571,14 @@ ns_clear_frame (struct frame *f) block_input (); ns_focus (f, &r, 1); - [ns_lookup_indexed_color (NS_FACE_BACKGROUND - (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set]; + [[NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND + (FACE_FROM_ID (f, DEFAULT_FACE_ID))] set]; NSRectFill (r); ns_unfocus (f); - /* as of 2006/11 or so this is now needed */ - /* FIXME: I don't see any reason for this and removing it makes no - difference here. Do we need it for GNUstep? */ - //ns_redraw_scroll_bars (f); +#ifdef NS_IMPL_GNUSTEP + ns_redraw_scroll_bars (f); +#endif unblock_input (); } @@ -2642,7 +2600,7 @@ ns_clear_frame_area (struct frame *f, int x, int y, int width, int height) r = NSIntersectionRect (r, [view frame]); ns_focus (f, &r, 1); - [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; + [[NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] set]; NSRectFill (r); @@ -2745,8 +2703,7 @@ ns_clear_under_internal_border (struct frame *f) return; ns_focus (f, NULL, 1); - [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; - + [[NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] set]; NSRectFill (NSMakeRect (0, margin, width, border)); NSRectFill (NSMakeRect (0, 0, border, height)); NSRectFill (NSMakeRect (0, margin, width, border)); @@ -2797,7 +2754,7 @@ ns_after_update_window_line (struct window *w, struct glyph_row *desired_row) NSRect r = NSMakeRect (0, y, FRAME_PIXEL_WIDTH (f), height); ns_focus (f, &r, 1); - [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; + [[NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] set]; NSRectFill (NSMakeRect (0, y, width, height)); NSRectFill (NSMakeRect (FRAME_PIXEL_WIDTH (f) - width, y, width, height)); @@ -2847,31 +2804,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; } } @@ -2965,11 +2922,19 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row, { NSTRACE_RECT ("clearRect", clearRect); - [ns_lookup_indexed_color(face->background, f) set]; + [[NSColor colorWithUnsignedLong:face->background] set]; NSRectFill (clearRect); } NSBezierPath *bmp = [fringe_bmp objectForKey:[NSNumber numberWithInt:p->which]]; + + if (bmp == nil + && p->which < max_used_fringe_bitmap) + { + gui_define_fringe_bitmap (f, p->which); + bmp = [fringe_bmp objectForKey: [NSNumber numberWithInt: p->which]]; + } + if (bmp) { NSAffineTransform *transform = [NSAffineTransform transform]; @@ -2982,9 +2947,9 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row, [bmp transformUsingAffineTransform:transform]; if (!p->cursor_p) - bm_color = ns_lookup_indexed_color(face->foreground, f); + bm_color = [NSColor colorWithUnsignedLong:face->foreground]; else if (p->overlay_p) - bm_color = ns_lookup_indexed_color(face->background, f); + bm_color = [NSColor colorWithUnsignedLong:face->background]; else bm_color = f->output_data.ns->cursor_color; @@ -3011,14 +2976,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; @@ -3034,6 +2998,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]) { @@ -3043,10 +3009,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 @@ -3078,17 +3040,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) { @@ -3096,13 +3058,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); @@ -3118,12 +3078,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); } @@ -3143,7 +3100,7 @@ ns_draw_vertical_window_border (struct window *w, int x, int y0, int y1) ns_focus (f, &r, 1); if (face) - [ns_lookup_indexed_color(face->foreground, f) set]; + [[NSColor colorWithUnsignedLong:face->foreground] set]; NSRectFill(r); ns_unfocus (f); @@ -3179,29 +3136,29 @@ ns_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) /* A vertical divider, at least three pixels wide: Draw first and last pixels differently. */ { - [ns_lookup_indexed_color(color_first, f) set]; + [[NSColor colorWithUnsignedLong:color_first] set]; NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0)); - [ns_lookup_indexed_color(color, f) set]; + [[NSColor colorWithUnsignedLong:color] set]; NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0)); - [ns_lookup_indexed_color(color_last, f) set]; + [[NSColor colorWithUnsignedLong:color_last] set]; NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0)); } else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) /* A horizontal divider, at least three pixels high: Draw first and last pixels differently. */ { - [ns_lookup_indexed_color(color_first, f) set]; + [[NSColor colorWithUnsignedLong:color_first] set]; NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1)); - [ns_lookup_indexed_color(color, f) set]; + [[NSColor colorWithUnsignedLong:color] set]; NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2)); - [ns_lookup_indexed_color(color_last, f) set]; + [[NSColor colorWithUnsignedLong:color_last] set]; NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1)); } else { /* In any other case do not draw the first and last pixels differently. */ - [ns_lookup_indexed_color(color, f) set]; + [[NSColor colorWithUnsignedLong:color] set]; NSRectFill(divider); } @@ -3303,15 +3260,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 + [defaultCol 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]; + if (!face->underline_defaulted_p) + [[NSColor colorWithUnsignedLong:face->underline_color] set]; ns_draw_underwave (s, width, x); } @@ -3324,7 +3284,11 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, /* If the prev was underlined, match its appearance. */ if (s->prev && s->prev->face->underline == FACE_UNDER_LINE - && s->prev->underline_thickness > 0) + && s->prev->underline_thickness > 0 + && (s->prev->face->underline_at_descent_line_p + == s->face->underline_at_descent_line_p) + && (s->prev->face->underline_pixels_above_descent_line + == s->face->underline_pixels_above_descent_line)) { thickness = s->prev->underline_thickness; position = s->prev->underline_position; @@ -3345,7 +3309,8 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, val = (WINDOW_BUFFER_LOCAL_VALUE (Qx_underline_at_descent_line, s->w)); - underline_at_descent_line = !(NILP (val) || EQ (val, Qunbound)); + underline_at_descent_line = (!(NILP (val) || EQ (val, Qunbound)) + || s->face->underline_at_descent_line_p); val = (WINDOW_BUFFER_LOCAL_VALUE (Qx_use_underline_position_properties, s->w)); @@ -3358,7 +3323,8 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, /* Determine the offset of underlining from the baseline. */ if (underline_at_descent_line) - position = descent - thickness; + position = (descent - thickness + - s->face->underline_pixels_above_descent_line); else if (use_underline_position_properties && font && font->underline_position >= 0) position = font->underline_position; @@ -3367,7 +3333,8 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, else position = minimum_offset; - position = max (position, minimum_offset); + if (!s->face->underline_pixels_above_descent_line) + position = max (position, minimum_offset); /* Ensure underlining is not cropped. */ if (descent <= position) @@ -3384,10 +3351,9 @@ ns_draw_text_decoration (struct glyph_string *s, struct face *face, 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]; + if (!face->underline_defaulted_p) + [[NSColor colorWithUnsignedLong:face->underline_color] set]; + NSRectFill (r); } } @@ -3398,10 +3364,9 @@ 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]; + if (!face->overline_color_defaulted_p) + [[NSColor colorWithUnsignedLong:face->overline_color] set]; + NSRectFill (r); } @@ -3424,10 +3389,9 @@ 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]; + if (!face->strike_through_color_defaulted_p) + [[NSColor colorWithUnsignedLong:face->strike_through_color] set]; + NSRectFill (r); } } @@ -3485,7 +3449,7 @@ ns_draw_relief (NSRect outer, int hthickness, int vthickness, char raised_p, if (s->face->use_box_color_for_shadows_p) { - newBaseCol = ns_lookup_indexed_color (s->face->box_color, s->f); + newBaseCol = [NSColor colorWithUnsignedLong:s->face->box_color]; } /* else if (s->first_glyph->type == IMAGE_GLYPH && s->img->pixmap @@ -3495,7 +3459,7 @@ ns_draw_relief (NSRect outer, int hthickness, int vthickness, char raised_p, } */ else { - newBaseCol = ns_lookup_indexed_color (s->face->background, s->f); + newBaseCol = [NSColor colorWithUnsignedLong:s->face->background]; } if (newBaseCol == nil) @@ -3575,17 +3539,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; @@ -3627,7 +3581,7 @@ ns_dumpglyphs_box_or_relief (struct glyph_string *s) if (s->face->box == FACE_SIMPLE_BOX && s->face->box_color) { ns_draw_box (r, abs (hthickness), abs (vthickness), - ns_lookup_indexed_color (face->box_color, s->f), + [NSColor colorWithUnsignedLong:face->box_color], left_p, right_p); } else @@ -3659,34 +3613,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 + ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] + : 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; } @@ -3707,7 +3653,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"); @@ -3728,17 +3674,8 @@ 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]; + [[NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] set]; if (bg_height > s->slice.height || s->img->hmargin || s->img->vmargin || s->img->mask || s->img->pixmap == 0 || s->width != s->background_width) @@ -3807,20 +3744,12 @@ 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) - 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); + [FRAME_CURSOR_COLOR (s->f) set]; + tdCol = [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)]; } else { - tdCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); + tdCol = [NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)]; } /* Draw underline, overline, strike-through. */ @@ -3868,66 +3797,39 @@ 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); - - glyphRect = NSMakeRect (s->x, s->y, s->background_width, s->height); - - [bgCol set]; + bgCol = [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)]; + fgCol = [NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)]; - /* 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; + { + fgCol = bgCol; + bgCol = FRAME_CURSOR_COLOR (s->f); + } - /* 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; + glyphRect = NSMakeRect (s->x, s->y, s->background_width, s->height); - NSRectFill (glyphRect); + [bgCol set]; - /* 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)); + /* Draw overlining, etc. on the stretch glyph (or the part of + the stretch glyph after the cursor). If the glyph has a box, + then decorations will be drawn after drawing the box in + ns_draw_glyph_string, in order to prevent them from being + overwritten by the box. */ + if (s->face->box == FACE_NO_BOX) + ns_draw_text_decoration (s, face, fgCol, NSWidth (glyphRect), + NSMinX (glyphRect)); - ns_unfocus (s->f); s->background_filled_p = 1; } } @@ -3936,7 +3838,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 @@ -3947,15 +3849,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); } @@ -4062,9 +3958,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; @@ -4074,17 +3970,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; } } @@ -4101,14 +3997,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: @@ -4121,57 +4024,34 @@ 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 + ? [NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (s->face)] + : FRAME_FOREGROUND_COLOR (s->f)); - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; - } + /* Draw underline, overline, strike-through. */ + ns_draw_text_decoration (s, s->face, col, s->width, s->x); + } + } - 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; @@ -4181,7 +4061,6 @@ ns_draw_glyph_string (struct glyph_string *s) /* ... */ /* Not yet implemented. */ /* ... */ - ns_unfocus (s->f); break; default: @@ -4190,13 +4069,102 @@ 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); + + if (s->face->box != FACE_NO_BOX + && s->first_glyph->type == STRETCH_GLYPH) { - n = ns_get_glyph_string_clip_rect (s, r); - ns_focus (s->f, r, n); - ns_dumpglyphs_box_or_relief (s); + NSColor *fg_color; + + fg_color = [NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (s->face)]; + ns_draw_text_decoration (s, s->face, fg_color, + s->background_width, s->x); + } + + ns_unfocus (s->f); + + /* Draw surrounding overhangs. */ + if (s->prev) + { + 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; + + prev->hl = s->hl; + NSRect r = NSMakeRect (s->x, s->y, s->width, s->height); + NSRect rc; + get_glyph_string_clip_rect (s, &rc); + [[NSGraphicsContext currentContext] saveGraphicsState]; + NSRectClip (r); + if (n) + NSRectClip (rc); +#ifdef NS_IMPL_GNUSTEP + DPSgsave ([NSGraphicsContext currentContext]); + DPSrectclip ([NSGraphicsContext currentContext], s->x, s->y, + s->width, s->height); + DPSrectclip ([NSGraphicsContext currentContext], NSMinX (rc), + NSMinY (rc), NSWidth (rc), NSHeight (rc)); +#endif + 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; + } 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; + + next->hl = s->hl; + NSRect r = NSMakeRect (s->x, s->y, s->width, s->height); + NSRect rc; + get_glyph_string_clip_rect (s, &rc); + [[NSGraphicsContext currentContext] saveGraphicsState]; + NSRectClip (r); + NSRectClip (rc); +#ifdef NS_IMPL_GNUSTEP + DPSgsave ([NSGraphicsContext currentContext]); + DPSrectclip ([NSGraphicsContext currentContext], s->x, s->y, + s->width, s->height); + DPSrectclip ([NSGraphicsContext currentContext], NSMinX (rc), + NSMinY (rc), NSWidth (rc), NSHeight (rc)); +#endif + 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->clip_head = s->next; + } + ns_unfocus (s->f); + } s->num_clips = 0; } @@ -4546,7 +4514,7 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, #ifdef HAVE_PTHREAD void -ns_run_loop_break () +ns_run_loop_break (void) /* Break out of the NS run loop in ns_select or ns_read_socket. */ { NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_run_loop_break"); @@ -4927,8 +4895,6 @@ ns_initialize_display_info (struct ns_display_info *dpyinfo) && ![NSCalibratedWhiteColorSpace isEqualToString: NSColorSpaceFromDepth (depth)]; dpyinfo->n_planes = NSBitsPerPixelFromDepth (depth); - dpyinfo->color_table = xmalloc (sizeof *dpyinfo->color_table); - dpyinfo->color_table->colors = NULL; dpyinfo->root_window = 42; /* A placeholder. */ dpyinfo->highlight_frame = dpyinfo->ns_focus_frame = NULL; dpyinfo->n_fonts = 0; @@ -4946,6 +4912,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 @@ -4962,7 +4939,11 @@ 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, @@ -5201,11 +5182,9 @@ ns_term_init (Lisp_Object display_name) color = XCAR (color_map); name = XCAR (color); c = XFIXNUM (XCDR (color)); + c |= 0xFF000000; [cl setColor: - [NSColor colorForEmacsRed: RED_FROM_ULONG (c) / 255.0 - green: GREEN_FROM_ULONG (c) / 255.0 - blue: BLUE_FROM_ULONG (c) / 255.0 - alpha: 1.0] + [NSColor colorWithUnsignedLong:c] forKey: [NSString stringWithLispString: name]]; } @@ -5870,7 +5849,7 @@ not_in_argv (NSString *arg) fd_set fds; FD_ZERO (&fds); FD_SET (selfds[0], &fds); - result = select (selfds[0]+1, &fds, NULL, NULL, NULL); + result = pselect (selfds[0]+1, &fds, NULL, NULL, NULL, NULL); if (result > 0 && read (selfds[0], &c, 1) == 1 && c == 'g') waiting = 0; } @@ -6014,17 +5993,15 @@ not_in_argv (NSString *arg) /* Called on font panel selection. */ - (void)changeFont: (id)sender { - NSEvent *e = [[self window] currentEvent]; struct face *face = FACE_FROM_ID (emacsframe, DEFAULT_FACE_ID); struct font *font = face->font; id newFont; CGFloat size; NSFont *nsfont; + struct input_event ie; NSTRACE ("[EmacsView changeFont:]"); - - if (!emacs_event) - return; + EVENT_INIT (ie); #ifdef NS_IMPL_GNUSTEP nsfont = ((struct nsfont_info *)font)->nsfont; @@ -6035,16 +6012,16 @@ not_in_argv (NSString *arg) if ((newFont = [sender convertFont: nsfont])) { - SET_FRAME_GARBAGED (emacsframe); /* now needed as of 2008/10 */ - - emacs_event->kind = NS_NONKEY_EVENT; - emacs_event->modifiers = 0; - emacs_event->code = KEY_NS_CHANGE_FONT; + ie.kind = NS_NONKEY_EVENT; + ie.modifiers = 0; + ie.code = KEY_NS_CHANGE_FONT; + XSETFRAME (ie.frame_or_window, emacsframe); size = [newFont pointSize]; ns_input_fontsize = make_fixnum (lrint (size)); ns_input_font = [[newFont familyName] lispString]; - EV_TRAILER (e); + + kbd_buffer_store_event (&ie); } } @@ -6189,9 +6166,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. */ @@ -6561,8 +6540,25 @@ not_in_argv (NSString *arg) */ bool horizontal; int lines = 0; + int x = 0, y = 0; int scrollUp = NO; + static bool end_flag = false; + + if (!ns_use_mwheel_momentum && !end_flag + && [theEvent momentumPhase] != NSEventPhaseNone) + { + emacs_event->kind = TOUCH_END_EVENT; + emacs_event->arg = Qnil; + end_flag = [theEvent momentumPhase] != NSEventPhaseNone; + XSETINT (emacs_event->x, lrint (p.x)); + XSETINT (emacs_event->y, lrint (p.y)); + EV_TRAILER (theEvent); + return; + } + + end_flag = [theEvent momentumPhase] != NSEventPhaseNone; + /* FIXME: At the top or bottom of the buffer we should * ignore momentum-phase events. */ if (! ns_use_mwheel_momentum @@ -6596,23 +6592,33 @@ not_in_argv (NSString *arg) * reset the total delta for the direction we're NOT * scrolling so that small movements don't add up. */ if (abs (totalDeltaX) > abs (totalDeltaY) - && abs (totalDeltaX) > lineHeight) + && (!mwheel_coalesce_scroll_events + || abs (totalDeltaX) > lineHeight)) { horizontal = YES; scrollUp = totalDeltaX > 0; lines = abs (totalDeltaX / lineHeight); - totalDeltaX = totalDeltaX % lineHeight; + x = totalDeltaX; + if (!mwheel_coalesce_scroll_events) + totalDeltaX = 0; + else + totalDeltaX = totalDeltaX % lineHeight; totalDeltaY = 0; } else if (abs (totalDeltaY) >= abs (totalDeltaX) - && abs (totalDeltaY) > lineHeight) + && (!mwheel_coalesce_scroll_events + || abs (totalDeltaY) > lineHeight)) { horizontal = NO; scrollUp = totalDeltaY > 0; lines = abs (totalDeltaY / lineHeight); - totalDeltaY = totalDeltaY % lineHeight; + y = totalDeltaY; + if (!mwheel_coalesce_scroll_events) + totalDeltaY = 0; + else + totalDeltaY = totalDeltaY % lineHeight; totalDeltaX = 0; } @@ -6638,13 +6644,25 @@ not_in_argv (NSString *arg) ? ceil (fabs (delta)) : 1; scrollUp = delta > 0; + x = ([theEvent scrollingDeltaX] + * FRAME_COLUMN_WIDTH (emacsframe)); + y = ([theEvent scrollingDeltaY] + * FRAME_LINE_HEIGHT (emacsframe)); } - if (lines == 0) + if (lines == 0 && mwheel_coalesce_scroll_events) return; + if (NUMBERP (Vns_scroll_event_delta_factor)) + { + x *= XFLOATINT (Vns_scroll_event_delta_factor); + y *= XFLOATINT (Vns_scroll_event_delta_factor); + } + emacs_event->kind = horizontal ? HORIZ_WHEEL_EVENT : WHEEL_EVENT; - emacs_event->arg = (make_fixnum (lines)); + emacs_event->arg = list3 (make_fixnum (lines), + make_float (x), + make_float (y)); emacs_event->code = 0; emacs_event->modifiers = EV_MODIFIERS (theEvent) | @@ -6704,6 +6722,11 @@ not_in_argv (NSString *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)); @@ -6792,6 +6815,7 @@ not_in_argv (NSString *arg) if (WINDOWP (window) && !EQ (window, last_mouse_window) && !EQ (window, selected_window) + && !MINI_WINDOW_P (XWINDOW (selected_window)) && (!NILP (focus_follows_mouse) || (EQ (XWINDOW (window)->frame, XWINDOW (selected_window)->frame)))) @@ -6845,6 +6869,42 @@ not_in_argv (NSString *arg) [self mouseMoved: e]; } +#ifdef NS_IMPL_COCOA +- (void) magnifyWithEvent: (NSEvent *) event +{ + NSPoint pt = [self convertPoint: [event locationInWindow] fromView: nil]; + static CGFloat last_scale; + + NSTRACE ("[EmacsView magnifyWithEvent]"); + if (emacs_event) + { + emacs_event->kind = PINCH_EVENT; + emacs_event->modifiers = EV_MODIFIERS (event); + XSETINT (emacs_event->x, lrint (pt.x)); + XSETINT (emacs_event->y, lrint (pt.y)); + XSETFRAME (emacs_event->frame_or_window, emacsframe); + + if ([event phase] == NSEventPhaseBegan) + { + last_scale = 1.0 + [event magnification]; + emacs_event->arg = list4 (make_float (0.0), + make_float (0.0), + make_float (last_scale), + make_float (0.0)); + } + else + /* Report a tiny change so that Lisp code doesn't think this + is the beginning of an event sequence. This is the best we + can do because NS doesn't report pinch events in as much + detail as XInput 2 or GTK+ do. */ + emacs_event->arg = list4 (make_float (0.01), + make_float (0.0), + make_float (last_scale += [event magnification]), + make_float (0.0)); + EV_TRAILER (event); + } +} +#endif - (BOOL)windowShouldClose: (id)sender { @@ -7004,7 +7064,6 @@ not_in_argv (NSString *arg) height = (int)NSHeight (frame); NSTRACE_SIZE ("New size", NSMakeSize (width, height)); - NSTRACE_SIZE ("Original size", size); /* Reset the frame size to match the bounds of the superview (the NSWindow's contentView). We need to do this as sometimes the @@ -7030,6 +7089,9 @@ not_in_argv (NSString *arg) { struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe); struct frame *old_focus = dpyinfo->ns_focus_frame; + struct input_event event; + + EVENT_INIT (event); NSTRACE ("[EmacsView windowDidBecomeKey]"); @@ -7038,11 +7100,9 @@ not_in_argv (NSString *arg) ns_frame_rehighlight (emacsframe); - if (emacs_event) - { - emacs_event->kind = FOCUS_IN_EVENT; - EV_TRAILER ((id)nil); - } + event.kind = FOCUS_IN_EVENT; + XSETFRAME (event.frame_or_window, emacsframe); + kbd_buffer_store_event (&event); } @@ -7073,6 +7133,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) @@ -7147,7 +7208,7 @@ not_in_argv (NSString *arg) [[EmacsWindow alloc] initWithEmacsFrame:f]; -#ifdef NS_IMPL_COCOA +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 /* 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 @@ -7553,7 +7614,7 @@ not_in_argv (NSString *arg) EmacsWindow *w, *fw; BOOL onFirstScreen; struct frame *f; - NSRect r, wr; + NSRect r; NSColor *col; NSTRACE ("[EmacsView toggleFullScreen:]"); @@ -7572,10 +7633,8 @@ not_in_argv (NSString *arg) w = (EmacsWindow *)[self window]; onFirstScreen = [[w screen] isEqual:[[NSScreen screens] objectAtIndex:0]]; f = emacsframe; - wr = [w frame]; - col = ns_lookup_indexed_color (NS_FACE_BACKGROUND - (FACE_FROM_ID (f, DEFAULT_FACE_ID)), - f); + col = [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND + (FACE_FROM_ID (f, DEFAULT_FACE_ID))]; if (fs_state != FULLSCREEN_BOTH) { @@ -7813,8 +7872,8 @@ not_in_argv (NSString *arg) } -#ifdef NS_IMPL_COCOA -- (CALayer *)makeBackingLayer; +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 +- (CALayer *)makeBackingLayer { EmacsLayer *l = [[EmacsLayer alloc] initWithColorSpace:[[[self window] colorSpace] CGColorSpace]]; @@ -7829,19 +7888,12 @@ not_in_argv (NSString *arg) { NSTRACE ("[EmacsView lockFocus]"); - if ([self wantsLayer]) - { - CGContextRef context = [(EmacsLayer*)[self layer] getContext]; + CGContextRef context = [(EmacsLayer*)[self layer] getContext]; - [NSGraphicsContext + [NSGraphicsContext setCurrentContext:[NSGraphicsContext graphicsContextWithCGContext:context flipped:YES]]; - } -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - else - [super lockFocus]; -#endif } @@ -7849,18 +7901,8 @@ not_in_argv (NSString *arg) { NSTRACE ("[EmacsView unlockFocus]"); - if ([self wantsLayer]) - { - [NSGraphicsContext setCurrentContext:nil]; - [self setNeedsDisplay:YES]; - } -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - else - { - [super unlockFocus]; - [super flushWindow]; - } -#endif + [NSGraphicsContext setCurrentContext:nil]; + [self setNeedsDisplay:YES]; } @@ -7869,19 +7911,16 @@ not_in_argv (NSString *arg) { NSTRACE ("EmacsView windowDidChangeBackingProperties:]"); - if ([self wantsLayer]) - { - NSRect frame = [self frame]; - EmacsLayer *layer = (EmacsLayer *)[self layer]; + NSRect frame = [self frame]; + EmacsLayer *layer = (EmacsLayer *)[self layer]; - [layer setContentsScale:[[notification object] backingScaleFactor]]; - [layer setColorSpace:[[[notification object] colorSpace] CGColorSpace]]; + [layer setContentsScale:[[notification object] backingScaleFactor]]; + [layer setColorSpace:[[[notification object] colorSpace] CGColorSpace]]; - ns_clear_frame (emacsframe); - expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame)); - } + ns_clear_frame (emacsframe); + expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame)); } -#endif /* NS_IMPL_COCOA */ +#endif - (void)copyRect:(NSRect)srcRect to:(NSPoint)dest @@ -7893,57 +7932,45 @@ not_in_argv (NSString *arg) NSRect dstRect = NSMakeRect (dest.x, dest.y, NSWidth (srcRect), NSHeight (srcRect)); -#ifdef NS_IMPL_COCOA - if ([self wantsLayer]) - { - double scale = [[self window] backingScaleFactor]; - CGContextRef context = [(EmacsLayer *)[self layer] getContext]; - int bpp = CGBitmapContextGetBitsPerPixel (context) / 8; - void *pixels = CGBitmapContextGetData (context); - int rowSize = CGBitmapContextGetBytesPerRow (context); - int srcRowSize = NSWidth (srcRect) * scale * bpp; - void *srcPixels = (char *) pixels - + (int) (NSMinY (srcRect) * scale * rowSize - + NSMinX (srcRect) * scale * bpp); - void *dstPixels = (char *) pixels - + (int) (dest.y * scale * rowSize - + dest.x * scale * bpp); - - if (NSIntersectsRect (srcRect, dstRect) - && NSMinY (srcRect) < NSMinY (dstRect)) - for (int y = NSHeight (srcRect) * scale - 1 ; y >= 0 ; y--) - memmove ((char *) dstPixels + y * rowSize, - (char *) srcPixels + y * rowSize, - srcRowSize); - else - for (int y = 0 ; y < NSHeight (srcRect) * scale ; y++) - memmove ((char *) dstPixels + y * rowSize, - (char *) srcPixels + y * rowSize, - srcRowSize); - - } -#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400 +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 + double scale = [[self window] backingScaleFactor]; + CGContextRef context = [(EmacsLayer *)[self layer] getContext]; + int bpp = CGBitmapContextGetBitsPerPixel (context) / 8; + void *pixels = CGBitmapContextGetData (context); + int rowSize = CGBitmapContextGetBytesPerRow (context); + int srcRowSize = NSWidth (srcRect) * scale * bpp; + void *srcPixels = (char *) pixels + + (int) (NSMinY (srcRect) * scale * rowSize + + NSMinX (srcRect) * scale * bpp); + void *dstPixels = (char *) pixels + + (int) (dest.y * scale * rowSize + + dest.x * scale * bpp); + + if (NSIntersectsRect (srcRect, dstRect) + && NSMinY (srcRect) < NSMinY (dstRect)) + for (int y = NSHeight (srcRect) * scale - 1 ; y >= 0 ; y--) + memmove ((char *) dstPixels + y * rowSize, + (char *) srcPixels + y * rowSize, + srcRowSize); else - { -#endif -#endif /* NS_IMPL_COCOA */ + for (int y = 0 ; y < NSHeight (srcRect) * scale ; y++) + memmove ((char *) dstPixels + y * rowSize, + (char *) srcPixels + y * rowSize, + srcRowSize); -#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - hide_bell(); // Ensure the bell image isn't scrolled. +#else + hide_bell(); // Ensure the bell image isn't scrolled. - ns_focus (emacsframe, &dstRect, 1); - [self scrollRect: srcRect - by: NSMakeSize (dstRect.origin.x - srcRect.origin.x, - dstRect.origin.y - srcRect.origin.y)]; - ns_unfocus (emacsframe); -#endif -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400 - } + ns_focus (emacsframe, &dstRect, 1); + [self scrollRect: srcRect + by: NSMakeSize (dstRect.origin.x - srcRect.origin.x, + dstRect.origin.y - srcRect.origin.y)]; + ns_unfocus (emacsframe); #endif } -#ifdef NS_IMPL_COCOA +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 /* 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 @@ -8008,6 +8035,37 @@ not_in_argv (NSString *arg) return YES; } +- (BOOL) wantsPeriodicDraggingUpdates +{ + return YES; +} + +- (NSDragOperation) draggingUpdated: (id <NSDraggingInfo>) sender +{ + struct input_event ie; + NSPoint position; + int x, y; + + EVENT_INIT (ie); + ie.kind = DRAG_N_DROP_EVENT; + + /* Get rid of mouse face. */ + [self mouseExited: [[self window] currentEvent]]; + + position = [self convertPoint: [sender draggingLocation] + fromView: nil]; + x = lrint (position.x); + y = lrint (position.y); + + XSETINT (ie.x, x); + XSETINT (ie.y, y); + XSETFRAME (ie.frame_or_window, emacsframe); + ie.arg = Qlambda; + ie.modifiers = 0; + + kbd_buffer_store_event (&ie); + return NSDragOperationGeneric; +} -(BOOL)performDragOperation: (id <NSDraggingInfo>) sender { @@ -8236,10 +8294,17 @@ not_in_argv (NSString *arg) if (fullscreen) styleMask = NSWindowStyleMaskBorderless; else if (FRAME_UNDECORATED (f)) - styleMask = FRAME_UNDECORATED_FLAGS; + { + styleMask = NSWindowStyleMaskBorderless; +#ifdef NS_IMPL_COCOA + styleMask |= NSWindowStyleMaskResizable; +#endif + } else - styleMask = FRAME_DECORATED_FLAGS; - + styleMask = NSWindowStyleMaskTitled + | NSWindowStyleMaskResizable + | NSWindowStyleMaskMiniaturizable + | NSWindowStyleMaskClosable; self = [super initWithContentRect: NSMakeRect (0, 0, @@ -8304,9 +8369,8 @@ not_in_argv (NSString *arg) f->border_width = [self borderWidth]; - col = ns_lookup_indexed_color (NS_FACE_BACKGROUND - (FACE_FROM_ID (f, DEFAULT_FACE_ID)), - f); + col = [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND + (FACE_FROM_ID (f, DEFAULT_FACE_ID))]; [self setBackgroundColor:col]; if ([col alphaComponent] != (EmacsCGFloat) 1.0) [self setOpaque:NO]; @@ -8336,7 +8400,7 @@ not_in_argv (NSString *arg) EmacsToolbar *toolbar = [[EmacsToolbar alloc] initForView:view - withIdentifier:[NSString stringWithLispString:f->name]]; + withIdentifier:[NSString stringWithFormat:@"%p", f]]; [self setToolbar:toolbar]; update_frame_tool_bar_1 (f, toolbar); @@ -8399,6 +8463,15 @@ not_in_argv (NSString *arg) #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 [ourView updateCollectionBehavior]; #endif + + /* Child frames are often used in ways that may mean they should + "disappear" into the contents of the parent frame. macOs's + drop-shadows break this effect, so remove them on undecorated + child frames. */ + if (parentFrame && FRAME_UNDECORATED (ourFrame)) + [self setHasShadow:NO]; + else + [self setHasShadow:YES]; #endif @@ -9372,7 +9445,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) @end /* EmacsScroller */ -#ifdef NS_IMPL_COCOA +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 /* ========================================================================== @@ -9982,8 +10055,15 @@ This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */); x_underline_at_descent_line, doc: /* SKIP: real doc in xterm.c. */); x_underline_at_descent_line = 0; + DEFSYM (Qx_underline_at_descent_line, "x-underline-at-descent-line"); + DEFVAR_LISP ("ns-scroll-event-delta-factor", Vns_scroll_event_delta_factor, + doc: /* A factor to apply to pixel deltas reported in scroll events. + This is only effective for pixel deltas generated from touch pads or + mice with smooth scrolling capability. */); + Vns_scroll_event_delta_factor = make_float (1.0); + /* Tell Emacs about this window system. */ Fprovide (Qns, Qnil); diff --git a/src/pdumper.c b/src/pdumper.c index b0167299d79..24393e03665 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -36,7 +36,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "coding.h" #include "fingerprint.h" #include "frame.h" -#include "getpagesize.h" #include "intervals.h" #include "lisp.h" #include "pdumper.h" @@ -163,7 +162,7 @@ ptrdiff_t_to_dump_off (ptrdiff_t value) /* Worst-case allocation granularity on any system that might load this dump. */ static int -dump_get_page_size (void) +dump_get_max_page_size (void) { return 64 * 1024; } @@ -312,14 +311,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. */ @@ -2067,7 +2067,7 @@ dump_interval_tree (struct dump_context *ctx, static dump_off dump_string (struct dump_context *ctx, const struct Lisp_String *string) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_String_348C2B2FDB) +#if CHECK_STRUCTS && !defined (HASH_Lisp_String_C2CAF90352) # error "Lisp_String changed. See CHECK_STRUCTS comment in config.h." #endif /* If we have text properties, write them _after_ the string so that @@ -2078,7 +2078,7 @@ dump_string (struct dump_context *ctx, const struct Lisp_String *string) we seldom write to string data and never relocate it, so lumping it together at the end of the dump saves on COW faults. - If, however, the string's size_byte field is -1, the string data + If, however, the string's size_byte field is -2, the string data is actually a pointer to Emacs data segment, so we can do even better by emitting a relocation instead of bothering to copy the string data. */ @@ -2853,7 +2853,7 @@ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v) static dump_off dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_F09D8E8E19) +#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_A212A8F82A) # error "Lisp_Subr changed. See CHECK_STRUCTS comment in config.h." #endif struct Lisp_Subr out; @@ -2877,11 +2877,13 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) COLD_OP_NATIVE_SUBR, make_lisp_ptr ((void *) subr, Lisp_Vectorlike)); dump_field_lv (ctx, &out, subr, &subr->native_intspec, WEIGHT_NORMAL); + dump_field_lv (ctx, &out, subr, &subr->command_modes, WEIGHT_NORMAL); } else { dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name); dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec); + dump_field_emacs_ptr (ctx, &out, subr, &subr->command_modes); } DUMP_FIELD_COPY (&out, subr, doc); #ifdef HAVE_NATIVE_COMP @@ -2947,7 +2949,7 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_pvec_type_F5BA506141 +#if CHECK_STRUCTS && !defined HASH_pvec_type_AFF6FED5BD # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Vector *v = XVECTOR (lv); @@ -3027,8 +3029,12 @@ dump_vectorlike (struct dump_context *ctx, error_unsupported_dump_object (ctx, lv, "mutex"); case PVEC_CONDVAR: error_unsupported_dump_object (ctx, lv, "condvar"); + case PVEC_SQLITE: + error_unsupported_dump_object (ctx, lv, "sqlite"); case PVEC_MODULE_FUNCTION: error_unsupported_dump_object (ctx, lv, "module function"); + case PVEC_SYMBOL_WITH_POS: + error_unsupported_dump_object (ctx, lv, "symbol with pos"); default: error_unsupported_dump_object(ctx, lv, "weird pseudovector"); } @@ -4041,7 +4047,7 @@ types. */) } while (number_finalizers_run); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Bind `command-line-processed' to nil before dumping, so that the dumped Emacs will process its command line @@ -4129,7 +4135,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; @@ -4204,7 +4210,7 @@ types. */) eassert (dump_queue_empty_p (&ctx->dump_queue)); dump_off discardable_end = ctx->offset; - dump_align_output (ctx, dump_get_page_size ()); + dump_align_output (ctx, dump_get_max_page_size ()); ctx->header.cold_start = ctx->offset; /* Start the cold section. This section contains bytes that should @@ -4922,7 +4928,7 @@ dump_mmap_contiguous (struct dump_memory_map *maps, int nr_maps) return true; size_t total_size = 0; - int worst_case_page_size = dump_get_page_size (); + int worst_case_page_size = dump_get_max_page_size (); for (int i = 0; i < nr_maps; ++i) { @@ -5350,7 +5356,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, their file names through expand-file-name and decode-coding-string. */ comp_u->file = eln_fname; - comp_u->handle = dynlib_open (SSDATA (eln_fname)); + comp_u->handle = dynlib_open_for_eln (SSDATA (eln_fname)); if (!comp_u->handle) { fprintf (stderr, "Error using execdir %s:\n", @@ -5597,8 +5603,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; } @@ -5610,7 +5616,7 @@ pdumper_load (const char *dump_filename, char *argv0) err = PDUMPER_LOAD_OOM; adj_discardable_start = header->discardable_start; - dump_page_size = dump_get_page_size (); + dump_page_size = dump_get_max_page_size (); /* Snap to next page boundary. */ adj_discardable_start = ROUNDUP (adj_discardable_start, dump_page_size); eassert (adj_discardable_start % dump_page_size == 0); @@ -5706,6 +5712,7 @@ pdumper_load (const char *dump_filename, char *argv0) dump_mmap_release (§ions[i]); if (dump_fd >= 0) emacs_close (dump_fd); + return err; } @@ -5790,6 +5797,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 8383283894b..ffc743df423 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/pgtkfns.c b/src/pgtkfns.c new file mode 100644 index 00000000000..e677f046299 --- /dev/null +++ b/src/pgtkfns.c @@ -0,0 +1,4005 @@ +/* Functions for the pure Gtk+-3. + +Copyright (C) 1989, 1992-1994, 2005-2006, 2008-2020, 2022 Free Software +Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +/* This should be the first include, as it may set up #defines affecting + interpretation of even the system includes. */ +#include <config.h> + +#include <math.h> +#include <c-strcase.h> + +#include "lisp.h" +#include "blockinput.h" +#include "gtkutil.h" +#include "window.h" +#include "character.h" +#include "buffer.h" +#include "keyboard.h" +#include "termhooks.h" +#include "fontset.h" +#include "font.h" +#include "xsettings.h" +#include "atimer.h" + +static ptrdiff_t image_cache_refcount; + +static int x_decode_color (struct frame *f, Lisp_Object color_name, + int mono_color); +static struct pgtk_display_info *pgtk_display_info_for_name (Lisp_Object); + +static const char *pgtk_app_name = "Emacs"; + +/* Scale factor manually set per monitor. */ +static Lisp_Object monitor_scale_factor_alist; + +/* ========================================================================== + + Internal utility functions + + ========================================================================== */ + +static double +pgtk_get_monitor_scale_factor (const char *model) +{ + if (model == NULL) + return 0.0; + + Lisp_Object mdl = build_string (model); + Lisp_Object tem = Fassoc (mdl, monitor_scale_factor_alist, Qnil); + if (NILP (tem)) + return 0; + Lisp_Object cdr = Fcdr (tem); + if (NILP (cdr)) + return 0; + if (FIXNUMP (cdr)) + return XFIXNUM (cdr); + else if (FLOATP (cdr)) + return XFLOAT_DATA (cdr); + else + error ("unknown type of scale-factor"); +} + +struct pgtk_display_info * +check_pgtk_display_info (Lisp_Object object) +{ + struct pgtk_display_info *dpyinfo = NULL; + + if (NILP (object)) + { + struct frame *sf = XFRAME (selected_frame); + + if (FRAME_PGTK_P (sf) && FRAME_LIVE_P (sf)) + dpyinfo = FRAME_DISPLAY_INFO (sf); + else if (x_display_list != 0) + dpyinfo = x_display_list; + else + error ("Frames are not in use or not initialized"); + } + else if (TERMINALP (object)) + { + struct terminal *t = decode_live_terminal (object); + + if (t->type != output_pgtk) + error ("Terminal %d is not a display", t->id); + + dpyinfo = t->display_info.pgtk; + } + else if (STRINGP (object)) + dpyinfo = pgtk_display_info_for_name (object); + else + { + struct frame *f = decode_window_system_frame (object); + dpyinfo = FRAME_DISPLAY_INFO (f); + } + + return dpyinfo; +} + +/* On Wayland, even if without WAYLAND_DISPLAY, --display DISPLAY + works, but gdk_display_get_name always return "wayland-0", which + may be different from DISPLAY. If with WAYLAND_DISPLAY, then it + always returns WAYLAND_DISPLAY. So pgtk Emacs is confused and + enters multi display environment. To workaround this situation, + treat all the wayland-* as the same display. */ +static Lisp_Object +is_wayland_display (Lisp_Object dpyname) +{ + const char *p = SSDATA (dpyname); + if (strncmp (p, "wayland-", 8) != 0) + return Qnil; + p += 8; + do { + if (*p < '0' || *p > '9') + return Qnil; + } while (*++p != '\0'); + return Qt; +} + +/* Return the X display structure for the display named NAME. + Open a new connection if necessary. */ +static struct pgtk_display_info * +pgtk_display_info_for_name (Lisp_Object name) +{ + struct pgtk_display_info *dpyinfo; + + CHECK_STRING (name); + + if (!NILP (is_wayland_display (name))) + { + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) + if (!NILP (is_wayland_display (XCAR (dpyinfo->name_list_element)))) + return dpyinfo; + } + else + { + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) + if (!NILP (Fstring_equal (XCAR (dpyinfo->name_list_element), name))) + return dpyinfo; + } + + /* Use this general default value to start with. */ + Vx_resource_name = Vinvocation_name; + + validate_x_resource_name (); + + dpyinfo = pgtk_term_init (name, SSDATA (Vx_resource_name)); + + if (dpyinfo == 0) + error ("Cannot connect to display server %s", SDATA (name)); + + XSETFASTINT (Vwindow_system_version, 11); + + return dpyinfo; +} + +/* ========================================================================== + + Frame parameter setters + + ========================================================================== */ + + +static void +pgtk_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + unsigned long fg, old_fg; + + block_input (); + old_fg = FRAME_FOREGROUND_COLOR (f); + fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); + FRAME_FOREGROUND_PIXEL (f) = fg; + FRAME_X_OUTPUT (f)->foreground_color = fg; + + if (FRAME_GTK_WIDGET (f)) + { + if (FRAME_X_OUTPUT (f)->cursor_color == old_fg) + { + FRAME_X_OUTPUT (f)->cursor_color = fg; + FRAME_X_OUTPUT (f)->cursor_xgcv.background = fg; + } + + update_face_from_frame_parameter (f, Qforeground_color, arg); + if (FRAME_VISIBLE_P (f)) + SET_FRAME_GARBAGED (f); + } + unblock_input (); +} + + +static void +pgtk_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + unsigned long bg; + + block_input (); + bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f)); + FRAME_BACKGROUND_PIXEL (f) = bg; + + /* Clear the frame. */ + if (FRAME_VISIBLE_P (f)) + pgtk_clear_frame (f); + + FRAME_X_OUTPUT (f)->background_color = bg; + FRAME_X_OUTPUT (f)->cursor_xgcv.foreground = bg; + + xg_set_background_color (f, bg); + update_face_from_frame_parameter (f, Qbackground_color, arg); + + if (FRAME_VISIBLE_P (f)) + SET_FRAME_GARBAGED (f); + unblock_input (); +} + +static void +pgtk_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + gui_set_alpha_background (f, arg, oldval); + + /* This prevents GTK from painting the window's background, which + interferes with transparent background in some environments */ + + gtk_widget_set_app_paintable (FRAME_GTK_OUTER_WIDGET (f), + f->alpha_background != 1.0); + + if (FRAME_GTK_OUTER_WIDGET (f) + && gtk_widget_get_realized (FRAME_GTK_OUTER_WIDGET (f)) + && f->alpha_background != 1.0) + gdk_window_set_opaque_region (gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)), + NULL); +} + +static void +pgtk_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + int pix; + + CHECK_STRING (arg); + pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); + FRAME_X_OUTPUT (f)->border_pixel = pix; + pgtk_frame_rehighlight (FRAME_DISPLAY_INFO (f)); +} + +static void +pgtk_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + unsigned long fore_pixel, pixel; + struct pgtk_output *x = f->output_data.pgtk; + + if (!NILP (Vx_cursor_fore_pixel)) + { + fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel, + WHITE_PIX_DEFAULT (f)); + } + else + fore_pixel = FRAME_BACKGROUND_PIXEL (f); + + pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); + + /* Make sure that the cursor color differs from the background color. */ + if (pixel == FRAME_BACKGROUND_PIXEL (f)) + { + pixel = x->mouse_color; + if (pixel == fore_pixel) + { + fore_pixel = FRAME_BACKGROUND_PIXEL (f); + } + } + + x->cursor_foreground_color = fore_pixel; + x->cursor_color = pixel; + + if (FRAME_X_WINDOW (f) != 0) + { + x->cursor_xgcv.background = x->cursor_color; + x->cursor_xgcv.foreground = fore_pixel; + + if (FRAME_VISIBLE_P (f)) + { + gui_update_cursor (f, false); + gui_update_cursor (f, true); + } + } + + update_face_from_frame_parameter (f, Qcursor_color, arg); +} + +static void +pgtk_set_name_internal (struct frame *f, Lisp_Object name) +{ + if (FRAME_GTK_OUTER_WIDGET (f)) + { + block_input (); + { + Lisp_Object encoded_name; + + /* As ENCODE_UTF_8 may cause GC and relocation of string data, + we use it before x_encode_text that may return string data. */ + encoded_name = ENCODE_UTF_8 (name); + + gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + SSDATA (encoded_name)); + } + unblock_input (); + } +} + +static void +pgtk_set_name (struct frame *f, Lisp_Object name, int explicit) +{ + /* Make sure that requests from lisp code override requests from + Emacs redisplay code. */ + if (explicit) + { + /* If we're switching from explicit to implicit, we had better + update the mode lines and thereby update the title. */ + if (f->explicit_name && NILP (name)) + update_mode_lines = 12; + + f->explicit_name = !NILP (name); + } + else if (f->explicit_name) + return; + + if (NILP (name)) + name = build_string (pgtk_app_name); + else + CHECK_STRING (name); + + /* Don't change the name if it's already NAME. */ + if (!NILP (Fstring_equal (name, f->name))) + return; + + fset_name (f, name); + + /* Title overrides explicit name. */ + if (!NILP (f->title)) + name = f->title; + + pgtk_set_name_internal (f, name); +} + + +/* This function should be called when the user's lisp code has + specified a name for the frame; the name will override any set by the + redisplay code. */ +static void +x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + pgtk_set_name (f, arg, true); +} + + +/* This function should be called by Emacs redisplay code to set the + name; names set this way will never override names set by the user's + lisp code. */ +void +pgtk_implicitly_set_name (struct frame *f, Lisp_Object arg, + Lisp_Object oldval) +{ + pgtk_set_name (f, arg, false); +} + + +/* Change the title of frame F to NAME. + If NAME is nil, use the frame name as the title. */ + +static void +pgtk_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) +{ + /* Don't change the title if it's already NAME. */ + if (EQ (name, f->title)) + return; + + update_mode_lines = 22; + + fset_title (f, name); + + if (NILP (name)) + name = f->name; + else + CHECK_STRING (name); + + pgtk_set_name_internal (f, name); +} + + +void +pgtk_set_doc_edited (void) +{ +} + + +static void +pgtk_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + int nlines; + /* Right now, menu bars don't work properly in minibuf-only frames; + most of the commands try to apply themselves to the minibuffer + frame itself, and get an error because you can't switch buffers + in or split the minibuffer window. */ + if (FRAME_MINIBUF_ONLY_P (f) || FRAME_PARENT_FRAME (f)) + return; + + if (TYPE_RANGED_FIXNUMP (int, value)) + nlines = XFIXNUM (value); + else + nlines = 0; + + /* Make sure we redisplay all windows in this frame. */ + fset_redisplay (f); + + FRAME_MENU_BAR_LINES (f) = 0; + FRAME_MENU_BAR_HEIGHT (f) = 0; + if (nlines) + { + FRAME_EXTERNAL_MENU_BAR (f) = 1; + if (FRAME_PGTK_P (f) && f->output_data.pgtk->menubar_widget == 0) + /* Make sure next redisplay shows the menu bar. */ + XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = true; + } + else + { + if (FRAME_EXTERNAL_MENU_BAR (f) == 1) + free_frame_menubar (f); + FRAME_EXTERNAL_MENU_BAR (f) = 0; + if (FRAME_X_P (f)) + f->output_data.pgtk->menubar_widget = 0; + } + + adjust_frame_glyphs (f); +} + +/* Set the number of lines used for the tab bar of frame F to VALUE. + VALUE not an integer, or < 0 means set the lines to zero. OLDVAL + is the old number of tab bar lines. This function changes the + height of all windows on frame F to match the new tab bar height. + The frame's height doesn't change. */ + +static void +pgtk_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + 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; + + x_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); +} + + +/* Set the pixel height of the tab bar of frame F to HEIGHT. */ +void +x_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_X_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); + if (FRAME_X_WINDOW (f)) + pgtk_clear_under_internal_border (f); +} + +/* Set the pixel height of the tool bar of frame F to HEIGHT. */ +static void +x_change_tool_bar_height (struct frame *f, int height) +{ + FRAME_TOOL_BAR_LINES (f) = 0; + FRAME_TOOL_BAR_HEIGHT (f) = 0; + if (height) + { + FRAME_EXTERNAL_TOOL_BAR (f) = true; + if (FRAME_X_P (f) && f->output_data.pgtk->toolbar_widget == 0) + /* Make sure next redisplay shows the tool bar. */ + XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = true; + update_frame_tool_bar (f); + } + else + { + if (FRAME_EXTERNAL_TOOL_BAR (f)) + free_frame_tool_bar (f); + FRAME_EXTERNAL_TOOL_BAR (f) = false; + } +} + +/* Toolbar support. */ +static void +pgtk_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + int nlines; + + /* Treat tool 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; + + x_change_tool_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); + +} + +static void +pgtk_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + int border = check_int_nonnegative (arg); + + if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f)) + { + f->child_frame_border_width = border; + + if (FRAME_X_WINDOW (f)) + { + adjust_frame_size (f, -1, -1, 3, false, Qchild_frame_border_width); + pgtk_clear_under_internal_border (f); + } + } + +} + +static void +pgtk_set_internal_border_width (struct frame *f, Lisp_Object arg, + Lisp_Object oldval) +{ + int border = check_int_nonnegative (arg); + + if (border != FRAME_INTERNAL_BORDER_WIDTH (f)) + { + f->internal_border_width = border; + + if (FRAME_X_WINDOW (f)) + { + adjust_frame_size (f, -1, -1, 3, false, Qinternal_border_width); + pgtk_clear_under_internal_border (f); + } + } +} + +static void +pgtk_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + bool result; + + if (STRINGP (arg)) + { + if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) + return; + } + else if (!STRINGP (oldval) && NILP (oldval) == NILP (arg)) + return; + + block_input (); + if (NILP (arg)) + result = pgtk_text_icon (f, + SSDATA ((!NILP (f->icon_name) + ? f->icon_name : f->name))); + else + result = FRAME_TERMINAL (f)->set_bitmap_icon_hook (f, arg); + + if (result) + { + unblock_input (); + error ("No icon window available"); + } + + unblock_input (); +} + +static void +pgtk_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + bool result; + + if (STRINGP (arg)) + { + if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt)) + return; + } + else if (!NILP (arg) || NILP (oldval)) + return; + + fset_icon_name (f, arg); + + block_input (); + + result = pgtk_text_icon (f, + SSDATA ((!NILP (f->icon_name) + ? f->icon_name + : !NILP (f->title) + ? f->title : f->name))); + + if (result) + { + unblock_input (); + error ("No icon window available"); + } + + unblock_input (); +} + +/* This is the same as the xfns.c definition. */ +static void +pgtk_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + set_frame_cursor_types (f, arg); +} + +/* called to set mouse pointer color, but all other terms use it to + initialize pointer types (and don't set the color ;) */ +static void +pgtk_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ +} + +/** + * pgtk_set_undecorated: + * + * Set frame F's `undecorated' parameter. If non-nil, F's window-system + * window is drawn without decorations, title, minimize/maximize boxes + * and external borders. This usually means that the window cannot be + * 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. + * + * Some window managers may not honor this parameter. + */ +static void +pgtk_set_undecorated (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + if (!EQ (new_value, old_value)) + { + FRAME_UNDECORATED (f) = NILP (new_value) ? false : true; + xg_set_undecorated (f, new_value); + } +} + +/** + * pgtk_set_skip_taskbar: + * + * Set frame F's `skip-taskbar' parameter. If non-nil, this should + * remove F's icon from the taskbar associated with the display of F's + * window-system window and inhibit switching to F's window via + * <Alt>-<TAB>. If nil, lift these restrictions. + * + * Some window managers may not honor this parameter. + */ +static void +pgtk_set_skip_taskbar (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + if (!EQ (new_value, old_value)) + { + xg_set_skip_taskbar (f, new_value); + FRAME_SKIP_TASKBAR (f) = !NILP (new_value); + } +} + +/** + * pgtk_set_override_redirect: + * + * Set frame F's `override_redirect' parameter which, if non-nil, hints + * that the window manager doesn't want to deal with F. Usually, such + * frames have no decorations and always appear on top of all frames. + * + * Some window managers may not honor this parameter. + */ +static void +pgtk_set_override_redirect (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + if (!EQ (new_value, old_value)) + { + /* Here (xfwm) override_redirect can be changed for invisible + frames only. */ + pgtk_make_frame_invisible (f); + + xg_set_override_redirect (f, new_value); + + pgtk_make_frame_visible (f); + FRAME_OVERRIDE_REDIRECT (f) = !NILP (new_value); + } +} + +/* Set icon from FILE for frame F. By using GTK functions the icon + may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */ + +bool +xg_set_icon (struct frame *f, Lisp_Object file) +{ + bool result = false; + Lisp_Object found; + + if (!FRAME_GTK_OUTER_WIDGET (f)) + return false; + + found = image_find_image_file (file); + + if (!NILP (found)) + { + GdkPixbuf *pixbuf; + GError *err = NULL; + char *filename = SSDATA (ENCODE_FILE (found)); + block_input (); + + pixbuf = gdk_pixbuf_new_from_file (filename, &err); + + if (pixbuf) + { + gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + pixbuf); + g_object_unref (pixbuf); + + result = true; + } + else + g_error_free (err); + + unblock_input (); + } + + return result; +} + +bool +xg_set_icon_from_xpm_data (struct frame *f, const char **data) +{ + GdkPixbuf *pixbuf = gdk_pixbuf_new_from_xpm_data (data); + + if (!pixbuf) + return false; + + if (!FRAME_GTK_OUTER_WIDGET (f)) + return false; + + gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), pixbuf); + g_object_unref (pixbuf); + return true; +} + +static void +pgtk_set_sticky (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + if (!FRAME_GTK_OUTER_WIDGET (f)) + return; + + if (!NILP (new_value)) + gtk_window_stick (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); + else + gtk_window_unstick (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); +} + +static void +pgtk_set_tool_bar_position (struct frame *f, + Lisp_Object new_value, Lisp_Object old_value) +{ + Lisp_Object choice = list4 (Qleft, Qright, Qtop, Qbottom); + + if (!NILP (Fmemq (new_value, choice))) + { + if (!EQ (new_value, old_value)) + { + xg_change_toolbar_position (f, new_value); + fset_tool_bar_position (f, new_value); + } + } + else + wrong_choice (choice, new_value); +} + +static void +pgtk_set_scroll_bar_foreground (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + GtkCssProvider *css_provider = + FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider; + + if (FRAME_TOOLTIP_P (f)) + return; + + if (NILP (new_value)) + { + gtk_css_provider_load_from_data (css_provider, "", -1, NULL); + update_face_from_frame_parameter (f, Qscroll_bar_foreground, new_value); + } + else if (STRINGP (new_value)) + { + Emacs_Color rgb; + + if (!pgtk_parse_color (f, SSDATA (new_value), &rgb)) + error ("Unknown color."); + + char css[64]; + sprintf (css, "scrollbar slider { background-color: #%06x; }", + (unsigned int) rgb.pixel & 0xffffff); + gtk_css_provider_load_from_data (css_provider, css, -1, NULL); + update_face_from_frame_parameter (f, Qscroll_bar_foreground, new_value); + + } + else + error ("Invalid scroll-bar-foreground."); +} + +static void +pgtk_set_scroll_bar_background (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + GtkCssProvider *css_provider = + FRAME_X_OUTPUT (f)->scrollbar_background_css_provider; + + if (NILP (new_value)) + { + gtk_css_provider_load_from_data (css_provider, "", -1, NULL); + update_face_from_frame_parameter (f, Qscroll_bar_background, new_value); + } + else if (STRINGP (new_value)) + { + Emacs_Color rgb; + + if (!pgtk_parse_color (f, SSDATA (new_value), &rgb)) + error ("Unknown color."); + + /* On pgtk, this frame parameter should be ignored, and honor + gtk theme. (It honors the GTK theme if not explictly set, so + I see no harm in letting users tinker a bit more.) */ + char css[64]; + sprintf (css, "scrollbar trough { background-color: #%06x; }", + (unsigned int) rgb.pixel & 0xffffff); + gtk_css_provider_load_from_data (css_provider, css, -1, NULL); + update_face_from_frame_parameter (f, Qscroll_bar_background, new_value); + + } + else + error ("Invalid scroll-bar-background."); +} + + +/*********************************************************************** + Printing + ***********************************************************************/ + + +DEFUN ("x-export-frames", Fx_export_frames, Sx_export_frames, 0, 2, 0, + doc: /* Return image data of FRAMES in TYPE format. +FRAMES should be nil (the selected frame), a frame, or a list of +frames (each of which corresponds to one page). Each frame should be +visible. Optional arg TYPE should be either `pdf' (default), `png', +`postscript', or `svg'. Supported types are determined by the +compile-time configuration of cairo. + +Note: Text drawn with the `x' font backend is shown with hollow boxes +unless TYPE is `png'. */) + (Lisp_Object frames, Lisp_Object type) +{ + Lisp_Object rest, tmp; + cairo_surface_type_t surface_type; + + if (!CONSP (frames)) + frames = list1 (frames); + + tmp = Qnil; + for (rest = frames; CONSP (rest); rest = XCDR (rest)) + { + struct frame *f = decode_window_system_frame (XCAR (rest)); + Lisp_Object frame; + + XSETFRAME (frame, f); + if (!FRAME_VISIBLE_P (f)) + error ("Frames to be exported must be visible."); + tmp = Fcons (frame, tmp); + } + frames = Fnreverse (tmp); + +#ifdef CAIRO_HAS_PDF_SURFACE + if (NILP (type) || EQ (type, Qpdf)) + surface_type = CAIRO_SURFACE_TYPE_PDF; + else +#endif +#ifdef CAIRO_HAS_PNG_FUNCTIONS + if (EQ (type, Qpng)) + { + if (!NILP (XCDR (frames))) + error ("PNG export cannot handle multiple frames."); + surface_type = CAIRO_SURFACE_TYPE_IMAGE; + } + else +#endif +#ifdef CAIRO_HAS_PS_SURFACE + if (EQ (type, Qpostscript)) + surface_type = CAIRO_SURFACE_TYPE_PS; + else +#endif +#ifdef CAIRO_HAS_SVG_SURFACE + if (EQ (type, Qsvg)) + { + /* For now, we stick to SVG 1.1. */ + if (!NILP (XCDR (frames))) + error ("SVG export cannot handle multiple frames."); + surface_type = CAIRO_SURFACE_TYPE_SVG; + } + else +#endif + error ("Unsupported export type"); + + return pgtk_cr_export_frames (frames, surface_type); +} + + +/* Note: see frame.c for template, also where generic functions are impl */ +frame_parm_handler pgtk_frame_parm_handlers[] = { + gui_set_autoraise, /* generic OK */ + gui_set_autolower, /* generic OK */ + pgtk_set_background_color, + pgtk_set_border_color, + gui_set_border_width, + pgtk_set_cursor_color, + pgtk_set_cursor_type, + gui_set_font, /* generic OK */ + pgtk_set_foreground_color, + pgtk_set_icon_name, + pgtk_set_icon_type, + pgtk_set_child_frame_border_width, + pgtk_set_internal_border_width, /* generic OK */ + gui_set_right_divider_width, + gui_set_bottom_divider_width, + pgtk_set_menu_bar_lines, + pgtk_set_mouse_color, + x_explicitly_set_name, + gui_set_scroll_bar_width, /* generic OK */ + gui_set_scroll_bar_height, /* generic OK */ + pgtk_set_title, + gui_set_unsplittable, /* generic OK */ + gui_set_vertical_scroll_bars, /* generic OK */ + gui_set_horizontal_scroll_bars, /* generic OK */ + gui_set_visibility, /* generic OK */ + pgtk_set_tab_bar_lines, + pgtk_set_tool_bar_lines, + pgtk_set_scroll_bar_foreground, + pgtk_set_scroll_bar_background, + gui_set_screen_gamma, /* generic OK */ + gui_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */ + gui_set_left_fringe, /* generic OK */ + gui_set_right_fringe, /* generic OK */ + 0, /* x_set_wait_for_wm */ + gui_set_fullscreen, /* generic OK */ + gui_set_font_backend, /* generic OK */ + gui_set_alpha, + pgtk_set_sticky, + pgtk_set_tool_bar_position, + 0, /* x_set_inhibit_double_buffering */ + pgtk_set_undecorated, + pgtk_set_parent_frame, + pgtk_set_skip_taskbar, + pgtk_set_no_focus_on_map, + pgtk_set_no_accept_focus, + pgtk_set_z_group, + pgtk_set_override_redirect, + gui_set_no_special_glyphs, + pgtk_set_alpha_background, +}; + + +/* Handler for signals raised during x_create_frame and + x_create_tip_frame. FRAME is the frame which is partially + constructed. */ + +static Lisp_Object +unwind_create_frame (Lisp_Object frame) +{ + struct frame *f = XFRAME (frame); + + /* If frame is already dead, nothing to do. This can happen if the + display is disconnected after the frame has become official, but + before x_create_frame removes the unwind protect. */ + if (!FRAME_LIVE_P (f)) + return Qnil; + + /* If frame is ``official'', nothing to do. */ + if (NILP (Fmemq (frame, Vframe_list))) + { + /* If the frame's image cache refcount is still the same as our + private shadow variable, it means we are unwinding a frame + for which we didn't yet call init_frame_faces, where the + refcount is incremented. Therefore, we increment it here, so + that free_frame_faces, called in x_free_frame_resources + below, will not mistakenly decrement the counter that was not + incremented yet to account for this new frame. */ + if (FRAME_IMAGE_CACHE (f) != NULL + && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount) + FRAME_IMAGE_CACHE (f)->refcount++; + + x_free_frame_resources (f); + free_glyphs (f); + return Qt; + } + + return Qnil; +} + +static void +do_unwind_create_frame (Lisp_Object frame) +{ + unwind_create_frame (frame); +} + +/* Return the pixel color value for color COLOR_NAME on frame F. If F + is a monochrome frame, return MONO_COLOR regardless of what ARG says. + Signal an error if color can't be allocated. */ + +static int +x_decode_color (struct frame *f, Lisp_Object color_name, int mono_color) +{ + Emacs_Color cdef; + + CHECK_STRING (color_name); + + /* Return MONO_COLOR for monochrome frames. */ + if (FRAME_DISPLAY_INFO (f)->n_planes == 1) + return mono_color; + + /* x_defined_color is responsible for coping with failures + by looking for a near-miss. */ + if (pgtk_defined_color (f, SSDATA (color_name), &cdef, true, 0)) + return cdef.pixel; + + signal_error ("Undefined color", color_name); +} + +void +pgtk_default_font_parameter (struct frame *f, Lisp_Object parms) +{ + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + Lisp_Object font_param = + gui_display_get_arg (dpyinfo, parms, Qfont, NULL, NULL, + RES_TYPE_STRING); + Lisp_Object font = Qnil; + if (EQ (font_param, Qunbound)) + font_param = Qnil; + + if (NILP (font_param)) + { + /* System font should take precedence over X resources. We suggest this + regardless of font-use-system-font because .emacs may not have been + read yet. */ + const char *system_font = xsettings_get_system_font (); + if (system_font) + font = font_open_by_name (f, build_unibyte_string (system_font)); + } + + if (NILP (font)) + font = !NILP (font_param) ? font_param + : gui_display_get_arg (dpyinfo, parms, Qfont, "font", "Font", + RES_TYPE_STRING); + + if (!FONTP (font) && !STRINGP (font)) + { + const char *names[] = { + "monospace-10", + "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1", + "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1", + "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1", + /* This was formerly the first thing tried, but it finds + too many fonts and takes too long. */ + "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1", + /* If those didn't work, look for something which will + at least work. */ + "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1", + "fixed", + NULL + }; + int i; + + for (i = 0; names[i]; i++) + { + font = font_open_by_name (f, build_unibyte_string (names[i])); + if (!NILP (font)) + break; + } + if (NILP (font)) + error ("No suitable font was found"); + } + else if (!NILP (font_param)) + { + /* Remember the explicit font parameter, so we can re-apply it after + we've applied the `default' face settings. */ + AUTO_FRAME_ARG (arg, Qfont_parameter, font_param); + gui_set_frame_parameters (f, arg); + } + + /* This call will make X resources override any system font setting. */ + gui_default_parameter (f, parms, Qfont, font, "font", "Font", + RES_TYPE_STRING); +} + +static void +update_watched_scale_factor (struct atimer *timer) +{ + struct frame *f = timer->client_data; + double scale_factor = FRAME_SCALE_FACTOR (f); + + if (scale_factor != FRAME_X_OUTPUT (f)->watched_scale_factor) + { + FRAME_X_OUTPUT (f)->watched_scale_factor = scale_factor; + pgtk_cr_update_surface_desired_size (f, + FRAME_CR_SURFACE_DESIRED_WIDTH (f), + FRAME_CR_SURFACE_DESIRED_HEIGHT (f), + true); + } +} + +/* ========================================================================== + + Lisp definitions + + ========================================================================== */ + +DEFUN ("pgtk-set-monitor-scale-factor", Fpgtk_set_monitor_scale_factor, + Spgtk_set_monitor_scale_factor, 2, 2, 0, + doc: /* Set monitor MONITOR-MODEL's scale factor to SCALE-FACTOR. +Since Gdk's scale factor is integer, physical pixel width/height is +incorrect when you specify fractional scale factor in compositor. +If you set scale factor by this function, it is used instead of Gdk's one. + +Pass nil as SCALE-FACTOR if you want to reset the specified monitor's +scale factor. */ ) + (Lisp_Object monitor_model, Lisp_Object scale_factor) +{ + CHECK_STRING (monitor_model); + if (!NILP (scale_factor)) + { + CHECK_NUMBER (scale_factor); + if (FIXNUMP (scale_factor)) + { + if (XFIXNUM (scale_factor) <= 0) + error ("scale factor must be > 0."); + } + else if (FLOATP (scale_factor)) + { + if (XFLOAT_DATA (scale_factor) <= 0.0) + error ("scale factor must be > 0."); + } + else + error ("unknown type of scale-factor"); + } + + Lisp_Object tem = Fassoc (monitor_model, monitor_scale_factor_alist, Qnil); + if (NILP (tem)) + { + if (!NILP (scale_factor)) + monitor_scale_factor_alist = Fcons (Fcons (monitor_model, scale_factor), + monitor_scale_factor_alist); + } + else + Fsetcdr (tem, scale_factor); + + return scale_factor; +} + +DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, 1, 1, 0, + doc: /* Make a new X window, which is called a "frame" in Emacs terms. +Return an Emacs frame object. PARMS is an alist of frame parameters. +If the parameters specify that the frame should not have a minibuffer, +and do not specify a specific minibuffer window to use, then +`default-minibuffer-frame' must be a frame whose minibuffer can be +shared by the new frame. + +This function is an internal primitive--use `make-frame' instead. */ ) + (Lisp_Object parms) +{ + struct frame *f; + Lisp_Object frame, tem; + Lisp_Object name; + bool minibuffer_only = false; + bool undecorated = false, override_redirect = false; + long window_prompting = 0; + specpdl_ref count = SPECPDL_INDEX (); + Lisp_Object display; + struct pgtk_display_info *dpyinfo = NULL; + Lisp_Object parent, parent_frame; + struct kboard *kb; + + parms = Fcopy_alist (parms); + + /* Use this general default value to start with + until we know if this frame has a specified name. */ + Vx_resource_name = Vinvocation_name; + + display = + gui_display_get_arg (dpyinfo, parms, Qterminal, 0, 0, RES_TYPE_NUMBER); + if (EQ (display, Qunbound)) + display = + gui_display_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING); + if (EQ (display, Qunbound)) + display = Qnil; + dpyinfo = check_pgtk_display_info (display); + kb = dpyinfo->terminal->kboard; + + if (!dpyinfo->terminal->name) + error ("Terminal is not live, can't create new frames on it"); + + name = + gui_display_get_arg (dpyinfo, parms, Qname, "name", "Name", + RES_TYPE_STRING); + if (!STRINGP (name) && !EQ (name, Qunbound) && !NILP (name)) + error ("Invalid frame name--not a string or nil"); + + if (STRINGP (name)) + Vx_resource_name = name; + + /* See if parent window is specified. */ + parent = + gui_display_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, + RES_TYPE_NUMBER); + if (EQ (parent, Qunbound)) + parent = Qnil; + if (!NILP (parent)) + CHECK_NUMBER (parent); + + frame = Qnil; + tem = + gui_display_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", + "Minibuffer", RES_TYPE_SYMBOL); + if (EQ (tem, Qnone) || NILP (tem)) + f = make_frame_without_minibuffer (Qnil, kb, display); + else if (EQ (tem, Qonly)) + { + f = make_minibuffer_frame (); + minibuffer_only = true; + } + else if (WINDOWP (tem)) + f = make_frame_without_minibuffer (tem, kb, display); + else + f = make_frame (true); + + parent_frame = + gui_display_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL, + RES_TYPE_SYMBOL); + /* Accept parent-frame iff parent-id was not specified. */ + if (!NILP (parent) + || EQ (parent_frame, Qunbound) + || NILP (parent_frame) + || !FRAMEP (parent_frame) + || !FRAME_LIVE_P (XFRAME (parent_frame)) + || !FRAME_PGTK_P (XFRAME (parent_frame))) + parent_frame = Qnil; + + fset_parent_frame (f, parent_frame); + store_frame_param (f, Qparent_frame, parent_frame); + + if (!NILP + (tem = + (gui_display_get_arg + (dpyinfo, parms, Qundecorated, NULL, NULL, RES_TYPE_BOOLEAN))) + && !(EQ (tem, Qunbound))) + undecorated = true; + + FRAME_UNDECORATED (f) = undecorated; + store_frame_param (f, Qundecorated, undecorated ? Qt : Qnil); + + if (!NILP + (tem = + (gui_display_get_arg + (dpyinfo, parms, Qoverride_redirect, NULL, NULL, RES_TYPE_BOOLEAN))) + && !(EQ (tem, Qunbound))) + override_redirect = true; + + FRAME_OVERRIDE_REDIRECT (f) = override_redirect; + store_frame_param (f, Qoverride_redirect, override_redirect ? Qt : Qnil); + + XSETFRAME (frame, f); + + f->terminal = dpyinfo->terminal; + + f->output_method = output_pgtk; + FRAME_X_OUTPUT (f) = xzalloc (sizeof *FRAME_X_OUTPUT (f)); + FRAME_FONTSET (f) = -1; + FRAME_X_OUTPUT (f)->white_relief.pixel = -1; + FRAME_X_OUTPUT (f)->black_relief.pixel = -1; + + FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider = + gtk_css_provider_new (); + FRAME_X_OUTPUT (f)->scrollbar_background_css_provider = + gtk_css_provider_new (); + + fset_icon_name (f, + gui_display_get_arg (dpyinfo, parms, Qicon_name, "iconName", + "Title", RES_TYPE_STRING)); + if (!STRINGP (f->icon_name)) + fset_icon_name (f, Qnil); + + FRAME_DISPLAY_INFO (f) = dpyinfo; + + /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe. */ + record_unwind_protect (do_unwind_create_frame, frame); + + /* These colors will be set anyway later, but it's important + to get the color reference counts right, so initialize them! */ + { + Lisp_Object black; + + /* Function x_decode_color can signal an error. Make + sure to initialize color slots so that we won't try + to free colors we haven't allocated. */ + FRAME_FOREGROUND_PIXEL (f) = -1; + FRAME_BACKGROUND_PIXEL (f) = -1; + FRAME_X_OUTPUT (f)->cursor_color = -1; + FRAME_X_OUTPUT (f)->cursor_foreground_color = -1; + FRAME_X_OUTPUT (f)->border_pixel = -1; + FRAME_X_OUTPUT (f)->mouse_color = -1; + + black = build_string ("black"); + FRAME_FOREGROUND_PIXEL (f) + = x_decode_color (f, black, BLACK_PIX_DEFAULT (f)); + FRAME_BACKGROUND_PIXEL (f) + = x_decode_color (f, black, BLACK_PIX_DEFAULT (f)); + FRAME_X_OUTPUT (f)->cursor_color + = x_decode_color (f, black, BLACK_PIX_DEFAULT (f)); + FRAME_X_OUTPUT (f)->cursor_foreground_color + = x_decode_color (f, black, BLACK_PIX_DEFAULT (f)); + FRAME_X_OUTPUT (f)->border_pixel + = x_decode_color (f, black, BLACK_PIX_DEFAULT (f)); + FRAME_X_OUTPUT (f)->mouse_color + = x_decode_color (f, black, BLACK_PIX_DEFAULT (f)); + } + + /* Specify the parent under which to make this X window. */ + if (!NILP (parent)) + { + FRAME_X_OUTPUT (f)->parent_desc = (Window) XFIXNAT (parent); + FRAME_X_OUTPUT (f)->explicit_parent = true; + } + else + { + FRAME_X_OUTPUT (f)->parent_desc = FRAME_DISPLAY_INFO (f)->root_window; + FRAME_X_OUTPUT (f)->explicit_parent = false; + } + + /* Set the name; the functions to which we pass f expect the name to + be set. */ + if (EQ (name, Qunbound) || NILP (name)) + { + fset_name (f, build_string (dpyinfo->x_id_name)); + f->explicit_name = false; + } + else + { + fset_name (f, name); + f->explicit_name = true; + /* Use the frame's title when getting resources for this frame. */ + specbind (Qx_resource_name, name); + } + + register_font_driver (&ftcrfont_driver, f); +#ifdef HAVE_HARFBUZZ + register_font_driver (&ftcrhbfont_driver, f); +#endif /* HAVE_HARFBUZZ */ + + image_cache_refcount = + FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0; + + gui_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + + /* Extract the window parameters from the supplied values + that are needed to determine window geometry. */ + pgtk_default_font_parameter (f, parms); + if (!FRAME_FONT (f)) + { + delete_frame (frame, Qnoelisp); + error ("Invalid frame font"); + } + + gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), + "borderWidth", "BorderWidth", RES_TYPE_NUMBER); + + if (NILP (Fassq (Qinternal_border_width, parms))) + { + Lisp_Object value; + + value = gui_display_get_arg (dpyinfo, parms, Qinternal_border_width, + "internalBorder", "internalBorder", + RES_TYPE_NUMBER); + if (!EQ (value, Qunbound)) + parms = Fcons (Fcons (Qinternal_border_width, value), parms); + } + + gui_default_parameter (f, parms, Qinternal_border_width, + make_fixnum (0), + "internalBorderWidth", "internalBorderWidth", + RES_TYPE_NUMBER); + + /* Same for child frames. */ + if (NILP (Fassq (Qchild_frame_border_width, parms))) + { + Lisp_Object value; + + value = gui_display_get_arg (dpyinfo, parms, Qchild_frame_border_width, + "childFrameBorder", "childFrameBorder", + RES_TYPE_NUMBER); + if (! EQ (value, Qunbound)) + parms = Fcons (Fcons (Qchild_frame_border_width, value), + parms); + + } + + gui_default_parameter (f, parms, Qchild_frame_border_width, + make_fixnum (0), + "childFrameBorderWidth", "childFrameBorderWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qvertical_scroll_bars, + Qright, + "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qhorizontal_scroll_bars, Qnil, + "horizontalScrollBars", "ScrollBars", + RES_TYPE_SYMBOL); + /* Also do the stuff which must be set before the window exists. */ + gui_default_parameter (f, parms, Qforeground_color, build_string ("black"), + "foreground", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qbackground_color, build_string ("white"), + "background", "Background", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qmouse_color, build_string ("black"), + "pointerColor", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qborder_color, build_string ("black"), + "borderColor", "BorderColor", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qscreen_gamma, Qnil, + "screenGamma", "ScreenGamma", RES_TYPE_FLOAT); + gui_default_parameter (f, parms, Qline_spacing, Qnil, + "lineSpacing", "LineSpacing", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qleft_fringe, Qnil, + "leftFringe", "LeftFringe", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qright_fringe, Qnil, + "rightFringe", "RightFringe", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qno_special_glyphs, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + + gui_default_parameter (f, parms, Qscroll_bar_foreground, Qnil, + "scrollBarForeground", "ScrollBarForeground", + RES_TYPE_STRING); + gui_default_parameter (f, parms, Qscroll_bar_background, Qnil, + "scrollBarBackground", "ScrollBarBackground", + RES_TYPE_STRING); + + /* Init faces before gui_default_parameter is called for the + scroll-bar-width parameter because otherwise we end up in + init_iterator with a null face cache, which should not happen. */ + init_frame_faces (f); + + /* We have to call adjust_frame_size here since otherwise + pgtk_set_tool_bar_lines will already work with the character + sizes installed by init_frame_faces while the frame's pixel size + is still calculated from a character size of 1 and we + subsequently hit the (height >= 0) assertion in + window_box_height. + + The non-pixelwise code apparently worked around this because it + had one frame line vs one toolbar line which left us with a zero + root window height which was obviously wrong as well ... + + Also process `min-width' and `min-height' parameters right here + because `frame-windows-min-size' needs them. */ + tem = gui_display_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, + RES_TYPE_NUMBER); + if (NUMBERP (tem)) + store_frame_param (f, Qmin_width, tem); + tem = gui_display_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, + RES_TYPE_NUMBER); + if (NUMBERP (tem)) + store_frame_param (f, Qmin_height, tem); + adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), + FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true, + Qx_create_frame_1); + + /* Set the menu-bar-lines and tool-bar-lines parameters. We don't + look up the X resources controlling the menu-bar and tool-bar + here; they are processed specially at startup, and reflected in + the values of the mode variables. */ + + gui_default_parameter (f, parms, Qmenu_bar_lines, + NILP (Vmenu_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qtab_bar_lines, + NILP (Vtab_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qtool_bar_lines, + NILP (Vtool_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + + gui_default_parameter (f, parms, Qbuffer_predicate, Qnil, + "bufferPredicate", "BufferPredicate", + RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qtitle, Qnil, + "title", "Title", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qwait_for_wm, Qt, + "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qtool_bar_position, + FRAME_TOOL_BAR_POSITION (f), 0, 0, RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + + /* Compute the size of the X window. */ + window_prompting = + gui_figure_window_size (f, parms, true, true); + + tem = + gui_display_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, + RES_TYPE_BOOLEAN); + f->no_split = minibuffer_only || EQ (tem, Qt); + + xg_create_frame_widgets (f); + pgtk_set_event_handler (f); + + if (FRAME_GTK_OUTER_WIDGET (f)) + gtk_widget_realize (FRAME_GTK_OUTER_WIDGET (f)); + + /* Many callers (including the Lisp functions that call + FRAME_SCALE_FACTOR) expect the widget to be realized. */ + if (FRAME_GTK_WIDGET (f)) + gtk_widget_realize (FRAME_GTK_WIDGET (f)); + +#define INSTALL_CURSOR(FIELD, NAME) \ + FRAME_X_OUTPUT (f)->FIELD = gdk_cursor_new_for_display (FRAME_X_DISPLAY (f), GDK_ ## NAME) + + INSTALL_CURSOR (text_cursor, XTERM); + INSTALL_CURSOR (nontext_cursor, LEFT_PTR); + INSTALL_CURSOR (modeline_cursor, XTERM); + INSTALL_CURSOR (hand_cursor, HAND2); + INSTALL_CURSOR (hourglass_cursor, WATCH); + INSTALL_CURSOR (horizontal_drag_cursor, SB_H_DOUBLE_ARROW); + INSTALL_CURSOR (vertical_drag_cursor, SB_V_DOUBLE_ARROW); + INSTALL_CURSOR (left_edge_cursor, LEFT_SIDE); + INSTALL_CURSOR (right_edge_cursor, RIGHT_SIDE); + INSTALL_CURSOR (top_edge_cursor, TOP_SIDE); + INSTALL_CURSOR (bottom_edge_cursor, BOTTOM_SIDE); + INSTALL_CURSOR (top_left_corner_cursor, TOP_LEFT_CORNER); + INSTALL_CURSOR (top_right_corner_cursor, TOP_RIGHT_CORNER); + INSTALL_CURSOR (bottom_right_corner_cursor, BOTTOM_RIGHT_CORNER); + INSTALL_CURSOR (bottom_left_corner_cursor, BOTTOM_LEFT_CORNER); + +#undef INSTALL_CURSOR + + /* Now consider the frame official. */ + f->terminal->reference_count++; + FRAME_DISPLAY_INFO (f)->reference_count++; + Vframe_list = Fcons (frame, Vframe_list); + + /* We need to do this after creating the X window, so that the + icon-creation functions can say whose icon they're describing. */ + gui_default_parameter (f, parms, Qicon_type, Qt, + "bitmapIcon", "BitmapIcon", RES_TYPE_BOOLEAN); + + gui_default_parameter (f, parms, Qauto_raise, Qnil, + "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qauto_lower, Qnil, + "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qcursor_type, Qbox, + "cursorType", "CursorType", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qscroll_bar_width, Qnil, + "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qscroll_bar_height, Qnil, + "scrollBarHeight", "ScrollBarHeight", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha, Qnil, + "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); + + if (!NILP (parent_frame)) + { + struct frame *p = XFRAME (parent_frame); + + block_input (); + + GtkWidget *fixed = FRAME_GTK_WIDGET (f); + GtkWidget *fixed_of_p = FRAME_GTK_WIDGET (p); + GtkWidget *whbox_of_f = gtk_widget_get_parent (fixed); + g_object_ref (fixed); + gtk_container_remove (GTK_CONTAINER (whbox_of_f), fixed); + gtk_fixed_put (GTK_FIXED (fixed_of_p), fixed, f->left_pos, f->top_pos); + gtk_widget_show_all (fixed); + g_object_unref (fixed); + + gtk_widget_destroy (FRAME_GTK_OUTER_WIDGET (f)); + FRAME_GTK_OUTER_WIDGET (f) = NULL; + FRAME_OUTPUT_DATA (f)->vbox_widget = NULL; + FRAME_OUTPUT_DATA (f)->hbox_widget = NULL; + FRAME_OUTPUT_DATA (f)->menubar_widget = NULL; + FRAME_OUTPUT_DATA (f)->toolbar_widget = NULL; + FRAME_OUTPUT_DATA (f)->ttip_widget = NULL; + FRAME_OUTPUT_DATA (f)->ttip_lbl = NULL; + FRAME_OUTPUT_DATA (f)->ttip_window = NULL; + + unblock_input (); + } + + if (FRAME_GTK_OUTER_WIDGET (f)) + { + GList *w = gtk_container_get_children (GTK_CONTAINER (FRAME_GTK_OUTER_WIDGET (f))); + for (; w != NULL; w = w->next) + gtk_widget_show_all (GTK_WIDGET (w->data)); + } + + gui_default_parameter (f, parms, Qno_focus_on_map, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qno_accept_focus, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + + /* Create the menu bar. */ + if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f)) + { + /* If this signals an error, we haven't set size hints for the + frame and we didn't make it visible. */ + initialize_frame_menubar (f); + + } + + /* Consider frame official, now. */ + f->can_set_window_size = true; + + /* Tell the server what size and position, etc, we want, and how + badly we want them. This should be done after we have the menu + bar so that its size can be taken into account. */ + block_input (); + x_wm_set_size_hint (f, window_prompting, false); + unblock_input (); + + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 0, true, Qx_create_frame_2); + + /* Process fullscreen parameter here in the hope that normalizing a + fullheight/fullwidth frame will produce the size set by the last + adjust_frame_size call. */ + gui_default_parameter (f, parms, Qfullscreen, Qnil, + "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); + + /* Make the window appear on the frame and enable display, unless + the caller says not to. However, with explicit parent, Emacs + cannot control visibility, so don't try. */ + if (!FRAME_X_OUTPUT (f)->explicit_parent) + { + /* When called from `x-create-frame-with-faces' visibility is + always explicitly nil. */ + Lisp_Object visibility + = gui_display_get_arg (dpyinfo, parms, Qvisibility, 0, 0, + RES_TYPE_SYMBOL); + Lisp_Object height + = gui_display_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER); + Lisp_Object width + = gui_display_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER); + + if (EQ (visibility, Qicon)) + { + f->was_invisible = true; + pgtk_iconify_frame (f); + } + else + { + if (EQ (visibility, Qunbound)) + visibility = Qt; + + if (!NILP (visibility)) + pgtk_make_frame_visible (f); + else + f->was_invisible = true; + } + + /* Leave f->was_invisible true only if height or width were + specified too. This takes effect only when we are not called + from `x-create-frame-with-faces' (see above comment). */ + f->was_invisible + = (f->was_invisible + && (!EQ (height, Qunbound) || !EQ (width, Qunbound))); + + store_frame_param (f, Qvisibility, visibility); + } + + /* Works iff frame has been already mapped. */ + gui_default_parameter (f, parms, Qskip_taskbar, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + /* The `z-group' parameter works only for visible frames. */ + gui_default_parameter (f, parms, Qz_group, Qnil, + NULL, NULL, RES_TYPE_SYMBOL); + + /* Initialize `default-minibuffer-frame' in case this is the first + frame on this terminal. */ + if (FRAME_HAS_MINIBUF_P (f) + && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) + || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) + kset_default_minibuffer_frame (kb, frame); + + /* All remaining specified parameters, which have not been "used" + by gui_display_get_arg and friends, now go in the misc. alist of the frame. */ + for (tem = parms; CONSP (tem); tem = XCDR (tem)) + if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) + fset_param_alist (f, Fcons (XCAR (tem), f->param_alist)); + + FRAME_X_OUTPUT (f)->border_color_css_provider = NULL; + + FRAME_X_OUTPUT (f)->cr_surface_visible_bell = NULL; + FRAME_X_OUTPUT (f)->atimer_visible_bell = NULL; + FRAME_X_OUTPUT (f)->watched_scale_factor = 1.0; + struct timespec ts = make_timespec (1, 0); + FRAME_X_OUTPUT (f)->scale_factor_atimer = start_atimer(ATIMER_CONTINUOUS, + ts, + update_watched_scale_factor, + f); + + /* Make sure windows on this frame appear in calls to next-window + and similar functions. */ + Vwindow_list = Qnil; + + return unbind_to (count, frame); +} + +/* Restack frame F1 below frame F2, above if ABOVE_FLAG is non-nil. + In practice this is a two-step action: The first step removes F1's + window-system window from the display. The second step reinserts + F1's window below (above if ABOVE_FLAG is true) that of F2. */ +static void +pgtk_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) +{ + block_input (); + xg_frame_restack (f1, f2, above_flag); + unblock_input (); +} + +DEFUN ("pgtk-frame-restack", Fpgtk_frame_restack, Spgtk_frame_restack, 2, 3, 0, + doc: /* Restack FRAME1 below FRAME2. +This means that if both frames are visible and the display areas of +these frames overlap, FRAME2 (partially) obscures FRAME1. If optional +third argument ABOVE is non-nil, restack FRAME1 above FRAME2. This +means that if both frames are visible and the display areas of these +frames overlap, FRAME1 (partially) obscures FRAME2. + +This may be thought of as an atomic action performed in two steps: The +first step removes FRAME1's window-step window from the display. The +second step reinserts FRAME1's window below (above if ABOVE is true) +that of FRAME2. Hence the position of FRAME2 in its display's Z +\(stacking) order relative to all other frames excluding FRAME1 remains +unaltered. + +Some window managers may refuse to restack windows. */) + (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object above) +{ + struct frame *f1 = decode_live_frame (frame1); + struct frame *f2 = decode_live_frame (frame2); + + if (!(FRAME_GTK_OUTER_WIDGET (f1) && FRAME_GTK_OUTER_WIDGET (f2))) + error ("Cannot restack frames"); + pgtk_frame_restack (f1, f2, !NILP (above)); + return Qt; +} + +#ifdef HAVE_GSETTINGS + +#define RESOURCE_KEY_MAX_LEN 128 +#define SCHEMA_ID "org.gnu.emacs.defaults" +#define PATH_FOR_CLASS_TYPE "/org/gnu/emacs/defaults-by-class/" +#define PATH_PREFIX_FOR_NAME_TYPE "/org/gnu/emacs/defaults-by-name/" + +static inline int +pgtk_is_lower_char (int c) +{ + return c >= 'a' && c <= 'z'; +} + +static inline int +pgtk_is_upper_char (int c) +{ + return c >= 'A' && c <= 'Z'; +} + +static inline int +pgtk_is_numeric_char (int c) +{ + return c >= '0' && c <= '9'; +} + +static GSettings * +parse_resource_key (const char *res_key, char *setting_key) +{ + char path[32 + RESOURCE_KEY_MAX_LEN]; + const char *sp = res_key; + char *dp; + + /* + * res_key="emacs.cursorBlink" + * -> path="/org/gnu/emacs/defaults-by-name/emacs/" + * setting_key="cursor-blink" + * + * res_key="Emacs.CursorBlink" + * -> path="/org/gnu/emacs/defaults-by-class/" + * setting_key="cursor-blink" + * + * Returns GSettings* if setting_key exists in schema, otherwise NULL. + */ + + /* generate path */ + if (pgtk_is_upper_char (*sp)) + { + /* First letter is upper case. It should be "Emacs", + * but don't care. + */ + strcpy (path, PATH_FOR_CLASS_TYPE); + while (*sp != '\0') + { + if (*sp == '.') + break; + sp++; + } + } + else + { + strcpy (path, PATH_PREFIX_FOR_NAME_TYPE); + dp = path + strlen (path); + while (*sp != '\0') + { + int c = *sp; + if (c == '.') + break; + if (pgtk_is_lower_char (c)) + (void) 0; /* lower -> NOP */ + else if (pgtk_is_upper_char (c)) + c = c - 'A' + 'a'; /* upper -> lower */ + else if (pgtk_is_numeric_char (c)) + (void) 0; /* numeric -> NOP */ + else + return NULL; /* invalid */ + *dp++ = c; + sp++; + } + *dp++ = '/'; /* must ends with '/' */ + *dp = '\0'; + } + + if (*sp++ != '.') + return NULL; + + /* generate setting_key */ + dp = setting_key; + while (*sp != '\0') + { + int c = *sp; + if (pgtk_is_lower_char (c)) + (void) 0; /* lower -> NOP */ + else if (pgtk_is_upper_char (c)) + { + c = c - 'A' + 'a'; /* upper -> lower */ + if (dp != setting_key) + *dp++ = '-'; /* store '-' unless first char */ + } + else if (pgtk_is_numeric_char (c)) + (void) 0; /* numeric -> NOP */ + else + return NULL; /* invalid */ + + *dp++ = c; + sp++; + } + *dp = '\0'; + + /* check existence of setting_key */ + GSettingsSchemaSource *ssrc = g_settings_schema_source_get_default (); + GSettingsSchema *scm = g_settings_schema_source_lookup (ssrc, SCHEMA_ID, FALSE); + if (!scm) + return NULL; /* *.schema.xml is not installed. */ + if (!g_settings_schema_has_key (scm, setting_key)) + { + g_settings_schema_unref (scm); + return NULL; + } + + /* create GSettings, and return it */ + GSettings *gs = g_settings_new_full (scm, NULL, path); + + g_settings_schema_unref (scm); + return gs; +} + +const char * +pgtk_get_defaults_value (const char *key) +{ + char skey[(RESOURCE_KEY_MAX_LEN + 1) * 2]; + + if (strlen (key) >= RESOURCE_KEY_MAX_LEN) + error ("resource key too long."); + + GSettings *gs = parse_resource_key (key, skey); + if (gs == NULL) + { + return NULL; + } + + gchar *str = g_settings_get_string (gs, skey); + + /* There is no timing to free str. + * So, copy it here and free it. + * + * MEMO: Resource values for emacs shouldn't need such a long string value. + */ + static char holder[128]; + strncpy (holder, str, 128); + holder[127] = '\0'; + + g_object_unref (gs); + g_free (str); + return holder[0] != '\0' ? holder : NULL; +} + +static void +pgtk_set_defaults_value (const char *key, const char *value) +{ + char skey[(RESOURCE_KEY_MAX_LEN + 1) * 2]; + + if (strlen (key) >= RESOURCE_KEY_MAX_LEN) + error ("resource key too long."); + + GSettings *gs = parse_resource_key (key, skey); + if (gs == NULL) + error ("unknown resource key."); + + if (value != NULL) + { + g_settings_set_string (gs, skey, value); + } + else + { + g_settings_reset (gs, skey); + } + + g_object_unref (gs); +} + +#undef RESOURCE_KEY_MAX_LEN +#undef SCHEMA_ID +#undef PATH_FOR_CLASS_TYPE +#undef PATH_PREFIX_FOR_NAME_TYPE + +#else /* not HAVE_GSETTINGS */ + +const char * +pgtk_get_defaults_value (const char *key) +{ + return NULL; +} + +static void +pgtk_set_defaults_value (const char *key, const char *value) +{ + error ("gsettings not supported."); +} + +#endif + + +DEFUN ("pgtk-set-resource", Fpgtk_set_resource, Spgtk_set_resource, 2, 2, 0, + doc: /* Set the value of ATTRIBUTE, of class CLASS, as VALUE, into defaults database. */ ) + (Lisp_Object attribute, Lisp_Object value) +{ + check_window_system (NULL); + + CHECK_STRING (attribute); + if (!NILP (value)) + CHECK_STRING (value); + + char *res = SSDATA (Vx_resource_name); + char *attr = SSDATA (attribute); + if (attr[0] >= 'A' && attr[0] <= 'Z') + res = SSDATA (Vx_resource_class); + + char *key = g_strdup_printf ("%s.%s", res, attr); + + pgtk_set_defaults_value (key, NILP (value) ? NULL : SSDATA (value)); + + return Qnil; +} + + +DEFUN ("x-server-max-request-size", Fx_server_max_request_size, Sx_server_max_request_size, 0, 1, 0, + doc: /* This function is a no-op. It is only present for completeness. */ ) + (Lisp_Object terminal) +{ + check_pgtk_display_info (terminal); + /* This function has no real equivalent under PGTK. Return nil to + indicate this. */ + return Qnil; +} + + +DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0, + doc: /* Return the number of screens on the display server TERMINAL. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. + +Note: "screen" here is not in X11's. For the number of physical monitors, +use `(length \(display-monitor-attributes-list TERMINAL))' instead. */) + (Lisp_Object terminal) +{ + check_pgtk_display_info (terminal); + return make_fixnum (1); +} + + +DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0, + doc: /* Return the height in millimeters of the the display TERMINAL. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. + +On \"multi-monitor\" setups this refers to the height in millimeters for +all physical monitors associated with TERMINAL. To get information +for each physical monitor, use `display-monitor-attributes-list'. */) + (Lisp_Object terminal) +{ + struct pgtk_display_info *dpyinfo = check_pgtk_display_info (terminal); + GdkDisplay *gdpy; + gint n_monitors, i; + int height_mm_at_0 = 0, height_mm_at_other = 0; + + block_input (); + gdpy = dpyinfo->gdpy; + n_monitors = gdk_display_get_n_monitors (gdpy); + + for (i = 0; i < n_monitors; ++i) + { + GdkRectangle rec; + + GdkMonitor *monitor = gdk_display_get_monitor (gdpy, i); + gdk_monitor_get_geometry (monitor, &rec); + + int mm = gdk_monitor_get_height_mm (monitor); + + if (rec.y == 0) + height_mm_at_0 = max (height_mm_at_0, mm); + else + height_mm_at_other += mm; + } + + unblock_input (); + + return make_fixnum (height_mm_at_0 + height_mm_at_other); +} + + +DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, + doc: /* Return the width in millimeters of the the display TERMINAL. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. + +On \"multi-monitor\" setups this refers to the width in millimeters for +all physical monitors associated with TERMINAL. To get information +for each physical monitor, use `display-monitor-attributes-list'. */) + (Lisp_Object terminal) +{ + struct pgtk_display_info *dpyinfo = check_pgtk_display_info (terminal); + GdkDisplay *gdpy; + gint n_monitors, i; + int width_mm_at_0 = 0, width_mm_at_other = 0; + + block_input (); + gdpy = dpyinfo->gdpy; + n_monitors = gdk_display_get_n_monitors (gdpy); + + for (i = 0; i < n_monitors; ++i) + { + GdkRectangle rec; + + GdkMonitor *monitor = gdk_display_get_monitor (gdpy, i); + gdk_monitor_get_geometry (monitor, &rec); + + int mm = gdk_monitor_get_width_mm (monitor); + + if (rec.x == 0) + width_mm_at_0 = max (width_mm_at_0, mm); + else + width_mm_at_other += mm; + } + + unblock_input (); + + return make_fixnum (width_mm_at_0 + width_mm_at_other); +} + + +DEFUN ("x-display-backing-store", Fx_display_backing_store, Sx_display_backing_store, 0, 1, 0, + doc: /* Return an indication of whether the the display TERMINAL does backing store. +The value may be `buffered', `retained', or `non-retained'. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. */) + (Lisp_Object terminal) +{ + check_pgtk_display_info (terminal); + return Qnil; +} + + +DEFUN ("x-display-visual-class", Fx_display_visual_class, Sx_display_visual_class, 0, 1, 0, + doc: /* Return the visual class of the the display TERMINAL. +The value is one of the symbols `static-gray', `gray-scale', +`static-color', `pseudo-color', `true-color', or `direct-color'. + +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. + +On PGTK, always return true-color. */) + (Lisp_Object terminal) +{ + return intern ("true-color"); +} + + +DEFUN ("x-display-save-under", Fx_display_save_under, Sx_display_save_under, 0, 1, 0, + doc: /* Return t if TERMINAL supports the save-under feature. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. */) + (Lisp_Object terminal) +{ + check_pgtk_display_info (terminal); + return Qnil; +} + + +DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 3, 0, + doc: /* Open a connection to a display server. +DISPLAY is the name of the display to connect to. +Optional second arg XRM-STRING is a string of resources in xrdb format. +If the optional third arg MUST-SUCCEED is non-nil, +terminate Emacs if we can't open the connection. */) + (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed) +{ + struct pgtk_display_info *dpyinfo; + + if (NILP (display)) + display = build_string (""); + + CHECK_STRING (display); + + dpyinfo = pgtk_term_init (display, SSDATA (Vx_resource_name)); + if (dpyinfo == 0) + { + if (!NILP (must_succeed)) + fatal ("Display on %s not responding.\n", SSDATA (display)); + else + error ("Display on %s not responding.\n", SSDATA (display)); + } + + return Qnil; +} + + +DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection, 1, 1, 0, + doc: /* Close the connection to TERMINAL's display server. +For TERMINAL, specify a terminal object, a frame or a display name (a +string). If TERMINAL is nil, that stands for the selected frame's +terminal. */) + (Lisp_Object terminal) +{ + struct pgtk_display_info *dpyinfo = check_pgtk_display_info (terminal); + + if (dpyinfo->reference_count > 0) + error ("Display still has frames on it"); + + pgtk_delete_terminal (dpyinfo->terminal); + + return Qnil; +} + + +DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, + doc: /* Return the list of display names that Emacs has connections to. */) + (void) +{ + Lisp_Object result = Qnil; + struct pgtk_display_info *ndi; + + for (ndi = x_display_list; ndi; ndi = ndi->next) + result = Fcons (XCAR (ndi->name_list_element), result); + + return result; +} + + +DEFUN ("pgtk-hide-others", Fpgtk_hide_others, Spgtk_hide_others, 0, 0, 0, + doc: /* Hides all applications other than Emacs. */) + (void) +{ + check_window_system (NULL); + return Qnil; +} + +DEFUN ("pgtk-hide-emacs", Fpgtk_hide_emacs, Spgtk_hide_emacs, 1, 1, 0, + doc: /* If ON is non-nil, the entire Emacs application is hidden. +Otherwise if Emacs is hidden, it is unhidden. +If ON is equal to `activate', Emacs is unhidden and becomes +the active application. */) + (Lisp_Object on) +{ + check_window_system (NULL); + return Qnil; +} + + +DEFUN ("pgtk-font-name", Fpgtk_font_name, Spgtk_font_name, 1, 1, 0, + doc: /* Determine font PostScript or family name for font NAME. +NAME should be a string containing either the font name or an XLFD +font descriptor. If string contains `fontset' and not +`fontset-startup', it is left alone. */) + (Lisp_Object name) +{ + char *nm; + CHECK_STRING (name); + nm = SSDATA (name); + + if (nm[0] != '-') + return name; + if (strstr (nm, "fontset") && !strstr (nm, "fontset-startup")) + return name; + + char *str = pgtk_xlfd_to_fontname (SSDATA (name)); + name = build_string (str); + xfree (str); + return name; +} + +/* ========================================================================== + + Miscellaneous functions not called through hooks + + ========================================================================== */ + +/* Called from frame.c. */ +struct pgtk_display_info * +check_x_display_info (Lisp_Object frame) +{ + return check_pgtk_display_info (frame); +} + + +void +pgtk_set_scroll_bar_default_width (struct frame *f) +{ + int unit = FRAME_COLUMN_WIDTH (f); + int minw = xg_get_default_scrollbar_width (f); + /* A minimum width of 14 doesn't look good for toolkit scroll bars. */ + FRAME_CONFIG_SCROLL_BAR_COLS (f) = (minw + unit - 1) / unit; + FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = minw; +} + +void +pgtk_set_scroll_bar_default_height (struct frame *f) +{ + int height = FRAME_LINE_HEIGHT (f); + int min_height = xg_get_default_scrollbar_height (f); + /* A minimum height of 14 doesn't look good for toolkit scroll bars. */ + FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = min_height; + FRAME_CONFIG_SCROLL_BAR_LINES (f) = (min_height + height - 1) / height; +} + +/* Terminals implement this instead of x-get-resource directly. */ +const char * +pgtk_get_string_resource (XrmDatabase rdb, const char *name, + const char *class) +{ + check_window_system (NULL); + + if (inhibit_x_resources) + /* --quick was passed, so this is a no-op. */ + return NULL; + + const char *res = pgtk_get_defaults_value (name); + if (res == NULL) + res = pgtk_get_defaults_value (class); + + if (res == NULL) + return NULL; + + if (c_strncasecmp (res, "YES", 3) == 0) + return "true"; + + if (c_strncasecmp (res, "NO", 2) == 0) + return "false"; + + return res; +} + + +Lisp_Object +x_get_focus_frame (struct frame *frame) +{ + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame); + Lisp_Object focus; + + if (!dpyinfo->x_focus_frame) + return Qnil; + + XSETFRAME (focus, dpyinfo->x_focus_frame); + return focus; +} + +DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, + doc: /* Internal function called by `color-defined-p', which see. */) + (Lisp_Object color, Lisp_Object frame) +{ + Emacs_Color col; + struct frame *f = decode_window_system_frame (frame); + + CHECK_STRING (color); + + if (pgtk_defined_color (f, SSDATA (color), &col, false, false)) + return Qt; + else + return Qnil; +} + + +DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0, + doc: /* Internal function called by `color-values', which see. */) + (Lisp_Object color, Lisp_Object frame) +{ + Emacs_Color col; + struct frame *f = decode_window_system_frame (frame); + + CHECK_STRING (color); + + if (pgtk_defined_color (f, SSDATA (color), &col, false, false)) + return list3i (col.red, col.green, col.blue); + else + return Qnil; +} + + +DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, + doc: /* Internal function called by `display-color-p', which see. */) + (Lisp_Object terminal) +{ + check_pgtk_display_info (terminal); + return Qt; +} + + +DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p, 0, 1, 0, + doc: /* Return t if the display supports shades of gray. +Note that color displays do support shades of gray. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. */) + (Lisp_Object terminal) +{ + return Qnil; +} + + +DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width, 0, 1, 0, + doc: /* Return the width in pixels of the display TERMINAL. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. + +On \"multi-monitor\" setups this refers to the pixel width for all +physical monitors associated with TERMINAL. To get information for +each physical monitor, use `display-monitor-attributes-list'. */) + (Lisp_Object terminal) +{ + struct pgtk_display_info *dpyinfo = check_pgtk_display_info (terminal); + GdkDisplay *gdpy; + gint n_monitors, i; + int width = 0; + + block_input (); + gdpy = dpyinfo->gdpy; + n_monitors = gdk_display_get_n_monitors (gdpy); + + for (i = 0; i < n_monitors; ++i) + { + GdkRectangle rec; + double scale = 1; + + GdkMonitor *monitor = gdk_display_get_monitor (gdpy, i); + gdk_monitor_get_geometry (monitor, &rec); + + /* GTK returns scaled sizes for the workareas. */ + scale = pgtk_get_monitor_scale_factor (gdk_monitor_get_model (monitor)); + if (scale == 0.0) + scale = gdk_monitor_get_scale_factor (monitor); + rec.x = rec.x * scale + 0.5; + rec.y = rec.y * scale + 0.5; + rec.width = rec.width * scale + 0.5; + rec.height = rec.height * scale + 0.5; + + width = max (width, rec.x + rec.width); + } + + unblock_input (); + + return make_fixnum (width); +} + + +DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_height, 0, 1, 0, + doc: /* Return the height in pixels of the display TERMINAL. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. + +On \"multi-monitor\" setups this refers to the pixel height for all +physical monitors associated with TERMINAL. To get information for +each physical monitor, use `display-monitor-attributes-list'. */) + (Lisp_Object terminal) +{ + struct pgtk_display_info *dpyinfo = check_pgtk_display_info (terminal); + GdkDisplay *gdpy; + gint n_monitors, i; + int height = 0; + + block_input (); + gdpy = dpyinfo->gdpy; + n_monitors = gdk_display_get_n_monitors (gdpy); + + for (i = 0; i < n_monitors; ++i) + { + GdkRectangle rec; + double scale = 1; + + GdkMonitor *monitor = gdk_display_get_monitor (gdpy, i); + gdk_monitor_get_geometry (monitor, &rec); + + /* GTK returns scaled sizes for the workareas. */ + scale = pgtk_get_monitor_scale_factor (gdk_monitor_get_model (monitor)); + if (scale == 0.0) + scale = gdk_monitor_get_scale_factor (monitor); + rec.x = rec.x * scale + 0.5; + rec.y = rec.y * scale + 0.5; + rec.width = rec.width * scale + 0.5; + rec.height = rec.height * scale + 0.5; + + height = max (height, rec.y + rec.height); + } + + unblock_input (); + + return make_fixnum (height); +} + +DEFUN ("pgtk-display-monitor-attributes-list", Fpgtk_display_monitor_attributes_list, + Spgtk_display_monitor_attributes_list, + 0, 1, 0, + doc: /* Return a list of physical monitor attributes on the X display TERMINAL. + +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. + +In addition to the standard attribute keys listed in +`display-monitor-attributes-list', the following keys are contained in +the attributes: + + source -- String describing the source from which multi-monitor + information is obtained, \"Gdk\" + +Internal use only, use `display-monitor-attributes-list' instead. */) + (Lisp_Object terminal) +{ + struct pgtk_display_info *dpyinfo = check_pgtk_display_info (terminal); + Lisp_Object attributes_list = Qnil; + + GdkDisplay *gdpy; + gint primary_monitor = 0, n_monitors, i; + Lisp_Object monitor_frames, rest, frame; + static const char *source = "Gdk"; + struct MonitorInfo *monitors; + + block_input (); + gdpy = dpyinfo->gdpy; + n_monitors = gdk_display_get_n_monitors (gdpy); + monitor_frames = make_nil_vector (n_monitors); + monitors = xzalloc (n_monitors * sizeof *monitors); + + FOR_EACH_FRAME (rest, frame) + { + struct frame *f = XFRAME (frame); + + if (FRAME_PGTK_P (f) + && FRAME_DISPLAY_INFO (f) == dpyinfo + && !FRAME_TOOLTIP_P (f)) + { + GdkWindow *gwin = gtk_widget_get_window (FRAME_GTK_WIDGET (f)); + + for (i = 0; i < n_monitors; i++) + if (gdk_display_get_monitor_at_window (gdpy, gwin) + == gdk_display_get_monitor (gdpy, i)) + break; + ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i))); + } + } + + for (i = 0; i < n_monitors; ++i) + { + gint width_mm, height_mm; + GdkRectangle rec, work; + struct MonitorInfo *mi = &monitors[i]; + double scale = 1; + + GdkMonitor *monitor = gdk_display_get_monitor (gdpy, i); + if (gdk_monitor_is_primary (monitor)) + primary_monitor = i; + gdk_monitor_get_geometry (monitor, &rec); + + width_mm = gdk_monitor_get_width_mm (monitor); + height_mm = gdk_monitor_get_height_mm (monitor); + gdk_monitor_get_workarea (monitor, &work); + + /* GTK returns scaled sizes for the workareas. */ + scale = pgtk_get_monitor_scale_factor (gdk_monitor_get_model (monitor)); + if (scale == 0.0) + scale = gdk_monitor_get_scale_factor (monitor); + rec.x = rec.x * scale + 0.5; + rec.y = rec.y * scale + 0.5; + rec.width = rec.width * scale + 0.5; + rec.height = rec.height * scale + 0.5; + work.x = work.x * scale + 0.5; + work.y = work.y * scale + 0.5; + work.width = work.width * scale + 0.5; + work.height = work.height * scale + 0.5; + + mi->geom.x = rec.x; + mi->geom.y = rec.y; + mi->geom.width = rec.width; + mi->geom.height = rec.height; + mi->work.x = work.x; + mi->work.y = work.y; + mi->work.width = work.width; + mi->work.height = work.height; + mi->mm_width = width_mm; + mi->mm_height = height_mm; + mi->scale_factor = scale; + + dupstring (&mi->name, (gdk_monitor_get_model (monitor))); + } + + attributes_list = make_monitor_attribute_list (monitors, + n_monitors, + primary_monitor, + monitor_frames, + source); + free_monitors (monitors, n_monitors); + unblock_input (); + + return attributes_list; +} + +double +pgtk_frame_scale_factor (struct frame *f) +{ + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + GdkDisplay *gdpy = dpyinfo->gdpy; + + block_input (); + + GdkWindow *gwin = gtk_widget_get_window (FRAME_GTK_WIDGET (f)); + GdkMonitor *gmon = gdk_display_get_monitor_at_window (gdpy, gwin); + + /* GTK returns scaled sizes for the workareas. */ + double scale = pgtk_get_monitor_scale_factor (gdk_monitor_get_model (gmon)); + if (scale == 0.0) + scale = gdk_monitor_get_scale_factor (gmon); + + unblock_input (); + + return scale; +} + +DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes, 0, 1, 0, + doc: /* Return the number of bitplanes of the display TERMINAL. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. */) + (Lisp_Object terminal) +{ + check_pgtk_display_info (terminal); + return make_fixnum (32); +} + + +DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells, 0, 1, 0, + doc: /* Returns the number of color cells of the display TERMINAL. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. */) + (Lisp_Object terminal) +{ + struct pgtk_display_info *dpyinfo = check_pgtk_display_info (terminal); + /* We force 24+ bit depths to 24-bit to prevent an overflow. */ + return make_fixnum (1 << min (dpyinfo->n_planes, 24)); +} + +/*********************************************************************** + Tool tips + ***********************************************************************/ + +/* The frame of the currently visible tooltip. */ +static Lisp_Object tip_frame; + +/* The window-system window corresponding to the frame of the + currently visible tooltip. */ +GtkWidget *tip_window; + +/* A timer that hides or deletes the currently visible tooltip when it + fires. */ +static Lisp_Object tip_timer; + +/* STRING argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_string; + +/* Normalized FRAME argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_frame; + +/* PARMS argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_parms; + + +static void +unwind_create_tip_frame (Lisp_Object frame) +{ + Lisp_Object deleted; + + deleted = unwind_create_frame (frame); + if (EQ (deleted, Qt)) + { + tip_window = NULL; + tip_frame = Qnil; + } +} + + +/* Create a frame for a tooltip on the display described by DPYINFO. + PARMS is a list of frame parameters. TEXT is the string to + display in the tip frame. Value is the frame. + + Note that functions called here, esp. gui_default_parameter can + signal errors, for instance when a specified color name is + undefined. We have to make sure that we're in a consistent state + when this happens. */ + +static Lisp_Object +x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct frame *p) +{ + struct frame *f; + Lisp_Object frame; + Lisp_Object name; + specpdl_ref count = SPECPDL_INDEX (); + bool face_change_before = face_change; + + if (!dpyinfo->terminal->name) + error ("Terminal is not live, can't create new frames on it"); + + parms = Fcopy_alist (parms); + + /* Get the name of the frame to use for resource lookup. */ + name = gui_display_get_arg (dpyinfo, parms, Qname, "name", "Name", + RES_TYPE_STRING); + if (!STRINGP (name) + && !EQ (name, Qunbound) + && !NILP (name)) + error ("Invalid frame name--not a string or nil"); + + frame = Qnil; + f = make_frame (false); + f->wants_modeline = false; + XSETFRAME (frame, f); + record_unwind_protect (unwind_create_tip_frame, frame); + + f->terminal = dpyinfo->terminal; + + /* By setting the output method, we're essentially saying that + the frame is live, as per FRAME_LIVE_P. If we get a signal + from this point on, x_destroy_window might screw up reference + counts etc. */ + f->output_method = output_pgtk; + f->output_data.pgtk = xzalloc (sizeof *f->output_data.pgtk); + FRAME_FONTSET (f) = -1; + f->output_data.pgtk->white_relief.pixel = -1; + f->output_data.pgtk->black_relief.pixel = -1; + + f->tooltip = true; + fset_icon_name (f, Qnil); + FRAME_DISPLAY_INFO (f) = dpyinfo; + f->output_data.pgtk->parent_desc = FRAME_DISPLAY_INFO (f)->root_window; + f->output_data.pgtk->explicit_parent = false; + + /* These colors will be set anyway later, but it's important + to get the color reference counts right, so initialize them! */ + { + Lisp_Object black; + + /* Function x_decode_color can signal an error. Make + sure to initialize color slots so that we won't try + to free colors we haven't allocated. */ + FRAME_FOREGROUND_PIXEL (f) = -1; + FRAME_BACKGROUND_PIXEL (f) = -1; + f->output_data.pgtk->border_pixel = -1; + + black = build_string ("black"); + FRAME_FOREGROUND_PIXEL (f) + = x_decode_color (f, black, BLACK_PIX_DEFAULT (f)); + FRAME_BACKGROUND_PIXEL (f) + = x_decode_color (f, black, BLACK_PIX_DEFAULT (f)); + f->output_data.pgtk->border_pixel + = x_decode_color (f, black, BLACK_PIX_DEFAULT (f)); + } + + /* Set the name; the functions to which we pass f expect the name to + be set. */ + if (EQ (name, Qunbound) || NILP (name)) + { + fset_name (f, build_string (dpyinfo->x_id_name)); + f->explicit_name = false; + } + else + { + fset_name (f, name); + f->explicit_name = true; + /* use the frame's title when getting resources for this frame. */ + specbind (Qx_resource_name, name); + } + + register_font_driver (&ftcrfont_driver, f); +#ifdef HAVE_HARFBUZZ + register_font_driver (&ftcrhbfont_driver, f); +#endif /* HAVE_HARFBUZZ */ + + image_cache_refcount = + FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0; + + gui_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + + /* Extract the window parameters from the supplied values that are + needed to determine window geometry. */ + pgtk_default_font_parameter (f, parms); + + gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), + "borderWidth", "BorderWidth", RES_TYPE_NUMBER); + + /* This defaults to 2 in order to match xterm. We recognize either + internalBorderWidth or internalBorder (which is what xterm calls + it). */ + if (NILP (Fassq (Qinternal_border_width, parms))) + { + Lisp_Object value; + + value = gui_display_get_arg (dpyinfo, parms, Qinternal_border_width, + "internalBorder", "internalBorder", + RES_TYPE_NUMBER); + if (! EQ (value, Qunbound)) + parms = Fcons (Fcons (Qinternal_border_width, value), + parms); + } + + gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (1), + "internalBorderWidth", "internalBorderWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + + /* Also do the stuff which must be set before the window exists. */ + gui_default_parameter (f, parms, Qforeground_color, build_string ("black"), + "foreground", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qbackground_color, build_string ("white"), + "background", "Background", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qmouse_color, build_string ("black"), + "pointerColor", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qcursor_color, build_string ("black"), + "cursorColor", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qborder_color, build_string ("black"), + "borderColor", "BorderColor", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qno_special_glyphs, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + + /* Init faces before gui_default_parameter is called for the + scroll-bar-width parameter because otherwise we end up in + init_iterator with a null face cache, which should not happen. */ + init_frame_faces (f); + + f->output_data.pgtk->parent_desc = FRAME_DISPLAY_INFO (f)->root_window; + + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + + gui_figure_window_size (f, parms, false, false); + + xg_create_frame_widgets (f); + pgtk_set_event_handler (f); + tip_window = FRAME_GTK_OUTER_WIDGET (f); + gtk_window_set_transient_for (GTK_WINDOW (tip_window), + GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (p))); + gtk_window_set_attached_to (GTK_WINDOW (tip_window), FRAME_GTK_WIDGET (p)); + gtk_window_set_destroy_with_parent (GTK_WINDOW (tip_window), TRUE); + gtk_window_set_decorated (GTK_WINDOW (tip_window), FALSE); + gtk_window_set_type_hint (GTK_WINDOW (tip_window), GDK_WINDOW_TYPE_HINT_TOOLTIP); + f->output_data.pgtk->current_cursor = f->output_data.pgtk->text_cursor; + + gui_default_parameter (f, parms, Qauto_raise, Qnil, + "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qauto_lower, Qnil, + "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qcursor_type, Qbox, + "cursorType", "CursorType", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qalpha, Qnil, + "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); + + /* Add `tooltip' frame parameter's default value. */ + if (NILP (Fframe_parameter (frame, Qtooltip))) + { + AUTO_FRAME_ARG (arg, Qtooltip, Qt); + Fmodify_frame_parameters (frame, arg); + } + + /* FIXME - can this be done in a similar way to normal frames? + https://lists.gnu.org/r/emacs-devel/2007-10/msg00641.html */ + + /* Set the `display-type' frame parameter before setting up faces. */ + { + Lisp_Object disptype; + + disptype = intern ("color"); + + if (NILP (Fframe_parameter (frame, Qdisplay_type))) + { + AUTO_FRAME_ARG (arg, Qdisplay_type, disptype); + Fmodify_frame_parameters (frame, arg); + } + } + + /* Set up faces after all frame parameters are known. This call + also merges in face attributes specified for new frames. + + Frame parameters may be changed if .Xdefaults contains + specifications for the default font. For example, if there is an + `Emacs.default.attributeBackground: pink', the `background-color' + attribute of the frame get's set, which let's the internal border + of the tooltip frame appear in pink. Prevent this. */ + { + Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); + + call2 (Qface_set_after_frame_default, frame, Qnil); + + if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) + { + AUTO_FRAME_ARG (arg, Qbackground_color, bg); + Fmodify_frame_parameters (frame, arg); + } + } + + f->no_split = true; + + /* Now that the frame will be official, it counts as a reference to + its display and terminal. */ + FRAME_DISPLAY_INFO (f)->reference_count++; + f->terminal->reference_count++; + + /* It is now ok to make the frame official even if we get an error + below. And the frame needs to be on Vframe_list or making it + visible won't work. */ + Vframe_list = Fcons (frame, Vframe_list); + f->can_set_window_size = true; + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 0, true, Qtip_frame); + + /* Setting attributes of faces of the tooltip frame from resources + and similar will set face_change, which leads to the clearing of + all current matrices. Since this isn't necessary here, avoid it + by resetting face_change to the value it had before we created + the tip frame. */ + face_change = face_change_before; + + /* Discard the unwind_protect. */ + return unbind_to (count, frame); +} + +/* Compute where to display tip frame F. PARMS is the list of frame + parameters for F. DX and DY are specified offsets from the current + location of the mouse. WIDTH and HEIGHT are the width and height + of the tooltip. Return coordinates relative to the root window of + the display in *ROOT_X, and *ROOT_Y. */ + +static void +compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx, + Lisp_Object dy, int width, int height, int *root_x, + int *root_y) +{ + Lisp_Object left, top, right, bottom; + int min_x, min_y, max_x, max_y = -1; + + /* User-specified position? */ + left = Fcdr (Fassq (Qleft, parms)); + top = Fcdr (Fassq (Qtop, parms)); + right = Fcdr (Fassq (Qright, parms)); + bottom = Fcdr (Fassq (Qbottom, parms)); + + /* Move the tooltip window where the mouse pointer is. Resize and + show it. */ + if ((!INTEGERP (left) && !INTEGERP (right)) + || (!INTEGERP (top) && !INTEGERP (bottom))) + { + Lisp_Object frame, attributes, monitor, geometry; + GdkSeat *seat = + gdk_display_get_default_seat (FRAME_DISPLAY_INFO (f)->gdpy); + GdkDevice *dev = gdk_seat_get_pointer (seat); + GdkScreen *scr; + + block_input (); + gdk_device_get_position (dev, &scr, root_x, root_y); + unblock_input (); + + XSETFRAME (frame, f); + attributes = Fpgtk_display_monitor_attributes_list (frame); + + /* Try to determine the monitor where the mouse pointer is and + its geometry. See bug#22549. */ + while (CONSP (attributes)) + { + monitor = XCAR (attributes); + geometry = Fassq (Qgeometry, monitor); + if (CONSP (geometry)) + { + min_x = XFIXNUM (Fnth (make_fixnum (1), geometry)); + min_y = XFIXNUM (Fnth (make_fixnum (2), geometry)); + max_x = min_x + XFIXNUM (Fnth (make_fixnum (3), geometry)); + max_y = min_y + XFIXNUM (Fnth (make_fixnum (4), geometry)); + if (min_x <= *root_x && *root_x < max_x + && min_y <= *root_y && *root_y < max_y) + { + break; + } + max_y = -1; + } + + attributes = XCDR (attributes); + } + } + + /* It was not possible to determine the monitor's geometry, so we + assign some sane defaults here: */ + if (max_y < 0) + { + min_x = 0; + min_y = 0; + max_x = x_display_pixel_width (FRAME_DISPLAY_INFO (f)); + max_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)); + } + + if (INTEGERP (top)) + *root_y = XFIXNUM (top); + else if (INTEGERP (bottom)) + *root_y = XFIXNUM (bottom) - height; + else if (*root_y + XFIXNUM (dy) <= min_y) + *root_y = min_y; /* Can happen for negative dy */ + else if (*root_y + XFIXNUM (dy) + height <= max_y) + /* It fits below the pointer */ + *root_y += XFIXNUM (dy); + else if (height + XFIXNUM (dy) + min_y <= *root_y) + /* It fits above the pointer. */ + *root_y -= height + XFIXNUM (dy); + else + /* Put it on the top. */ + *root_y = min_y; + + if (INTEGERP (left)) + *root_x = XFIXNUM (left); + else if (INTEGERP (right)) + *root_x = XFIXNUM (right) - width; + else if (*root_x + XFIXNUM (dx) <= min_x) + *root_x = 0; /* Can happen for negative dx */ + else if (*root_x + XFIXNUM (dx) + width <= max_x) + /* It fits to the right of the pointer. */ + *root_x += XFIXNUM (dx); + else if (width + XFIXNUM (dx) + min_x <= *root_x) + /* It fits to the left of the pointer. */ + *root_x -= width + XFIXNUM (dx); + else + /* Put it left justified on the screen -- it ought to fit that way. */ + *root_x = min_x; +} + + +/* Hide tooltip. Delete its frame if DELETE is true. */ +static Lisp_Object +x_hide_tip (bool delete) +{ + if (!NILP (tip_timer)) + { + call1 (Qcancel_timer, tip_timer); + tip_timer = Qnil; + } + + /* Any GTK+ system tooltip can be found via the x_output structure of + tip_last_frame, provided that frame is still live. Any Emacs + tooltip is found via the tip_frame variable. Note that the current + value of x_gtk_use_system_tooltips might not be the same as used + for the tooltip we have to hide, see Bug#30399. */ + if ((NILP (tip_last_frame) && NILP (tip_frame)) + || (!use_system_tooltips + && !delete + && FRAMEP (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 + Emacs tooltip and we don't want to change its type. Return + quickly. */ + return Qnil; + else + { + Lisp_Object was_open = Qnil; + + specpdl_ref count = SPECPDL_INDEX (); + specbind (Qinhibit_redisplay, Qt); + specbind (Qinhibit_quit, Qt); + + /* Try to hide the GTK+ system tip first. */ + if (FRAMEP (tip_last_frame)) + { + struct frame *f = XFRAME (tip_last_frame); + + if (FRAME_LIVE_P (f)) + { + if (xg_hide_tooltip (f)) + was_open = Qt; + } + } + + /* When using GTK+ system tooltips (compare Bug#41200) reset + tip_last_frame. It will be reassigned when showing the next + GTK+ system tooltip. */ + if (use_system_tooltips) + tip_last_frame = Qnil; + + /* Now look whether there's an Emacs tip around. */ + if (FRAMEP (tip_frame)) + { + struct frame *f = XFRAME (tip_frame); + + if (FRAME_LIVE_P (f)) + { + if (delete || use_system_tooltips) + { + /* Delete the Emacs tooltip frame when DELETE is true + or we change the tooltip type from an Emacs one to + a GTK+ system one. */ + delete_frame (tip_frame, Qnil); + tip_frame = Qnil; + } + else + pgtk_make_frame_invisible (f); + + was_open = Qt; + } + else + tip_frame = Qnil; + } + else + tip_frame = Qnil; + + return unbind_to (count, was_open); + } +} + +DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, + doc: /* Show STRING in a "tooltip" window on frame FRAME. +A tooltip window is a small X window displaying a string. + +This is an internal function; Lisp code should call `tooltip-show'. + +FRAME nil or omitted means use the selected frame. + +PARMS is an optional list of frame parameters which can be used to +change the tooltip's appearance. + +Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil +means use the default timeout of 5 seconds. + +If the list of frame parameters PARMS contains a `left' parameter, +display the tooltip at that x-position. If the list of frame parameters +PARMS contains no `left' but a `right' parameter, display the tooltip +right-adjusted at that x-position. Otherwise display it at the +x-position of the mouse, with offset DX added (default is 5 if DX isn't +specified). + +Likewise for the y-position: If a `top' frame parameter is specified, it +determines the position of the upper edge of the tooltip window. If a +`bottom' parameter but no `top' frame parameter is specified, it +determines the position of the lower edge of the tooltip window. +Otherwise display the tooltip window at the y-position of the mouse, +with offset DY added (default is -10). + +A tooltip's maximum size is specified by `x-max-tooltip-size'. +Text larger than the specified size is clipped. */) + (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, + Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy) +{ + struct frame *f, *tip_f; + struct window *w; + int root_x, root_y; + struct buffer *old_buffer; + struct text_pos pos; + int width, height; + int old_windows_or_buffers_changed = windows_or_buffers_changed; + specpdl_ref count = SPECPDL_INDEX (); + Lisp_Object window, size, tip_buf; + AUTO_STRING (tip, " *tip*"); + + specbind (Qinhibit_redisplay, Qt); + + CHECK_STRING (string); + if (SCHARS (string) == 0) + string = make_unibyte_string (" ", 1); + + if (NILP (frame)) + frame = selected_frame; + f = decode_window_system_frame (frame); + + if (!FRAME_GTK_OUTER_WIDGET (f)) + return unbind_to (count, Qnil); + + if (NILP (timeout)) + timeout = make_fixnum (5); + else + CHECK_FIXNAT (timeout); + + if (NILP (dx)) + dx = make_fixnum (5); + else + CHECK_FIXNUM (dx); + + if (NILP (dy)) + dy = make_fixnum (-10); + else + CHECK_FIXNUM (dy); + + if (use_system_tooltips) + { + bool ok; + + /* Hide a previous tip, if any. */ + Fx_hide_tip (); + + block_input (); + + ok = true; + xg_show_tooltip (f, string); + tip_last_frame = frame; + + unblock_input (); + if (ok) goto start_timer; + } + + if (FRAMEP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame))) + { + if (FRAME_VISIBLE_P (XFRAME (tip_frame)) + && EQ (frame, tip_last_frame) + && !NILP (Fequal_including_properties (tip_last_string, string)) + && !NILP (Fequal (tip_last_parms, parms))) + { + /* Only DX and DY have changed. */ + tip_f = XFRAME (tip_frame); + if (!NILP (tip_timer)) + { + call1 (Qcancel_timer, tip_timer); + tip_timer = Qnil; + } + + block_input (); + compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f), + FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y); + gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (tip_f)), root_x, root_y); + unblock_input (); + + goto start_timer; + } + else if (tooltip_reuse_hidden_frame && EQ (frame, tip_last_frame)) + { + bool delete = false; + Lisp_Object tail, elt, parm, last; + + /* Check if every parameter in PARMS has the same value in + tip_last_parms. This may destruct tip_last_parms which, + however, will be recreated below. */ + for (tail = parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = Fcar (elt); + /* The left, top, right and bottom parameters are handled + by compute_tip_xy so they can be ignored here. */ + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) + && !EQ (parm, Qright) && !EQ (parm, Qbottom)) + { + last = Fassq (parm, tip_last_parms); + if (NILP (Fequal (Fcdr (elt), Fcdr (last)))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + else + tip_last_parms = + call2 (Qassq_delete_all, parm, tip_last_parms); + } + else + tip_last_parms = + call2 (Qassq_delete_all, parm, tip_last_parms); + } + + /* Now check if every parameter in what is left of + tip_last_parms with a non-nil value has an association in + PARMS. */ + for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = Fcar (elt); + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright) + && !EQ (parm, Qbottom) && !NILP (Fcdr (elt))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + } + + x_hide_tip (delete); + } + else + x_hide_tip (true); + } + else + x_hide_tip (true); + + tip_last_frame = frame; + tip_last_string = string; + tip_last_parms = parms; + + if (!FRAMEP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame))) + { + /* Add default values to frame parameters. */ + if (NILP (Fassq (Qname, parms))) + parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms); + if (NILP (Fassq (Qinternal_border_width, parms))) + parms = Fcons (Fcons (Qinternal_border_width, make_fixnum (3)), parms); + if (NILP (Fassq (Qborder_width, parms))) + parms = Fcons (Fcons (Qborder_width, make_fixnum (1)), parms); + if (NILP (Fassq (Qborder_color, parms))) + parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms); + if (NILP (Fassq (Qbackground_color, parms))) + parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")), + parms); + + /* Create a frame for the tooltip, and record it in the global + variable tip_frame. */ + if (NILP (tip_frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms, f))) + /* Creating the tip frame failed. */ + return unbind_to (count, Qnil); + } + + tip_f = XFRAME (tip_frame); + window = FRAME_ROOT_WINDOW (tip_f); + tip_buf = Fget_buffer_create (tip, Qnil); + /* We will mark the tip window a "pseudo-window" below, and such + windows cannot have display margins. */ + bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); + bset_right_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); + set_window_buffer (window, tip_buf, false, false); + w = XWINDOW (window); + w->pseudo_window_p = true; + + /* Set up the frame's root window. Note: The following code does not + try to size the window or its frame correctly. Its only purpose is + to make the subsequent text size calculations work. The right + sizes should get installed when the toolkit gets back to us. */ + w->left_col = 0; + w->top_line = 0; + w->pixel_left = 0; + w->pixel_top = 0; + + if (CONSP (Vx_max_tooltip_size) + && RANGED_FIXNUMP (1, XCAR (Vx_max_tooltip_size), INT_MAX) + && RANGED_FIXNUMP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) + { + w->total_cols = XFIXNAT (XCAR (Vx_max_tooltip_size)); + w->total_lines = XFIXNAT (XCDR (Vx_max_tooltip_size)); + } + else + { + w->total_cols = 80; + w->total_lines = 40; + } + + w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (tip_f); + w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (tip_f); + FRAME_TOTAL_COLS (tip_f) = w->total_cols; + adjust_frame_glyphs (tip_f); + + /* Insert STRING into root window's buffer and fit the frame to the + buffer. */ + specpdl_ref count_1 = SPECPDL_INDEX (); + old_buffer = current_buffer; + set_buffer_internal_1 (XBUFFER (w->contents)); + bset_truncate_lines (current_buffer, Qnil); + specbind (Qinhibit_read_only, Qt); + specbind (Qinhibit_modification_hooks, Qt); + specbind (Qinhibit_point_motion_hooks, Qt); + Ferase_buffer (); + Finsert (1, &string); + clear_glyph_matrix (w->desired_matrix); + clear_glyph_matrix (w->current_matrix); + SET_TEXT_POS (pos, BEGV, BEGV_BYTE); + try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); + /* Calculate size of tooltip window. */ + size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, + make_fixnum (w->pixel_height), Qnil, + Qnil); + /* Add the frame's internal border to calculated size. */ + width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + width += FRAME_COLUMN_WIDTH (tip_f); + + /* Calculate position of tooltip frame. */ + compute_tip_xy (tip_f, parms, dx, dy, width, height, &root_x, &root_y); + + /* Show tooltip frame. */ + block_input (); + gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (tip_f)), width, height); + gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (tip_f)), root_x, root_y); + gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (tip_f)); + SET_FRAME_VISIBLE (tip_f, 1); + gdk_window_set_cursor (gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (tip_f)), + f->output_data.pgtk->current_cursor); + + unblock_input (); + + pgtk_cr_update_surface_desired_size (tip_f, width, height, false); + + w->must_be_updated_p = true; + update_single_window (w); + flush_frame (tip_f); + set_buffer_internal_1 (old_buffer); + unbind_to (count_1, Qnil); + windows_or_buffers_changed = old_windows_or_buffers_changed; + + start_timer: + /* Let the tip disappear after timeout seconds. */ + tip_timer = call3 (intern ("run-at-time"), timeout, Qnil, + intern ("x-hide-tip")); + + return unbind_to (count, Qnil); +} + + +DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0, + doc: /* Hide the current tooltip window, if there is any. +Value is t if tooltip was open, nil otherwise. */) + (void) +{ + return x_hide_tip (!tooltip_reuse_hidden_frame); +} + +/* Return geometric attributes of FRAME. According to the value of + ATTRIBUTES return the outer edges of FRAME (Qouter_edges), the inner + edges of FRAME, the root window edges of frame (Qroot_edges). Any + other value means to return the geometry as returned by + Fx_frame_geometry. */ +static Lisp_Object +frame_geometry (Lisp_Object frame, Lisp_Object attribute) +{ + struct frame *f = decode_live_frame (frame); + Lisp_Object fullscreen_symbol = Fframe_parameter (frame, Qfullscreen); + bool fullscreen = (EQ (fullscreen_symbol, Qfullboth) + || EQ (fullscreen_symbol, Qfullscreen)); + int border = fullscreen ? 0 : f->border_width; + int title_height = 0; + int native_width = FRAME_PIXEL_WIDTH (f); + int native_height = FRAME_PIXEL_HEIGHT (f); + int outer_width = native_width + 2 * border; + int outer_height = native_height + 2 * border + title_height; + + /* Get these here because they can't be got in configure_event(). */ + int left_pos, top_pos; + + if (FRAME_GTK_OUTER_WIDGET (f)) + { + gtk_window_get_position (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + &left_pos, &top_pos); + } + else + { + GtkAllocation alloc; + + if (FRAME_GTK_WIDGET (f) == NULL) + return Qnil; /* This can occur while creating a frame. */ + + gtk_widget_get_allocation (FRAME_GTK_WIDGET (f), &alloc); + left_pos = alloc.x; + top_pos = alloc.y; + } + + int native_left = left_pos + border; + int native_top = top_pos + border + title_height; + int native_right = left_pos + outer_width - border; + int native_bottom = top_pos + outer_height - border; + int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f); + int tab_bar_height = 0, tab_bar_width = 0; + int tool_bar_height = FRAME_TOOLBAR_HEIGHT (f); + int tool_bar_width = (tool_bar_height + ? outer_width - 2 * internal_border_width : 0); + + tab_bar_height = FRAME_TAB_BAR_HEIGHT (f); + tab_bar_width = (tab_bar_height + ? native_width - 2 * internal_border_width : 0); + /* inner_top += tab_bar_height; */ + + /* Construct list. */ + if (EQ (attribute, Qouter_edges)) + return list4 (make_fixnum (left_pos), make_fixnum (top_pos), + make_fixnum (left_pos + outer_width), + make_fixnum (top_pos + outer_height)); + else if (EQ (attribute, Qnative_edges)) + return list4 (make_fixnum (native_left), make_fixnum (native_top), + make_fixnum (native_right), make_fixnum (native_bottom)); + else if (EQ (attribute, Qinner_edges)) + return list4 (make_fixnum (native_left + internal_border_width), + make_fixnum (native_top + + tool_bar_height + + internal_border_width), + make_fixnum (native_right - internal_border_width), + make_fixnum (native_bottom - internal_border_width)); + else + return + list (Fcons (Qouter_position, + Fcons (make_fixnum (left_pos), + make_fixnum (top_pos))), + Fcons (Qouter_size, + Fcons (make_fixnum (outer_width), + make_fixnum (outer_height))), + Fcons (Qexternal_border_size, + (fullscreen + ? Fcons (make_fixnum (0), make_fixnum (0)) + : Fcons (make_fixnum (border), make_fixnum (border)))), + Fcons (Qtitle_bar_size, + Fcons (make_fixnum (0), make_fixnum (title_height))), + Fcons (Qmenu_bar_external, Qnil), + Fcons (Qmenu_bar_size, Fcons (make_fixnum (0), make_fixnum (0))), + Fcons (Qtab_bar_size, + Fcons (make_fixnum (tab_bar_width), + make_fixnum (tab_bar_height))), + Fcons (Qtool_bar_external, + FRAME_EXTERNAL_TOOL_BAR (f) ? Qt : Qnil), + Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)), + Fcons (Qtool_bar_size, + Fcons (make_fixnum (tool_bar_width), + make_fixnum (tool_bar_height))), + Fcons (Qinternal_border_width, + make_fixnum (internal_border_width))); +} + +DEFUN ("pgtk-frame-geometry", Fpgtk_frame_geometry, Spgtk_frame_geometry, 0, 1, 0, + doc: /* Return geometric attributes of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is an association list of the attributes listed below. All height +and width values are in pixels. + +`outer-position' is a cons of the outer left and top edges of FRAME +relative to the origin - the position (0, 0) - of FRAME's display. + +`outer-size' is a cons of the outer width and height of FRAME. The +outer size includes the title bar and the external borders as well as +any menu and/or tool bar of frame. + +`external-border-size' is a cons of the horizontal and vertical width of +FRAME's external borders as supplied by the window manager. + +`title-bar-size' is a cons of the width and height of the title bar of +FRAME as supplied by the window manager. If both of them are zero, +FRAME has no title bar. If only the width is zero, Emacs was not +able to retrieve the width information. + +`menu-bar-external', if non-nil, means the menu bar is external (never +included in the inner edges of FRAME). + +`menu-bar-size' is a cons of the width and height of the menu bar of +FRAME. + +`tool-bar-external', if non-nil, means the tool bar is external (never +included in the inner edges of FRAME). + +`tool-bar-position' tells on which side the tool bar on FRAME is and can +be one of `left', `top', `right' or `bottom'. If this is nil, FRAME +has no tool bar. + +`tool-bar-size' is a cons of the width and height of the tool bar of +FRAME. + +`internal-border-width' is the width of the internal border of +FRAME. */) + (Lisp_Object frame) +{ + return frame_geometry (frame, Qnil); +} + +DEFUN ("pgtk-frame-edges", Fpgtk_frame_edges, Spgtk_frame_edges, 0, 2, 0, + doc: /* Return edge coordinates of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are +in pixels relative to the origin - the position (0, 0) - of FRAME's +display. + +If optional argument TYPE is the symbol `outer-edges', return the outer +edges of FRAME. The outer edges comprise the decorations of the window +manager (like the title bar or external borders) as well as any external +menu or tool bar of FRAME. If optional argument TYPE is the symbol +`native-edges' or nil, return the native edges of FRAME. The native +edges exclude the decorations of the window manager and any external +menu or tool bar of FRAME. If TYPE is the symbol `inner-edges', return +the inner edges of FRAME. These edges exclude title bar, any borders, +menu bar or tool bar of FRAME. */) + (Lisp_Object frame, Lisp_Object type) +{ + return frame_geometry (frame, ((EQ (type, Qouter_edges) + || EQ (type, Qinner_edges)) + ? type : Qnative_edges)); +} + +DEFUN ("pgtk-set-mouse-absolute-pixel-position", Fpgtk_set_mouse_absolute_pixel_position, Spgtk_set_mouse_absolute_pixel_position, 2, 2, 0, + doc: /* Move mouse pointer to absolute pixel position (X, Y). +The coordinates X and Y are interpreted in pixels relative to a position +\(0, 0) of the selected frame's display. */) + (Lisp_Object x, Lisp_Object y) +{ + struct frame *f = SELECTED_FRAME (); + GtkWidget *widget = gtk_widget_get_toplevel (FRAME_WIDGET (f)); + GdkWindow *window = gtk_widget_get_window (widget); + GdkDisplay *gdpy = gdk_window_get_display (window); + GdkScreen *gscr = gdk_window_get_screen (window); + GdkSeat *seat = gdk_display_get_default_seat (gdpy); + GdkDevice *device = gdk_seat_get_pointer (seat); + + gdk_device_warp (device, gscr, XFIXNUM (x), XFIXNUM (y)); /* No effect on wayland. */ + + return Qnil; +} + +DEFUN ("pgtk-mouse-absolute-pixel-position", Fpgtk_mouse_absolute_pixel_position, Spgtk_mouse_absolute_pixel_position, 0, 0, 0, + doc: /* Return absolute position of mouse cursor in pixels. +The position is returned as a cons cell (X . Y) of the +coordinates of the mouse cursor position in pixels relative to a +position (0, 0) of the selected frame's terminal. */) + (void) +{ + struct frame *f = SELECTED_FRAME (); + GtkWidget *widget = gtk_widget_get_toplevel (FRAME_WIDGET (f)); + GdkWindow *window = gtk_widget_get_window (widget); + GdkDisplay *gdpy = gdk_window_get_display (window); + GdkScreen *gscr; + GdkSeat *seat = gdk_display_get_default_seat (gdpy); + GdkDevice *device = gdk_seat_get_pointer (seat); + int x = 0, y = 0; + + gdk_device_get_position (device, &gscr, &x, &y); /* can't get on wayland? */ + + return Fcons (make_fixnum (x), make_fixnum (y)); +} + + +DEFUN ("pgtk-page-setup-dialog", Fpgtk_page_setup_dialog, Spgtk_page_setup_dialog, 0, 0, 0, + doc: /* Pop up a page setup dialog. +The current page setup can be obtained using `x-get-page-setup'. */) + (void) +{ + block_input (); + xg_page_setup_dialog (); + unblock_input (); + + return Qnil; +} + +DEFUN ("pgtk-get-page-setup", Fpgtk_get_page_setup, Spgtk_get_page_setup, 0, 0, 0, + doc: /* Return the value of the current page setup. +The return value is an alist containing the following keys: + +orientation: page orientation (symbol `portrait', `landscape', +`reverse-portrait', or `reverse-landscape'). +width, height: page width/height in points not including margins. +left-margin, right-margin, top-margin, bottom-margin: print margins, +which is the parts of the page that the printer cannot print +on, in points. + +The paper width can be obtained as the sum of width, left-margin, and +right-margin values if the page orientation is `portrait' or +`reverse-portrait'. Otherwise, it is the sum of width, top-margin, +and bottom-margin values. Likewise, the paper height is the sum of +height, top-margin, and bottom-margin values if the page orientation +is `portrait' or `reverse-portrait'. Otherwise, it is the sum of +height, left-margin, and right-margin values. */) + (void) +{ + Lisp_Object result; + + block_input (); + result = xg_get_page_setup (); + unblock_input (); + + return result; +} + +DEFUN ("pgtk-print-frames-dialog", Fpgtk_print_frames_dialog, Spgtk_print_frames_dialog, 0, 1, "", + doc: /* Pop up a print dialog to print the current contents of FRAMES. +FRAMES should be nil (the selected frame), a frame, or a list of +frames (each of which corresponds to one page). Each frame should be +visible. */) + (Lisp_Object frames) +{ + Lisp_Object rest, tmp; + + if (!CONSP (frames)) + frames = list1 (frames); + + tmp = Qnil; + for (rest = frames; CONSP (rest); rest = XCDR (rest)) + { + struct frame *f = decode_window_system_frame (XCAR (rest)); + Lisp_Object frame; + + XSETFRAME (frame, f); + if (!FRAME_VISIBLE_P (f)) + error ("Frames to be printed must be visible."); + tmp = Fcons (frame, tmp); + } + frames = Fnreverse (tmp); + + /* Make sure the current matrices are up-to-date. */ + specpdl_ref count = SPECPDL_INDEX (); + specbind (Qredisplay_dont_pause, Qt); + redisplay_preserve_echo_area (32); + unbind_to (count, Qnil); + + block_input (); + xg_print_frames_dialog (frames); + unblock_input (); + + return Qnil; +} + +static void +clean_up_dialog (void) +{ + pgtk_menu_set_in_use (false); +} + +DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, + doc: /* Read file name, prompting with PROMPT in directory DIR. +Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file +selection box, if specified. If MUSTMATCH is non-nil, the returned file +or directory must exist. + +This function is defined only on PGTK, NS, MS Windows, and X Windows with the +Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored. +Otherwise, if ONLY-DIR-P is non-nil, the user can select only directories. +On MS Windows 7 and later, the file selection dialog "remembers" the last +directory where the user selected a file, and will open that directory +instead of DIR on subsequent invocations of this function with the same +value of DIR as in previous invocations; this is standard MS Windows behavior. */) + (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, + Lisp_Object mustmatch, Lisp_Object only_dir_p) +{ + struct frame *f = SELECTED_FRAME (); + char *fn; + Lisp_Object file = Qnil; + Lisp_Object decoded_file; + specpdl_ref count = SPECPDL_INDEX (); + char *cdef_file; + + check_window_system (f); + + if (popup_activated ()) + error ("Trying to use a menu from within a menu-entry"); + else + pgtk_menu_set_in_use (true); + + CHECK_STRING (prompt); + CHECK_STRING (dir); + + /* Prevent redisplay. */ + specbind (Qinhibit_redisplay, Qt); + record_unwind_protect_void (clean_up_dialog); + + block_input (); + + if (STRINGP (default_filename)) + cdef_file = SSDATA (default_filename); + else + cdef_file = SSDATA (dir); + + fn = xg_get_file_name (f, SSDATA (prompt), cdef_file, + !NILP (mustmatch), !NILP (only_dir_p)); + + if (fn) + { + file = build_string (fn); + xfree (fn); + } + + unblock_input (); + + /* Make "Cancel" equivalent to C-g. */ + if (NILP (file)) + quit (); + + decoded_file = DECODE_FILE (file); + + return unbind_to (count, decoded_file); +} + +DEFUN ("pgtk-backend-display-class", Fpgtk_backend_display_class, Spgtk_backend_display_class, 0, 1, "", + doc: /* Return the name of the Gdk backend display class of TERMINAL. +The optional argument TERMINAL specifies which display to ask about. +TERMINAL should be a terminal object, a frame or a display name (a string). +If omitted or nil, that stands for the selected frame's display. */) + (Lisp_Object terminal) +{ + struct pgtk_display_info *dpyinfo = check_pgtk_display_info (terminal); + GdkDisplay *gdpy = dpyinfo->gdpy; + const gchar *type_name = G_OBJECT_TYPE_NAME (G_OBJECT (gdpy)); + return build_string (type_name); +} + +DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0, + doc: /* Read a font using a GTK dialog and return a font spec. + +FRAME is the frame on which to pop up the font chooser. If omitted or +nil, it defaults to the selected frame. */) + (Lisp_Object frame, Lisp_Object ignored) +{ + struct frame *f = decode_window_system_frame (frame); + Lisp_Object font; + Lisp_Object font_param; + char *default_name = NULL; + specpdl_ref count = SPECPDL_INDEX (); + + if (popup_activated ()) + error ("Trying to use a menu from within a menu-entry"); + else + pgtk_menu_set_in_use (true); + + /* Prevent redisplay. */ + specbind (Qinhibit_redisplay, Qt); + record_unwind_protect_void (clean_up_dialog); + + block_input (); + + XSETFONT (font, FRAME_FONT (f)); + font_param = Ffont_get (font, QCname); + if (STRINGP (font_param)) + default_name = xlispstrdup (font_param); + else + { + font_param = Fframe_parameter (frame, Qfont_parameter); + if (STRINGP (font_param)) + default_name = xlispstrdup (font_param); + } + + font = xg_get_font (f, default_name); + xfree (default_name); + + unblock_input (); + + if (NILP (font)) + quit (); + + return unbind_to (count, font); +} + +DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object enable) +{ + gboolean enable_debug = !NILP (enable); + + block_input (); + gtk_window_set_interactive_debugging (enable_debug); + unblock_input (); + + return NILP (enable) ? Qnil : Qt; +} + +void +syms_of_pgtkfns (void) +{ + DEFSYM (Qfont_parameter, "font-parameter"); + DEFSYM (Qfontsize, "fontsize"); + DEFSYM (Qcancel_timer, "cancel-timer"); + DEFSYM (Qframe_title_format, "frame-title-format"); + DEFSYM (Qicon_title_format, "icon-title-format"); + DEFSYM (Qdark, "dark"); + DEFSYM (Qhide, "hide"); + DEFSYM (Qresize_mode, "resize-mode"); + + DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel, + doc: /* SKIP: real doc in xfns.c. */); + Vx_cursor_fore_pixel = Qnil; + + Fprovide (intern_c_string ("gtk"), Qnil); + + DEFVAR_LISP ("gtk-version-string", Vgtk_version_string, + doc: /* Version info for GTK+. */); + { + char *ver = g_strdup_printf ("%d.%d.%d", + GTK_MAJOR_VERSION, GTK_MINOR_VERSION, + GTK_MICRO_VERSION); + int len = strlen (ver); + Vgtk_version_string = make_pure_string (ver, len, len, false); + g_free (ver); + } + + + Fprovide (intern_c_string ("cairo"), Qnil); + + DEFVAR_LISP ("cairo-version-string", Vcairo_version_string, + doc: /* Version info for cairo. */); + { + char *ver = g_strdup_printf ("%d.%d.%d", + CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR, + CAIRO_VERSION_MICRO); + int len = strlen (ver); + Vcairo_version_string = make_pure_string (ver, len, len, false); + g_free (ver); + } + + + defsubr (&Spgtk_set_resource); + defsubr (&Sxw_display_color_p); /* this and next called directly by C code */ + defsubr (&Sx_display_grayscale_p); + defsubr (&Spgtk_font_name); + defsubr (&Sxw_color_defined_p); + defsubr (&Sxw_color_values); + defsubr (&Sx_server_max_request_size); + defsubr (&Sx_display_pixel_width); + defsubr (&Sx_display_pixel_height); + defsubr (&Spgtk_display_monitor_attributes_list); + defsubr (&Spgtk_frame_geometry); + defsubr (&Spgtk_frame_edges); + defsubr (&Spgtk_frame_restack); + defsubr (&Spgtk_set_mouse_absolute_pixel_position); + defsubr (&Spgtk_mouse_absolute_pixel_position); + defsubr (&Sx_display_mm_width); + defsubr (&Sx_display_mm_height); + defsubr (&Sx_display_screens); + defsubr (&Sx_display_planes); + defsubr (&Sx_display_color_cells); + defsubr (&Sx_display_visual_class); + defsubr (&Sx_display_backing_store); + defsubr (&Sx_display_save_under); + defsubr (&Sx_create_frame); + defsubr (&Sx_open_connection); + defsubr (&Sx_close_connection); + defsubr (&Sx_display_list); + defsubr (&Sx_gtk_debug); + + defsubr (&Spgtk_hide_others); + defsubr (&Spgtk_hide_emacs); + + defsubr (&Sx_show_tip); + defsubr (&Sx_hide_tip); + + defsubr (&Sx_export_frames); + defsubr (&Spgtk_page_setup_dialog); + defsubr (&Spgtk_get_page_setup); + defsubr (&Spgtk_print_frames_dialog); + defsubr (&Spgtk_backend_display_class); + + defsubr (&Spgtk_set_monitor_scale_factor); + + defsubr (&Sx_file_dialog); + defsubr (&Sx_select_font); + + monitor_scale_factor_alist = Qnil; + staticpro (&monitor_scale_factor_alist); + + tip_timer = Qnil; + staticpro (&tip_timer); + tip_frame = Qnil; + staticpro (&tip_frame); + tip_last_frame = Qnil; + staticpro (&tip_last_frame); + tip_last_string = Qnil; + staticpro (&tip_last_string); + tip_last_parms = Qnil; + staticpro (&tip_last_parms); + + /* This is not ifdef:ed, so other builds than GTK can customize it. */ + DEFVAR_BOOL ("x-gtk-use-old-file-dialog", x_gtk_use_old_file_dialog, + doc: /* SKIP: real doc in xfns.c. */); + x_gtk_use_old_file_dialog = false; + + DEFVAR_BOOL ("x-gtk-show-hidden-files", x_gtk_show_hidden_files, + doc: /* SKIP: real doc in xfns.c. */); + x_gtk_show_hidden_files = false; + + DEFVAR_BOOL ("x-gtk-file-dialog-help-text", x_gtk_file_dialog_help_text, + doc: /* SKIP: real doc in xfns.c. */); + x_gtk_file_dialog_help_text = true; + + DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size, + doc: /* SKIP: real doc in xfns.c. */); + Vx_max_tooltip_size = Fcons (make_fixnum (80), make_fixnum (40)); + + DEFSYM (Qmono, "mono"); + DEFSYM (Qassq_delete_all, "assq-delete-all"); + + DEFSYM (Qpdf, "pdf"); + + DEFSYM (Qorientation, "orientation"); + DEFSYM (Qtop_margin, "top-margin"); + DEFSYM (Qbottom_margin, "bottom-margin"); + DEFSYM (Qportrait, "portrait"); + DEFSYM (Qlandscape, "landscape"); + DEFSYM (Qreverse_portrait, "reverse-portrait"); + DEFSYM (Qreverse_landscape, "reverse-landscape"); +} diff --git a/src/pgtkgui.h b/src/pgtkgui.h new file mode 100644 index 00000000000..389052631c8 --- /dev/null +++ b/src/pgtkgui.h @@ -0,0 +1,119 @@ +/* Definitions and headers for communication on the pure Gtk+3. + Copyright (C) 1995, 2005, 2008-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#ifndef __PGTKGUI_H__ +#define __PGTKGUI_H__ + +/* Emulate XCharStruct. */ +typedef struct _XCharStruct +{ + int rbearing; + int lbearing; + int width; + int ascent; + int descent; +} XCharStruct; + +/* Fake structure from Xlib.h to represent two-byte characters. */ +typedef unsigned short unichar; +typedef unichar XChar2b; + +#define STORE_XCHAR2B(chp, b1, b2) \ + (*(chp) = ((XChar2b)((((b1) & 0x00ff) << 8) | ((b2) & 0x00ff)))) + +#define XCHAR2B_BYTE1(chp) \ + ((*(chp) & 0xff00) >> 8) + +#define XCHAR2B_BYTE2(chp) \ + (*(chp) & 0x00ff) + + +typedef struct _GdkCursor *Emacs_Cursor; + +typedef void *Color; +typedef int Window; +typedef struct _GdkDisplay Display; + +/* Xism */ +typedef void *XrmDatabase; + + +/* Some sort of attempt to normalize rectangle handling.. seems a bit much + for what is accomplished. */ +typedef struct +{ + int x, y; + unsigned width, height; +} XRectangle; + +/* This stuff is needed by frame.c. */ +#define ForgetGravity 0 +#define NorthWestGravity 1 +#define NorthGravity 2 +#define NorthEastGravity 3 +#define WestGravity 4 +#define CenterGravity 5 +#define EastGravity 6 +#define SouthWestGravity 7 +#define SouthGravity 8 +#define SouthEastGravity 9 +#define StaticGravity 10 + +#define NoValue 0x0000 +#define XValue 0x0001 +#define YValue 0x0002 +#define WidthValue 0x0004 +#define HeightValue 0x0008 +#define AllValues 0x000F +#define XNegative 0x0010 +#define YNegative 0x0020 + +#define USPosition (1L << 0) /* user specified x, y */ +#define USSize (1L << 1) /* user specified width, height */ + +#define PPosition (1L << 2) /* program specified position */ +#define PSize (1L << 3) /* program specified size */ +#define PMinSize (1L << 4) /* program specified minimum size */ +#define PMaxSize (1L << 5) /* program specified maximum size */ +#define PResizeInc (1L << 6) /* program specified resize increments */ +#define PAspect (1L << 7) /* program specified min, max aspect ratios */ +#define PBaseSize (1L << 8) /* program specified base for incrementing */ +#define PWinGravity (1L << 9) /* program specified window gravity */ + + +#define NativeRectangle XRectangle + +#define CONVERT_TO_EMACS_RECT(xr, nr) \ + ((xr).x = (nr).x, \ + (xr).y = (nr).y, \ + (xr).width = (nr).width, \ + (xr).height = (nr).height) + +#define CONVERT_FROM_EMACS_RECT(xr, nr) \ + ((nr).x = (xr).x, \ + (nr).y = (xr).y, \ + (nr).width = (xr).width, \ + (nr).height = (xr).height) + +#define STORE_NATIVE_RECT(nr, px, py, pwidth, pheight) \ + ((nr).x = (px), \ + (nr).y = (py), \ + (nr).width = (pwidth), \ + (nr).height = (pheight)) + +#endif /* __PGTKGUI_H__ */ diff --git a/src/pgtkim.c b/src/pgtkim.c new file mode 100644 index 00000000000..e1fffafb611 --- /dev/null +++ b/src/pgtkim.c @@ -0,0 +1,313 @@ +/* Pure Gtk+-3 communication module. + +Copyright (C) 1989, 1993-1994, 2005-2006, 2008-2022 Free Software +Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +/* This should be the first include, as it may set up #defines affecting + interpretation of even the system includes. */ +#include <config.h> + +#include "pgtkterm.h" + +static void +im_context_commit_cb (GtkIMContext *imc, + gchar *str, + gpointer user_data) +{ + struct pgtk_display_info *dpyinfo = user_data; + struct frame *f = dpyinfo->im.focused_frame; + + if (dpyinfo->im.context == NULL) + return; + if (f == NULL) + return; + + pgtk_enqueue_string (f, str); +} + +static gboolean +im_context_retrieve_surrounding_cb (GtkIMContext *imc, gpointer user_data) +{ + gtk_im_context_set_surrounding (imc, "", -1, 0); + return TRUE; +} + +static gboolean +im_context_delete_surrounding_cb (GtkIMContext *imc, int offset, int n_chars, + gpointer user_data) +{ + return TRUE; +} + +static Lisp_Object +make_color_string (PangoAttrColor *pac) +{ + char buf[256]; + sprintf (buf, "#%02x%02x%02x", + pac->color.red >> 8, pac->color.green >> 8, pac->color.blue >> 8); + return build_string (buf); +} + +static void +im_context_preedit_changed_cb (GtkIMContext *imc, gpointer user_data) +{ + struct pgtk_display_info *dpyinfo = user_data; + struct frame *f = dpyinfo->im.focused_frame; + char *str; + PangoAttrList *attrs; + int pos; + + if (dpyinfo->im.context == NULL) + return; + if (f == NULL) + return; + + gtk_im_context_get_preedit_string (imc, &str, &attrs, &pos); + + + /* + * ( + * (TEXT (ul . COLOR) (bg . COLOR) (fg . COLOR)) + * ... + * ) + */ + Lisp_Object list = Qnil; + + PangoAttrIterator *iter; + iter = pango_attr_list_get_iterator (attrs); + do + { + int st, ed; + int has_underline = 0; + Lisp_Object part = Qnil; + + pango_attr_iterator_range (iter, &st, &ed); + + if (ed > strlen (str)) + ed = strlen (str); + if (st >= ed) + continue; + + Lisp_Object text = make_string (str + st, ed - st); + part = Fcons (text, part); + + PangoAttrInt *ul = + (PangoAttrInt *) pango_attr_iterator_get (iter, PANGO_ATTR_UNDERLINE); + if (ul != NULL) + { + if (ul->value != PANGO_UNDERLINE_NONE) + has_underline = 1; + } + + PangoAttrColor *pac; + if (has_underline) + { + pac = + (PangoAttrColor *) pango_attr_iterator_get (iter, + PANGO_ATTR_UNDERLINE_COLOR); + if (pac != NULL) + part = Fcons (Fcons (Qul, make_color_string (pac)), part); + else + part = Fcons (Fcons (Qul, Qt), part); + } + + pac = + (PangoAttrColor *) pango_attr_iterator_get (iter, + PANGO_ATTR_FOREGROUND); + if (pac != NULL) + part = Fcons (Fcons (Qfg, make_color_string (pac)), part); + + pac = + (PangoAttrColor *) pango_attr_iterator_get (iter, + PANGO_ATTR_BACKGROUND); + if (pac != NULL) + part = Fcons (Fcons (Qbg, make_color_string (pac)), part); + + part = Fnreverse (part); + list = Fcons (part, list); + } + while (pango_attr_iterator_next (iter)); + + list = Fnreverse (list); + pgtk_enqueue_preedit (f, list); + + g_free (str); + pango_attr_list_unref (attrs); +} + +static void +im_context_preedit_end_cb (GtkIMContext *imc, gpointer user_data) +{ + struct pgtk_display_info *dpyinfo = user_data; + struct frame *f = dpyinfo->im.focused_frame; + + if (dpyinfo->im.context == NULL) + return; + if (f == NULL) + return; + + pgtk_enqueue_preedit (f, Qnil); +} + +static void +im_context_preedit_start_cb (GtkIMContext *imc, gpointer user_data) +{ +} + +void +pgtk_im_focus_in (struct frame *f) +{ + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + if (dpyinfo->im.context != NULL) + { + gtk_im_context_reset (dpyinfo->im.context); + gtk_im_context_set_client_window (dpyinfo->im.context, + gtk_widget_get_window + (FRAME_GTK_WIDGET (f))); + gtk_im_context_focus_in (dpyinfo->im.context); + } + dpyinfo->im.focused_frame = f; +} + +void +pgtk_im_focus_out (struct frame *f) +{ + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + if (dpyinfo->im.focused_frame == f) + { + if (dpyinfo->im.context != NULL) + { + gtk_im_context_reset (dpyinfo->im.context); + gtk_im_context_focus_out (dpyinfo->im.context); + gtk_im_context_set_client_window (dpyinfo->im.context, NULL); + } + dpyinfo->im.focused_frame = NULL; + } +} + +bool +pgtk_im_filter_keypress (struct frame *f, GdkEventKey * ev) +{ + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + if (dpyinfo->im.context != NULL) + { + if (gtk_im_context_filter_keypress (dpyinfo->im.context, ev)) + return true; + } + return false; +} + +void +pgtk_im_set_cursor_location (struct frame *f, int x, int y, int width, + int height) +{ + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + if (dpyinfo->im.context != NULL && dpyinfo->im.focused_frame == f) + { + GdkRectangle area = { x, y, width, height }; + gtk_im_context_set_cursor_location (dpyinfo->im.context, &area); + } +} + +static void +pgtk_im_use_context (struct pgtk_display_info *dpyinfo, bool use_p) +{ + if (!use_p) + { + if (dpyinfo->im.context != NULL) + { + gtk_im_context_reset (dpyinfo->im.context); + gtk_im_context_focus_out (dpyinfo->im.context); + gtk_im_context_set_client_window (dpyinfo->im.context, NULL); + + g_object_unref (dpyinfo->im.context); + dpyinfo->im.context = NULL; + } + } + else + { + if (dpyinfo->im.context == NULL) + { + dpyinfo->im.context = gtk_im_multicontext_new (); + g_signal_connect (dpyinfo->im.context, "commit", + G_CALLBACK (im_context_commit_cb), dpyinfo); + g_signal_connect (dpyinfo->im.context, "retrieve-surrounding", + G_CALLBACK (im_context_retrieve_surrounding_cb), + dpyinfo); + g_signal_connect (dpyinfo->im.context, "delete-surrounding", + G_CALLBACK (im_context_delete_surrounding_cb), + dpyinfo); + g_signal_connect (dpyinfo->im.context, "preedit-changed", + G_CALLBACK (im_context_preedit_changed_cb), + dpyinfo); + g_signal_connect (dpyinfo->im.context, "preedit-end", + G_CALLBACK (im_context_preedit_end_cb), dpyinfo); + g_signal_connect (dpyinfo->im.context, "preedit-start", + G_CALLBACK (im_context_preedit_start_cb), + dpyinfo); + gtk_im_context_set_use_preedit (dpyinfo->im.context, TRUE); + + if (dpyinfo->im.focused_frame) + pgtk_im_focus_in (dpyinfo->im.focused_frame); + } + } +} + +void +pgtk_im_init (struct pgtk_display_info *dpyinfo) +{ + dpyinfo->im.context = NULL; + + pgtk_im_use_context (dpyinfo, !NILP (Vpgtk_use_im_context_on_new_connection)); +} + +void +pgtk_im_finish (struct pgtk_display_info *dpyinfo) +{ + if (dpyinfo->im.context != NULL) + g_object_unref (dpyinfo->im.context); + dpyinfo->im.context = NULL; +} + +DEFUN ("pgtk-use-im-context", Fpgtk_use_im_context, Spgtk_use_im_context, 1, 2, 0, + doc: /* Set whether to use GtkIMContext. */) + (Lisp_Object use_p, Lisp_Object terminal) +{ + struct pgtk_display_info *dpyinfo = check_pgtk_display_info (terminal); + + pgtk_im_use_context (dpyinfo, !NILP (use_p)); + + return Qnil; +} + +void +syms_of_pgtkim (void) +{ + defsubr (&Spgtk_use_im_context); + + DEFSYM (Qpgtk_refresh_preedit, "pgtk-refresh-preedit"); + DEFSYM (Qul, "ul"); + DEFSYM (Qfg, "fg"); + DEFSYM (Qbg, "bg"); + + DEFVAR_LISP ("pgtk-use-im-context-on-new-connection", Vpgtk_use_im_context_on_new_connection, + doc: /* Whether to use GtkIMContext on a new connection. +If you want to change it after connection, use the `pgtk-use-im-context' +function. */ ); + Vpgtk_use_im_context_on_new_connection = Qt; +} diff --git a/src/pgtkmenu.c b/src/pgtkmenu.c new file mode 100644 index 00000000000..eec9f419d07 --- /dev/null +++ b/src/pgtkmenu.c @@ -0,0 +1,1138 @@ +/* Pure GTK3 menu and toolbar module. + Copyright (C) 2019-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +/* + */ + + +/* This should be the first include, as it may set up #defines affecting + interpretation of even the system includes. */ +#include <config.h> + +#include "lisp.h" +#include "frame.h" +#include "window.h" +#include "character.h" +#include "buffer.h" +#include "keymap.h" +#include "coding.h" +#include "commands.h" +#include "blockinput.h" +#include "termhooks.h" +#include "keyboard.h" +#include "menu.h" +#include "pdumper.h" +#include "xgselect.h" + +#include "gtkutil.h" +#include <gtk/gtk.h> + +/* Flag which when set indicates a dialog or menu has been posted by + GTK on behalf of one of the widget sets. */ +static int popup_activated_flag; + +/* Set menu_items_inuse so no other popup menu or dialog is created. */ + +void +pgtk_menu_set_in_use (bool in_use) +{ + Lisp_Object frames, frame; + + menu_items_inuse = in_use; + popup_activated_flag = in_use; + + /* Don't let frames in `above' z-group obscure popups. */ + FOR_EACH_FRAME (frames, frame) + { + struct frame *f = XFRAME (frame); + + if (in_use && FRAME_Z_GROUP_ABOVE (f)) + pgtk_set_z_group (f, Qabove_suspended, Qabove); + else if (!in_use && FRAME_Z_GROUP_ABOVE_SUSPENDED (f)) + pgtk_set_z_group (f, Qabove, Qabove_suspended); + } +} + +DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_internal, 0, 1, "i", + doc: /* SKIP: real doc in USE_GTK definition in xmenu.c. */) + (Lisp_Object frame) +{ + GtkWidget *menubar; + struct frame *f; + + block_input (); + f = decode_window_system_frame (frame); + + if (FRAME_EXTERNAL_MENU_BAR (f)) + set_frame_menubar (f, true); + + menubar = FRAME_X_OUTPUT (f)->menubar_widget; + if (menubar) + { + /* Activate the first menu. */ + GList *children = gtk_container_get_children (GTK_CONTAINER (menubar)); + + if (children) + { + g_signal_emit_by_name (children->data, "activate_item"); + g_list_free (children); + } + } + unblock_input (); + + return Qnil; +} + +/* Loop util popup_activated_flag is set to zero in a callback. + Used for popup menus and dialogs. */ + +static void +popup_widget_loop (bool do_timers, GtkWidget *widget) +{ + ++popup_activated_flag; + + /* Process events in the Gtk event loop until done. */ + while (popup_activated_flag) + gtk_main_iteration (); +} + +void +pgtk_activate_menubar (struct frame *f) +{ + set_frame_menubar (f, true); + + popup_activated_flag = 1; + + /* f->output_data.pgtk->menubar_active = 1; */ +} + +/* This callback is invoked when a dialog or menu is finished being + used and has been unposted. */ + +static void +popup_deactivate_callback (GtkWidget *widget, gpointer client_data) +{ + pgtk_menu_set_in_use (false); +} + +/* Function that finds the frame for WIDGET and shows the HELP text + for that widget. + F is the frame if known, or NULL if not known. */ +static void +show_help_event (struct frame *f, GtkWidget *widget, Lisp_Object help) +{ + /* Don't show help echo on PGTK, as tooltips are always transient + for the main widget, so on Wayland the menu will display above + and obscure the tooltip. FIXME: this is some low hanging fruit + for fixing. After you fix Fx_show_tip in pgtkterm.c so that it + can display tooltips above menus, copy the definition of this + function from xmenu.c. + + As a workaround, GTK is used to display menu tooltips, outside + the Emacs help echo machinery. */ +} + +/* Callback called when menu items are highlighted/unhighlighted + while moving the mouse over them. WIDGET is the menu bar or menu + popup widget. ID is its LWLIB_ID. CALL_DATA contains a pointer to + the data structure for the menu item, or null in case of + unhighlighting. */ + +static void +menu_highlight_callback (GtkWidget *widget, gpointer call_data) +{ + xg_menu_item_cb_data *cb_data; + Lisp_Object help; + + cb_data = g_object_get_data (G_OBJECT (widget), XG_ITEM_DATA); + if (!cb_data) + return; + + help = call_data ? cb_data->help : Qnil; + + /* If popup_activated_flag is greater than 1 we are in a popup menu. + Don't pass the frame to show_help_event for those. + Passing frame creates an Emacs event. As we are looping in + popup_widget_loop, it won't be handled. Passing NULL shows the tip + directly without using an Emacs event. This is what the Lucid code + does below. */ + show_help_event (popup_activated_flag <= 1 ? cb_data->cl_data->f : NULL, + widget, help); +} + +/* Gtk calls callbacks just because we tell it what item should be + selected in a radio group. If this variable is set to a non-zero + value, we are creating menus and don't want callbacks right now. +*/ +static bool xg_crazy_callback_abort; + +/* This callback is called from the menu bar pulldown menu + when the user makes a selection. + Figure out what the user chose + and put the appropriate events into the keyboard buffer. */ +static void +menubar_selection_callback (GtkWidget *widget, gpointer client_data) +{ + xg_menu_item_cb_data *cb_data = client_data; + + if (xg_crazy_callback_abort) + return; + + if (!cb_data || !cb_data->cl_data || !cb_data->cl_data->f) + return; + + /* For a group of radio buttons, GTK calls the selection callback first + for the item that was active before the selection and then for the one that + is active after the selection. For C-h k this means we get the help on + the deselected item and then the selected item is executed. Prevent that + by ignoring the non-active item. */ + if (GTK_IS_RADIO_MENU_ITEM (widget) + && !gtk_check_menu_item_get_active (GTK_CHECK_MENU_ITEM (widget))) + return; + + /* When a menu is popped down, X generates a focus event (i.e. focus + goes back to the frame below the menu). Since GTK buffers events, + we force it out here before the menu selection event. Otherwise + sit-for will exit at once if the focus event follows the menu selection + event. */ + + block_input (); + while (gtk_events_pending ()) + gtk_main_iteration (); + unblock_input (); + + find_and_call_menu_selection (cb_data->cl_data->f, + cb_data->cl_data->menu_bar_items_used, + cb_data->cl_data->menu_bar_vector, + cb_data->call_data); +} + +/* Recompute all the widgets of frame F, when the menu bar has been + changed. */ + +static void +update_frame_menubar (struct frame *f) +{ + xg_update_frame_menubar (f); +} + +/* Set the contents of the menubar widgets of frame F. + The argument FIRST_TIME is currently ignored; + it is set the first time this is called, from initialize_frame_menubar. */ + +void +set_frame_menubar (struct frame *f, bool deep_p) +{ + GtkWidget *menubar_widget; + Lisp_Object items; + widget_value *wv, *first_wv, *prev_wv = 0; + int i; + int *submenu_start, *submenu_end; + bool *submenu_top_level_items; + int *submenu_n_panes; + + + menubar_widget = f->output_data.pgtk->menubar_widget; + + XSETFRAME (Vmenu_updating_frame, f); + + if (!menubar_widget) + deep_p = true; + + if (deep_p) + { + struct buffer *prev = current_buffer; + Lisp_Object buffer; + specpdl_ref specpdl_count = SPECPDL_INDEX (); + int previous_menu_items_used = f->menu_bar_items_used; + Lisp_Object *previous_items + = alloca (previous_menu_items_used * sizeof *previous_items); + int subitems; + + /* If we are making a new widget, its contents are empty, + do always reinitialize them. */ + if (!menubar_widget) + previous_menu_items_used = 0; + + buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->contents; + specbind (Qinhibit_quit, Qt); + /* Don't let the debugger step into this code + because it is not reentrant. */ + specbind (Qdebug_on_next_call, Qnil); + + record_unwind_save_match_data (); + if (NILP (Voverriding_local_map_menu_flag)) + { + specbind (Qoverriding_terminal_local_map, Qnil); + specbind (Qoverriding_local_map, Qnil); + } + + set_buffer_internal_1 (XBUFFER (buffer)); + + /* Run the Lucid hook. */ + safe_run_hooks (Qactivate_menubar_hook); + + /* If it has changed current-menubar from previous value, + really recompute the menubar from the value. */ + if (!NILP (Vlucid_menu_bar_dirty_flag)) + call0 (Qrecompute_lucid_menubar); + safe_run_hooks (Qmenu_bar_update_hook); + fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); + + items = FRAME_MENU_BAR_ITEMS (f); + + /* Save the frame's previous menu bar contents data. */ + if (previous_menu_items_used) + memcpy (previous_items, xvector_contents (f->menu_bar_vector), + previous_menu_items_used * word_size); + + /* Fill in menu_items with the current menu bar contents. + This can evaluate Lisp code. */ + save_menu_items (); + + menu_items = f->menu_bar_vector; + menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0; + subitems = ASIZE (items) / 4; + submenu_start = alloca ((subitems + 1) * sizeof *submenu_start); + submenu_end = alloca (subitems * sizeof *submenu_end); + submenu_n_panes = alloca (subitems * sizeof *submenu_n_panes); + submenu_top_level_items = alloca (subitems + * sizeof *submenu_top_level_items); + init_menu_items (); + for (i = 0; i < subitems; i++) + { + Lisp_Object key, string, maps; + + key = AREF (items, 4 * i); + string = AREF (items, 4 * i + 1); + maps = AREF (items, 4 * i + 2); + if (NILP (string)) + break; + + submenu_start[i] = menu_items_used; + + menu_items_n_panes = 0; + submenu_top_level_items[i] + = parse_single_submenu (key, string, maps); + submenu_n_panes[i] = menu_items_n_panes; + + submenu_end[i] = menu_items_used; + } + + submenu_start[i] = -1; + finish_menu_items (); + + /* Convert menu_items into widget_value trees + to display the menu. This cannot evaluate Lisp code. */ + + wv = make_widget_value ("menubar", NULL, true, Qnil); + wv->button_type = BUTTON_TYPE_NONE; + first_wv = wv; + + for (i = 0; submenu_start[i] >= 0; i++) + { + menu_items_n_panes = submenu_n_panes[i]; + wv = digest_single_submenu (submenu_start[i], submenu_end[i], + submenu_top_level_items[i]); + if (prev_wv) + prev_wv->next = wv; + else + first_wv->contents = wv; + /* Don't set wv->name here; GC during the loop might relocate it. */ + wv->enabled = true; + wv->button_type = BUTTON_TYPE_NONE; + prev_wv = wv; + } + + set_buffer_internal_1 (prev); + + /* If there has been no change in the Lisp-level contents + of the menu bar, skip redisplaying it. Just exit. */ + + /* Compare the new menu items with the ones computed last time. */ + for (i = 0; i < previous_menu_items_used; i++) + if (menu_items_used == i + || (!EQ (previous_items[i], AREF (menu_items, i)))) + break; + if (i == menu_items_used && i == previous_menu_items_used && i != 0) + { + /* The menu items have not changed. Don't bother updating + the menus in any form, since it would be a no-op. */ + free_menubar_widget_value_tree (first_wv); + discard_menu_items (); + unbind_to (specpdl_count, Qnil); + return; + } + + /* The menu items are different, so store them in the frame. */ + fset_menu_bar_vector (f, menu_items); + f->menu_bar_items_used = menu_items_used; + + /* This undoes save_menu_items. */ + unbind_to (specpdl_count, Qnil); + + /* Now GC cannot happen during the lifetime of the widget_value, + so it's safe to store data from a Lisp_String. */ + wv = first_wv->contents; + for (i = 0; i < ASIZE (items); i += 4) + { + Lisp_Object string; + string = AREF (items, i + 1); + if (NILP (string)) + break; + wv->name = SSDATA (string); + update_submenu_strings (wv->contents); + wv = wv->next; + } + + } + else + { + /* Make a widget-value tree containing + just the top level menu bar strings. */ + + wv = make_widget_value ("menubar", NULL, true, Qnil); + wv->button_type = BUTTON_TYPE_NONE; + first_wv = wv; + + items = FRAME_MENU_BAR_ITEMS (f); + for (i = 0; i < ASIZE (items); i += 4) + { + Lisp_Object string; + + string = AREF (items, i + 1); + if (NILP (string)) + break; + + wv = make_widget_value (SSDATA (string), NULL, true, Qnil); + wv->button_type = BUTTON_TYPE_NONE; + /* This prevents lwlib from assuming this + menu item is really supposed to be empty. */ + /* The intptr_t cast avoids a warning. + This value just has to be different from small integers. */ + wv->call_data = (void *) (intptr_t) (-1); + + if (prev_wv) + prev_wv->next = wv; + else + first_wv->contents = wv; + prev_wv = wv; + } + + /* Forget what we thought we knew about what is in the + detailed contents of the menu bar menus. + Changing the top level always destroys the contents. */ + f->menu_bar_items_used = 0; + } + + block_input (); + + xg_crazy_callback_abort = true; + if (menubar_widget) + { + /* The fourth arg is DEEP_P, which says to consider the entire + menu trees we supply, rather than just the menu bar item names. */ + xg_modify_menubar_widgets (menubar_widget, + f, + first_wv, + deep_p, + G_CALLBACK (menubar_selection_callback), + G_CALLBACK (popup_deactivate_callback), + G_CALLBACK (menu_highlight_callback)); + } + else + { + menubar_widget + = xg_create_widget ("menubar", "menubar", f, first_wv, + G_CALLBACK (menubar_selection_callback), + G_CALLBACK (popup_deactivate_callback), + G_CALLBACK (menu_highlight_callback)); + + f->output_data.pgtk->menubar_widget = menubar_widget; + } + + free_menubar_widget_value_tree (first_wv); + update_frame_menubar (f); + + xg_crazy_callback_abort = false; + + unblock_input (); +} + +/* Called from Fx_create_frame to create the initial menubar of a frame + before it is mapped, so that the window is mapped with the menubar already + there instead of us tacking it on later and thrashing the window after it + is visible. */ + +void +initialize_frame_menubar (struct frame *f) +{ + /* This function is called before the first chance to redisplay + the frame. It has to be, so the frame will have the right size. */ + fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); + set_frame_menubar (f, true); +} + + +/* x_menu_show actually displays a menu using the panes and items in menu_items + and returns the value selected from it. + There are two versions of x_menu_show, one for Xt and one for Xlib. + Both assume input is blocked by the caller. */ + +/* F is the frame the menu is for. + X and Y are the frame-relative specified position, + relative to the inside upper left corner of the frame F. + Bitfield MENUFLAGS bits are: + MENU_FOR_CLICK is set if this menu was invoked for a mouse click. + MENU_KEYMAPS is set if this menu was specified with keymaps; + in that case, we return a list containing the chosen item's value + and perhaps also the pane's prefix. + TITLE is the specified menu title. + ERROR is a place to store an error message string in case of failure. + (We return nil on failure, but the value doesn't actually matter.) */ + +/* The item selected in the popup menu. */ +static Lisp_Object *volatile menu_item_selection; + +static void +popup_selection_callback (GtkWidget *widget, gpointer client_data) +{ + xg_menu_item_cb_data *cb_data = client_data; + + if (xg_crazy_callback_abort) + return; + if (cb_data) + menu_item_selection = cb_data->call_data; +} + +static void +pop_down_menu (void *arg) +{ + popup_activated_flag = 0; + block_input (); + gtk_widget_destroy (GTK_WIDGET (arg)); + unblock_input (); +} + +/* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the + menu pops down. + menu_item_selection will be set to the selection. */ +static void +create_and_show_popup_menu (struct frame *f, widget_value * first_wv, + int x, int y, bool for_click) +{ + GtkWidget *menu; + specpdl_ref specpdl_count = SPECPDL_INDEX (); + + eassert (FRAME_PGTK_P (f)); + + xg_crazy_callback_abort = true; + menu = xg_create_widget ("popup", first_wv->name, f, first_wv, + G_CALLBACK (popup_selection_callback), + G_CALLBACK (popup_deactivate_callback), + G_CALLBACK (menu_highlight_callback)); + xg_crazy_callback_abort = false; + + /* Display the menu. */ + gtk_widget_show_all (menu); + + if (for_click) + gtk_menu_popup_at_pointer (GTK_MENU (menu), + FRAME_DISPLAY_INFO (f)->last_click_event); + else + { + GdkRectangle rect; + rect.x = x; + rect.y = y; + rect.width = 1; + rect.height = 1; + gtk_menu_popup_at_rect (GTK_MENU (menu), + gtk_widget_get_window (FRAME_GTK_WIDGET (f)), + &rect, + GDK_GRAVITY_NORTH_WEST, GDK_GRAVITY_NORTH_WEST, + FRAME_DISPLAY_INFO (f)->last_click_event); + } + + record_unwind_protect_ptr (pop_down_menu, menu); + + if (gtk_widget_get_mapped (menu)) + { + /* Set this to one. popup_widget_loop increases it by one, so it becomes + two. show_help_echo uses this to detect popup menus. */ + popup_activated_flag = 1; + /* Process events that apply to the menu. */ + popup_widget_loop (true, menu); + } + + unbind_to (specpdl_count, Qnil); + + /* Must reset this manually because the button release event is not passed + to Emacs event loop. */ + FRAME_DISPLAY_INFO (f)->grabbed = 0; +} + +static void +cleanup_widget_value_tree (void *arg) +{ + free_menubar_widget_value_tree (arg); +} + +Lisp_Object +pgtk_menu_show (struct frame *f, int x, int y, int menuflags, + Lisp_Object title, const char **error_name) +{ + int i; + widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; + widget_value **submenu_stack + = alloca (menu_items_used * sizeof *submenu_stack); + Lisp_Object *subprefix_stack + = alloca (menu_items_used * sizeof *subprefix_stack); + int submenu_depth = 0; + + specpdl_ref specpdl_count = SPECPDL_INDEX (); + + eassert (FRAME_PGTK_P (f)); + + *error_name = NULL; + + if (!FRAME_GTK_OUTER_WIDGET (f)) { + *error_name = "Can't popup from child frames."; + return Qnil; + } + + if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) + { + *error_name = "Empty menu"; + return Qnil; + } + + block_input (); + + /* Create a tree of widget_value objects + representing the panes and their items. */ + wv = make_widget_value ("menu", NULL, true, Qnil); + wv->button_type = BUTTON_TYPE_NONE; + first_wv = wv; + bool first_pane = true; + + /* Loop over all panes and items, filling in the tree. */ + i = 0; + while (i < menu_items_used) + { + if (NILP (AREF (menu_items, i))) + { + submenu_stack[submenu_depth++] = save_wv; + save_wv = prev_wv; + prev_wv = 0; + first_pane = true; + i++; + } + else if (EQ (AREF (menu_items, i), Qlambda)) + { + prev_wv = save_wv; + save_wv = submenu_stack[--submenu_depth]; + first_pane = false; + i++; + } + else if (EQ (AREF (menu_items, i), Qt) && submenu_depth != 0) + i += MENU_ITEMS_PANE_LENGTH; + /* Ignore a nil in the item list. + It's meaningful only for dialog boxes. */ + else if (EQ (AREF (menu_items, i), Qquote)) + i += 1; + else if (EQ (AREF (menu_items, i), Qt)) + { + /* Create a new pane. */ + Lisp_Object pane_name, prefix; + const char *pane_string; + + pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); + prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); + +#ifndef HAVE_MULTILINGUAL_MENU + if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name)) + { + pane_name = ENCODE_MENU_STRING (pane_name); + ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); + } +#endif + pane_string = (NILP (pane_name) ? "" : SSDATA (pane_name)); + /* If there is just one top-level pane, put all its items directly + under the top-level menu. */ + if (menu_items_n_panes == 1) + pane_string = ""; + + /* If the pane has a meaningful name, + make the pane a top-level menu item + with its items as a submenu beneath it. */ + if (!(menuflags & MENU_KEYMAPS) && strcmp (pane_string, "")) + { + wv = make_widget_value (pane_string, NULL, true, Qnil); + if (save_wv) + save_wv->next = wv; + else + first_wv->contents = wv; + if ((menuflags & MENU_KEYMAPS) && !NILP (prefix)) + wv->name++; + wv->button_type = BUTTON_TYPE_NONE; + save_wv = wv; + prev_wv = 0; + } + else if (first_pane) + { + save_wv = wv; + prev_wv = 0; + } + first_pane = false; + i += MENU_ITEMS_PANE_LENGTH; + } + else + { + /* Create a new item within current pane. */ + Lisp_Object item_name, enable, descrip, def, type, selected, help; + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); + enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); + descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); + def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION); + type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE); + selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED); + help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); + +#ifndef HAVE_MULTILINGUAL_MENU + if (STRINGP (item_name) && STRING_MULTIBYTE (item_name)) + { + item_name = ENCODE_MENU_STRING (item_name); + ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); + } + + if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) + { + descrip = ENCODE_MENU_STRING (descrip); + ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); + } +#endif /* not HAVE_MULTILINGUAL_MENU */ + + wv = make_widget_value (SSDATA (item_name), NULL, !NILP (enable), + STRINGP (help) ? help : Qnil); + if (prev_wv) + prev_wv->next = wv; + else + save_wv->contents = wv; + if (!NILP (descrip)) + wv->key = SSDATA (descrip); + /* If this item has a null value, + make the call_data null so that it won't display a box + when the mouse is on it. */ + wv->call_data = !NILP (def) ? aref_addr (menu_items, i) : 0; + + if (NILP (type)) + wv->button_type = BUTTON_TYPE_NONE; + else if (EQ (type, QCtoggle)) + wv->button_type = BUTTON_TYPE_TOGGLE; + else if (EQ (type, QCradio)) + wv->button_type = BUTTON_TYPE_RADIO; + else + emacs_abort (); + + wv->selected = !NILP (selected); + + prev_wv = wv; + + i += MENU_ITEMS_ITEM_LENGTH; + } + } + + /* Deal with the title, if it is non-nil. */ + if (!NILP (title)) + { + widget_value *wv_title; + widget_value *wv_sep1 = make_widget_value ("--", NULL, false, Qnil); + widget_value *wv_sep2 = make_widget_value ("--", NULL, false, Qnil); + + wv_sep2->next = first_wv->contents; + wv_sep1->next = wv_sep2; + +#ifndef HAVE_MULTILINGUAL_MENU + if (STRING_MULTIBYTE (title)) + title = ENCODE_MENU_STRING (title); +#endif + + wv_title = make_widget_value (SSDATA (title), NULL, true, Qnil); + wv_title->button_type = BUTTON_TYPE_NONE; + wv_title->next = wv_sep1; + first_wv->contents = wv_title; + } + + /* No selection has been chosen yet. */ + menu_item_selection = 0; + + /* Make sure to free the widget_value objects we used to specify the + contents even with longjmp. */ + record_unwind_protect_ptr (cleanup_widget_value_tree, first_wv); + + /* Actually create and show the menu until popped down. */ + create_and_show_popup_menu (f, first_wv, x, y, menuflags & MENU_FOR_CLICK); + + unbind_to (specpdl_count, Qnil); + + /* Find the selected item, and its pane, to return + the proper value. */ + if (menu_item_selection != 0) + { + Lisp_Object prefix, entry; + + prefix = entry = Qnil; + i = 0; + while (i < menu_items_used) + { + if (NILP (AREF (menu_items, i))) + { + subprefix_stack[submenu_depth++] = prefix; + prefix = entry; + i++; + } + else if (EQ (AREF (menu_items, i), Qlambda)) + { + prefix = subprefix_stack[--submenu_depth]; + i++; + } + else if (EQ (AREF (menu_items, i), Qt)) + { + prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); + i += MENU_ITEMS_PANE_LENGTH; + } + /* Ignore a nil in the item list. + It's meaningful only for dialog boxes. */ + else if (EQ (AREF (menu_items, i), Qquote)) + i += 1; + else + { + entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); + if (menu_item_selection == aref_addr (menu_items, i)) + { + if (menuflags & MENU_KEYMAPS) + { + int j; + + entry = list1 (entry); + if (!NILP (prefix)) + entry = Fcons (prefix, entry); + for (j = submenu_depth - 1; j >= 0; j--) + if (!NILP (subprefix_stack[j])) + entry = Fcons (subprefix_stack[j], entry); + } + unblock_input (); + return entry; + } + i += MENU_ITEMS_ITEM_LENGTH; + } + } + } + else if (!(menuflags & MENU_FOR_CLICK)) + { + unblock_input (); + /* Make "Cancel" equivalent to C-g. */ + quit (); + } + + unblock_input (); + return Qnil; +} + +static void +dialog_selection_callback (GtkWidget *widget, gpointer client_data) +{ + /* Treat the pointer as an integer. There's no problem + as long as pointers have enough bits to hold small integers. */ + if ((intptr_t) client_data != -1) + menu_item_selection = client_data; + + popup_activated_flag = 0; +} + +/* Pop up the dialog for frame F defined by FIRST_WV and loop until the + dialog pops down. + menu_item_selection will be set to the selection. */ +static void +create_and_show_dialog (struct frame *f, widget_value *first_wv) +{ + GtkWidget *menu; + + eassert (FRAME_PGTK_P (f)); + + menu = xg_create_widget ("dialog", first_wv->name, f, first_wv, + G_CALLBACK (dialog_selection_callback), + G_CALLBACK (popup_deactivate_callback), 0); + + if (menu) + { + specpdl_ref specpdl_count = SPECPDL_INDEX (); + record_unwind_protect_ptr (pop_down_menu, menu); + + /* Display the menu. */ + gtk_widget_show_all (menu); + + /* Process events that apply to the menu. */ + popup_widget_loop (true, menu); + + unbind_to (specpdl_count, Qnil); + } +} + +static const char *button_names[] = { + "button1", "button2", "button3", "button4", "button5", + "button6", "button7", "button8", "button9", "button10" +}; + +Lisp_Object +pgtk_dialog_show (struct frame *f, Lisp_Object title, + Lisp_Object header, const char **error_name) +{ + int i, nb_buttons = 0; + char dialog_name[6]; + + widget_value *wv, *first_wv = 0, *prev_wv = 0; + + /* Number of elements seen so far, before boundary. */ + int left_count = 0; + /* Whether we've seen the boundary between left-hand elts and right-hand. */ + bool boundary_seen = false; + + specpdl_ref specpdl_count = SPECPDL_INDEX (); + + eassert (FRAME_PGTK_P (f)); + + *error_name = NULL; + + if (!FRAME_GTK_OUTER_WIDGET (f)) { + *error_name = "Can't popup from child frames."; + return Qnil; + } + + if (menu_items_n_panes > 1) + { + *error_name = "Multiple panes in dialog box"; + return Qnil; + } + + /* Create a tree of widget_value objects + representing the text label and buttons. */ + { + Lisp_Object pane_name; + const char *pane_string; + pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME); + pane_string = (NILP (pane_name) ? "" : SSDATA (pane_name)); + prev_wv = make_widget_value ("message", (char *) pane_string, true, Qnil); + first_wv = prev_wv; + + /* Loop over all panes and items, filling in the tree. */ + i = MENU_ITEMS_PANE_LENGTH; + while (i < menu_items_used) + { + + /* Create a new item within current pane. */ + Lisp_Object item_name, enable, descrip; + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); + enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); + descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); + + if (NILP (item_name)) + { + free_menubar_widget_value_tree (first_wv); + *error_name = "Submenu in dialog items"; + return Qnil; + } + if (EQ (item_name, Qquote)) + { + /* This is the boundary between left-side elts + and right-side elts. Stop incrementing right_count. */ + boundary_seen = true; + i++; + continue; + } + if (nb_buttons >= 9) + { + free_menubar_widget_value_tree (first_wv); + *error_name = "Too many dialog items"; + return Qnil; + } + + wv = make_widget_value (button_names[nb_buttons], + SSDATA (item_name), !NILP (enable), Qnil); + prev_wv->next = wv; + if (!NILP (descrip)) + wv->key = SSDATA (descrip); + wv->call_data = aref_addr (menu_items, i); + prev_wv = wv; + + if (!boundary_seen) + left_count++; + + nb_buttons++; + i += MENU_ITEMS_ITEM_LENGTH; + } + + /* If the boundary was not specified, + by default put half on the left and half on the right. */ + if (!boundary_seen) + left_count = nb_buttons - nb_buttons / 2; + + wv = make_widget_value (dialog_name, NULL, false, Qnil); + + /* Frame title: 'Q' = Question, 'I' = Information. + Can also have 'E' = Error if, one day, we want + a popup for errors. */ + if (NILP (header)) + dialog_name[0] = 'Q'; + else + dialog_name[0] = 'I'; + + /* Dialog boxes use a really stupid name encoding + which specifies how many buttons to use + and how many buttons are on the right. */ + dialog_name[1] = '0' + nb_buttons; + dialog_name[2] = 'B'; + dialog_name[3] = 'R'; + /* Number of buttons to put on the right. */ + dialog_name[4] = '0' + nb_buttons - left_count; + dialog_name[5] = 0; + wv->contents = first_wv; + first_wv = wv; + } + + /* No selection has been chosen yet. */ + menu_item_selection = 0; + + /* Make sure to free the widget_value objects we used to specify the + contents even with longjmp. */ + record_unwind_protect_ptr (cleanup_widget_value_tree, first_wv); + + /* Actually create and show the dialog. */ + create_and_show_dialog (f, first_wv); + + unbind_to (specpdl_count, Qnil); + + /* Find the selected item, and its pane, to return + the proper value. */ + if (menu_item_selection != 0) + { + i = 0; + while (i < menu_items_used) + { + Lisp_Object entry; + + if (EQ (AREF (menu_items, i), Qt)) + i += MENU_ITEMS_PANE_LENGTH; + else if (EQ (AREF (menu_items, i), Qquote)) + { + /* This is the boundary between left-side elts and + right-side elts. */ + ++i; + } + else + { + entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); + if (menu_item_selection == aref_addr (menu_items, i)) + return entry; + i += MENU_ITEMS_ITEM_LENGTH; + } + } + } + else + /* Make "Cancel" equivalent to C-g. */ + quit (); + + return Qnil; +} + +Lisp_Object +pgtk_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) +{ + Lisp_Object title; + const char *error_name; + Lisp_Object selection; + specpdl_ref specpdl_count = SPECPDL_INDEX (); + + check_window_system (f); + + /* Decode the dialog items from what was specified. */ + title = Fcar (contents); + CHECK_STRING (title); + record_unwind_protect_void (unuse_menu_items); + + if (NILP (Fcar (Fcdr (contents)))) + /* No buttons specified, add an "Ok" button so users can pop down + the dialog. Also, the lesstif/motif version crashes if there are + no buttons. */ + contents = list2 (title, Fcons (build_string ("Ok"), Qt)); + + list_of_panes (list1 (contents)); + + /* Display them in a dialog box. */ + block_input (); + selection = pgtk_dialog_show (f, title, header, &error_name); + unblock_input (); + + unbind_to (specpdl_count, Qnil); + discard_menu_items (); + + if (error_name) + error ("%s", error_name); + return selection; +} + +/* Detect if a dialog or menu has been posted. MSDOS has its own + implementation on msdos.c. */ + +int +popup_activated (void) +{ + return popup_activated_flag; +} + +/* The following is used by delayed window autoselection. */ + +DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0, + doc: /* Return t if a menu or popup dialog is active. +\(On MS Windows, this refers to the selected frame.) */) + (void) +{ + return (popup_activated ())? Qt : Qnil; +} + +static void syms_of_pgtkmenu_for_pdumper (void); + +void +syms_of_pgtkmenu (void) +{ + DEFSYM (Qdebug_on_next_call, "debug-on-next-call"); + defsubr (&Smenu_or_popup_active_p); + + DEFSYM (Qframe_monitor_workarea, "frame-monitor-workarea"); + + defsubr (&Sx_menu_bar_open_internal); + Ffset (intern_c_string ("accelerate-menu"), + intern_c_string (Sx_menu_bar_open_internal.s.symbol_name)); + + pdumper_do_now_and_after_load (syms_of_pgtkmenu_for_pdumper); +} + +static void +syms_of_pgtkmenu_for_pdumper (void) +{ +} diff --git a/src/pgtkselect.c b/src/pgtkselect.c new file mode 100644 index 00000000000..4c87aaa7ea6 --- /dev/null +++ b/src/pgtkselect.c @@ -0,0 +1,536 @@ +/* Gtk selection processing for emacs. + Copyright (C) 1993-1994, 2005-2006, 2008-2022 Free Software + Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +/* FIXME: this file needs a major rewrite to replace the use of GTK's + own high-level GtkClipboard API with the GDK selection API: + + https://developer-old.gnome.org/gdk3/stable/gdk3-Selections.html + + That way, most of the code can be shared with X, and non-text + targets along with drag-and-drop can be supported. GDK implements + selections according to the ICCCM, as on X, but its selection API + will work on any supported window system. */ + +/* This should be the first include, as it may set up #defines affecting + interpretation of even the system includes. */ +#include <config.h> + +#include "lisp.h" +#include "pgtkterm.h" +#include "termhooks.h" +#include "keyboard.h" +#include "pgtkselect.h" +#include <gdk/gdk.h> + +static GQuark quark_primary_data = 0; +static GQuark quark_primary_size = 0; +static GQuark quark_secondary_data = 0; +static GQuark quark_secondary_size = 0; +static GQuark quark_clipboard_data = 0; +static GQuark quark_clipboard_size = 0; + +/* ========================================================================== + + Internal utility functions + + ========================================================================== */ + +/* From a Lisp_Object, return a suitable frame for selection + operations. OBJECT may be a frame, a terminal object, or nil + (which stands for the selected frame--or, if that is not an pgtk + frame, the first pgtk display on the list). If no suitable frame can + be found, return NULL. */ + +static struct frame * +frame_for_pgtk_selection (Lisp_Object object) +{ + Lisp_Object tail, frame; + struct frame *f; + + if (NILP (object)) + { + f = XFRAME (selected_frame); + if (FRAME_PGTK_P (f) && FRAME_LIVE_P (f)) + return f; + + FOR_EACH_FRAME (tail, frame) + { + f = XFRAME (frame); + if (FRAME_PGTK_P (f) && FRAME_LIVE_P (f)) + return f; + } + } + else if (TERMINALP (object)) + { + struct terminal *t = decode_live_terminal (object); + + if (t->type == output_pgtk) + FOR_EACH_FRAME (tail, frame) + { + f = XFRAME (frame); + if (FRAME_LIVE_P (f) && f->terminal == t) + return f; + } + } + else if (FRAMEP (object)) + { + f = XFRAME (object); + if (FRAME_PGTK_P (f) && FRAME_LIVE_P (f)) + return f; + } + + return NULL; +} + +static GtkClipboard * +symbol_to_gtk_clipboard (GtkWidget * widget, Lisp_Object symbol) +{ + GdkAtom atom; + + CHECK_SYMBOL (symbol); + if (NILP (symbol)) + { + atom = GDK_SELECTION_PRIMARY; + } + else if (EQ (symbol, QCLIPBOARD)) + { + atom = GDK_SELECTION_CLIPBOARD; + } + else if (EQ (symbol, QPRIMARY)) + { + atom = GDK_SELECTION_PRIMARY; + } + else if (EQ (symbol, QSECONDARY)) + { + atom = GDK_SELECTION_SECONDARY; + } + else if (EQ (symbol, Qt)) + { + atom = GDK_SELECTION_SECONDARY; + } + else + { + atom = 0; + error ("Bad selection"); + } + + return gtk_widget_get_clipboard (widget, atom); +} + +static void +selection_type_to_quarks (GdkAtom type, GQuark * quark_data, + GQuark * quark_size) +{ + if (type == GDK_SELECTION_PRIMARY) + { + *quark_data = quark_primary_data; + *quark_size = quark_primary_size; + } + else if (type == GDK_SELECTION_SECONDARY) + { + *quark_data = quark_secondary_data; + *quark_size = quark_secondary_size; + } + else if (type == GDK_SELECTION_CLIPBOARD) + { + *quark_data = quark_clipboard_data; + *quark_size = quark_clipboard_size; + } + else + /* FIXME: Is it safe to use 'error' here? */ + error ("Unknown selection type."); +} + +static void +get_func (GtkClipboard * cb, GtkSelectionData * data, guint info, + gpointer user_data_or_owner) +{ + GObject *obj = G_OBJECT (user_data_or_owner); + const char *str; + int size; + GQuark quark_data, quark_size; + + selection_type_to_quarks (gtk_clipboard_get_selection (cb), &quark_data, + &quark_size); + + str = g_object_get_qdata (obj, quark_data); + size = GPOINTER_TO_SIZE (g_object_get_qdata (obj, quark_size)); + gtk_selection_data_set_text (data, str, size); +} + +static void +clear_func (GtkClipboard * cb, gpointer user_data_or_owner) +{ + GObject *obj = G_OBJECT (user_data_or_owner); + GQuark quark_data, quark_size; + + selection_type_to_quarks (gtk_clipboard_get_selection (cb), &quark_data, + &quark_size); + + g_object_set_qdata (obj, quark_data, NULL); + g_object_set_qdata (obj, quark_size, 0); +} + + +/* ========================================================================== + + Functions used externally + + ========================================================================== */ + +void +pgtk_selection_init (void) +{ + if (quark_primary_data == 0) + { + quark_primary_data = g_quark_from_static_string ("pgtk-primary-data"); + quark_primary_size = g_quark_from_static_string ("pgtk-primary-size"); + quark_secondary_data = + g_quark_from_static_string ("pgtk-secondary-data"); + quark_secondary_size = + g_quark_from_static_string ("pgtk-secondary-size"); + quark_clipboard_data = + g_quark_from_static_string ("pgtk-clipboard-data"); + quark_clipboard_size = + g_quark_from_static_string ("pgtk-clipboard-size"); + } +} + +void +pgtk_selection_lost (GtkWidget * widget, GdkEventSelection * event, + gpointer user_data) +{ + GQuark quark_data, quark_size; + + selection_type_to_quarks (event->selection, &quark_data, &quark_size); + + g_object_set_qdata (G_OBJECT (widget), quark_data, NULL); + g_object_set_qdata (G_OBJECT (widget), quark_size, 0); +} + +static bool +pgtk_selection_usable (void) +{ + if (pgtk_enable_selection_on_multi_display) + return true; + + /* Gdk uses `gdk_display_get_default' when handling selections, so + selections don't work properly when Emacs is connected to + multiple displays. */ + + GdkDisplayManager *dpyman = gdk_display_manager_get (); + GSList *list = gdk_display_manager_list_displays (dpyman); + int len = g_slist_length (list); + g_slist_free (list); + return len < 2; +} + +/* ========================================================================== + + Lisp Defuns + + ========================================================================== */ + + +DEFUN ("pgtk-own-selection-internal", Fpgtk_own_selection_internal, Spgtk_own_selection_internal, 2, 3, 0, + doc: /* Assert an X selection of type SELECTION and value VALUE. +SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. +\(Those are literal upper-case symbol names, since that's what X expects.) +VALUE is typically a string, or a cons of two markers, but may be +anything that the functions on `selection-converter-alist' know about. + +FRAME should be a frame that should own the selection. If omitted or +nil, it defaults to the selected frame. */) + (Lisp_Object selection, Lisp_Object value, Lisp_Object frame) +{ + Lisp_Object successful_p = Qnil; + Lisp_Object target_symbol, rest; + GtkClipboard *cb; + struct frame *f; + GQuark quark_data, quark_size; + + check_window_system (NULL); + + if (!pgtk_selection_usable ()) + return Qnil; + + if (NILP (frame)) + frame = selected_frame; + if (!FRAME_LIVE_P (XFRAME (frame)) || !FRAME_PGTK_P (XFRAME (frame))) + error ("pgtk selection unavailable for this frame"); + f = XFRAME (frame); + + cb = symbol_to_gtk_clipboard (FRAME_GTK_WIDGET (f), selection); + selection_type_to_quarks (gtk_clipboard_get_selection (cb), &quark_data, + &quark_size); + + /* We only support copy of text. */ + target_symbol = QTEXT; + if (STRINGP (value)) + { + GtkTargetList *list; + GtkTargetEntry *targets; + gint n_targets; + GtkWidget *widget; + + list = gtk_target_list_new (NULL, 0); + gtk_target_list_add_text_targets (list, 0); + + { + /* text/plain: Strings encoded by Gtk are not correctly decoded by Chromium(Wayland). */ + GdkAtom atom_text_plain = gdk_atom_intern ("text/plain", false); + gtk_target_list_remove (list, atom_text_plain); + } + + targets = gtk_target_table_new_from_list (list, &n_targets); + + int size = SBYTES (value); + gchar *str = xmalloc (size + 1); + memcpy (str, SSDATA (value), size); + str[size] = '\0'; + + widget = FRAME_GTK_WIDGET (f); + g_object_set_qdata_full (G_OBJECT (widget), quark_data, str, xfree); + g_object_set_qdata_full (G_OBJECT (widget), quark_size, + GSIZE_TO_POINTER (size), NULL); + + if (gtk_clipboard_set_with_owner (cb, + targets, n_targets, + get_func, clear_func, + G_OBJECT (FRAME_GTK_WIDGET (f)))) + { + successful_p = Qt; + } + gtk_clipboard_set_can_store (cb, NULL, 0); + + gtk_target_table_free (targets, n_targets); + gtk_target_list_unref (list); + } + + if (!EQ (Vpgtk_sent_selection_hooks, Qunbound)) + { + /* FIXME: Use run-hook-with-args! */ + for (rest = Vpgtk_sent_selection_hooks; CONSP (rest); + rest = Fcdr (rest)) + call3 (Fcar (rest), selection, target_symbol, successful_p); + } + + return value; +} + + +DEFUN ("pgtk-disown-selection-internal", Fpgtk_disown_selection_internal, + Spgtk_disown_selection_internal, 1, 2, 0, + doc: /* If we own the selection SELECTION, disown it. +Disowning it means there is no such selection. + +TERMINAL should be a terminal object or a frame specifying the X +server to query. If omitted or nil, that stands for the selected +frame's display, or the first available X display. */) + (Lisp_Object selection, Lisp_Object terminal) +{ + struct frame *f = frame_for_pgtk_selection (terminal); + GtkClipboard *cb; + + if (!pgtk_selection_usable ()) + return Qnil; + + if (!f) + return Qnil; + + cb = symbol_to_gtk_clipboard (FRAME_GTK_WIDGET (f), selection); + + gtk_clipboard_clear (cb); + + return Qt; +} + + +DEFUN ("pgtk-selection-exists-p", Fpgtk_selection_exists_p, Spgtk_selection_exists_p, 0, 2, 0, + doc: /* Whether there is an owner for the given X selection. +SELECTION should be the name of the selection in question, typically +one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects +these literal upper-case names.) The symbol nil is the same as +`PRIMARY', and t is the same as `SECONDARY'. + +TERMINAL should be a terminal object or a frame specifying the X +server to query. If omitted or nil, that stands for the selected +frame's display, or the first available X display. + +On Nextstep, TERMINAL is unused. */) + (Lisp_Object selection, Lisp_Object terminal) +{ + struct frame *f = frame_for_pgtk_selection (terminal); + GtkClipboard *cb; + + if (!pgtk_selection_usable ()) + return Qnil; + + if (!f) + return Qnil; + + cb = symbol_to_gtk_clipboard (FRAME_GTK_WIDGET (f), selection); + + return gtk_clipboard_wait_is_text_available (cb) ? Qt : Qnil; +} + + +DEFUN ("pgtk-selection-owner-p", Fpgtk_selection_owner_p, Spgtk_selection_owner_p, 0, 2, 0, + doc: /* Whether the current Emacs process owns the given X Selection. +The arg should be the name of the selection in question, typically one of +the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. +\(Those are literal upper-case symbol names, since that's what X expects.) +For convenience, the symbol nil is the same as `PRIMARY', +and t is the same as `SECONDARY'. + +TERMINAL should be a terminal object or a frame specifying the X +server to query. If omitted or nil, that stands for the selected +frame's display, or the first available X display. + +On Nextstep, TERMINAL is unused. */) + (Lisp_Object selection, Lisp_Object terminal) +{ + struct frame *f = frame_for_pgtk_selection (terminal); + GtkClipboard *cb; + GObject *obj; + GQuark quark_data, quark_size; + + if (!pgtk_selection_usable ()) + return Qnil; + + cb = symbol_to_gtk_clipboard (FRAME_GTK_WIDGET (f), selection); + selection_type_to_quarks (gtk_clipboard_get_selection (cb), &quark_data, + &quark_size); + + obj = gtk_clipboard_get_owner (cb); + + return obj && g_object_get_qdata (obj, quark_data) != NULL ? Qt : Qnil; +} + + +DEFUN ("pgtk-get-selection-internal", Fpgtk_get_selection_internal, + Spgtk_get_selection_internal, 2, 3, 0, + doc: /* Return text selected from some program. +SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. +\(Those are literal upper-case symbol names, since that's what X expects.) +TARGET-TYPE is the type of data desired, typically `STRING'. + +TERMINAL should be a terminal object or a frame specifying the X +server to query. If omitted or nil, that stands for the selected +frame's display, or the first available display. */) + (Lisp_Object selection_symbol, Lisp_Object target_type, + Lisp_Object terminal) +{ + struct frame *f = frame_for_pgtk_selection (terminal); + GtkClipboard *cb; + + CHECK_SYMBOL (selection_symbol); + CHECK_SYMBOL (target_type); + + if (EQ (target_type, QMULTIPLE)) + error ("Retrieving MULTIPLE selections is currently unimplemented"); + if (!f) + error ("PGTK selection unavailable for this frame"); + + if (!pgtk_selection_usable ()) + return Qnil; + + cb = symbol_to_gtk_clipboard (FRAME_GTK_WIDGET (f), selection_symbol); + + GdkAtom target_atom = gdk_atom_intern (SSDATA (SYMBOL_NAME (target_type)), false); + GtkSelectionData *seldata = gtk_clipboard_wait_for_contents (cb, target_atom); + + if (seldata == NULL) + return Qnil; + + const guchar *sd_data = gtk_selection_data_get_data (seldata); + int sd_len = gtk_selection_data_get_length (seldata); + int sd_format = gtk_selection_data_get_format (seldata); + GdkAtom sd_type = gtk_selection_data_get_data_type (seldata); + + if (sd_format == 8) + { + Lisp_Object str, lispy_type; + + str = make_unibyte_string ((char *) sd_data, sd_len); + /* Indicate that this string is from foreign selection by a text + property `foreign-selection' so that the caller of + x-get-selection-internal (usually x-get-selection) can know + that the string must be decode. */ + if (sd_type == gdk_atom_intern ("COMPOUND_TEXT", false)) + lispy_type = QCOMPOUND_TEXT; + else if (sd_type == gdk_atom_intern ("UTF8_STRING", false)) + lispy_type = QUTF8_STRING; + else if (sd_type == gdk_atom_intern ("text/plain;charset=utf-8", false)) + lispy_type = Qtext_plain_charset_utf_8; + else + lispy_type = QSTRING; + Fput_text_property (make_fixnum (0), make_fixnum (sd_len), + Qforeign_selection, lispy_type, str); + + gtk_selection_data_free (seldata); + return str; + } + + gtk_selection_data_free (seldata); + return Qnil; +} + +void +syms_of_pgtkselect (void) +{ + DEFSYM (QCLIPBOARD, "CLIPBOARD"); + DEFSYM (QSECONDARY, "SECONDARY"); + DEFSYM (QTEXT, "TEXT"); + DEFSYM (QFILE_NAME, "FILE_NAME"); + DEFSYM (QMULTIPLE, "MULTIPLE"); + + DEFSYM (Qforeign_selection, "foreign-selection"); + DEFSYM (QUTF8_STRING, "UTF8_STRING"); + DEFSYM (QSTRING, "STRING"); + DEFSYM (QCOMPOUND_TEXT, "COMPOUND_TEXT"); + DEFSYM (Qtext_plain_charset_utf_8, "text/plain;charset=utf-8"); + + defsubr (&Spgtk_disown_selection_internal); + defsubr (&Spgtk_get_selection_internal); + defsubr (&Spgtk_own_selection_internal); + defsubr (&Spgtk_selection_exists_p); + defsubr (&Spgtk_selection_owner_p); + + DEFVAR_LISP ("pgtk-sent-selection-hooks", Vpgtk_sent_selection_hooks, + doc: /* A list of functions to be called when Emacs answers a selection request +The functions are called with four arguments: + - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD'); + - the selection-type which Emacs was asked to convert the + selection into before sending (for example, `STRING' or `LENGTH'); + - a flag indicating success or failure for responding to the request. +We might have failed (and declined the request) for any number of reasons, +including being asked for a selection that we no longer own, or being asked +to convert into a type that we don't know about or that is inappropriate. +This hook doesn't let you change the behavior of Emacs's selection replies, +it merely informs you that they have happened. */); + Vpgtk_sent_selection_hooks = Qnil; + + DEFVAR_BOOL ("pgtk-enable-selection-on-multi-display", pgtk_enable_selection_on_multi_display, + doc: /* Enable selections when connected to multiple displays. +This may cause crashes due to a GTK bug, which assumes that clients +will connect to a single display. It might also cause selections to +not arrive at the correct display. */); + pgtk_enable_selection_on_multi_display = false; +} diff --git a/src/pgtkselect.h b/src/pgtkselect.h new file mode 100644 index 00000000000..fd9910b2d18 --- /dev/null +++ b/src/pgtkselect.h @@ -0,0 +1,31 @@ +/* Definitions and headers for selection of pure Gtk+3. + Copyright (C) 1989, 1993, 2005, 2008-2022 Free Software Foundation, + Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + + +#include "dispextern.h" +#include "frame.h" + +#ifdef HAVE_PGTK + +#include <gtk/gtk.h> + +extern void pgtk_selection_init (void); +extern void pgtk_selection_lost (GtkWidget *, GdkEventSelection *, gpointer); + +#endif /* HAVE_PGTK */ diff --git a/src/pgtkterm.c b/src/pgtkterm.c new file mode 100644 index 00000000000..a59abba625a --- /dev/null +++ b/src/pgtkterm.c @@ -0,0 +1,7152 @@ +/* Pure Gtk+-3 communication module. -*- coding: utf-8 -*- + +Copyright (C) 1989, 1993-1994, 2005-2006, 2008-2022 Free Software +Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +/* This should be the first include, as it may set up #defines affecting + interpretation of even the system includes. */ +#include <config.h> + +#include <cairo.h> +#include <fcntl.h> +#include <math.h> +#include <pthread.h> +#include <sys/types.h> +#include <time.h> +#include <signal.h> +#include <unistd.h> +#include <errno.h> + +#include <c-ctype.h> +#include <c-strcase.h> +#include <ftoastr.h> + +#include <dlfcn.h> + +#include "lisp.h" +#include "blockinput.h" +#include "frame.h" +#include "sysselect.h" +#include "gtkutil.h" +#include "systime.h" +#include "character.h" +#include "xwidget.h" +#include "fontset.h" +#include "composite.h" +#include "ccl.h" + +#include "termhooks.h" +#include "termopts.h" +#include "termchar.h" +#include "emacs-icon.h" +#include "menu.h" +#include "window.h" +#include "keyboard.h" +#include "atimer.h" +#include "buffer.h" +#include "font.h" +#include "xsettings.h" +#include "pgtkselect.h" +#include "emacsgtkfixed.h" + +#ifdef GDK_WINDOWING_WAYLAND +#include <gdk/gdkwayland.h> +#endif + +#define FRAME_CR_CONTEXT(f) ((f)->output_data.pgtk->cr_context) +#define FRAME_CR_ACTIVE_CONTEXT(f) ((f)->output_data.pgtk->cr_active) +#define FRAME_CR_SURFACE(f) (cairo_get_target (FRAME_CR_CONTEXT (f))) + +/* Non-zero means that a HELP_EVENT has been generated since Emacs + start. */ + +static bool any_help_event_p; + +struct pgtk_display_info *x_display_list; /* Chain of existing displays */ +extern Lisp_Object tip_frame; + +static struct event_queue_t +{ + union buffered_input_event *q; + int nr, cap; +} event_q = { + NULL, 0, 0, +}; + +/* Non-zero timeout value means ignore next mouse click if it arrives + before that timeout elapses (i.e. as part of the same sequence of + events resulting from clicking on a frame to select it). */ + +static Time ignore_next_mouse_click_timeout; + +static Lisp_Object xg_default_icon_file; + +static void pgtk_delete_display (struct pgtk_display_info *); +static void pgtk_clear_frame_area (struct frame *, int, int, int, int); +static void pgtk_fill_rectangle (struct frame *, unsigned long, int, int, + int, int, bool); +static void pgtk_clip_to_row (struct window *, struct glyph_row *, + enum glyph_row_area, cairo_t *); +static struct frame *pgtk_any_window_to_frame (GdkWindow *); +static void pgtk_regenerate_devices (struct pgtk_display_info *); + +static void +pgtk_device_added_or_removal_cb (GdkSeat *seat, GdkDevice *device, + gpointer user_data) +{ + pgtk_regenerate_devices (user_data); +} + +static void +pgtk_seat_added_cb (GdkDisplay *dpy, GdkSeat *seat, + gpointer user_data) +{ + pgtk_regenerate_devices (user_data); + + g_signal_connect (G_OBJECT (seat), "device-added", + G_CALLBACK (pgtk_device_added_or_removal_cb), + user_data); + g_signal_connect (G_OBJECT (seat), "device-removed", + G_CALLBACK (pgtk_device_added_or_removal_cb), + user_data); +} + +static void +pgtk_seat_removed_cb (GdkDisplay *dpy, GdkSeat *seat, + gpointer user_data) +{ + pgtk_regenerate_devices (user_data); + + g_signal_handlers_disconnect_by_func (G_OBJECT (seat), + G_CALLBACK (pgtk_device_added_or_removal_cb), + user_data); +} + +static void +pgtk_enumerate_devices (struct pgtk_display_info *dpyinfo, + bool initial_p) +{ + struct pgtk_device_t *rec; + GList *all_seats, *devices_on_seat, *tem, *t1; + GdkSeat *seat; + char printbuf[1026]; /* Believe it or not, some device names are + actually almost this long. */ + + block_input (); + all_seats = gdk_display_list_seats (dpyinfo->gdpy); + + for (tem = all_seats; tem; tem = tem->next) + { + seat = GDK_SEAT (tem->data); + + if (initial_p) + { + g_signal_connect (G_OBJECT (seat), "device-added", + G_CALLBACK (pgtk_device_added_or_removal_cb), + dpyinfo); + g_signal_connect (G_OBJECT (seat), "device-removed", + G_CALLBACK (pgtk_device_added_or_removal_cb), + dpyinfo); + } + + /* We only want slaves, not master devices. */ + devices_on_seat = gdk_seat_get_slaves (seat, + GDK_SEAT_CAPABILITY_ALL); + + for (t1 = devices_on_seat; t1; t1 = t1->next) + { + rec = xmalloc (sizeof *rec); + rec->seat = g_object_ref (seat); + rec->device = GDK_DEVICE (t1->data); + + snprintf (printbuf, 1026, "%u:%s", + gdk_device_get_source (rec->device), + gdk_device_get_name (rec->device)); + + rec->name = build_string (printbuf); + rec->next = dpyinfo->devices; + dpyinfo->devices = rec; + } + + g_list_free (devices_on_seat); + } + + g_list_free (all_seats); + unblock_input (); +} + +static void +pgtk_free_devices (struct pgtk_display_info *dpyinfo) +{ + struct pgtk_device_t *last, *tem; + + tem = dpyinfo->devices; + while (tem) + { + last = tem; + tem = tem->next; + + g_object_unref (last->seat); + xfree (last); + } + + dpyinfo->devices = NULL; +} + +static void +pgtk_regenerate_devices (struct pgtk_display_info *dpyinfo) +{ + pgtk_free_devices (dpyinfo); + pgtk_enumerate_devices (dpyinfo, false); +} + +static void +pgtk_toolkit_position (struct frame *f, int x, int y, + bool *menu_bar_p, bool *tool_bar_p) +{ + GdkRectangle test_rect; + int scale; + + y += (FRAME_MENUBAR_HEIGHT (f) + + FRAME_TOOLBAR_TOP_HEIGHT (f)); + x += FRAME_TOOLBAR_LEFT_WIDTH (f); + + if (FRAME_EXTERNAL_MENU_BAR (f)) + *menu_bar_p = (x >= 0 && x < FRAME_PIXEL_WIDTH (f) + && y >= 0 && y < FRAME_MENUBAR_HEIGHT (f)); + + if (FRAME_X_OUTPUT (f)->toolbar_widget) + { + scale = xg_get_scale (f); + test_rect.x = x / scale; + test_rect.y = y / scale; + test_rect.width = 1; + test_rect.height = 1; + + *tool_bar_p = gtk_widget_intersect (FRAME_X_OUTPUT (f)->toolbar_widget, + &test_rect, NULL); + } +} + +static Lisp_Object +pgtk_get_device_for_event (struct pgtk_display_info *dpyinfo, + GdkEvent *event) +{ + struct pgtk_device_t *tem; + GdkDevice *device; + + device = gdk_event_get_source_device (event); + + if (!device) + return Qt; + + for (tem = dpyinfo->devices; tem; tem = tem->next) + { + if (tem->device == device) + return tem->name; + } + + return Qt; +} + +/* This is not a flip context in the same sense as gpu rendering + scenes, it only occurs when a new context was required due to a + resize or other fundamental change. This is called when that + context's surface has completed drawing. */ + +static void +flip_cr_context (struct frame *f) +{ + cairo_t *cr = FRAME_CR_ACTIVE_CONTEXT (f); + + block_input (); + if (cr != FRAME_CR_CONTEXT (f)) + { + cairo_destroy (cr); + FRAME_CR_ACTIVE_CONTEXT (f) = cairo_reference (FRAME_CR_CONTEXT (f)); + + } + unblock_input (); +} + + +static void +evq_enqueue (union buffered_input_event *ev) +{ + struct event_queue_t *evq = &event_q; + if (evq->cap == 0) + { + evq->cap = 4; + evq->q = xmalloc (sizeof *evq->q * evq->cap); + } + + if (evq->nr >= evq->cap) + { + evq->cap += evq->cap / 2; + evq->q = xrealloc (evq->q, sizeof *evq->q * evq->cap); + } + + evq->q[evq->nr++] = *ev; + raise (SIGIO); +} + +static int +evq_flush (struct input_event *hold_quit) +{ + struct event_queue_t *evq = &event_q; + int n = 0; + + while (evq->nr > 0) + { + /* kbd_buffer_store_buffered_event may do longjmp, so + we need to shift event queue first and pass the event + to kbd_buffer_store_buffered_event so that events in + queue are not processed twice. Bug#52941 */ + union buffered_input_event ev = evq->q[0]; + int i; + for (i = 1; i < evq->nr; i++) + evq->q[i - 1] = evq->q[i]; + evq->nr--; + + kbd_buffer_store_buffered_event (&ev, hold_quit); + n++; + } + + return n; +} + +void +mark_pgtkterm (void) +{ + struct pgtk_display_info *dpyinfo; + struct pgtk_device_t *device; + struct event_queue_t *evq = &event_q; + int i, n = evq->nr; + + for (i = 0; i < n; i++) + { + union buffered_input_event *ev = &evq->q[i]; + mark_object (ev->ie.x); + mark_object (ev->ie.y); + mark_object (ev->ie.frame_or_window); + mark_object (ev->ie.arg); + mark_object (ev->ie.device); + } + + for (dpyinfo = x_display_list; dpyinfo; + dpyinfo = dpyinfo->next) + { + for (device = dpyinfo->devices; device; + device = device->next) + mark_object (device->name); + } +} + +char * +get_keysym_name (int keysym) +{ + return gdk_keyval_name (keysym); +} + +void +frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) +/* -------------------------------------------------------------------------- + Programmatically reposition mouse pointer in pixel coordinates + -------------------------------------------------------------------------- */ +{ +} + +/* Raise frame F. */ + +static void +pgtk_raise_frame (struct frame *f) +{ + /* This works only for non-child frames on X. + It does not work for child frames on X, and it does not work + on Wayland too. */ + block_input (); + if (FRAME_VISIBLE_P (f)) + gdk_window_raise (gtk_widget_get_window (FRAME_WIDGET (f))); + unblock_input (); +} + +/* Lower frame F. */ + +static void +pgtk_lower_frame (struct frame *f) +{ + if (FRAME_VISIBLE_P (f)) + { + block_input (); + gdk_window_lower (gtk_widget_get_window (FRAME_WIDGET (f))); + unblock_input (); + } +} + +static void +pgtk_frame_raise_lower (struct frame *f, bool raise_flag) +{ + if (raise_flag) + pgtk_raise_frame (f); + else + pgtk_lower_frame (f); +} + +/* Free X resources of frame F. */ + +void +x_free_frame_resources (struct frame *f) +{ + struct pgtk_display_info *dpyinfo; + Mouse_HLInfo *hlinfo; + + check_window_system (f); + dpyinfo = FRAME_DISPLAY_INFO (f); + hlinfo = MOUSE_HL_INFO (f); + + block_input (); + +#ifdef HAVE_XWIDGETS + kill_frame_xwidget_views (f); +#endif + free_frame_faces (f); + + if (FRAME_X_OUTPUT (f)->scale_factor_atimer != NULL) + { + cancel_atimer (FRAME_X_OUTPUT (f)->scale_factor_atimer); + FRAME_X_OUTPUT (f)->scale_factor_atimer = NULL; + } + +#define CLEAR_IF_EQ(FIELD) \ + do { if (f == dpyinfo->FIELD) dpyinfo->FIELD = 0; } while (false) + + CLEAR_IF_EQ (x_focus_frame); + CLEAR_IF_EQ (highlight_frame); + CLEAR_IF_EQ (x_focus_event_frame); + CLEAR_IF_EQ (last_mouse_frame); + CLEAR_IF_EQ (last_mouse_motion_frame); + CLEAR_IF_EQ (last_mouse_glyph_frame); + CLEAR_IF_EQ (im.focused_frame); + +#undef CLEAR_IF_EQ + + if (f == hlinfo->mouse_face_mouse_frame) + reset_mouse_highlight (hlinfo); + + g_clear_object (&FRAME_X_OUTPUT (f)->text_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->nontext_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->modeline_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->hand_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->hourglass_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->horizontal_drag_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->vertical_drag_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->left_edge_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->right_edge_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->top_edge_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->bottom_edge_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->top_left_corner_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->top_right_corner_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->bottom_right_corner_cursor); + g_clear_object (&FRAME_X_OUTPUT (f)->bottom_left_corner_cursor); + + + if (FRAME_X_OUTPUT (f)->border_color_css_provider != NULL) + { + GtkStyleContext *ctxt = gtk_widget_get_style_context (FRAME_WIDGET (f)); + GtkCssProvider *old = FRAME_X_OUTPUT (f)->border_color_css_provider; + gtk_style_context_remove_provider (ctxt, GTK_STYLE_PROVIDER (old)); + g_object_unref (old); + FRAME_X_OUTPUT (f)->border_color_css_provider = NULL; + } + + if (FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider != NULL) + { + GtkCssProvider *old = + FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider; + g_object_unref (old); + FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider = NULL; + } + + if (FRAME_X_OUTPUT (f)->scrollbar_background_css_provider != NULL) + { + GtkCssProvider *old = + FRAME_X_OUTPUT (f)->scrollbar_background_css_provider; + g_object_unref (old); + FRAME_X_OUTPUT (f)->scrollbar_background_css_provider = NULL; + } + + gtk_widget_destroy (FRAME_WIDGET (f)); + + if (FRAME_X_OUTPUT (f)->cr_surface_visible_bell != NULL) + { + cairo_surface_destroy (FRAME_X_OUTPUT (f)->cr_surface_visible_bell); + FRAME_X_OUTPUT (f)->cr_surface_visible_bell = NULL; + } + + if (FRAME_X_OUTPUT (f)->atimer_visible_bell != NULL) + { + cancel_atimer (FRAME_X_OUTPUT (f)->atimer_visible_bell); + FRAME_X_OUTPUT (f)->atimer_visible_bell = NULL; + } + + xfree (f->output_data.pgtk); + f->output_data.pgtk = NULL; + + unblock_input (); +} + +void +x_destroy_window (struct frame *f) +/* -------------------------------------------------------------------------- + External: Delete the window + -------------------------------------------------------------------------- */ +{ + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + + check_window_system (f); + if (dpyinfo->gdpy != NULL) + x_free_frame_resources (f); + + dpyinfo->reference_count--; +} + +/* Calculate the absolute position in frame F + from its current recorded position values and gravity. */ + +static void +x_calc_absolute_position (struct frame *f) +{ + int flags = f->size_hint_flags; + struct frame *p = FRAME_PARENT_FRAME (f); + + /* We have nothing to do if the current position + is already for the top-left corner. */ + if (! ((flags & XNegative) || (flags & YNegative))) + return; + + /* Treat negative positions as relative to the leftmost bottommost + position that fits on the screen. */ + if ((flags & XNegative) && (f->left_pos <= 0)) + { + int width = FRAME_PIXEL_WIDTH (f); + + /* A frame that has been visible at least once should have outer + edges. */ + if (f->output_data.pgtk->has_been_visible && !p) + { + Lisp_Object frame; + Lisp_Object edges = Qnil; + + XSETFRAME (frame, f); + edges = Fpgtk_frame_edges (frame, Qouter_edges); + if (!NILP (edges)) + width = (XFIXNUM (Fnth (make_fixnum (2), edges)) + - XFIXNUM (Fnth (make_fixnum (0), edges))); + } + + if (p) + f->left_pos = (FRAME_PIXEL_WIDTH (p) - width - 2 * f->border_width + + f->left_pos); + else + f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f)) + - width + f->left_pos); + + } + + if ((flags & YNegative) && (f->top_pos <= 0)) + { + int height = FRAME_PIXEL_HEIGHT (f); + + if (f->output_data.pgtk->has_been_visible && !p) + { + Lisp_Object frame; + Lisp_Object edges = Qnil; + + XSETFRAME (frame, f); + if (NILP (edges)) + edges = Fpgtk_frame_edges (frame, Qouter_edges); + if (!NILP (edges)) + height = (XFIXNUM (Fnth (make_fixnum (3), edges)) + - XFIXNUM (Fnth (make_fixnum (1), edges))); + } + + if (p) + f->top_pos = (FRAME_PIXEL_HEIGHT (p) - height - 2 * f->border_width + + f->top_pos); + else + f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f)) + - height + f->top_pos); + } + + /* The left_pos and top_pos + are now relative to the top and left screen edges, + so the flags should correspond. */ + f->size_hint_flags &= ~ (XNegative | YNegative); +} + +/* CHANGE_GRAVITY is 1 when calling from Fset_frame_position, + to really change the position, and 0 when calling from + x_make_frame_visible (in that case, XOFF and YOFF are the current + position values). It is -1 when calling from x_set_frame_parameters, + which means, do adjust for borders but don't change the gravity. */ + +static void +pgtk_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) +{ + if (change_gravity > 0) + { + f->top_pos = yoff; + f->left_pos = xoff; + f->size_hint_flags &= ~ (XNegative | YNegative); + if (xoff < 0) + f->size_hint_flags |= XNegative; + if (yoff < 0) + f->size_hint_flags |= YNegative; + f->win_gravity = NorthWestGravity; + } + + x_calc_absolute_position (f); + + block_input (); + x_wm_set_size_hint (f, 0, false); + + if (change_gravity != 0) + { + if (FRAME_GTK_OUTER_WIDGET (f)) + { + gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + f->left_pos, f->top_pos); + } + else + { + GtkWidget *fixed = FRAME_GTK_WIDGET (f); + GtkWidget *parent = gtk_widget_get_parent (fixed); + gtk_fixed_move (GTK_FIXED (parent), fixed, + f->left_pos, f->top_pos); + } + } + unblock_input (); + return; +} + +static void +pgtk_set_window_size (struct frame *f, bool change_gravity, + int width, int height) +/* -------------------------------------------------------------------------- + Adjust window pixel size based on given character grid size + Impl is a bit more complex than other terms, need to do some + internal clipping. + -------------------------------------------------------------------------- */ +{ + int pixelwidth, pixelheight; + + block_input (); + + gtk_widget_get_size_request (FRAME_GTK_WIDGET (f), &pixelwidth, + &pixelheight); + + pixelwidth = width; + pixelheight = height; + + for (GtkWidget * w = FRAME_GTK_WIDGET (f); w != NULL; + w = gtk_widget_get_parent (w)) + { + gint wd, hi; + gtk_widget_get_size_request (w, &wd, &hi); + } + + f->output_data.pgtk->preferred_width = pixelwidth; + f->output_data.pgtk->preferred_height = pixelheight; + x_wm_set_size_hint (f, 0, 0); + xg_frame_set_char_size (f, pixelwidth, pixelheight); + gtk_widget_queue_resize (FRAME_WIDGET (f)); + + unblock_input (); +} + +void +pgtk_iconify_frame (struct frame *f) +/* -------------------------------------------------------------------------- + External: Iconify window + -------------------------------------------------------------------------- */ +{ + /* Don't keep the highlight on an invisible frame. */ + if (FRAME_DISPLAY_INFO (f)->highlight_frame == f) + FRAME_DISPLAY_INFO (f)->highlight_frame = 0; + + if (FRAME_ICONIFIED_P (f)) + return; + + block_input (); + + if (FRAME_GTK_OUTER_WIDGET (f)) + { + if (!FRAME_VISIBLE_P (f)) + gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (f)); + + gtk_window_iconify (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); + SET_FRAME_VISIBLE (f, 0); + SET_FRAME_ICONIFIED (f, true); + unblock_input (); + return; + } + + /* Make sure the X server knows where the window should be positioned, + in case the user deiconifies with the window manager. */ + if (!FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f)) + pgtk_set_offset (f, f->left_pos, f->top_pos, 0); + + SET_FRAME_ICONIFIED (f, true); + SET_FRAME_VISIBLE (f, 0); + + unblock_input (); +} + +static gboolean +pgtk_make_frame_visible_wait_for_map_event_cb (GtkWidget * widget, + GdkEventAny * event, + gpointer user_data) +{ + int *foundptr = user_data; + *foundptr = 1; + return FALSE; +} + +static gboolean +pgtk_make_frame_visible_wait_for_map_event_timeout (gpointer user_data) +{ + int *timedoutptr = user_data; + *timedoutptr = 1; + return FALSE; +} + +static void +pgtk_wait_for_map_event (struct frame *f, bool multiple_times) +{ + if (FLOATP (Vpgtk_wait_for_event_timeout)) + { + guint msec = + (guint) (XFLOAT_DATA (Vpgtk_wait_for_event_timeout) * 1000); + int found = 0; + int timed_out = 0; + gulong id = + g_signal_connect (FRAME_WIDGET (f), "map-event", + G_CALLBACK + (pgtk_make_frame_visible_wait_for_map_event_cb), + &found); + guint src = + g_timeout_add (msec, + pgtk_make_frame_visible_wait_for_map_event_timeout, + &timed_out); + + if (!multiple_times) + { + while (!found && !timed_out) + gtk_main_iteration (); + } + else + { + while (!timed_out) + gtk_main_iteration (); + } + + g_signal_handler_disconnect (FRAME_WIDGET (f), id); + if (!timed_out) + g_source_remove (src); + } +} + +void +pgtk_make_frame_visible (struct frame *f) +/* -------------------------------------------------------------------------- + External: Show the window (X11 semantics) + -------------------------------------------------------------------------- */ +{ + GtkWidget *win = FRAME_GTK_OUTER_WIDGET (f); + + if (!FRAME_VISIBLE_P (f)) + { + gtk_widget_show (FRAME_WIDGET (f)); + if (win) + gtk_window_deiconify (GTK_WINDOW (win)); + + pgtk_wait_for_map_event (f, false); + } +} + + +void +pgtk_make_frame_invisible (struct frame *f) +/* -------------------------------------------------------------------------- + External: Hide the window (X11 semantics) + -------------------------------------------------------------------------- */ +{ + gtk_widget_hide (FRAME_WIDGET (f)); + + /* Map events are emitted many times, and + * map_event() do SET_FRAME_VISIBLE(f, 1). + * I expect visible = 0, so process those map events here and + * SET_FRAME_VISIBLE(f, 0) after that. + */ + pgtk_wait_for_map_event (f, true); + + SET_FRAME_VISIBLE (f, 0); + SET_FRAME_ICONIFIED (f, false); +} + +static void +pgtk_make_frame_visible_invisible (struct frame *f, bool visible) +{ + if (visible) + pgtk_make_frame_visible (f); + else + pgtk_make_frame_invisible (f); +} + +static Lisp_Object +pgtk_new_font (struct frame *f, Lisp_Object font_object, int fontset) +{ + struct font *font = XFONT_OBJECT (font_object); + int font_ascent, font_descent; + + if (fontset < 0) + fontset = fontset_from_font (font_object); + FRAME_FONTSET (f) = fontset; + + if (FRAME_FONT (f) == font) + { + /* This font is already set in frame F. There's nothing more to + do. */ + return font_object; + } + + FRAME_FONT (f) = font; + + FRAME_BASELINE_OFFSET (f) = font->baseline_offset; + FRAME_COLUMN_WIDTH (f) = font->average_width; + get_font_ascent_descent (font, &font_ascent, &font_descent); + FRAME_LINE_HEIGHT (f) = font_ascent + font_descent; + + /* We could use a more elaborate calculation here. */ + FRAME_TAB_BAR_HEIGHT (f) = FRAME_TAB_BAR_LINES (f) * FRAME_LINE_HEIGHT (f); + + /* Compute the scroll bar width in character columns. */ + if (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0) + { + int wid = FRAME_COLUMN_WIDTH (f); + FRAME_CONFIG_SCROLL_BAR_COLS (f) + = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + wid - 1) / wid; + } + else + { + int wid = FRAME_COLUMN_WIDTH (f); + FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid; + } + + /* Compute the scroll bar height in character lines. */ + if (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) > 0) + { + int height = FRAME_LINE_HEIGHT (f); + FRAME_CONFIG_SCROLL_BAR_LINES (f) + = (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) + height - 1) / height; + } + else + { + int height = FRAME_LINE_HEIGHT (f); + FRAME_CONFIG_SCROLL_BAR_LINES (f) = (14 + height - 1) / height; + } + + /* Now make the frame display the given font. */ + if (FRAME_GTK_WIDGET (f) != NULL) + adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), + FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 3, + false, Qfont); + + return font_object; +} + +int +x_display_pixel_height (struct pgtk_display_info *dpyinfo) +{ + GdkDisplay *gdpy = dpyinfo->gdpy; + GdkScreen *gscr = gdk_display_get_default_screen (gdpy); + return gdk_screen_get_height (gscr); +} + +int +x_display_pixel_width (struct pgtk_display_info *dpyinfo) +{ + GdkDisplay *gdpy = dpyinfo->gdpy; + GdkScreen *gscr = gdk_display_get_default_screen (gdpy); + return gdk_screen_get_width (gscr); +} + +void +pgtk_set_parent_frame (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + struct frame *p = NULL; + + if (!NILP (new_value) + && (!FRAMEP (new_value) + || !FRAME_LIVE_P (p = XFRAME (new_value)) + || !FRAME_PGTK_P (p))) + { + store_frame_param (f, Qparent_frame, old_value); + error ("Invalid specification of `parent-frame'"); + } + + if (p != FRAME_PARENT_FRAME (f)) + { + block_input (); + + if (p != NULL) + { + if (FRAME_DISPLAY_INFO (f) != FRAME_DISPLAY_INFO (p)) + error ("Cross display reparent."); + } + + GtkWidget *fixed = FRAME_GTK_WIDGET (f); + + GtkAllocation alloc; + gtk_widget_get_allocation (fixed, &alloc); + g_object_ref (fixed); + + /* Remember the css provider, and restore it later. */ + GtkCssProvider *provider = FRAME_X_OUTPUT (f)->border_color_css_provider; + FRAME_X_OUTPUT (f)->border_color_css_provider = NULL; + { + GtkStyleContext *ctxt = gtk_widget_get_style_context (FRAME_WIDGET (f)); + if (provider != NULL) + gtk_style_context_remove_provider (ctxt, GTK_STYLE_PROVIDER (provider)); + } + + { + GtkWidget *whbox_of_f = gtk_widget_get_parent (fixed); + /* Here, unhighlight can be called and may change border_color_css_provider. */ + gtk_container_remove (GTK_CONTAINER (whbox_of_f), fixed); + + if (FRAME_GTK_OUTER_WIDGET (f)) + { + gtk_widget_destroy (FRAME_GTK_OUTER_WIDGET (f)); + FRAME_GTK_OUTER_WIDGET (f) = NULL; + FRAME_OUTPUT_DATA (f)->vbox_widget = NULL; + FRAME_OUTPUT_DATA (f)->hbox_widget = NULL; + FRAME_OUTPUT_DATA (f)->menubar_widget = NULL; + FRAME_OUTPUT_DATA (f)->toolbar_widget = NULL; + FRAME_OUTPUT_DATA (f)->ttip_widget = NULL; + FRAME_OUTPUT_DATA (f)->ttip_lbl = NULL; + FRAME_OUTPUT_DATA (f)->ttip_window = NULL; + } + } + + if (p == NULL) + { + xg_create_frame_outer_widgets (f); + pgtk_set_event_handler (f); + gtk_box_pack_start (GTK_BOX (f->output_data.pgtk->hbox_widget), fixed, TRUE, TRUE, 0); + f->output_data.pgtk->preferred_width = alloc.width; + f->output_data.pgtk->preferred_height = alloc.height; + x_wm_set_size_hint (f, 0, 0); + xg_frame_set_char_size (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, alloc.width), + FRAME_PIXEL_TO_TEXT_HEIGHT (f, alloc.height)); + gtk_widget_queue_resize (FRAME_WIDGET (f)); + gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (f)); + } + else + { + GtkWidget *fixed_of_p = FRAME_GTK_WIDGET (p); + gtk_fixed_put (GTK_FIXED (fixed_of_p), fixed, f->left_pos, f->top_pos); + gtk_widget_set_size_request (fixed, alloc.width, alloc.height); + gtk_widget_show_all (fixed); + } + + /* Restore css provider. */ + GtkStyleContext *ctxt = gtk_widget_get_style_context (FRAME_WIDGET (f)); + GtkCssProvider *old = FRAME_X_OUTPUT (f)->border_color_css_provider; + FRAME_X_OUTPUT (f)->border_color_css_provider = provider; + if (provider != NULL) + { + gtk_style_context_add_provider (ctxt, GTK_STYLE_PROVIDER (provider), + GTK_STYLE_PROVIDER_PRIORITY_USER); + } + if (old != NULL) + { + gtk_style_context_remove_provider (ctxt, GTK_STYLE_PROVIDER (old)); + g_object_unref(old); + } + + g_object_unref (fixed); + + unblock_input (); + + fset_parent_frame (f, new_value); + } +} + +/* Doesn't work on wayland. */ +void +pgtk_set_no_focus_on_map (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + if (!EQ (new_value, old_value)) + { + xg_set_no_focus_on_map (f, new_value); + FRAME_NO_FOCUS_ON_MAP (f) = !NILP (new_value); + } +} + +void +pgtk_set_no_accept_focus (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + xg_set_no_accept_focus (f, new_value); + FRAME_NO_ACCEPT_FOCUS (f) = !NILP (new_value); +} + +void +pgtk_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) +{ + if (!FRAME_GTK_OUTER_WIDGET (f)) + return; + + if (NILP (new_value)) + { + gtk_window_set_keep_above (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + FALSE); + gtk_window_set_keep_below (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + FALSE); + FRAME_Z_GROUP (f) = z_group_none; + } + else if (EQ (new_value, Qabove)) + { + gtk_window_set_keep_above (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + TRUE); + gtk_window_set_keep_below (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + FALSE); + FRAME_Z_GROUP (f) = z_group_above; + } + else if (EQ (new_value, Qabove_suspended)) + { + gtk_window_set_keep_above (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + FALSE); + FRAME_Z_GROUP (f) = z_group_above_suspended; + } + else if (EQ (new_value, Qbelow)) + { + gtk_window_set_keep_above (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + FALSE); + gtk_window_set_keep_below (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + TRUE); + FRAME_Z_GROUP (f) = z_group_below; + } + else + error ("Invalid z-group specification"); +} + +static void +pgtk_initialize_display_info (struct pgtk_display_info *dpyinfo) +/* -------------------------------------------------------------------------- + Initialize global info and storage for display. + -------------------------------------------------------------------------- */ +{ + dpyinfo->resx = 96; + dpyinfo->resy = 96; + dpyinfo->color_p = 1; + dpyinfo->n_planes = 32; + dpyinfo->root_window = 42; /* a placeholder.. */ + dpyinfo->highlight_frame = dpyinfo->x_focus_frame = NULL; + dpyinfo->n_fonts = 0; + dpyinfo->smallest_font_height = 1; + dpyinfo->smallest_char_width = 1; + + reset_mouse_highlight (&dpyinfo->mouse_highlight); +} + +/* Set S->gc to a suitable GC for drawing glyph string S in cursor + face. */ + +static void +pgtk_set_cursor_gc (struct glyph_string *s) +{ + if (s->font == FRAME_FONT (s->f) + && s->face->background == FRAME_BACKGROUND_PIXEL (s->f) + && s->face->foreground == FRAME_FOREGROUND_PIXEL (s->f) && !s->cmp) + s->xgcv = FRAME_X_OUTPUT (s->f)->cursor_xgcv; + else + { + /* Cursor on non-default face: must merge. */ + Emacs_GC xgcv; + + xgcv.background = FRAME_X_OUTPUT (s->f)->cursor_color; + xgcv.foreground = s->face->background; + + /* If the glyph would be invisible, try a different foreground. */ + if (xgcv.foreground == xgcv.background) + xgcv.foreground = s->face->foreground; + if (xgcv.foreground == xgcv.background) + xgcv.foreground = FRAME_X_OUTPUT (s->f)->cursor_foreground_color; + if (xgcv.foreground == xgcv.background) + xgcv.foreground = s->face->foreground; + + /* Make sure the cursor is distinct from text in this face. */ + if (xgcv.background == s->face->background + && xgcv.foreground == s->face->foreground) + { + xgcv.background = s->face->foreground; + xgcv.foreground = s->face->background; + } + + s->xgcv = xgcv; + } +} + + +/* Set up S->gc of glyph string S for drawing text in mouse face. */ + +static void +pgtk_set_mouse_face_gc (struct glyph_string *s) +{ + prepare_face_for_display (s->f, s->face); + + if (s->font == s->face->font) + { + s->xgcv.foreground = s->face->foreground; + s->xgcv.background = s->face->background; + } + else + { + /* Otherwise construct scratch_cursor_gc with values from FACE + except for FONT. */ + Emacs_GC xgcv; + + xgcv.background = s->face->background; + xgcv.foreground = s->face->foreground; + + s->xgcv = xgcv; + + } +} + + +/* Set S->gc of glyph string S to a GC suitable for drawing a mode line. + Faces to use in the mode line have already been computed when the + matrix was built, so there isn't much to do, here. */ + +static void +pgtk_set_mode_line_face_gc (struct glyph_string *s) +{ + s->xgcv.foreground = s->face->foreground; + s->xgcv.background = s->face->background; +} + + +/* Set S->gc of glyph string S for drawing that glyph string. Set + S->stippled_p to a non-zero value if the face of S has a stipple + pattern. */ + +static void +pgtk_set_glyph_string_gc (struct glyph_string *s) +{ + prepare_face_for_display (s->f, s->face); + + if (s->hl == DRAW_NORMAL_TEXT) + { + s->xgcv.foreground = s->face->foreground; + s->xgcv.background = s->face->background; + s->stippled_p = s->face->stipple != 0; + } + else if (s->hl == DRAW_INVERSE_VIDEO) + { + pgtk_set_mode_line_face_gc (s); + s->stippled_p = s->face->stipple != 0; + } + else if (s->hl == DRAW_CURSOR) + { + pgtk_set_cursor_gc (s); + s->stippled_p = false; + } + else if (s->hl == DRAW_MOUSE_FACE) + { + pgtk_set_mouse_face_gc (s); + s->stippled_p = s->face->stipple != 0; + } + else if (s->hl == DRAW_IMAGE_RAISED || s->hl == DRAW_IMAGE_SUNKEN) + { + s->xgcv.foreground = s->face->foreground; + s->xgcv.background = s->face->background; + s->stippled_p = s->face->stipple != 0; + } + else + emacs_abort (); +} + + +/* Set clipping for output of glyph string S. S may be part of a mode + line or menu if we don't have X toolkit support. */ + +static void +pgtk_set_glyph_string_clipping (struct glyph_string *s, cairo_t * cr) +{ + XRectangle r[2]; + int n = get_glyph_string_clip_rects (s, r, 2); + + if (n > 0) + { + for (int i = 0; i < n; i++) + { + cairo_rectangle (cr, r[i].x, r[i].y, r[i].width, r[i].height); + } + cairo_clip (cr); + } +} + + +/* Set SRC's clipping for output of glyph string DST. This is called + when we are drawing DST's left_overhang or right_overhang only in + the area of SRC. */ + +static void +pgtk_set_glyph_string_clipping_exactly (struct glyph_string *src, + struct glyph_string *dst, cairo_t * cr) +{ + dst->clip[0].x = src->x; + dst->clip[0].y = src->y; + dst->clip[0].width = src->width; + dst->clip[0].height = src->height; + dst->num_clips = 1; + + cairo_rectangle (cr, src->x, src->y, src->width, src->height); + cairo_clip (cr); +} + + +/* RIF: + Compute left and right overhang of glyph string S. */ + +static void +pgtk_compute_glyph_string_overhangs (struct glyph_string *s) +{ + if (s->cmp == NULL + && (s->first_glyph->type == CHAR_GLYPH + || s->first_glyph->type == COMPOSITE_GLYPH)) + { + struct font_metrics metrics; + + if (s->first_glyph->type == CHAR_GLYPH) + { + unsigned *code = alloca (sizeof (unsigned) * s->nchars); + struct font *font = s->font; + int i; + + for (i = 0; i < s->nchars; i++) + code[i] = s->char2b[i]; + font->driver->text_extents (font, code, 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 if (s->cmp) + { + s->right_overhang = s->cmp->rbearing - s->cmp->pixel_width; + s->left_overhang = -s->cmp->lbearing; + } +} + + +/* Fill rectangle X, Y, W, H with background color of glyph string S. */ + +static void +x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h) +{ + pgtk_fill_rectangle (s->f, s->xgcv.background, x, y, w, h, + (s->first_glyph->type != STRETCH_GLYPH + || s->hl != DRAW_CURSOR)); +} + + +static void +fill_background_by_face (struct frame *f, struct face *face, int x, int y, + int width, int height) +{ + cairo_t *cr = pgtk_begin_cr_clip (f); + + cairo_rectangle (cr, x, y, width, height); + cairo_clip (cr); + + double r = ((face->background >> 16) & 0xff) / 255.0; + double g = ((face->background >> 8) & 0xff) / 255.0; + double b = ((face->background >> 0) & 0xff) / 255.0; + cairo_set_source_rgb (cr, r, g, b); + cairo_paint (cr); + + if (face->stipple != 0) + { + cairo_pattern_t *mask = + FRAME_DISPLAY_INFO (f)->bitmaps[face->stipple - 1].pattern; + + double r = ((face->foreground >> 16) & 0xff) / 255.0; + double g = ((face->foreground >> 8) & 0xff) / 255.0; + double b = ((face->foreground >> 0) & 0xff) / 255.0; + cairo_set_source_rgb (cr, r, g, b); + cairo_mask (cr, mask); + } + + pgtk_end_cr_clip (f); +} + +static void +fill_background (struct glyph_string *s, int x, int y, int width, int height) +{ + fill_background_by_face (s->f, s->face, x, y, width, height); +} + +/* Draw the background of glyph_string S. If S->background_filled_p + is non-zero don't draw it. FORCE_P non-zero means draw the + background even if it wouldn't be drawn normally. This is used + when a string preceding S draws into the background of S, or S + contains the first component of a composition. */ + +static void +x_draw_glyph_string_background (struct glyph_string *s, bool force_p) +{ + /* Nothing to do if background has already been drawn or if it + shouldn't be drawn in the first place. */ + if (!s->background_filled_p) + { + int box_line_width = max (s->face->box_horizontal_line_width, 0); + + if (s->stippled_p) + { + /* Fill background with a stipple pattern. */ + + fill_background (s, + s->x, s->y + box_line_width, + s->background_width, + s->height - 2 * box_line_width); + s->background_filled_p = true; + } + else if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width + /* When xdisp.c ignores FONT_HEIGHT, we cannot trust + font dimensions, since the actual glyphs might be + much smaller. So in that case we always clear the + rectangle with background color. */ + || FONT_TOO_HIGH (s->font) + || s->font_not_found_p + || s->extends_to_end_of_line_p || force_p) + { + x_clear_glyph_string_rect (s, s->x, s->y + box_line_width, + s->background_width, + s->height - 2 * box_line_width); + s->background_filled_p = true; + } + } +} + + +static void +pgtk_draw_rectangle (struct frame *f, unsigned long color, int x, int y, + int width, int height, bool respect_alpha_background) +{ + cairo_t *cr; + + cr = pgtk_begin_cr_clip (f); + pgtk_set_cr_source_with_color (f, color, respect_alpha_background); + cairo_rectangle (cr, x + 0.5, y + 0.5, width, height); + cairo_set_line_width (cr, 1); + cairo_stroke (cr); + pgtk_end_cr_clip (f); +} + +/* Draw the foreground of glyph string S. */ + +static void +x_draw_glyph_string_foreground (struct glyph_string *s) +{ + int i, x; + + /* If first glyph of S has a left box line, start drawing the text + of S to the right of that box line. */ + if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) + x = s->x + max (s->face->box_vertical_line_width, 0); + else + x = s->x; + + /* Draw characters of S as rectangles if S's font could not be + loaded. */ + if (s->font_not_found_p) + { + for (i = 0; i < s->nchars; ++i) + { + struct glyph *g = s->first_glyph + i; + pgtk_draw_rectangle (s->f, + s->face->foreground, x, s->y, + g->pixel_width - 1, s->height - 1, + false); + x += g->pixel_width; + } + } + else + { + struct font *font = s->font; + int boff = font->baseline_offset; + int y; + + if (font->vertical_centering) + boff = VCENTER_BASELINE_OFFSET (font, s->f) - boff; + + y = s->ybase - boff; + if (s->for_overlaps || (s->background_filled_p && s->hl != DRAW_CURSOR)) + font->driver->draw (s, 0, s->nchars, x, y, false); + else + font->driver->draw (s, 0, s->nchars, x, y, true); + if (s->face->overstrike) + font->driver->draw (s, 0, s->nchars, x + 1, y, false); + } +} + +/* Draw the foreground of composite glyph string S. */ + +static void +x_draw_composite_glyph_string_foreground (struct glyph_string *s) +{ + int i, j, x; + struct font *font = s->font; + + /* If first glyph of S has a left box line, start drawing the text + of S to the right of that box line. */ + if (s->face && s->face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p) + x = s->x + max (s->face->box_vertical_line_width, 0); + else + x = s->x; + + /* S is a glyph string for a composition. S->cmp_from is the index + of the first character drawn for glyphs of this composition. + S->cmp_from == 0 means we are drawing the very first character of + this composition. */ + + /* Draw a rectangle for the composition if the font for the very + first character of the composition could not be loaded. */ + if (s->font_not_found_p) + { + if (s->cmp_from == 0) + pgtk_draw_rectangle (s->f, s->face->foreground, x, s->y, + s->width - 1, s->height - 1, false); + } + else if (!s->first_glyph->u.cmp.automatic) + { + int y = s->ybase; + + for (i = 0, j = s->cmp_from; i < s->nchars; i++, j++) + /* TAB in a composition means display glyphs with padding + space on the left or right. */ + if (COMPOSITION_GLYPH (s->cmp, j) != '\t') + { + int xx = x + s->cmp->offsets[j * 2]; + int yy = y - s->cmp->offsets[j * 2 + 1]; + + font->driver->draw (s, j, j + 1, xx, yy, false); + if (s->face->overstrike) + font->driver->draw (s, j, j + 1, xx + 1, yy, false); + } + } + else + { + Lisp_Object gstring = composition_gstring_from_id (s->cmp_id); + Lisp_Object glyph; + int y = s->ybase; + int width = 0; + + for (i = j = s->cmp_from; i < s->cmp_to; i++) + { + glyph = LGSTRING_GLYPH (gstring, i); + if (NILP (LGLYPH_ADJUSTMENT (glyph))) + width += LGLYPH_WIDTH (glyph); + else + { + int xoff, yoff, wadjust; + + if (j < i) + { + font->driver->draw (s, j, i, x, y, false); + if (s->face->overstrike) + font->driver->draw (s, j, i, x + 1, y, false); + x += width; + } + xoff = LGLYPH_XOFF (glyph); + yoff = LGLYPH_YOFF (glyph); + wadjust = LGLYPH_WADJUST (glyph); + font->driver->draw (s, i, i + 1, x + xoff, y + yoff, false); + if (s->face->overstrike) + font->driver->draw (s, i, i + 1, x + xoff + 1, y + yoff, + false); + x += wadjust; + j = i + 1; + width = 0; + } + } + if (j < i) + { + font->driver->draw (s, j, i, x, y, false); + if (s->face->overstrike) + font->driver->draw (s, j, i, x + 1, y, false); + } + } +} + + +/* Draw the foreground of glyph string S for glyphless characters. */ + +static void +x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) +{ + struct glyph *glyph = s->first_glyph; + unsigned char2b[8]; + int x, i, j; + + /* If first glyph of S has a left box line, start drawing the text + of S to the right of that box line. */ + if (s->face && s->face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p) + x = s->x + max (s->face->box_vertical_line_width, 0); + else + x = s->x; + + s->char2b = char2b; + + for (i = 0; i < s->nchars; i++, glyph++) + { +#ifdef GCC_LINT + enum + { PACIFY_GCC_BUG_81401 = 1 }; +#else + enum + { PACIFY_GCC_BUG_81401 = 0 }; +#endif + char buf[7 + PACIFY_GCC_BUG_81401]; + char *str = NULL; + int len = glyph->u.glyphless.len; + + if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM) + { + if (len > 0 + && CHAR_TABLE_P (Vglyphless_char_display) + && + (CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) + >= 1)) + { + Lisp_Object acronym + = (!glyph->u.glyphless.for_no_font + ? CHAR_TABLE_REF (Vglyphless_char_display, + glyph->u.glyphless.ch) + : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + if (STRINGP (acronym)) + str = SSDATA (acronym); + } + } + else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE) + { + unsigned int ch = glyph->u.glyphless.ch; + eassume (ch <= MAX_CHAR); + sprintf (buf, "%0*X", ch < 0x10000 ? 4 : 6, ch); + str = buf; + } + + if (str) + { + int upper_len = (len + 1) / 2; + + /* It is assured that all LEN characters in STR is ASCII. */ + for (j = 0; j < len; j++) + char2b[j] = + s->font->driver->encode_char (s->font, str[j]) & 0xFFFF; + s->font->driver->draw (s, 0, upper_len, + x + glyph->slice.glyphless.upper_xoff, + s->ybase + glyph->slice.glyphless.upper_yoff, + false); + s->font->driver->draw (s, upper_len, len, + x + glyph->slice.glyphless.lower_xoff, + s->ybase + glyph->slice.glyphless.lower_yoff, + false); + } + if (glyph->u.glyphless.method != GLYPHLESS_DISPLAY_THIN_SPACE) + pgtk_draw_rectangle (s->f, s->face->foreground, + x, s->ybase - glyph->ascent, + glyph->pixel_width - 1, + glyph->ascent + glyph->descent - 1, + false); + x += glyph->pixel_width; + } +} + +/* Brightness beyond which a color won't have its highlight brightness + boosted. + + Nominally, highlight colors for `3d' faces are calculated by + brightening an object's color by a constant scale factor, but this + doesn't yield good results for dark colors, so for colors who's + brightness is less than this value (on a scale of 0-65535) have an + use an additional additive factor. + + The value here is set so that the default menu-bar/mode-line color + (grey75) will not have its highlights changed at all. */ +#define HIGHLIGHT_COLOR_DARK_BOOST_LIMIT 48000 + + +/* Allocate a color which is lighter or darker than *PIXEL by FACTOR + or DELTA. Try a color with RGB values multiplied by FACTOR first. + If this produces the same color as PIXEL, try a color where all RGB + values have DELTA added. Return the allocated color in *PIXEL. + DISPLAY is the X display, CMAP is the colormap to operate on. + Value is non-zero if successful. */ + +static bool +x_alloc_lighter_color (struct frame *f, unsigned long *pixel, double factor, + int delta) +{ + Emacs_Color color, new; + long bright; + bool success_p; + + /* Get RGB color values. */ + color.pixel = *pixel; + pgtk_query_color (f, &color); + + /* Change RGB values by specified FACTOR. Avoid overflow! */ + eassert (factor >= 0); + new.red = min (0xffff, factor * color.red); + new.green = min (0xffff, factor * color.green); + new.blue = min (0xffff, factor * color.blue); + + /* Calculate brightness of COLOR. */ + bright = (2 * color.red + 3 * color.green + color.blue) / 6; + + /* We only boost colors that are darker than + HIGHLIGHT_COLOR_DARK_BOOST_LIMIT. */ + if (bright < HIGHLIGHT_COLOR_DARK_BOOST_LIMIT) + /* Make an additive adjustment to NEW, because it's dark enough so + that scaling by FACTOR alone isn't enough. */ + { + /* How far below the limit this color is (0 - 1, 1 being darker). */ + double dimness = 1 - (double) bright / HIGHLIGHT_COLOR_DARK_BOOST_LIMIT; + /* The additive adjustment. */ + int min_delta = delta * dimness * factor / 2; + + if (factor < 1) + { + new.red = max (0, new.red - min_delta); + new.green = max (0, new.green - min_delta); + new.blue = max (0, new.blue - min_delta); + } + else + { + new.red = min (0xffff, min_delta + new.red); + new.green = min (0xffff, min_delta + new.green); + new.blue = min (0xffff, min_delta + new.blue); + } + } + + /* Try to allocate the color. */ + new.pixel = new.red >> 8 << 16 | new.green >> 8 << 8 | new.blue >> 8; + success_p = true; + if (success_p) + { + if (new.pixel == *pixel) + { + /* If we end up with the same color as before, try adding + delta to the RGB values. */ + new.red = min (0xffff, delta + color.red); + new.green = min (0xffff, delta + color.green); + new.blue = min (0xffff, delta + color.blue); + new.pixel = + new.red >> 8 << 16 | new.green >> 8 << 8 | new.blue >> 8; + success_p = true; + } + else + success_p = true; + *pixel = new.pixel; + } + + return success_p; +} + +static void +x_fill_trapezoid_for_relief (struct frame *f, unsigned long color, int x, + int y, int width, int height, int top_p) +{ + cairo_t *cr; + + cr = pgtk_begin_cr_clip (f); + pgtk_set_cr_source_with_color (f, color, false); + cairo_move_to (cr, top_p ? x : x + height, y); + cairo_line_to (cr, x, y + height); + cairo_line_to (cr, top_p ? x + width - height : x + width, y + height); + cairo_line_to (cr, x + width, y); + cairo_fill (cr); + pgtk_end_cr_clip (f); +} + +enum corners +{ + CORNER_BOTTOM_RIGHT, /* 0 -> pi/2 */ + CORNER_BOTTOM_LEFT, /* pi/2 -> pi */ + CORNER_TOP_LEFT, /* pi -> 3pi/2 */ + CORNER_TOP_RIGHT, /* 3pi/2 -> 2pi */ + CORNER_LAST +}; + +static void +x_erase_corners_for_relief (struct frame *f, unsigned long color, int x, + int y, int width, int height, double radius, + double margin, int corners) +{ + cairo_t *cr; + int i; + + cr = pgtk_begin_cr_clip (f); + pgtk_set_cr_source_with_color (f, color, false); + for (i = 0; i < CORNER_LAST; i++) + if (corners & (1 << i)) + { + double xm, ym, xc, yc; + + if (i == CORNER_TOP_LEFT || i == CORNER_BOTTOM_LEFT) + xm = x - margin, xc = xm + radius; + else + xm = x + width + margin, xc = xm - radius; + if (i == CORNER_TOP_LEFT || i == CORNER_TOP_RIGHT) + ym = y - margin, yc = ym + radius; + else + ym = y + height + margin, yc = ym - radius; + + cairo_move_to (cr, xm, ym); + cairo_arc (cr, xc, yc, radius, i * M_PI_2, (i + 1) * M_PI_2); + } + cairo_clip (cr); + cairo_rectangle (cr, x, y, width, height); + cairo_fill (cr); + pgtk_end_cr_clip (f); +} + +/* Set up the foreground color for drawing relief lines of glyph + string S. RELIEF is a pointer to a struct relief containing the GC + with which lines will be drawn. Use a color that is FACTOR or + DELTA lighter or darker than the relief's background which is found + in S->f->output_data.pgtk->relief_background. If such a color cannot + be allocated, use DEFAULT_PIXEL, instead. */ + +static void +pgtk_setup_relief_color (struct frame *f, struct relief *relief, double factor, + int delta, unsigned long default_pixel) +{ + Emacs_GC xgcv; + struct pgtk_output *di = FRAME_X_OUTPUT (f); + unsigned long pixel; + unsigned long background = di->relief_background; + + /* Allocate new color. */ + xgcv.foreground = default_pixel; + pixel = background; + if (x_alloc_lighter_color (f, &pixel, factor, delta)) + xgcv.foreground = relief->pixel = pixel; + + relief->xgcv = xgcv; +} + +/* Set up colors for the relief lines around glyph string S. */ + +static void +pgtk_setup_relief_colors (struct glyph_string *s) +{ + struct pgtk_output *di = FRAME_X_OUTPUT (s->f); + unsigned long color; + + if (s->face->use_box_color_for_shadows_p) + color = s->face->box_color; + else if (s->first_glyph->type == IMAGE_GLYPH + && s->img->pixmap + && !IMAGE_BACKGROUND_TRANSPARENT (s->img, s->f, 0)) + color = IMAGE_BACKGROUND (s->img, s->f, 0); + else + { + /* Get the background color of the face. */ + color = s->xgcv.background; + } + + if (TRUE) + { + di->relief_background = color; + pgtk_setup_relief_color (s->f, &di->white_relief, 1.2, 0x8000, + WHITE_PIX_DEFAULT (s->f)); + pgtk_setup_relief_color (s->f, &di->black_relief, 0.6, 0x4000, + BLACK_PIX_DEFAULT (s->f)); + } +} + + +static void +pgtk_set_clip_rectangles (struct frame *f, cairo_t *cr, + XRectangle *rectangles, int n) +{ + if (n > 0) + { + for (int i = 0; i < n; i++) + { + cairo_rectangle (cr, + rectangles[i].x, + rectangles[i].y, + rectangles[i].width, rectangles[i].height); + } + cairo_clip (cr); + } +} + +/* Draw a relief on frame F inside the rectangle given by LEFT_X, + TOP_Y, RIGHT_X, and BOTTOM_Y. WIDTH is the thickness of the relief + to draw, it must be >= 0. RAISED_P means draw a raised + relief. LEFT_P means draw a relief on the left side of + the rectangle. RIGHT_P means draw a relief on the right + side of the rectangle. CLIP_RECT is the clipping rectangle to use + when drawing. */ + +static void +x_draw_relief_rect (struct frame *f, + int left_x, int top_y, int right_x, int bottom_y, + int hwidth, int vwidth, bool raised_p, bool top_p, + bool bot_p, bool left_p, bool right_p, + XRectangle * clip_rect) +{ + unsigned long top_left_color, bottom_right_color; + int corners = 0; + + cairo_t *cr = pgtk_begin_cr_clip (f); + + if (raised_p) + { + top_left_color = FRAME_X_OUTPUT (f)->white_relief.xgcv.foreground; + bottom_right_color = FRAME_X_OUTPUT (f)->black_relief.xgcv.foreground; + } + else + { + top_left_color = FRAME_X_OUTPUT (f)->black_relief.xgcv.foreground; + bottom_right_color = FRAME_X_OUTPUT (f)->white_relief.xgcv.foreground; + } + + pgtk_set_clip_rectangles (f, cr, clip_rect, 1); + + if (left_p) + { + pgtk_fill_rectangle (f, top_left_color, left_x, top_y, + vwidth, bottom_y + 1 - top_y, false); + if (top_p) + corners |= 1 << CORNER_TOP_LEFT; + if (bot_p) + corners |= 1 << CORNER_BOTTOM_LEFT; + } + if (right_p) + { + pgtk_fill_rectangle (f, bottom_right_color, right_x + 1 - vwidth, top_y, + vwidth, bottom_y + 1 - top_y, false); + if (top_p) + corners |= 1 << CORNER_TOP_RIGHT; + if (bot_p) + corners |= 1 << CORNER_BOTTOM_RIGHT; + } + if (top_p) + { + if (!right_p) + pgtk_fill_rectangle (f, top_left_color, left_x, top_y, + right_x + 1 - left_x, hwidth, false); + else + x_fill_trapezoid_for_relief (f, top_left_color, left_x, top_y, + right_x + 1 - left_x, hwidth, 1); + } + if (bot_p) + { + if (!left_p) + pgtk_fill_rectangle (f, bottom_right_color, left_x, + bottom_y + 1 - hwidth, right_x + 1 - left_x, + hwidth, false); + else + x_fill_trapezoid_for_relief (f, bottom_right_color, + left_x, bottom_y + 1 - hwidth, + right_x + 1 - left_x, hwidth, 0); + } + if (left_p && vwidth > 1) + pgtk_fill_rectangle (f, bottom_right_color, left_x, top_y, + 1, bottom_y + 1 - top_y, false); + if (top_p && hwidth > 1) + pgtk_fill_rectangle (f, bottom_right_color, left_x, top_y, + right_x + 1 - left_x, 1, false); + if (corners) + { + x_erase_corners_for_relief (f, FRAME_BACKGROUND_PIXEL (f), left_x, + top_y, right_x - left_x + 1, + bottom_y - top_y + 1, 6, 1, corners); + } + + pgtk_end_cr_clip (f); +} + +/* Draw a box on frame F inside the rectangle given by LEFT_X, TOP_Y, + RIGHT_X, and BOTTOM_Y. WIDTH is the thickness of the lines to + draw, it must be >= 0. LEFT_P means draw a line on the + left side of the rectangle. RIGHT_P means draw a line + on the right side of the rectangle. CLIP_RECT is the clipping + rectangle to use when drawing. */ + +static void +x_draw_box_rect (struct glyph_string *s, + int left_x, int top_y, int right_x, int bottom_y, int hwidth, + int vwidth, bool left_p, bool right_p, + XRectangle * clip_rect) +{ + unsigned long foreground_backup; + + cairo_t *cr = pgtk_begin_cr_clip (s->f); + + foreground_backup = s->xgcv.foreground; + s->xgcv.foreground = s->face->box_color; + + pgtk_set_clip_rectangles (s->f, cr, clip_rect, 1); + + /* Top. */ + pgtk_fill_rectangle (s->f, s->xgcv.foreground, + left_x, top_y, right_x - left_x + 1, hwidth, + false); + + /* Left. */ + if (left_p) + pgtk_fill_rectangle (s->f, s->xgcv.foreground, + left_x, top_y, vwidth, bottom_y - top_y + 1, + false); + + /* Bottom. */ + pgtk_fill_rectangle (s->f, s->xgcv.foreground, + left_x, bottom_y - hwidth + 1, right_x - left_x + 1, + hwidth, false); + + /* Right. */ + if (right_p) + pgtk_fill_rectangle (s->f, s->xgcv.foreground, + right_x - vwidth + 1, top_y, vwidth, + bottom_y - top_y + 1, false); + + s->xgcv.foreground = foreground_backup; + + pgtk_end_cr_clip (s->f); +} + + +/* Draw a box around glyph string S. */ + +static void +x_draw_glyph_string_box (struct glyph_string *s) +{ + int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x; + bool raised_p, left_p, right_p; + struct glyph *last_glyph; + XRectangle clip_rect; + + last_x = ((s->row->full_width_p && !s->w->pseudo_window_p) + ? WINDOW_RIGHT_EDGE_X (s->w) : window_box_right (s->w, s->area)); + + /* The glyph that may have a right box line. */ + last_glyph = (s->cmp || s->img + ? s->first_glyph : s->first_glyph + s->nchars - 1); + + vwidth = eabs (s->face->box_vertical_line_width); + hwidth = eabs (s->face->box_horizontal_line_width); + raised_p = s->face->box == FACE_RAISED_BOX; + left_x = s->x; + right_x = (s->row->full_width_p && s->extends_to_end_of_line_p + ? last_x - 1 : min (last_x, s->x + s->background_width) - 1); + top_y = s->y; + bottom_y = top_y + s->height - 1; + + left_p = (s->first_glyph->left_box_line_p + || (s->hl == DRAW_MOUSE_FACE + && (s->prev == NULL || s->prev->hl != s->hl))); + right_p = (last_glyph->right_box_line_p + || (s->hl == DRAW_MOUSE_FACE + && (s->next == NULL || s->next->hl != s->hl))); + + get_glyph_string_clip_rect (s, &clip_rect); + + if (s->face->box == FACE_SIMPLE_BOX) + x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, left_p, right_p, &clip_rect); + else + { + pgtk_setup_relief_colors (s); + x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, raised_p, true, true, left_p, right_p, + &clip_rect); + } +} + +static void +x_get_scale_factor (int *scale_x, int *scale_y) +{ + *scale_x = *scale_y = 1; +} + +static void +x_draw_horizontal_wave (struct frame *f, unsigned long color, int x, int y, + int width, int height, int wave_length) +{ + cairo_t *cr; + double dx = wave_length, dy = height - 1; + int xoffset, n; + + cr = pgtk_begin_cr_clip (f); + pgtk_set_cr_source_with_color (f, color, false); + cairo_rectangle (cr, x, y, width, height); + cairo_clip (cr); + + if (x >= 0) + { + xoffset = x % (wave_length * 2); + if (xoffset == 0) + xoffset = wave_length * 2; + } + else + xoffset = x % (wave_length * 2) + wave_length * 2; + n = (width + xoffset) / wave_length + 1; + if (xoffset > wave_length) + { + xoffset -= wave_length; + --n; + y += height - 1; + dy = -dy; + } + + cairo_move_to (cr, x - xoffset + 0.5, y + 0.5); + while (--n >= 0) + { + cairo_rel_line_to (cr, dx, dy); + dy = -dy; + } + cairo_set_line_width (cr, 1); + cairo_stroke (cr); + pgtk_end_cr_clip (f); +} + +/* + Draw a wavy line under S. The wave fills wave_height pixels from y0. + + x0 wave_length = 2 + -- + y0 * * * * * + |* * * * * * * * * + wave_height = 3 | * * * * + +*/ +static void +x_draw_underwave (struct glyph_string *s, unsigned long color) +{ + /* Adjust for scale/HiDPI. */ + int scale_x, scale_y; + + x_get_scale_factor (&scale_x, &scale_y); + + int wave_height = 3 * scale_y, wave_length = 2 * scale_x; + + x_draw_horizontal_wave (s->f, color, s->x, s->ybase - wave_height + 3, + s->width, wave_height, wave_length); +} + +/* Draw a relief around the image glyph string S. */ + +static void +x_draw_image_relief (struct glyph_string *s) +{ + int x1, y1, thick; + bool raised_p, top_p, bot_p, left_p, right_p; + int extra_x, extra_y; + XRectangle r; + int x = s->x; + int y = s->ybase - image_ascent (s->img, s->face, &s->slice); + + /* If first glyph of S has a left box line, start drawing it to the + right of that line. */ + if (s->face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p + && s->slice.x == 0) + x += max (s->face->box_vertical_line_width, 0); + + /* If there is a margin around the image, adjust x- and y-position + by that margin. */ + if (s->slice.x == 0) + x += s->img->hmargin; + if (s->slice.y == 0) + y += s->img->vmargin; + + if (s->hl == DRAW_IMAGE_SUNKEN + || s->hl == DRAW_IMAGE_RAISED) + { + 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 + { + thick = eabs (s->img->relief); + raised_p = s->img->relief > 0; + } + + x1 = x + s->slice.width - 1; + y1 = y + s->slice.height - 1; + + extra_x = extra_y = 0; + if (s->face->id == TAB_BAR_FACE_ID) + { + if (CONSP (Vtab_bar_button_margin) + && FIXNUMP (XCAR (Vtab_bar_button_margin)) + && FIXNUMP (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) - thick; + } + + if (s->face->id == TOOL_BAR_FACE_ID) + { + if (CONSP (Vtool_bar_button_margin) + && FIXNUMP (XCAR (Vtool_bar_button_margin)) + && FIXNUMP (XCDR (Vtool_bar_button_margin))) + { + extra_x = XFIXNUM (XCAR (Vtool_bar_button_margin)); + extra_y = XFIXNUM (XCDR (Vtool_bar_button_margin)); + } + else if (FIXNUMP (Vtool_bar_button_margin)) + extra_x = extra_y = XFIXNUM (Vtool_bar_button_margin); + } + + top_p = bot_p = left_p = right_p = false; + + if (s->slice.x == 0) + x -= thick + extra_x, left_p = true; + if (s->slice.y == 0) + y -= thick + extra_y, top_p = true; + if (s->slice.x + s->slice.width == s->img->width) + x1 += thick + extra_x, right_p = true; + if (s->slice.y + s->slice.height == s->img->height) + y1 += thick + extra_y, bot_p = true; + + pgtk_setup_relief_colors (s); + get_glyph_string_clip_rect (s, &r); + x_draw_relief_rect (s->f, x, y, x1, y1, thick, thick, raised_p, + top_p, bot_p, left_p, right_p, &r); +} + +/* Draw part of the background of glyph string S. X, Y, W, and H + give the rectangle to draw. */ + +static void +x_draw_glyph_string_bg_rect (struct glyph_string *s, int x, int y, int w, + int h) +{ + if (s->stippled_p) + { + /* Fill background with a stipple pattern. */ + + fill_background (s, x, y, w, h); + } + else + x_clear_glyph_string_rect (s, x, y, w, h); +} + +static void +x_cr_draw_image (struct frame *f, Emacs_GC *gc, cairo_pattern_t *image, + int src_x, int src_y, int width, int height, + int dest_x, int dest_y, bool overlay_p) +{ + cairo_t *cr = pgtk_begin_cr_clip (f); + + if (overlay_p) + cairo_rectangle (cr, dest_x, dest_y, width, height); + else + { + pgtk_set_cr_source_with_gc_background (f, gc, false); + cairo_rectangle (cr, dest_x, dest_y, width, height); + cairo_fill_preserve (cr); + } + + cairo_translate (cr, dest_x - src_x, dest_y - src_y); + + cairo_surface_t *surface; + cairo_pattern_get_surface (image, &surface); + cairo_format_t format = cairo_image_surface_get_format (surface); + if (format != CAIRO_FORMAT_A8 && format != CAIRO_FORMAT_A1) + { + cairo_set_source (cr, image); + cairo_fill (cr); + } + else + { + pgtk_set_cr_source_with_gc_foreground (f, gc, false); + cairo_clip (cr); + cairo_mask (cr, image); + } + + pgtk_end_cr_clip (f); +} + +/* Draw foreground of image glyph string S. */ + +static void +x_draw_image_foreground (struct glyph_string *s) +{ + int x = s->x; + int y = s->ybase - image_ascent (s->img, s->face, &s->slice); + + /* If first glyph of S has a left box line, start drawing it to the + right of that line. */ + if (s->face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p + && s->slice.x == 0) + x += max (s->face->box_vertical_line_width, 0); + + /* If there is a margin around the image, adjust x- and y-position + by that margin. */ + if (s->slice.x == 0) + x += s->img->hmargin; + if (s->slice.y == 0) + y += s->img->vmargin; + + if (s->img->cr_data) + { + cairo_t *cr = pgtk_begin_cr_clip (s->f); + pgtk_set_glyph_string_clipping (s, cr); + x_cr_draw_image (s->f, &s->xgcv, s->img->cr_data, + s->slice.x, s->slice.y, s->slice.width, s->slice.height, + x, y, true); + if (!s->img->mask) + { + /* When the image has a mask, we can expect that at + least part of a mouse highlight or a block cursor will + be visible. If the image doesn't have a mask, make + a block cursor visible by drawing a rectangle around + the image. I believe it's looking better if we do + nothing here for mouse-face. */ + if (s->hl == DRAW_CURSOR) + { + int relief = eabs (s->img->relief); + pgtk_draw_rectangle (s->f, s->xgcv.foreground, x - relief, y - relief, + s->slice.width + relief*2 - 1, + s->slice.height + relief*2 - 1, false); + } + } + pgtk_end_cr_clip (s->f); + } + else + /* Draw a rectangle if image could not be loaded. */ + pgtk_draw_rectangle (s->f, s->xgcv.foreground, x, y, + s->slice.width - 1, s->slice.height - 1, false); +} + +/* Draw image glyph string S. + + s->y + s->x +------------------------- + | s->face->box + | + | +------------------------- + | | s->img->margin + | | + | | +------------------- + | | | the image + + */ + +static void +x_draw_image_glyph_string (struct glyph_string *s) +{ + int box_line_hwidth = max (s->face->box_vertical_line_width, 0); + int box_line_vwidth = max (s->face->box_horizontal_line_width, 0); + int height; + + height = s->height; + if (s->slice.y == 0) + height -= box_line_vwidth; + if (s->slice.y + s->slice.height >= s->img->height) + height -= box_line_vwidth; + + /* Fill background with face under the image. Do it only if row is + taller than image or if image has a clip mask to reduce + flickering. */ + s->stippled_p = s->face->stipple != 0; + if (height > s->slice.height + || s->img->hmargin + || s->img->vmargin + || s->img->mask + || s->img->pixmap == 0 + || s->width != s->background_width) + { + { + int x = s->x; + int y = s->y; + int width = s->background_width; + + if (s->first_glyph->left_box_line_p + && s->slice.x == 0) + { + x += box_line_hwidth; + width -= box_line_hwidth; + } + + if (s->slice.y == 0) + y += box_line_vwidth; + + x_draw_glyph_string_bg_rect (s, x, y, width, height); + } + + s->background_filled_p = true; + } + + /* Draw the foreground. */ + x_draw_image_foreground (s); + + /* If we must draw a relief around the image, do it. */ + if (s->img->relief + || s->hl == DRAW_IMAGE_RAISED + || s->hl == DRAW_IMAGE_SUNKEN) + x_draw_image_relief (s); +} + +/* Draw stretch glyph string S. */ + +static void +x_draw_stretch_glyph_string (struct glyph_string *s) +{ + eassert (s->first_glyph->type == STRETCH_GLYPH); + + if (s->hl == DRAW_CURSOR && !x_stretch_cursor_p) + { + /* If `x-stretch-cursor' is nil, don't draw a block cursor as + wide as the stretch glyph. */ + int width, background_width = s->background_width; + int x = s->x; + + if (!s->row->reversed_p) + { + int left_x = window_box_left_offset (s->w, TEXT_AREA); + + if (x < left_x) + { + background_width -= left_x - x; + x = left_x; + } + } + else + { + /* In R2L rows, draw the cursor on the right edge of the + stretch glyph. */ + int right_x = window_box_right (s->w, TEXT_AREA); + + if (x + background_width > right_x) + background_width -= x - right_x; + x += background_width; + } + width = min (FRAME_COLUMN_WIDTH (s->f), background_width); + if (s->row->reversed_p) + x -= width; + + /* Draw cursor. */ + x_draw_glyph_string_bg_rect (s, x, s->y, width, s->height); + + /* Clear rest using the GC of the original non-cursor face. */ + if (width < background_width) + { + int y = s->y; + int w = background_width - width, h = s->height; + XRectangle r; + unsigned long color; + + if (!s->row->reversed_p) + x += width; + else + x = s->x; + if (s->row->mouse_face_p && cursor_in_mouse_face_p (s->w)) + { + pgtk_set_mouse_face_gc (s); + color = s->xgcv.foreground; + } + else + color = s->face->background; + + cairo_t *cr = pgtk_begin_cr_clip (s->f); + + get_glyph_string_clip_rect (s, &r); + pgtk_set_clip_rectangles (s->f, cr, &r, 1); + + if (s->face->stipple) + { + /* Fill background with a stipple pattern. */ + fill_background (s, x, y, w, h); + } + else + { + pgtk_fill_rectangle (s->f, color, x, y, w, h, + true); + } + + pgtk_end_cr_clip (s->f); + } + } + else if (!s->background_filled_p) + { + int background_width = s->background_width; + 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 (s->area == TEXT_AREA + && x < text_left_x && !s->row->mode_line_p) + { + 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); + } + + s->background_filled_p = true; +} + +static void +pgtk_draw_glyph_string (struct glyph_string *s) +{ + bool relief_drawn_p = false; + + /* If S draws into the background of its successors, draw the + background of the successors first so that S can draw into it. + This makes S->next use XDrawString instead of XDrawImageString. */ + if (s->next && s->right_overhang && !s->for_overlaps) + { + int width; + struct glyph_string *next; + + for (width = 0, next = s->next; + next && width < s->right_overhang; + width += next->width, next = next->next) + if (next->first_glyph->type != IMAGE_GLYPH) + { + cairo_t *cr = pgtk_begin_cr_clip (next->f); + pgtk_set_glyph_string_gc (next); + pgtk_set_glyph_string_clipping (next, cr); + if (next->first_glyph->type == STRETCH_GLYPH) + x_draw_stretch_glyph_string (next); + else + x_draw_glyph_string_background (next, true); + next->num_clips = 0; + pgtk_end_cr_clip (next->f); + } + } + + /* Set up S->gc, set clipping and draw S. */ + pgtk_set_glyph_string_gc (s); + + cairo_t *cr = pgtk_begin_cr_clip (s->f); + + /* Draw relief (if any) in advance for char/composition so that the + glyph string can be drawn over it. */ + if (!s->for_overlaps + && s->face->box != FACE_NO_BOX + && (s->first_glyph->type == CHAR_GLYPH + || s->first_glyph->type == COMPOSITE_GLYPH)) + + { + pgtk_set_glyph_string_clipping (s, cr); + x_draw_glyph_string_background (s, true); + x_draw_glyph_string_box (s); + pgtk_set_glyph_string_clipping (s, cr); + relief_drawn_p = true; + } + else 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))) + /* We must clip just this glyph. left_overhang part has already + drawn when s->prev was drawn, and right_overhang part will be + drawn later when s->next is drawn. */ + pgtk_set_glyph_string_clipping_exactly (s, s, cr); + else + pgtk_set_glyph_string_clipping (s, cr); + + switch (s->first_glyph->type) + { + case IMAGE_GLYPH: + x_draw_image_glyph_string (s); + break; + + case XWIDGET_GLYPH: + x_draw_xwidget_glyph_string (s); + break; + + case STRETCH_GLYPH: + x_draw_stretch_glyph_string (s); + break; + + case CHAR_GLYPH: + if (s->for_overlaps) + s->background_filled_p = true; + else + x_draw_glyph_string_background (s, false); + x_draw_glyph_string_foreground (s); + break; + + case COMPOSITE_GLYPH: + if (s->for_overlaps || (s->cmp_from > 0 + && !s->first_glyph->u.cmp.automatic)) + s->background_filled_p = true; + else + x_draw_glyph_string_background (s, true); + x_draw_composite_glyph_string_foreground (s); + break; + + case GLYPHLESS_GLYPH: + if (s->for_overlaps) + s->background_filled_p = true; + else + x_draw_glyph_string_background (s, true); + x_draw_glyphless_glyph_string_foreground (s); + break; + + default: + emacs_abort (); + } + + if (!s->for_overlaps) + { + /* Draw relief if not yet drawn. */ + if (!relief_drawn_p && s->face->box != FACE_NO_BOX) + x_draw_glyph_string_box (s); + + /* Draw underline. */ + if (s->face->underline) + { + if (s->face->underline == FACE_UNDER_WAVE) + { + if (s->face->underline_defaulted_p) + x_draw_underwave (s, s->xgcv.foreground); + else + { + x_draw_underwave (s, s->face->underline_color); + } + } + else if (s->face->underline == FACE_UNDER_LINE) + { + unsigned long thickness, position; + int y; + + if (s->prev + && s->prev->face->underline == FACE_UNDER_LINE + && (s->prev->face->underline_at_descent_line_p + == s->face->underline_at_descent_line_p) + && (s->prev->face->underline_pixels_above_descent_line + == s->face->underline_pixels_above_descent_line)) + { + /* We use the same underline style as the previous one. */ + thickness = s->prev->underline_thickness; + position = s->prev->underline_position; + } + else + { + struct font *font = font_for_underline_metrics (s); + + /* Get the underline thickness. Default is 1 pixel. */ + if (font && font->underline_thickness > 0) + thickness = font->underline_thickness; + else + thickness = 1; + if ((x_underline_at_descent_line + || s->face->underline_at_descent_line_p)) + position = ((s->height - thickness) + - (s->ybase - s->y) + - s->face->underline_pixels_above_descent_line); + else + { + /* Get the underline position. This is the recommended + vertical offset in pixels from the baseline to the top of + the underline. This is a signed value according to the + specs, and its default is + + ROUND ((maximum descent) / 2), with + ROUND(x) = floor (x + 0.5) */ + + if (x_use_underline_position_properties + && font && font->underline_position >= 0) + position = font->underline_position; + else if (font) + position = (font->descent + 1) / 2; + else + position = underline_minimum_offset; + } + + /* Ignore minimum_offset if the amount of pixels was + explictly specified. */ + if (!s->face->underline_pixels_above_descent_line) + position = max (position, underline_minimum_offset); + } + /* Check the sanity of thickness and position. We should + avoid drawing underline out of the current line area. */ + if (s->y + s->height <= s->ybase + position) + position = (s->height - 1) - (s->ybase - s->y); + if (s->y + s->height < s->ybase + position + thickness) + thickness = (s->y + s->height) - (s->ybase + position); + s->underline_thickness = thickness; + s->underline_position = position; + y = s->ybase + position; + if (s->face->underline_defaulted_p) + pgtk_fill_rectangle (s->f, s->xgcv.foreground, + s->x, y, s->width, thickness, + false); + else + { + pgtk_fill_rectangle (s->f, s->face->underline_color, + s->x, y, s->width, thickness, + false); + } + } + } + /* Draw overline. */ + if (s->face->overline_p) + { + unsigned long dy = 0, h = 1; + + if (s->face->overline_color_defaulted_p) + pgtk_fill_rectangle (s->f, s->xgcv.foreground, s->x, s->y + dy, + s->width, h, false); + else + { + pgtk_fill_rectangle (s->f, s->face->overline_color, s->x, + s->y + dy, s->width, h, false); + } + } + + /* Draw strike-through. */ + if (s->face->strike_through_p) + { + /* Y-coordinate and height of the glyph string's first + glyph. We cannot use s->y and s->height because those + could be larger if there are taller display elements + (e.g., characters displayed with a larger font) in the + same glyph row. */ + int glyph_y = s->ybase - s->first_glyph->ascent; + int glyph_height = s->first_glyph->ascent + s->first_glyph->descent; + /* Strike-through width and offset from the glyph string's + top edge. */ + unsigned long h = 1; + unsigned long dy = (glyph_height - h) / 2; + + if (s->face->strike_through_color_defaulted_p) + pgtk_fill_rectangle (s->f, s->xgcv.foreground, s->x, glyph_y + dy, + s->width, h, false); + else + { + pgtk_fill_rectangle (s->f, s->face->strike_through_color, s->x, + glyph_y + dy, s->width, h, false); + } + } + + if (s->prev) + { + 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; + + prev->hl = s->hl; + pgtk_set_glyph_string_gc (prev); + cairo_save (cr); + pgtk_set_glyph_string_clipping_exactly (s, prev, cr); + if (prev->first_glyph->type == CHAR_GLYPH) + x_draw_glyph_string_foreground (prev); + else + x_draw_composite_glyph_string_foreground (prev); + prev->hl = save; + prev->num_clips = 0; + cairo_restore (cr); + } + } + + if (s->next) + { + 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; + + next->hl = s->hl; + pgtk_set_glyph_string_gc (next); + cairo_save (cr); + pgtk_set_glyph_string_clipping_exactly (s, next, cr); + if (next->first_glyph->type == CHAR_GLYPH) + x_draw_glyph_string_foreground (next); + else + x_draw_composite_glyph_string_foreground (next); + cairo_restore (cr); + next->hl = save; + next->num_clips = 0; + next->clip_head = s->next; + } + } + } + + /* Reset clipping. */ + pgtk_end_cr_clip (s->f); + s->num_clips = 0; +} + +/* RIF: Define cursor CURSOR on frame F. */ + +static void +pgtk_define_frame_cursor (struct frame *f, Emacs_Cursor cursor) +{ + if (!f->pointer_invisible && FRAME_X_OUTPUT (f)->current_cursor != cursor) + gdk_window_set_cursor (gtk_widget_get_window (FRAME_GTK_WIDGET (f)), + cursor); + FRAME_X_OUTPUT (f)->current_cursor = cursor; +} + +static void +pgtk_after_update_window_line (struct window *w, + struct glyph_row *desired_row) +{ + struct frame *f; + int width, height; + + /* begin copy from other terms */ + eassert (w); + + if (!desired_row->mode_line_p && !w->pseudo_window_p) + desired_row->redraw_fringe_bitmaps_p = 1; + + /* When a window has disappeared, make sure that no rest of + full-width rows stays visible in the internal border. */ + if (windows_or_buffers_changed + && desired_row->full_width_p + && (f = XFRAME (w->frame), + width = FRAME_INTERNAL_BORDER_WIDTH (f), + width != 0) && (height = desired_row->visible_height, height > 0)) + { + int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y)); + + block_input (); + pgtk_clear_frame_area (f, 0, y, width, height); + pgtk_clear_frame_area (f, + FRAME_PIXEL_WIDTH (f) - width, y, width, height); + unblock_input (); + } +} + +static void +pgtk_clear_frame_area (struct frame *f, int x, int y, int width, int height) +{ + pgtk_clear_area (f, x, y, width, height); +} + +/* Draw a hollow box cursor on window W in glyph row ROW. */ + +static void +x_draw_hollow_cursor (struct window *w, struct glyph_row *row) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + int x, y, wd, h; + struct glyph *cursor_glyph; + + /* Get the glyph the cursor is on. If we can't tell because + the current matrix is invalid or such, give up. */ + cursor_glyph = get_phys_cursor_glyph (w); + if (cursor_glyph == NULL) + return; + + /* Compute frame-relative coordinates for phys cursor. */ + get_phys_cursor_geometry (w, row, cursor_glyph, &x, &y, &h); + wd = w->phys_cursor_width - 1; + + /* The foreground of cursor_gc is typically the same as the normal + background color, which can cause the cursor box to be invisible. */ + cairo_t *cr = pgtk_begin_cr_clip (f); + pgtk_set_cr_source_with_color (f, FRAME_X_OUTPUT (f)->cursor_color, false); + + /* When on R2L character, show cursor at the right edge of the + glyph, unless the cursor box is as wide as the glyph or wider + (the latter happens when x-stretch-cursor is non-nil). */ + if ((cursor_glyph->resolved_level & 1) != 0 + && cursor_glyph->pixel_width > wd) + { + x += cursor_glyph->pixel_width - wd; + if (wd > 0) + wd -= 1; + } + /* Set clipping, draw the rectangle, and reset clipping again. */ + pgtk_clip_to_row (w, row, TEXT_AREA, cr); + pgtk_draw_rectangle (f, FRAME_X_OUTPUT (f)->cursor_color, x, y, wd, h - 1, false); + pgtk_end_cr_clip (f); +} + +/* Draw a bar cursor on window W in glyph row ROW. + + Implementation note: One would like to draw a bar cursor with an + angle equal to the one given by the font property XA_ITALIC_ANGLE. + Unfortunately, I didn't find a font yet that has this property set. + --gerd. */ + +static void +x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, + enum text_cursor_kinds kind) +{ + struct frame *f = XFRAME (w->frame); + struct glyph *cursor_glyph; + + /* 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. */ + cursor_glyph = get_phys_cursor_glyph (w); + if (cursor_glyph == NULL) + return; + + /* Experimental avoidance of cursor on xwidget. */ + if (cursor_glyph->type == XWIDGET_GLYPH) + return; + + /* If on an image, draw like a normal cursor. That's usually better + visible than drawing a bar, esp. if the image is large so that + the bar might not be in the window. */ + if (cursor_glyph->type == IMAGE_GLYPH) + { + struct glyph_row *r; + r = MATRIX_ROW (w->current_matrix, w->phys_cursor.vpos); + draw_phys_cursor_glyph (w, r, DRAW_CURSOR); + } + else + { + struct face *face = FACE_FROM_ID (f, cursor_glyph->face_id); + unsigned long color; + + cairo_t *cr = pgtk_begin_cr_clip (f); + + /* If the glyph's background equals the color we normally draw + the bars cursor in, the bar cursor in its normal color is + invisible. Use the glyph's foreground color instead in this + case, on the assumption that the glyph's colors are chosen so + that the glyph is legible. */ + if (face->background == FRAME_X_OUTPUT (f)->cursor_color) + color = face->foreground; + else + color = FRAME_X_OUTPUT (f)->cursor_color; + + pgtk_clip_to_row (w, row, TEXT_AREA, cr); + + if (kind == BAR_CURSOR) + { + int x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x); + + if (width < 0) + width = FRAME_CURSOR_WIDTH (f); + width = min (cursor_glyph->pixel_width, width); + + w->phys_cursor_width = width; + + /* If the character under cursor is R2L, draw the bar cursor + on the right of its glyph, rather than on the left. */ + if ((cursor_glyph->resolved_level & 1) != 0) + x += cursor_glyph->pixel_width - width; + + pgtk_fill_rectangle (f, color, x, + WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y), + width, row->height, false); + } + else /* HBAR_CURSOR */ + { + int dummy_x, dummy_y, dummy_h; + int x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x); + + if (width < 0) + width = row->height; + + width = min (row->height, width); + + get_phys_cursor_geometry (w, row, cursor_glyph, &dummy_x, + &dummy_y, &dummy_h); + + if ((cursor_glyph->resolved_level & 1) != 0 + && cursor_glyph->pixel_width > w->phys_cursor_width - 1) + x += cursor_glyph->pixel_width - w->phys_cursor_width + 1; + pgtk_fill_rectangle (f, color, x, + WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y + + row->height - width), + w->phys_cursor_width - 1, width, false); + } + + pgtk_end_cr_clip (f); + } +} + +/* RIF: Draw cursor on window W. */ + +static void +pgtk_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, + int y, enum text_cursor_kinds cursor_type, + int cursor_width, bool on_p, bool active_p) +{ + struct frame *f = XFRAME (w->frame); + if (on_p) + { + w->phys_cursor_type = cursor_type; + w->phys_cursor_on_p = true; + + if (glyph_row->exact_window_width_line_p + && (glyph_row->reversed_p + ? (w->phys_cursor.hpos < 0) + : (w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA]))) + { + glyph_row->cursor_in_fringe_p = true; + draw_fringe_bitmap (w, glyph_row, glyph_row->reversed_p); + } + else + { + switch (cursor_type) + { + case HOLLOW_BOX_CURSOR: + x_draw_hollow_cursor (w, glyph_row); + break; + + case FILLED_BOX_CURSOR: + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + break; + + case BAR_CURSOR: + x_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR); + break; + + case HBAR_CURSOR: + x_draw_bar_cursor (w, glyph_row, cursor_width, HBAR_CURSOR); + break; + + case NO_CURSOR: + w->phys_cursor_width = 0; + break; + + default: + emacs_abort (); + } + } + + if (w == XWINDOW (f->selected_window)) + { + int frame_x = + WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w); + int frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, y); + pgtk_im_set_cursor_location (f, frame_x, frame_y, + w->phys_cursor_width, + w->phys_cursor_height); + } + } + +} + +static void +pgtk_copy_bits (struct frame *f, cairo_rectangle_t *src_rect, + cairo_rectangle_t *dst_rect) +{ + cairo_t *cr; + cairo_surface_t *surface; /* temporary surface */ + + surface = + cairo_surface_create_similar (FRAME_CR_SURFACE (f), + CAIRO_CONTENT_COLOR_ALPHA, + (int) src_rect->width, + (int) src_rect->height); + + cr = cairo_create (surface); + cairo_set_source_surface (cr, FRAME_CR_SURFACE (f), -src_rect->x, + -src_rect->y); + cairo_rectangle (cr, 0, 0, src_rect->width, src_rect->height); + cairo_clip (cr); + cairo_paint (cr); + cairo_destroy (cr); + + cr = pgtk_begin_cr_clip (f); + cairo_set_source_surface (cr, surface, dst_rect->x, dst_rect->y); + cairo_set_operator (cr, CAIRO_OPERATOR_SOURCE); + cairo_rectangle (cr, dst_rect->x, dst_rect->y, dst_rect->width, + dst_rect->height); + cairo_clip (cr); + cairo_paint (cr); + pgtk_end_cr_clip (f); + + cairo_surface_destroy (surface); +} + +/* Scroll part of the display as described by RUN. */ + +static void +pgtk_scroll_run (struct window *w, struct run *run) +{ + struct frame *f = XFRAME (w->frame); + int x, y, width, height, from_y, to_y, bottom_y; + + /* Get frame-relative bounding box of the text display area of W, + without mode lines. Include in this box the left and right + fringe of W. */ + window_box (w, ANY_AREA, &x, &y, &width, &height); + + from_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->current_y); + to_y = WINDOW_TO_FRAME_PIXEL_Y (w, run->desired_y); + bottom_y = y + height; + + if (to_y < from_y) + { + /* Scrolling up. Make sure we don't copy part of the mode + line at the bottom. */ + if (from_y + run->height > bottom_y) + height = bottom_y - from_y; + else + height = run->height; + } + else + { + /* Scrolling down. Make sure we don't copy over the mode line. + at the bottom. */ + if (to_y + run->height > bottom_y) + height = bottom_y - to_y; + else + height = run->height; + } + + block_input (); + +#ifdef HAVE_XWIDGETS + /* "Copy" xwidget views in the area that will be scrolled. */ + GtkWidget *tem, *parent = FRAME_GTK_WIDGET (f); + GList *children = gtk_container_get_children (GTK_CONTAINER (parent)); + GList *iter; + struct xwidget_view *view; + + for (iter = children; iter; iter = iter->next) + { + tem = iter->data; + view = g_object_get_data (G_OBJECT (tem), XG_XWIDGET_VIEW); + + 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; + gtk_widget_hide (tem); + 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, view->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; + gtk_widget_hide (tem); + } + else + { + gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (f)), + tem, view->x + view->clip_left, + view->y + view->clip_top); + gtk_widget_set_size_request (tem, view->clip_right - view->clip_left, + view->clip_bottom - view->clip_top); + gtk_widget_queue_allocate (tem); + } + } + } + } + + g_list_free (children); +#endif + + /* Cursor off. Will be switched on again in x_update_window_end. */ + gui_clear_cursor (w); + + { + cairo_rectangle_t src_rect = { x, from_y, width, height }; + cairo_rectangle_t dst_rect = { x, to_y, width, height }; + pgtk_copy_bits (f, &src_rect, &dst_rect); + } + + unblock_input (); +} + +/* Icons. */ + +/* Make the x-window of frame F use the gnu icon bitmap. */ + +static bool +pgtk_bitmap_icon (struct frame *f, Lisp_Object file) +{ + ptrdiff_t bitmap_id; + + if (FRAME_GTK_WIDGET (f) == 0) + return true; + + /* Free up our existing icon bitmap and mask if any. */ + if (f->output_data.pgtk->icon_bitmap > 0) + image_destroy_bitmap (f, f->output_data.pgtk->icon_bitmap); + f->output_data.pgtk->icon_bitmap = 0; + + if (STRINGP (file)) + { + /* Use gtk_window_set_icon_from_file () if available, + It's not restricted to bitmaps */ + if (xg_set_icon (f, file)) + return false; + bitmap_id = image_create_bitmap_from_file (f, file); + } + else + { + /* Create the GNU bitmap and mask if necessary. */ + if (FRAME_DISPLAY_INFO (f)->icon_bitmap_id < 0) + { + ptrdiff_t rc = -1; + + if (xg_set_icon (f, xg_default_icon_file) + || xg_set_icon_from_xpm_data (f, gnu_xpm_bits)) + { + FRAME_DISPLAY_INFO (f)->icon_bitmap_id = -2; + return false; + } + + /* If all else fails, use the (black and white) xbm image. */ + if (rc == -1) + { + rc = image_create_bitmap_from_data (f, + (char *) gnu_xbm_bits, + gnu_xbm_width, + gnu_xbm_height); + if (rc == -1) + return true; + + FRAME_DISPLAY_INFO (f)->icon_bitmap_id = rc; + } + } + + /* The first time we create the GNU bitmap and mask, + this increments the ref-count one extra time. + As a result, the GNU bitmap and mask are never freed. + That way, we don't have to worry about allocating it again. */ + image_reference_bitmap (f, FRAME_DISPLAY_INFO (f)->icon_bitmap_id); + + bitmap_id = FRAME_DISPLAY_INFO (f)->icon_bitmap_id; + } + + if (FRAME_DISPLAY_INFO (f)->bitmaps[bitmap_id - 1].img != NULL) + { + gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + FRAME_DISPLAY_INFO (f)->bitmaps[bitmap_id - 1].img); + } + f->output_data.pgtk->icon_bitmap = bitmap_id; + + return false; +} + + +/* Make the x-window of frame F use a rectangle with text. + Use ICON_NAME as the text. */ + +bool +pgtk_text_icon (struct frame *f, const char *icon_name) +{ + if (FRAME_GTK_OUTER_WIDGET (f)) + { + gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), NULL); + gtk_window_set_title (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), icon_name); + } + + return false; +} + +/*********************************************************************** + Starting and ending an update + ***********************************************************************/ + +/* Start an update of frame F. This function is installed as a hook + for update_begin, i.e. it is called when update_begin is called. + This function is called prior to calls to x_update_window_begin for + each window being updated. Currently, there is nothing to do here + because all interesting stuff is done on a window basis. */ + +static void +pgtk_update_begin (struct frame *f) +{ + pgtk_clear_under_internal_border (f); +} + +/* Draw a vertical window border from (x,y0) to (x,y1) */ + +static void +pgtk_draw_vertical_window_border (struct window *w, int x, int y0, int y1) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + struct face *face; + cairo_t *cr; + + cr = pgtk_begin_cr_clip (f); + + face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID); + if (face) + pgtk_set_cr_source_with_color (f, face->foreground, false); + + cairo_rectangle (cr, x, y0, 1, y1 - y0); + cairo_fill (cr); + + pgtk_end_cr_clip (f); +} + +/* Draw a window divider from (x0,y0) to (x1,y1) */ + +static void +pgtk_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + struct face *face = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FACE_ID); + struct face *face_first + = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID); + struct face *face_last + = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_LAST_PIXEL_FACE_ID); + unsigned long color = face ? face->foreground : FRAME_FOREGROUND_PIXEL (f); + unsigned long color_first = (face_first + ? face_first->foreground + : FRAME_FOREGROUND_PIXEL (f)); + unsigned long color_last = (face_last + ? face_last->foreground + : FRAME_FOREGROUND_PIXEL (f)); + cairo_t *cr = pgtk_begin_cr_clip (f); + + if (y1 - y0 > x1 - x0 && x1 - x0 > 2) + /* Vertical. */ + { + pgtk_set_cr_source_with_color (f, color_first, false); + cairo_rectangle (cr, x0, y0, 1, y1 - y0); + cairo_fill (cr); + pgtk_set_cr_source_with_color (f, color, false); + cairo_rectangle (cr, x0 + 1, y0, x1 - x0 - 2, y1 - y0); + cairo_fill (cr); + pgtk_set_cr_source_with_color (f, color_last, false); + cairo_rectangle (cr, x1 - 1, y0, 1, y1 - y0); + cairo_fill (cr); + } + else if (x1 - x0 > y1 - y0 && y1 - y0 > 3) + /* Horizontal. */ + { + pgtk_set_cr_source_with_color (f, color_first, false); + cairo_rectangle (cr, x0, y0, x1 - x0, 1); + cairo_fill (cr); + pgtk_set_cr_source_with_color (f, color, false); + cairo_rectangle (cr, x0, y0 + 1, x1 - x0, y1 - y0 - 2); + cairo_fill (cr); + pgtk_set_cr_source_with_color (f, color_last, false); + cairo_rectangle (cr, x0, y1 - 1, x1 - x0, 1); + cairo_fill (cr); + } + else + { + pgtk_set_cr_source_with_color (f, color, false); + cairo_rectangle (cr, x0, y0, x1 - x0, y1 - y0); + cairo_fill (cr); + } + + pgtk_end_cr_clip (f); +} + +/* End update of frame F. This function is installed as a hook in + update_end. */ + +static void +pgtk_update_end (struct frame *f) +{ + /* Mouse highlight may be displayed again. */ + MOUSE_HL_INFO (f)->mouse_face_defer = false; +} + +static void +pgtk_frame_up_to_date (struct frame *f) +{ + block_input (); + FRAME_MOUSE_UPDATE (f); + if (!buffer_flipping_blocked_p ()) + { + flip_cr_context (f); + gtk_widget_queue_draw (FRAME_GTK_WIDGET (f)); + } + unblock_input (); +} + +/* Return the current position of the mouse. + *FP should be a frame which indicates which display to ask about. + + If the mouse movement started in a scroll bar, set *FP, *BAR_WINDOW, + and *PART to the frame, window, and scroll bar part that the mouse + is over. Set *X and *Y to the portion and whole of the mouse's + position on the scroll bar. + + If the mouse movement started elsewhere, set *FP to the frame the + mouse is on, *BAR_WINDOW to nil, and *X and *Y to the character cell + the mouse is over. + + Set *TIMESTAMP to the server time-stamp for the time at which the mouse + was at this position. + + Don't store anything if we don't have a valid set of values to report. + + This clears the mouse_moved flag, so we can wait for the next mouse + movement. */ + +static void +pgtk_mouse_position (struct frame **fp, int insist, Lisp_Object * bar_window, + enum scroll_bar_part *part, Lisp_Object *x, + Lisp_Object *y, Time *timestamp) +{ + struct frame *f1; + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (*fp); + int win_x, win_y; + GdkSeat *seat; + GdkDevice *device; + GdkModifierType mask; + GdkWindow *win; + bool return_frame_flag = false; + + block_input (); + + Lisp_Object frame, tail; + + /* Clear the mouse-moved flag for every frame on this display. */ + FOR_EACH_FRAME (tail, frame) + if (FRAME_PGTK_P (XFRAME (frame)) + && FRAME_X_DISPLAY (XFRAME (frame)) == FRAME_X_DISPLAY (*fp)) + XFRAME (frame)->mouse_moved = false; + + dpyinfo->last_mouse_scroll_bar = NULL; + + if (gui_mouse_grabbed (dpyinfo) + && (!EQ (track_mouse, Qdropping) + && !EQ (track_mouse, Qdrag_source))) + { + /* 1.1. use last_mouse_frame as frame where the pointer is + on. */ + f1 = dpyinfo->last_mouse_frame; + } + else + { + f1 = *fp; + /* 1.2. get frame where the pointer is on. */ + win = gtk_widget_get_window (FRAME_GTK_WIDGET (*fp)); + seat = gdk_display_get_default_seat (dpyinfo->gdpy); + device = gdk_seat_get_pointer (seat); + win = gdk_window_get_device_position (win, device, &win_x, + &win_y, &mask); + if (win != NULL) + f1 = pgtk_any_window_to_frame (win); + else + { + f1 = SELECTED_FRAME (); + + if (!FRAME_PGTK_P (f1)) + f1 = dpyinfo->last_mouse_frame; + + return_frame_flag = EQ (track_mouse, Qdrag_source); + } + } + + /* F1 can be a terminal frame. (Bug#50322) */ + if (f1 == NULL || !FRAME_PGTK_P (f1)) + { + unblock_input (); + return; + } + + /* 2. get the display and the device. */ + win = gtk_widget_get_window (FRAME_GTK_WIDGET (f1)); + GdkDisplay *gdpy = gdk_window_get_display (win); + seat = gdk_display_get_default_seat (gdpy); + device = gdk_seat_get_pointer (seat); + + /* 3. get x, y relative to edit window of the frame. */ + win = gdk_window_get_device_position (win, device, &win_x, &win_y, &mask); + + if (f1 != NULL) + { + dpyinfo = FRAME_DISPLAY_INFO (f1); + remember_mouse_glyph (f1, win_x, win_y, &dpyinfo->last_mouse_glyph); + dpyinfo->last_mouse_glyph_frame = f1; + + *bar_window = Qnil; + *part = 0; + *fp = !return_frame_flag ? f1 : NULL; + XSETINT (*x, win_x); + XSETINT (*y, win_y); + *timestamp = dpyinfo->last_mouse_movement_time; + } + + unblock_input (); +} + +/* Fringe bitmaps. */ + +static int max_fringe_bmp = 0; +static cairo_pattern_t **fringe_bmp = 0; + +static void +pgtk_define_fringe_bitmap (int which, unsigned short *bits, int h, int wd) +{ + int i, stride; + cairo_surface_t *surface; + unsigned char *data; + cairo_pattern_t *pattern; + + if (which >= max_fringe_bmp) + { + i = max_fringe_bmp; + max_fringe_bmp = which + 20; + fringe_bmp = + (cairo_pattern_t **) xrealloc (fringe_bmp, + max_fringe_bmp * + sizeof (cairo_pattern_t *)); + while (i < max_fringe_bmp) + fringe_bmp[i++] = 0; + } + + block_input (); + + surface = cairo_image_surface_create (CAIRO_FORMAT_A1, wd, h); + stride = cairo_image_surface_get_stride (surface); + data = cairo_image_surface_get_data (surface); + + for (i = 0; i < h; i++) + { + *((unsigned short *) data) = bits[i]; + data += stride; + } + + cairo_surface_mark_dirty (surface); + pattern = cairo_pattern_create_for_surface (surface); + cairo_surface_destroy (surface); + + unblock_input (); + + fringe_bmp[which] = pattern; +} + +static void +pgtk_destroy_fringe_bitmap (int which) +{ + if (which >= max_fringe_bmp) + return; + + if (fringe_bmp[which]) + { + block_input (); + cairo_pattern_destroy (fringe_bmp[which]); + unblock_input (); + } + fringe_bmp[which] = 0; +} + +static void +pgtk_clip_to_row (struct window *w, struct glyph_row *row, + enum glyph_row_area area, cairo_t * cr) +{ + int window_x, window_y, window_width; + cairo_rectangle_int_t rect; + + window_box (w, area, &window_x, &window_y, &window_width, 0); + + rect.x = window_x; + rect.y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, row->y)); + rect.y = max (rect.y, window_y); + rect.width = window_width; + rect.height = row->visible_height; + + cairo_rectangle (cr, rect.x, rect.y, rect.width, rect.height); + cairo_clip (cr); +} + +static void +pgtk_cr_draw_image (struct frame *f, Emacs_GC * gc, cairo_pattern_t * image, + int src_x, int src_y, int width, int height, + int dest_x, int dest_y, bool overlay_p) +{ + cairo_t *cr = pgtk_begin_cr_clip (f); + + if (overlay_p) + cairo_rectangle (cr, dest_x, dest_y, width, height); + else + { + pgtk_set_cr_source_with_gc_background (f, gc, false); + cairo_rectangle (cr, dest_x, dest_y, width, height); + cairo_fill_preserve (cr); + } + cairo_translate (cr, dest_x - src_x, dest_y - src_y); + + cairo_surface_t *surface; + cairo_pattern_get_surface (image, &surface); + cairo_format_t format = cairo_image_surface_get_format (surface); + if (format != CAIRO_FORMAT_A8 && format != CAIRO_FORMAT_A1) + { + cairo_set_source (cr, image); + cairo_fill (cr); + } + else + { + pgtk_set_cr_source_with_gc_foreground (f, gc, false); + cairo_clip (cr); + cairo_mask (cr, image); + } + + pgtk_end_cr_clip (f); +} + +static void +pgtk_draw_fringe_bitmap (struct window *w, struct glyph_row *row, + struct draw_fringe_bitmap_params *p) +{ + struct frame *f = XFRAME (WINDOW_FRAME (w)); + struct face *face = p->face; + + cairo_t *cr = pgtk_begin_cr_clip (f); + + /* Must clip because of partially visible lines. */ + pgtk_clip_to_row (w, row, ANY_AREA, cr); + + if (p->bx >= 0 && !p->overlay_p) + { + /* In case the same realized face is used for fringes and + for something displayed in the text (e.g. face `region' on + mono-displays, the fill style may have been changed to + FillSolid in x_draw_glyph_string_background. */ + if (face->stipple) + { + fill_background_by_face (f, face, p->bx, p->by, p->nx, p->ny); + } + else + { + pgtk_set_cr_source_with_color (f, face->background, true); + cairo_rectangle (cr, p->bx, p->by, p->nx, p->ny); + cairo_fill (cr); + } + } + + if (p->which + && p->which < max_fringe_bmp + && p->which < max_used_fringe_bitmap) + { + Emacs_GC gcv; + + if (!fringe_bmp[p->which]) + { + /* This fringe bitmap is known to fringe.c, but lacks the + cairo_pattern_t pattern which shadows that bitmap. This + is typical to define-fringe-bitmap being called when the + selected frame was not a GUI frame, for example, when + packages that define fringe bitmaps are loaded by a + daemon Emacs. Create the missing pattern now. */ + gui_define_fringe_bitmap (f, p->which); + } + + gcv.foreground = (p->cursor_p + ? (p->overlay_p ? face->background + : FRAME_X_OUTPUT (f)->cursor_color) + : face->foreground); + gcv.background = face->background; + pgtk_cr_draw_image (f, &gcv, fringe_bmp[p->which], 0, p->dh, + p->wd, p->h, p->x, p->y, p->overlay_p); + } + + pgtk_end_cr_clip (f); +} + +static struct atimer *hourglass_atimer = NULL; +static int hourglass_enter_count = 0; + +static void +hourglass_cb (struct atimer *timer) +{ + /*NOP*/} + +static void +pgtk_show_hourglass (struct frame *f) +{ + struct pgtk_output *x = FRAME_X_OUTPUT (f); + if (x->hourglass_widget != NULL) + gtk_widget_destroy (x->hourglass_widget); + x->hourglass_widget = gtk_event_box_new (); /* gtk_event_box is GDK_INPUT_ONLY. */ + gtk_widget_set_has_window (x->hourglass_widget, true); + gtk_fixed_put (GTK_FIXED (FRAME_GTK_WIDGET (f)), x->hourglass_widget, 0, 0); + gtk_widget_show (x->hourglass_widget); + gtk_widget_set_size_request (x->hourglass_widget, 30000, 30000); + gdk_window_raise (gtk_widget_get_window (x->hourglass_widget)); + gdk_window_set_cursor (gtk_widget_get_window (x->hourglass_widget), + x->hourglass_cursor); + + /* For cursor animation, we receive signals, set pending_signals, and dispatch. */ + if (hourglass_enter_count++ == 0) + { + struct timespec ts = make_timespec (0, 50 * 1000 * 1000); + if (hourglass_atimer != NULL) + cancel_atimer (hourglass_atimer); + hourglass_atimer = + start_atimer (ATIMER_CONTINUOUS, ts, hourglass_cb, NULL); + } + + /* Cursor frequently stops animation. gtk's bug? */ +} + +static void +pgtk_hide_hourglass (struct frame *f) +{ + struct pgtk_output *x = FRAME_X_OUTPUT (f); + if (--hourglass_enter_count == 0) + { + if (hourglass_atimer != NULL) + { + cancel_atimer (hourglass_atimer); + hourglass_atimer = NULL; + } + } + if (x->hourglass_widget != NULL) + { + gtk_widget_destroy (x->hourglass_widget); + x->hourglass_widget = NULL; + } +} + +/* Flushes changes to display. */ +static void +pgtk_flush_display (struct frame *f) +{ +} + +extern frame_parm_handler pgtk_frame_parm_handlers[]; + +static struct redisplay_interface pgtk_redisplay_interface = { + pgtk_frame_parm_handlers, + gui_produce_glyphs, + gui_write_glyphs, + gui_insert_glyphs, + gui_clear_end_of_line, + pgtk_scroll_run, + pgtk_after_update_window_line, + NULL, /* gui_update_window_begin, */ + NULL, /* gui_update_window_end, */ + pgtk_flush_display, + gui_clear_window_mouse_face, + gui_get_glyph_overhangs, + gui_fix_overlapping_area, + pgtk_draw_fringe_bitmap, + pgtk_define_fringe_bitmap, + pgtk_destroy_fringe_bitmap, + pgtk_compute_glyph_string_overhangs, + pgtk_draw_glyph_string, + pgtk_define_frame_cursor, + pgtk_clear_frame_area, + pgtk_clear_under_internal_border, + pgtk_draw_window_cursor, + pgtk_draw_vertical_window_border, + pgtk_draw_window_divider, + NULL, /* pgtk_shift_glyphs_for_insert, */ + pgtk_show_hourglass, + pgtk_hide_hourglass, + pgtk_default_font_parameter, +}; + +static void +pgtk_redraw_scroll_bars (struct frame *f) +{ +} + +void +pgtk_clear_frame (struct frame *f) +/* -------------------------------------------------------------------------- + External (hook): Erase the entire frame + -------------------------------------------------------------------------- */ +{ + /* comes on initial frame because we have + after-make-frame-functions = select-frame */ + if (!FRAME_DEFAULT_FACE (f)) + return; + + /* mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f))); */ + + block_input (); + + pgtk_clear_area (f, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); + + /* as of 2006/11 or so this is now needed */ + pgtk_redraw_scroll_bars (f); + unblock_input (); +} + +/* Invert the middle quarter of the frame for .15 sec. */ + +static void +recover_from_visible_bell (struct atimer *timer) +{ + struct frame *f = timer->client_data; + + if (FRAME_X_OUTPUT (f)->cr_surface_visible_bell != NULL) + { + cairo_surface_destroy (FRAME_X_OUTPUT (f)->cr_surface_visible_bell); + FRAME_X_OUTPUT (f)->cr_surface_visible_bell = NULL; + } + + if (FRAME_X_OUTPUT (f)->atimer_visible_bell != NULL) + FRAME_X_OUTPUT (f)->atimer_visible_bell = NULL; +} + +static void +pgtk_flash (struct frame *f) +{ + { + if (!FRAME_CR_CONTEXT (f)) + return; + + block_input (); + + cairo_surface_t *surface_orig = FRAME_CR_SURFACE (f); + + int width = FRAME_CR_SURFACE_DESIRED_WIDTH (f); + int height = FRAME_CR_SURFACE_DESIRED_HEIGHT (f); + cairo_surface_t *surface = + cairo_surface_create_similar (surface_orig, CAIRO_CONTENT_COLOR_ALPHA, + width, height); + + cairo_t *cr = cairo_create (surface); + cairo_set_source_surface (cr, surface_orig, 0, 0); + cairo_rectangle (cr, 0, 0, width, height); + cairo_clip (cr); + cairo_paint (cr); + + cairo_set_source_rgb (cr, 1, 1, 1); + cairo_set_operator (cr, CAIRO_OPERATOR_DIFFERENCE); + + { + /* Get the height not including a menu bar widget. */ + int height = FRAME_PIXEL_HEIGHT (f); + /* Height of each line to flash. */ + int flash_height = FRAME_LINE_HEIGHT (f); + /* These will be the left and right margins of the rectangles. */ + int flash_left = FRAME_INTERNAL_BORDER_WIDTH (f); + int flash_right = + FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f); + int width = flash_right - flash_left; + + /* If window is tall, flash top and bottom line. */ + if (height > 3 * FRAME_LINE_HEIGHT (f)) + { + cairo_rectangle (cr, + flash_left, + (FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_TOP_MARGIN_HEIGHT (f)), + width, flash_height); + cairo_fill (cr); + + cairo_rectangle (cr, + flash_left, + (height - flash_height + - FRAME_INTERNAL_BORDER_WIDTH (f)), + width, flash_height); + cairo_fill (cr); + } + else + { + /* If it is short, flash it all. */ + cairo_rectangle (cr, + flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), + width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + cairo_fill (cr); + } + + FRAME_X_OUTPUT (f)->cr_surface_visible_bell = surface; + { + struct timespec delay = make_timespec (0, 50 * 1000 * 1000); + if (FRAME_X_OUTPUT (f)->atimer_visible_bell != NULL) + { + cancel_atimer (FRAME_X_OUTPUT (f)->atimer_visible_bell); + FRAME_X_OUTPUT (f)->atimer_visible_bell = NULL; + } + FRAME_X_OUTPUT (f)->atimer_visible_bell = + start_atimer (ATIMER_RELATIVE, delay, recover_from_visible_bell, f); + } + + } + + cairo_destroy (cr); + unblock_input (); + } +} + +/* Make audible bell. */ + +static void +pgtk_ring_bell (struct frame *f) +{ + if (visible_bell) + { + pgtk_flash (f); + } + else + { + block_input (); + gtk_widget_error_bell (FRAME_GTK_WIDGET (f)); + unblock_input (); + } +} + +/* Read events coming from the X server. + Return as soon as there are no more events to be read. + + Return the number of characters stored into the buffer, + thus pretending to be `read' (except the characters we store + in the keyboard buffer can be multibyte, so are not necessarily + C chars). */ + +static int +pgtk_read_socket (struct terminal *terminal, struct input_event *hold_quit) +{ + GMainContext *context; + bool context_acquired = false; + int count; + + count = evq_flush (hold_quit); + if (count > 0) + { + return count; + } + + context = g_main_context_default (); + context_acquired = g_main_context_acquire (context); + + block_input (); + + if (context_acquired) + { + while (g_main_context_pending (context)) + { + g_main_context_dispatch (context); + } + } + + unblock_input (); + + if (context_acquired) + g_main_context_release (context); + + count = evq_flush (hold_quit); + if (count > 0) + { + return count; + } + + return 0; +} + +/* Lisp window being scrolled. Set when starting to interact with + a toolkit scroll bar, reset to nil when ending the interaction. */ + +static Lisp_Object window_being_scrolled; + +static void +pgtk_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part, + int portion, int whole, bool horizontal) +{ + union buffered_input_event inev; + + EVENT_INIT (inev.ie); + + inev.ie.kind = + horizontal ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT : SCROLL_BAR_CLICK_EVENT; + inev.ie.frame_or_window = window; + inev.ie.arg = Qnil; + inev.ie.timestamp = 0; + inev.ie.code = 0; + inev.ie.part = part; + inev.ie.x = make_fixnum (portion); + inev.ie.y = make_fixnum (whole); + inev.ie.modifiers = 0; + + evq_enqueue (&inev); +} + + +/* Scroll bar callback for GTK scroll bars. WIDGET is the scroll + bar widget. DATA is a pointer to the scroll_bar structure. */ + +static gboolean +xg_scroll_callback (GtkRange * range, + GtkScrollType scroll, gdouble value, gpointer user_data) +{ + int whole = 0, portion = 0; + struct scroll_bar *bar = user_data; + enum scroll_bar_part part = scroll_bar_nowhere; + GtkAdjustment *adj = GTK_ADJUSTMENT (gtk_range_get_adjustment (range)); + + if (xg_ignore_gtk_scrollbar) + return false; + + switch (scroll) + { + case GTK_SCROLL_JUMP: + if (bar->horizontal) + { + part = scroll_bar_horizontal_handle; + whole = (int) (gtk_adjustment_get_upper (adj) - + gtk_adjustment_get_page_size (adj)); + portion = min ((int) value, whole); + bar->dragging = portion; + } + else + { + part = scroll_bar_handle; + whole = gtk_adjustment_get_upper (adj) - + gtk_adjustment_get_page_size (adj); + portion = min ((int) value, whole); + bar->dragging = portion; + } + break; + case GTK_SCROLL_STEP_BACKWARD: + part = (bar->horizontal ? scroll_bar_left_arrow : scroll_bar_up_arrow); + bar->dragging = -1; + break; + case GTK_SCROLL_STEP_FORWARD: + part = (bar->horizontal + ? scroll_bar_right_arrow : scroll_bar_down_arrow); + bar->dragging = -1; + break; + case GTK_SCROLL_PAGE_BACKWARD: + part = (bar->horizontal + ? scroll_bar_before_handle : scroll_bar_above_handle); + bar->dragging = -1; + break; + case GTK_SCROLL_PAGE_FORWARD: + part = (bar->horizontal + ? scroll_bar_after_handle : scroll_bar_below_handle); + bar->dragging = -1; + break; + default: + break; + } + + if (part != scroll_bar_nowhere) + { + window_being_scrolled = bar->window; + pgtk_send_scroll_bar_event (bar->window, part, portion, whole, + bar->horizontal); + } + + return false; +} + +/* Callback for button release. Sets dragging to -1 when dragging is done. */ + +static gboolean +xg_end_scroll_callback (GtkWidget * widget, + GdkEventButton * event, gpointer user_data) +{ + struct scroll_bar *bar = user_data; + bar->dragging = -1; + if (WINDOWP (window_being_scrolled)) + { + pgtk_send_scroll_bar_event (window_being_scrolled, + scroll_bar_end_scroll, 0, 0, + bar->horizontal); + window_being_scrolled = Qnil; + } + + return false; +} + +#define SCROLL_BAR_NAME "verticalScrollBar" +#define SCROLL_BAR_HORIZONTAL_NAME "horizontalScrollBar" + +/* Create the widget for scroll bar BAR on frame F. Record the widget + and X window of the scroll bar in BAR. */ + +static void +x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar) +{ + const char *scroll_bar_name = SCROLL_BAR_NAME; + + block_input (); + xg_create_scroll_bar (f, bar, G_CALLBACK (xg_scroll_callback), + G_CALLBACK (xg_end_scroll_callback), scroll_bar_name); + unblock_input (); +} + +static void +x_create_horizontal_toolkit_scroll_bar (struct frame *f, + struct scroll_bar *bar) +{ + const char *scroll_bar_name = SCROLL_BAR_HORIZONTAL_NAME; + + block_input (); + xg_create_horizontal_scroll_bar (f, bar, G_CALLBACK (xg_scroll_callback), + G_CALLBACK (xg_end_scroll_callback), + scroll_bar_name); + unblock_input (); +} + +/* Set the thumb size and position of scroll bar BAR. We are currently + displaying PORTION out of a whole WHOLE, and our position POSITION. */ + +static void +pgtk_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, + int position, int whole) +{ + xg_set_toolkit_scroll_bar_thumb (bar, portion, position, whole); +} + +static void +pgtk_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, + int portion, int position, + int whole) +{ + xg_set_toolkit_horizontal_scroll_bar_thumb (bar, portion, position, whole); +} + + + +/* Create a scroll bar and return the scroll bar vector for it. W is + the Emacs window on which to create the scroll bar. TOP, LEFT, + WIDTH and HEIGHT are the pixel coordinates and dimensions of the + scroll bar. */ + +static struct scroll_bar * +x_scroll_bar_create (struct window *w, int top, int left, + int width, int height, bool horizontal) +{ + struct frame *f = XFRAME (w->frame); + struct scroll_bar *bar + = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, prev, PVEC_OTHER); + Lisp_Object barobj; + + block_input (); + + if (horizontal) + x_create_horizontal_toolkit_scroll_bar (f, bar); + else + x_create_toolkit_scroll_bar (f, bar); + + XSETWINDOW (bar->window, w); + bar->top = top; + bar->left = left; + bar->width = width; + bar->height = height; + bar->start = 0; + bar->end = 0; + bar->dragging = -1; + bar->horizontal = horizontal; + + /* Add bar to its frame's list of scroll bars. */ + bar->next = FRAME_SCROLL_BARS (f); + bar->prev = Qnil; + XSETVECTOR (barobj, bar); + fset_scroll_bars (f, barobj); + if (!NILP (bar->next)) + XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); + + /* Map the window/widget. */ + { + if (horizontal) + xg_update_horizontal_scrollbar_pos (f, bar->x_window, top, + left, width, max (height, 1)); + else + xg_update_scrollbar_pos (f, bar->x_window, top, + left, width, max (height, 1)); + } + + unblock_input (); + return bar; +} + +/* Destroy scroll bar BAR, and set its Emacs window's scroll bar to + nil. */ + +static void +x_scroll_bar_remove (struct scroll_bar *bar) +{ + struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); + block_input (); + + xg_remove_scroll_bar (f, bar->x_window); + + /* Dissociate this scroll bar from its window. */ + if (bar->horizontal) + wset_horizontal_scroll_bar (XWINDOW (bar->window), Qnil); + else + wset_vertical_scroll_bar (XWINDOW (bar->window), Qnil); + + unblock_input (); +} + +/* Set the handle of the vertical scroll bar for WINDOW to indicate + that we are displaying PORTION characters out of a total of WHOLE + characters, starting at POSITION. If WINDOW has no scroll bar, + create one. */ + +static void +pgtk_set_vertical_scroll_bar (struct window *w, int portion, int whole, + int position) +{ + struct frame *f = XFRAME (w->frame); + Lisp_Object barobj; + struct scroll_bar *bar; + int top, height, left, width; + int window_y, window_height; + + /* Get window dimensions. */ + window_box (w, ANY_AREA, 0, &window_y, 0, &window_height); + top = window_y; + height = window_height; + left = WINDOW_SCROLL_BAR_AREA_X (w); + width = WINDOW_SCROLL_BAR_AREA_WIDTH (w); + + /* Does the scroll bar exist yet? */ + if (NILP (w->vertical_scroll_bar)) + { + if (width > 0 && height > 0) + { + block_input (); + pgtk_clear_area (f, left, top, width, height); + unblock_input (); + } + + bar = x_scroll_bar_create (w, top, left, width, max (height, 1), false); + } + else + { + /* It may just need to be moved and resized. */ + unsigned int mask = 0; + + bar = XSCROLL_BAR (w->vertical_scroll_bar); + + block_input (); + + if (left != bar->left) + mask |= 1; + if (top != bar->top) + mask |= 1; + if (width != bar->width) + mask |= 1; + if (height != bar->height) + mask |= 1; + + /* Move/size the scroll bar widget. */ + if (mask) + { + /* Since toolkit scroll bars are smaller than the space reserved + for them on the frame, we have to clear "under" them. */ + if (width > 0 && height > 0) + pgtk_clear_area (f, left, top, width, height); + xg_update_scrollbar_pos (f, bar->x_window, top, + left, width, max (height, 1)); + } + + /* Remember new settings. */ + bar->left = left; + bar->top = top; + bar->width = width; + bar->height = height; + + unblock_input (); + } + + pgtk_set_toolkit_scroll_bar_thumb (bar, portion, position, whole); + + XSETVECTOR (barobj, bar); + wset_vertical_scroll_bar (w, barobj); +} + + +static void +pgtk_set_horizontal_scroll_bar (struct window *w, int portion, int whole, + int position) +{ + struct frame *f = XFRAME (w->frame); + Lisp_Object barobj; + struct scroll_bar *bar; + int top, height, left, width; + int window_x, window_width; + int pixel_width = WINDOW_PIXEL_WIDTH (w); + + /* Get window dimensions. */ + window_box (w, ANY_AREA, &window_x, 0, &window_width, 0); + left = window_x; + width = window_width; + top = WINDOW_SCROLL_BAR_AREA_Y (w); + height = WINDOW_SCROLL_BAR_AREA_HEIGHT (w); + + /* Does the scroll bar exist yet? */ + if (NILP (w->horizontal_scroll_bar)) + { + if (width > 0 && height > 0) + { + block_input (); + + /* Clear also part between window_width and + WINDOW_PIXEL_WIDTH. */ + pgtk_clear_area (f, left, top, pixel_width, height); + unblock_input (); + } + + bar = x_scroll_bar_create (w, top, left, width, height, true); + } + else + { + /* It may just need to be moved and resized. */ + unsigned int mask = 0; + + bar = XSCROLL_BAR (w->horizontal_scroll_bar); + + block_input (); + + if (left != bar->left) + mask |= 1; + if (top != bar->top) + mask |= 1; + if (width != bar->width) + mask |= 1; + if (height != bar->height) + mask |= 1; + + /* Move/size the scroll bar widget. */ + if (mask) + { + /* Since toolkit scroll bars are smaller than the space reserved + for them on the frame, we have to clear "under" them. */ + if (width > 0 && height > 0) + pgtk_clear_area (f, + WINDOW_LEFT_EDGE_X (w), top, + pixel_width - WINDOW_RIGHT_DIVIDER_WIDTH (w), + height); + xg_update_horizontal_scrollbar_pos (f, bar->x_window, top, left, + width, height); + } + + /* Remember new settings. */ + bar->left = left; + bar->top = top; + bar->width = width; + bar->height = height; + + unblock_input (); + } + + pgtk_set_toolkit_horizontal_scroll_bar_thumb (bar, portion, position, whole); + + XSETVECTOR (barobj, bar); + wset_horizontal_scroll_bar (w, barobj); +} + +/* The following three hooks are used when we're doing a thorough + redisplay of the frame. We don't explicitly know which scroll bars + are going to be deleted, because keeping track of when windows go + away is a real pain - "Can you say set-window-configuration, boys + and girls?" Instead, we just assert at the beginning of redisplay + that *all* scroll bars are to be removed, and then save a scroll bar + from the fiery pit when we actually redisplay its window. */ + +/* Arrange for all scroll bars on FRAME to be removed at the next call + to `*judge_scroll_bars_hook'. A scroll bar may be spared if + `*redeem_scroll_bar_hook' is applied to its window before the judgment. */ + +static void +pgtk_condemn_scroll_bars (struct frame *frame) +{ + if (!NILP (FRAME_SCROLL_BARS (frame))) + { + if (!NILP (FRAME_CONDEMNED_SCROLL_BARS (frame))) + { + /* Prepend scrollbars to already condemned ones. */ + Lisp_Object last = FRAME_SCROLL_BARS (frame); + + while (!NILP (XSCROLL_BAR (last)->next)) + last = XSCROLL_BAR (last)->next; + + XSCROLL_BAR (last)->next = FRAME_CONDEMNED_SCROLL_BARS (frame); + XSCROLL_BAR (FRAME_CONDEMNED_SCROLL_BARS (frame))->prev = last; + } + + fset_condemned_scroll_bars (frame, FRAME_SCROLL_BARS (frame)); + fset_scroll_bars (frame, Qnil); + } +} + + +/* Un-mark WINDOW's scroll bar for deletion in this judgment cycle. + Note that WINDOW isn't necessarily condemned at all. */ + +static void +pgtk_redeem_scroll_bar (struct window *w) +{ + struct scroll_bar *bar; + Lisp_Object barobj; + struct frame *f; + + /* We can't redeem this window's scroll bar if it doesn't have one. */ + if (NILP (w->vertical_scroll_bar) && NILP (w->horizontal_scroll_bar)) + emacs_abort (); + + if (!NILP (w->vertical_scroll_bar) && WINDOW_HAS_VERTICAL_SCROLL_BAR (w)) + { + bar = XSCROLL_BAR (w->vertical_scroll_bar); + /* Unlink it from the condemned list. */ + f = XFRAME (WINDOW_FRAME (w)); + if (NILP (bar->prev)) + { + /* If the prev pointer is nil, it must be the first in one of + the lists. */ + if (EQ (FRAME_SCROLL_BARS (f), w->vertical_scroll_bar)) + /* It's not condemned. Everything's fine. */ + goto horizontal; + else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f), + w->vertical_scroll_bar)) + fset_condemned_scroll_bars (f, bar->next); + else + /* If its prev pointer is nil, it must be at the front of + one or the other! */ + emacs_abort (); + } + else + XSCROLL_BAR (bar->prev)->next = bar->next; + + if (!NILP (bar->next)) + XSCROLL_BAR (bar->next)->prev = bar->prev; + + bar->next = FRAME_SCROLL_BARS (f); + bar->prev = Qnil; + XSETVECTOR (barobj, bar); + fset_scroll_bars (f, barobj); + if (!NILP (bar->next)) + XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); + } + +horizontal: + if (!NILP (w->horizontal_scroll_bar) + && WINDOW_HAS_HORIZONTAL_SCROLL_BAR (w)) + { + bar = XSCROLL_BAR (w->horizontal_scroll_bar); + /* Unlink it from the condemned list. */ + f = XFRAME (WINDOW_FRAME (w)); + if (NILP (bar->prev)) + { + /* If the prev pointer is nil, it must be the first in one of + the lists. */ + if (EQ (FRAME_SCROLL_BARS (f), w->horizontal_scroll_bar)) + /* It's not condemned. Everything's fine. */ + return; + else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f), + w->horizontal_scroll_bar)) + fset_condemned_scroll_bars (f, bar->next); + else + /* If its prev pointer is nil, it must be at the front of + one or the other! */ + emacs_abort (); + } + else + XSCROLL_BAR (bar->prev)->next = bar->next; + + if (!NILP (bar->next)) + XSCROLL_BAR (bar->next)->prev = bar->prev; + + bar->next = FRAME_SCROLL_BARS (f); + bar->prev = Qnil; + XSETVECTOR (barobj, bar); + fset_scroll_bars (f, barobj); + if (!NILP (bar->next)) + XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); + } +} + +/* Remove all scroll bars on FRAME that haven't been saved since the + last call to `*condemn_scroll_bars_hook'. */ + +static void +pgtk_judge_scroll_bars (struct frame *f) +{ + Lisp_Object bar, next; + + bar = FRAME_CONDEMNED_SCROLL_BARS (f); + + /* Clear out the condemned list now so we won't try to process any + more events on the hapless scroll bars. */ + fset_condemned_scroll_bars (f, Qnil); + + for (; !NILP (bar); bar = next) + { + struct scroll_bar *b = XSCROLL_BAR (bar); + + x_scroll_bar_remove (b); + + next = b->next; + b->next = b->prev = Qnil; + } + + /* Now there should be no references to the condemned scroll bars, + and they should get garbage-collected. */ +} + +static void +set_fullscreen_state (struct frame *f) +{ + if (!FRAME_GTK_OUTER_WIDGET (f)) + return; + + GtkWindow *widget = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)); + switch (f->want_fullscreen) + { + case FULLSCREEN_NONE: + gtk_window_unfullscreen (widget); + gtk_window_unmaximize (widget); + store_frame_param (f, Qfullscreen, Qnil); + break; + + case FULLSCREEN_BOTH: + gtk_window_unmaximize (widget); + gtk_window_fullscreen (widget); + store_frame_param (f, Qfullscreen, Qfullboth); + break; + + case FULLSCREEN_MAXIMIZED: + gtk_window_unfullscreen (widget); + gtk_window_maximize (widget); + store_frame_param (f, Qfullscreen, Qmaximized); + break; + + case FULLSCREEN_WIDTH: + case FULLSCREEN_HEIGHT: + /* Not supported by gtk. Ignore them. */ + break; + } + + f->want_fullscreen = FULLSCREEN_NONE; +} + +static void +pgtk_fullscreen_hook (struct frame *f) +{ + if (FRAME_VISIBLE_P (f)) + { + block_input (); + set_fullscreen_state (f); + unblock_input (); + } +} + +/* This function is called when the last frame on a display is deleted. */ +void +pgtk_delete_terminal (struct terminal *terminal) +{ + struct pgtk_display_info *dpyinfo = terminal->display_info.pgtk; + + /* Protect against recursive calls. delete_frame in + delete_terminal calls us back when it deletes our last frame. */ + if (!terminal->name) + return; + + block_input (); + + pgtk_im_finish (dpyinfo); + + /* Normally, the display is available... */ + if (dpyinfo->gdpy) + { + image_destroy_all_bitmaps (dpyinfo); + + g_clear_object (&dpyinfo->xg_cursor); + g_clear_object (&dpyinfo->vertical_scroll_bar_cursor); + g_clear_object (&dpyinfo->horizontal_scroll_bar_cursor); + g_clear_object (&dpyinfo->invisible_cursor); + if (dpyinfo->last_click_event != NULL) + { + gdk_event_free (dpyinfo->last_click_event); + dpyinfo->last_click_event = NULL; + } + + /* Disconnect these handlers before the display closes so + useless removal signals don't fire. */ + g_signal_handlers_disconnect_by_func (G_OBJECT (dpyinfo->gdpy), + G_CALLBACK (pgtk_seat_added_cb), + dpyinfo); + g_signal_handlers_disconnect_by_func (G_OBJECT (dpyinfo->gdpy), + G_CALLBACK (pgtk_seat_removed_cb), + dpyinfo); + xg_display_close (dpyinfo->gdpy); + + dpyinfo->gdpy = NULL; + } + + if (dpyinfo->connection >= 0) + emacs_close (dpyinfo->connection); + + dpyinfo->connection = -1; + + delete_keyboard_wait_descriptor (0); + + pgtk_delete_display (dpyinfo); + unblock_input (); +} + +/* Store F's background color into *BGCOLOR. */ +static void +pgtk_query_frame_background_color (struct frame *f, Emacs_Color * bgcolor) +{ + bgcolor->pixel = FRAME_BACKGROUND_PIXEL (f); + pgtk_query_color (f, bgcolor); +} + +static void +pgtk_free_pixmap (struct frame *_f, Emacs_Pixmap pixmap) +{ + if (pixmap) + { + xfree (pixmap->data); + xfree (pixmap); + } +} + +void +pgtk_focus_frame (struct frame *f, bool noactivate) +{ + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + + GtkWidget *wid = FRAME_WIDGET (f); + + if (dpyinfo->x_focus_frame != f && wid != NULL) + { + block_input (); + gtk_widget_grab_focus (wid); + unblock_input (); + } +} + + +static void +set_opacity_recursively (GtkWidget * w, gpointer data) +{ + gtk_widget_set_opacity (w, *(double *) data); + if (GTK_IS_CONTAINER (w)) + gtk_container_foreach (GTK_CONTAINER (w), set_opacity_recursively, data); +} + +static void +pgtk_set_frame_alpha (struct frame *f) +{ + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + double alpha = 1.0; + double alpha_min = 1.0; + + if (dpyinfo->highlight_frame == f) + alpha = f->alpha[0]; + else + alpha = f->alpha[1]; + + if (alpha < 0.0) + return; + + if (FLOATP (Vframe_alpha_lower_limit)) + alpha_min = XFLOAT_DATA (Vframe_alpha_lower_limit); + else if (FIXNUMP (Vframe_alpha_lower_limit)) + alpha_min = (XFIXNUM (Vframe_alpha_lower_limit)) / 100.0; + + if (alpha > 1.0) + alpha = 1.0; + else if (alpha < alpha_min && alpha_min <= 1.0) + alpha = alpha_min; + + set_opacity_recursively (FRAME_WIDGET (f), &alpha); + /* without this, blending mode is strange on wayland. */ + gtk_widget_queue_resize_no_redraw (FRAME_WIDGET (f)); +} + +static void +frame_highlight (struct frame *f) +{ + /* We used to only do this if Vx_no_window_manager was non-nil, but + the ICCCM (section 4.1.6) says that the window's border pixmap + and border pixel are window attributes which are "private to the + client", so we can always change it to whatever we want. */ + block_input (); + /* I recently started to get errors in this XSetWindowBorder, depending on + the window-manager in use, tho something more is at play since I've been + using that same window-manager binary for ever. Let's not crash just + because of this (bug#9310). */ + + GtkWidget *w = FRAME_WIDGET (f); + + char *css = + g_strdup_printf ("decoration { border: solid %dpx #%06x; }", + f->border_width, + (unsigned int) FRAME_X_OUTPUT (f)->border_pixel & 0x00ffffff); + + GtkStyleContext *ctxt = gtk_widget_get_style_context (w); + GtkCssProvider *css_provider = gtk_css_provider_new (); + gtk_css_provider_load_from_data (css_provider, css, -1, NULL); + gtk_style_context_add_provider (ctxt, GTK_STYLE_PROVIDER (css_provider), + GTK_STYLE_PROVIDER_PRIORITY_USER); + g_free (css); + + GtkCssProvider *old = FRAME_X_OUTPUT (f)->border_color_css_provider; + FRAME_X_OUTPUT (f)->border_color_css_provider = css_provider; + if (old != NULL) + { + gtk_style_context_remove_provider (ctxt, GTK_STYLE_PROVIDER (old)); + g_object_unref (old); + } + + unblock_input (); + gui_update_cursor (f, true); + pgtk_set_frame_alpha (f); +} + +static void +frame_unhighlight (struct frame *f) +{ + /* We used to only do this if Vx_no_window_manager was non-nil, but + the ICCCM (section 4.1.6) says that the window's border pixmap + and border pixel are window attributes which are "private to the + client", so we can always change it to whatever we want. */ + block_input (); + /* Same as above for XSetWindowBorder (bug#9310). */ + + GtkWidget *w = FRAME_WIDGET (f); + + char *css = + g_strdup_printf ("decoration { border: dotted %dpx #ffffff; }", + f->border_width); + + GtkStyleContext *ctxt = gtk_widget_get_style_context (w); + GtkCssProvider *css_provider = gtk_css_provider_new (); + gtk_css_provider_load_from_data (css_provider, css, -1, NULL); + gtk_style_context_add_provider (ctxt, GTK_STYLE_PROVIDER (css_provider), + GTK_STYLE_PROVIDER_PRIORITY_USER); + g_free (css); + + GtkCssProvider *old = FRAME_X_OUTPUT (f)->border_color_css_provider; + FRAME_X_OUTPUT (f)->border_color_css_provider = css_provider; + if (old != NULL) + { + gtk_style_context_remove_provider (ctxt, GTK_STYLE_PROVIDER (old)); + g_object_unref (old); + } + + unblock_input (); + gui_update_cursor (f, true); + pgtk_set_frame_alpha (f); +} + + +void +pgtk_frame_rehighlight (struct pgtk_display_info *dpyinfo) +{ + struct frame *old_highlight = dpyinfo->highlight_frame; + + if (dpyinfo->x_focus_frame) + { + dpyinfo->highlight_frame + = ((FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame))) + ? XFRAME (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame)) + : dpyinfo->x_focus_frame); + if (!FRAME_LIVE_P (dpyinfo->highlight_frame)) + { + fset_focus_frame (dpyinfo->x_focus_frame, Qnil); + dpyinfo->highlight_frame = dpyinfo->x_focus_frame; + } + } + else + dpyinfo->highlight_frame = 0; + + if (old_highlight) + frame_unhighlight (old_highlight); + if (dpyinfo->highlight_frame) + frame_highlight (dpyinfo->highlight_frame); +} + +/* The focus has changed, or we have redirected a frame's focus to + another frame (this happens when a frame uses a surrogate + mini-buffer frame). Shift the highlight as appropriate. + + The FRAME argument doesn't necessarily have anything to do with which + frame is being highlighted or un-highlighted; we only use it to find + the appropriate X display info. */ + +static void +pgtk_frame_rehighlight_hook (struct frame *frame) +{ + pgtk_frame_rehighlight (FRAME_DISPLAY_INFO (frame)); +} + + +/* Set whether or not the mouse pointer should be visible on frame + F. */ + +static void +pgtk_toggle_invisible_pointer (struct frame *f, bool invisible) +{ + Emacs_Cursor cursor; + if (invisible) + cursor = FRAME_DISPLAY_INFO (f)->invisible_cursor; + else + cursor = f->output_data.pgtk->current_cursor; + gdk_window_set_cursor (gtk_widget_get_window (FRAME_GTK_WIDGET (f)), + cursor); + f->pointer_invisible = invisible; +} + +/* The focus has changed. Update the frames as necessary to reflect + the new situation. Note that we can't change the selected frame + here, because the Lisp code we are interrupting might become confused. + Each event gets marked with the frame in which it occurred, so the + Lisp code can tell when the switch took place by examining the events. */ + +static void +x_new_focus_frame (struct pgtk_display_info *dpyinfo, struct frame *frame) +{ + struct frame *old_focus = dpyinfo->x_focus_frame; + /* doesn't work on wayland */ + + if (frame != dpyinfo->x_focus_frame) + { + /* Set this before calling other routines, so that they see + the correct value of x_focus_frame. */ + dpyinfo->x_focus_frame = frame; + + if (old_focus && old_focus->auto_lower) + if (FRAME_GTK_OUTER_WIDGET (old_focus)) + gdk_window_lower (gtk_widget_get_window + (FRAME_GTK_OUTER_WIDGET (old_focus))); + + if (dpyinfo->x_focus_frame && dpyinfo->x_focus_frame->auto_raise) + if (FRAME_GTK_OUTER_WIDGET (dpyinfo->x_focus_frame)) + gdk_window_raise (gtk_widget_get_window + (FRAME_GTK_OUTER_WIDGET (dpyinfo->x_focus_frame))); + } + + pgtk_frame_rehighlight (dpyinfo); +} + +static void +pgtk_buffer_flipping_unblocked_hook (struct frame *f) +{ + block_input (); + flip_cr_context (f); + gtk_widget_queue_draw (FRAME_GTK_WIDGET (f)); + unblock_input (); +} + +static struct terminal * +pgtk_create_terminal (struct pgtk_display_info *dpyinfo) +/* -------------------------------------------------------------------------- + Set up use of Gtk before we make the first connection. + -------------------------------------------------------------------------- */ +{ + struct terminal *terminal; + + terminal = create_terminal (output_pgtk, &pgtk_redisplay_interface); + + terminal->display_info.pgtk = dpyinfo; + dpyinfo->terminal = terminal; + + terminal->clear_frame_hook = pgtk_clear_frame; + terminal->ring_bell_hook = pgtk_ring_bell; + terminal->toggle_invisible_pointer_hook = pgtk_toggle_invisible_pointer; + terminal->update_begin_hook = pgtk_update_begin; + terminal->update_end_hook = pgtk_update_end; + terminal->read_socket_hook = pgtk_read_socket; + terminal->frame_up_to_date_hook = pgtk_frame_up_to_date; + terminal->mouse_position_hook = pgtk_mouse_position; + terminal->frame_rehighlight_hook = pgtk_frame_rehighlight_hook; + terminal->buffer_flipping_unblocked_hook = pgtk_buffer_flipping_unblocked_hook; + terminal->frame_raise_lower_hook = pgtk_frame_raise_lower; + terminal->frame_visible_invisible_hook = pgtk_make_frame_visible_invisible; + terminal->fullscreen_hook = pgtk_fullscreen_hook; + terminal->menu_show_hook = pgtk_menu_show; + terminal->activate_menubar_hook = pgtk_activate_menubar; + terminal->popup_dialog_hook = pgtk_popup_dialog; + terminal->change_tab_bar_height_hook = x_change_tab_bar_height; + terminal->set_vertical_scroll_bar_hook = pgtk_set_vertical_scroll_bar; + terminal->set_horizontal_scroll_bar_hook = pgtk_set_horizontal_scroll_bar; + terminal->condemn_scroll_bars_hook = pgtk_condemn_scroll_bars; + terminal->redeem_scroll_bar_hook = pgtk_redeem_scroll_bar; + terminal->judge_scroll_bars_hook = pgtk_judge_scroll_bars; + terminal->get_string_resource_hook = pgtk_get_string_resource; + terminal->delete_frame_hook = x_destroy_window; + terminal->delete_terminal_hook = pgtk_delete_terminal; + terminal->query_frame_background_color = pgtk_query_frame_background_color; + terminal->defined_color_hook = pgtk_defined_color; + terminal->set_new_font_hook = pgtk_new_font; + terminal->set_bitmap_icon_hook = pgtk_bitmap_icon; + terminal->implicit_set_name_hook = pgtk_implicitly_set_name; + terminal->iconify_frame_hook = pgtk_iconify_frame; + terminal->set_scroll_bar_default_width_hook = + pgtk_set_scroll_bar_default_width; + terminal->set_scroll_bar_default_height_hook = + pgtk_set_scroll_bar_default_height; + terminal->set_window_size_hook = pgtk_set_window_size; + terminal->query_colors = pgtk_query_colors; + terminal->get_focus_frame = x_get_focus_frame; + terminal->focus_frame_hook = pgtk_focus_frame; + terminal->set_frame_offset_hook = pgtk_set_offset; + terminal->free_pixmap = pgtk_free_pixmap; + terminal->toolkit_position_hook = pgtk_toolkit_position; + + /* Other hooks are NULL by default. */ + + return terminal; +} + +struct pgtk_window_is_of_frame_recursive_t +{ + GdkWindow *window; + bool result; + GtkWidget *emacs_gtk_fixed; /* stop on emacsgtkfixed other than this. */ +}; + +static void +pgtk_window_is_of_frame_recursive (GtkWidget * widget, gpointer data) +{ + struct pgtk_window_is_of_frame_recursive_t *datap = data; + + if (datap->result) + return; + + if (EMACS_IS_FIXED (widget) && widget != datap->emacs_gtk_fixed) + return; + + if (gtk_widget_get_window (widget) == datap->window) + { + datap->result = true; + return; + } + + if (GTK_IS_CONTAINER (widget)) { + gtk_container_foreach (GTK_CONTAINER (widget), + pgtk_window_is_of_frame_recursive, datap); + } +} + +static bool +pgtk_window_is_of_frame (struct frame *f, GdkWindow * window) +{ + struct pgtk_window_is_of_frame_recursive_t data; + data.window = window; + data.result = false; + data.emacs_gtk_fixed = FRAME_GTK_WIDGET (f); + pgtk_window_is_of_frame_recursive (FRAME_WIDGET (f), &data); + return data.result; +} + +/* Like x_window_to_frame but also compares the window with the widget's + windows. */ +static struct frame * +pgtk_any_window_to_frame (GdkWindow * window) +{ + Lisp_Object tail, frame; + struct frame *f, *found = NULL; + + if (window == NULL) + return NULL; + + FOR_EACH_FRAME (tail, frame) + { + if (found) + break; + f = XFRAME (frame); + if (FRAME_PGTK_P (f)) + { + if (pgtk_window_is_of_frame (f, window)) + found = f; + } + } + + return found; +} + +static gboolean +pgtk_handle_event (GtkWidget *widget, GdkEvent *event, gpointer *data) +{ + struct frame *f; + union buffered_input_event inev; + GtkWidget *frame_widget; + gint x, y; + + if (event->type == GDK_TOUCHPAD_PINCH + && (event->touchpad_pinch.phase + != GDK_TOUCHPAD_GESTURE_PHASE_END)) + { + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + frame_widget = FRAME_GTK_WIDGET (f); + + gtk_widget_translate_coordinates (widget, frame_widget, + lrint (event->touchpad_pinch.x), + lrint (event->touchpad_pinch.y), + &x, &y); + if (f) + { + + inev.ie.kind = PINCH_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + XSETINT (inev.ie.x, x); + XSETINT (inev.ie.y, y); + inev.ie.arg = list4 (make_float (event->touchpad_pinch.dx), + make_float (event->touchpad_pinch.dy), + make_float (event->touchpad_pinch.scale), + make_float (event->touchpad_pinch.angle_delta)); + inev.ie.modifiers = pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), + event->touchpad_pinch.state); + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); + evq_enqueue (&inev); + } + + return TRUE; + } + return FALSE; +} + +static void +pgtk_fill_rectangle (struct frame *f, unsigned long color, int x, int y, + int width, int height, bool respect_alpha_background) +{ + cairo_t *cr; + cr = pgtk_begin_cr_clip (f); + pgtk_set_cr_source_with_color (f, color, respect_alpha_background); + cairo_rectangle (cr, x, y, width, height); + cairo_fill (cr); + pgtk_end_cr_clip (f); +} + +void +pgtk_clear_under_internal_border (struct frame *f) +{ + if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0 + && (!FRAME_GTK_OUTER_WIDGET (f) + || gtk_widget_get_realized (FRAME_GTK_OUTER_WIDGET (f)))) + { + 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) + ? lookup_basic_face (NULL, f, CHILD_FRAME_BORDER_FACE_ID) + : CHILD_FRAME_BORDER_FACE_ID) + : (!NILP (Vface_remapping_alist) + ? lookup_basic_face (NULL, f, INTERNAL_BORDER_FACE_ID) + : INTERNAL_BORDER_FACE_ID)); + struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); + + block_input (); + + if (face) + { +#define x_fill_rectangle(f, gc, x, y, w, h) \ + fill_background_by_face (f, face, x, y, w, h) + x_fill_rectangle (f, gc, 0, margin, width, border); + x_fill_rectangle (f, gc, 0, 0, border, height); + x_fill_rectangle (f, gc, width - border, 0, border, height); + x_fill_rectangle (f, gc, 0, height - border, width, border); +#undef x_fill_rectangle + } + else + { +#define x_clear_area(f, x, y, w, h) pgtk_clear_area (f, x, y, w, h) + x_clear_area (f, 0, 0, border, height); + x_clear_area (f, 0, margin, width, border); + x_clear_area (f, width - border, 0, border, height); + x_clear_area (f, 0, height - border, width, border); +#undef x_clear_area + } + + unblock_input (); + } +} + +static gboolean +pgtk_handle_draw (GtkWidget * widget, cairo_t * cr, gpointer * data) +{ + struct frame *f; + + GdkWindow *win = gtk_widget_get_window (widget); + + if (win != NULL) + { + cairo_surface_t *src = NULL; + f = pgtk_any_window_to_frame (win); + if (f != NULL) + { + src = FRAME_X_OUTPUT (f)->cr_surface_visible_bell; + if (src == NULL && FRAME_CR_ACTIVE_CONTEXT (f) != NULL) + src = cairo_get_target (FRAME_CR_ACTIVE_CONTEXT (f)); + } + if (src != NULL) + { + cairo_set_source_surface (cr, src, 0, 0); + cairo_paint (cr); + } + } + return FALSE; +} + +static void +size_allocate (GtkWidget * widget, GtkAllocation * alloc, + gpointer user_data) +{ + struct frame *f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + + /* Between a frame is created and not shown, size is allocated and + * this handler is called. When that, since the widget's window is + * NULL, we can't get f, pgtk_cr_update_surface_desired_size is not + * called, and its size is 0x0. That causes empty frame. + * + * Fortunately since we know f in pgtk_set_event_handler, we can get + * it through user_data; + */ + if (!f) + f = user_data; + + if (f) + { + xg_frame_resized (f, alloc->width, alloc->height); + pgtk_cr_update_surface_desired_size (f, alloc->width, alloc->height, false); + } +} + +static void +get_modifier_values (int *mod_ctrl, int *mod_meta, int *mod_alt, + int *mod_hyper, int *mod_super) +{ + Lisp_Object tem; + + *mod_ctrl = ctrl_modifier; + *mod_meta = meta_modifier; + *mod_alt = alt_modifier; + *mod_hyper = hyper_modifier; + *mod_super = super_modifier; + + tem = Fget (Vx_ctrl_keysym, Qmodifier_value); + if (INTEGERP (tem)) + *mod_ctrl = XFIXNUM (tem) & INT_MAX; + tem = Fget (Vx_alt_keysym, Qmodifier_value); + if (INTEGERP (tem)) + *mod_alt = XFIXNUM (tem) & INT_MAX; + tem = Fget (Vx_meta_keysym, Qmodifier_value); + if (INTEGERP (tem)) + *mod_meta = XFIXNUM (tem) & INT_MAX; + tem = Fget (Vx_hyper_keysym, Qmodifier_value); + if (INTEGERP (tem)) + *mod_hyper = XFIXNUM (tem) & INT_MAX; + tem = Fget (Vx_super_keysym, Qmodifier_value); + if (INTEGERP (tem)) + *mod_super = XFIXNUM (tem) & INT_MAX; +} + +int +pgtk_gtk_to_emacs_modifiers (struct pgtk_display_info *dpyinfo, int state) +{ + int mod_ctrl; + int mod_meta; + int mod_alt; + int mod_hyper; + int mod_super; + int mod; + + get_modifier_values (&mod_ctrl, &mod_meta, &mod_alt, &mod_hyper, + &mod_super); + + mod = 0; + if (state & GDK_SHIFT_MASK) + mod |= shift_modifier; + if (state & GDK_CONTROL_MASK) + mod |= mod_ctrl; + if (state & GDK_META_MASK || state & GDK_MOD1_MASK) + mod |= mod_meta; + if (state & GDK_SUPER_MASK) + mod |= mod_super; + if (state & GDK_HYPER_MASK) + mod |= mod_hyper; + + return mod; +} + +int +pgtk_emacs_to_gtk_modifiers (struct pgtk_display_info *dpyinfo, int state) +{ + int mod_ctrl; + int mod_meta; + int mod_alt; + int mod_hyper; + int mod_super; + int mask; + + get_modifier_values (&mod_ctrl, &mod_meta, &mod_alt, &mod_hyper, + &mod_super); + + mask = 0; + if (state & mod_super) + mask |= GDK_SUPER_MASK; + if (state & mod_hyper) + mask |= GDK_HYPER_MASK; + if (state & shift_modifier) + mask |= GDK_SHIFT_MASK; + if (state & mod_ctrl) + mask |= GDK_CONTROL_MASK; + if (state & mod_meta) + mask |= GDK_MOD1_MASK; + return mask; +} + +#define IsCursorKey(keysym) (0xff50 <= (keysym) && (keysym) < 0xff60) +#define IsMiscFunctionKey(keysym) (0xff60 <= (keysym) && (keysym) < 0xff6c) +#define IsKeypadKey(keysym) (0xff80 <= (keysym) && (keysym) < 0xffbe) +#define IsFunctionKey(keysym) (0xffbe <= (keysym) && (keysym) < 0xffe1) +#define IsModifierKey(keysym) \ + ((((keysym) >= GDK_KEY_Shift_L) && ((keysym) <= GDK_KEY_Hyper_R)) \ + || (((keysym) >= GDK_KEY_ISO_Lock) && ((keysym) <= GDK_KEY_ISO_Level5_Lock)) \ + || ((keysym) == GDK_KEY_Mode_switch) \ + || ((keysym) == GDK_KEY_Num_Lock)) + + +void +pgtk_enqueue_string (struct frame *f, gchar * str) +{ + gunichar *ustr, *uptr; + + uptr = ustr = g_utf8_to_ucs4 (str, -1, NULL, NULL, NULL); + if (ustr == NULL) + return; + for (; *ustr != 0; ustr++) + { + union buffered_input_event inev; + Lisp_Object c = make_fixnum (*ustr); + EVENT_INIT (inev.ie); + inev.ie.kind = (SINGLE_BYTE_CHAR_P (XFIXNAT (c)) + ? ASCII_KEYSTROKE_EVENT + : MULTIBYTE_CHAR_KEYSTROKE_EVENT); + inev.ie.arg = Qnil; + inev.ie.code = XFIXNAT (c); + XSETFRAME (inev.ie.frame_or_window, f); + inev.ie.modifiers = 0; + inev.ie.timestamp = 0; + evq_enqueue (&inev); + } + + g_free (uptr); +} + +void +pgtk_enqueue_preedit (struct frame *f, Lisp_Object preedit) +{ + union buffered_input_event inev; + EVENT_INIT (inev.ie); + inev.ie.kind = PREEDIT_TEXT_EVENT; + inev.ie.arg = preedit; + inev.ie.code = 0; + XSETFRAME (inev.ie.frame_or_window, f); + inev.ie.modifiers = 0; + inev.ie.timestamp = 0; + evq_enqueue (&inev); +} + +static gboolean +key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) +{ + union buffered_input_event inev; + ptrdiff_t nbytes = 0; + Mouse_HLInfo *hlinfo; + struct frame *f; + + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + EVENT_INIT (inev.ie); + hlinfo = MOUSE_HL_INFO (f); + + /* If mouse-highlight is an integer, input clears out + mouse highlighting. */ + if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight)) + { + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = true; + } + + if (f != 0) + { + guint keysym, orig_keysym; + /* al%imercury@uunet.uu.net says that making this 81 + instead of 80 fixed a bug whereby meta chars made + his Emacs hang. + + It seems that some version of XmbLookupString has + a bug of not returning XBufferOverflow in + status_return even if the input is too long to + fit in 81 bytes. So, we must prepare sufficient + bytes for copy_buffer. 513 bytes (256 chars for + two-byte character set) seems to be a fairly good + approximation. -- 2000.8.10 handa@etl.go.jp */ + unsigned char copy_buffer[513]; + unsigned char *copy_bufptr = copy_buffer; + int copy_bufsiz = sizeof (copy_buffer); + int modifiers; + Lisp_Object c; + guint state; + + state = event->key.state; + + /* While super is pressed, the input method will always always + resend the key events ignoring super. As a workaround, don't + filter key events with super or hyper pressed. */ + if (!(event->key.state & (GDK_SUPER_MASK | GDK_HYPER_MASK))) + { + if (pgtk_im_filter_keypress (f, &event->key)) + return TRUE; + } + + state |= + pgtk_emacs_to_gtk_modifiers (FRAME_DISPLAY_INFO (f), + extra_keyboard_modifiers); + modifiers = state; + + /* This will have to go some day... */ + + /* make_lispy_event turns chars into control chars. + Don't do it here because XLookupString is too eager. */ + state &= ~GDK_CONTROL_MASK; + state &= ~(GDK_META_MASK + | GDK_SUPER_MASK | GDK_HYPER_MASK | GDK_MOD1_MASK); + + nbytes = event->key.length; + if (nbytes > copy_bufsiz) + nbytes = copy_bufsiz; + memcpy (copy_bufptr, event->key.string, nbytes); + + keysym = event->key.keyval; + orig_keysym = keysym; + + /* Common for all keysym input events. */ + XSETFRAME (inev.ie.frame_or_window, f); + inev.ie.modifiers = + pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers); + inev.ie.timestamp = event->key.time; + + /* First deal with keysyms which have defined + translations to characters. */ + if (keysym >= 32 && keysym < 128) + /* Avoid explicitly decoding each ASCII character. */ + { + inev.ie.kind = ASCII_KEYSTROKE_EVENT; + inev.ie.code = keysym; + + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); + goto done; + } + + /* Keysyms directly mapped to Unicode characters. */ + if (keysym >= 0x01000000 && keysym <= 0x0110FFFF) + { + if (keysym < 0x01000080) + inev.ie.kind = ASCII_KEYSTROKE_EVENT; + else + inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + inev.ie.code = keysym & 0xFFFFFF; + + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); + goto done; + } + + /* Now non-ASCII. */ + if (HASH_TABLE_P (Vpgtk_keysym_table) + && (c = Fgethash (make_fixnum (keysym), + Vpgtk_keysym_table, Qnil), FIXNATP (c))) + { + inev.ie.kind = (SINGLE_BYTE_CHAR_P (XFIXNAT (c)) + ? ASCII_KEYSTROKE_EVENT + : MULTIBYTE_CHAR_KEYSTROKE_EVENT); + inev.ie.code = XFIXNAT (c); + + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); + goto done; + } + + /* Random non-modifier sorts of keysyms. */ + if (((keysym >= GDK_KEY_BackSpace && keysym <= GDK_KEY_Escape) + || keysym == GDK_KEY_Delete +#ifdef GDK_KEY_ISO_Left_Tab + || (keysym >= GDK_KEY_ISO_Left_Tab && keysym <= GDK_KEY_ISO_Enter) +#endif + || IsCursorKey (keysym) /* 0xff50 <= x < 0xff60 */ + || IsMiscFunctionKey (keysym) /* 0xff60 <= x < VARIES */ +#ifdef HPUX + /* This recognizes the "extended function + keys". It seems there's no cleaner way. + Test IsModifierKey to avoid handling + mode_switch incorrectly. */ + || (GDK_KEY_Select <= keysym && keysym < GDK_KEY_KP_Space) +#endif +#ifdef GDK_KEY_dead_circumflex + || orig_keysym == GDK_KEY_dead_circumflex +#endif +#ifdef GDK_KEY_dead_grave + || orig_keysym == GDK_KEY_dead_grave +#endif +#ifdef GDK_KEY_dead_tilde + || orig_keysym == GDK_KEY_dead_tilde +#endif +#ifdef GDK_KEY_dead_diaeresis + || orig_keysym == GDK_KEY_dead_diaeresis +#endif +#ifdef GDK_KEY_dead_macron + || orig_keysym == GDK_KEY_dead_macron +#endif +#ifdef GDK_KEY_dead_degree + || orig_keysym == GDK_KEY_dead_degree +#endif +#ifdef GDK_KEY_dead_acute + || orig_keysym == GDK_KEY_dead_acute +#endif +#ifdef GDK_KEY_dead_cedilla + || orig_keysym == GDK_KEY_dead_cedilla +#endif +#ifdef GDK_KEY_dead_breve + || orig_keysym == GDK_KEY_dead_breve +#endif +#ifdef GDK_KEY_dead_ogonek + || orig_keysym == GDK_KEY_dead_ogonek +#endif +#ifdef GDK_KEY_dead_caron + || orig_keysym == GDK_KEY_dead_caron +#endif +#ifdef GDK_KEY_dead_doubleacute + || orig_keysym == GDK_KEY_dead_doubleacute +#endif +#ifdef GDK_KEY_dead_abovedot + || orig_keysym == GDK_KEY_dead_abovedot +#endif + || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */ + || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */ + /* Any "vendor-specific" key is ok. */ + || (orig_keysym & (1 << 28)) + || (keysym != GDK_KEY_VoidSymbol && nbytes == 0)) + && !(event->key.is_modifier + /* Gtk's modifier keys are different from Xlib's ones. + * I need to exclude them. + */ + || IsModifierKey (orig_keysym) + /* The symbols from GDK_KEY_ISO_Lock + to GDK_KEY_ISO_Last_Group_Lock + don't have real modifiers but + should be treated similarly to + Mode_switch by Emacs. */ +#if defined GDK_KEY_ISO_Lock && defined GDK_KEY_ISO_Last_Group_Lock + || (GDK_KEY_ISO_Lock <= orig_keysym + && orig_keysym <= GDK_KEY_ISO_Last_Group_Lock) +#endif + )) + { + /* make_lispy_event will convert this to a symbolic + key. */ + inev.ie.kind = NON_ASCII_KEYSTROKE_EVENT; + inev.ie.code = keysym; + + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); + goto done; + } + + { + inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + inev.ie.arg = make_unibyte_string ((char *) copy_bufptr, nbytes); + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); + + if (keysym == GDK_KEY_VoidSymbol) + goto done; + } + } + +done: + if (inev.ie.kind != NO_EVENT) + { + XSETFRAME (inev.ie.frame_or_window, f); + evq_enqueue (&inev); + } + + return TRUE; +} + +static gboolean +key_release_event (GtkWidget *widget, + GdkEvent *event, + gpointer *user_data) +{ + return TRUE; +} + +static gboolean +configure_event (GtkWidget *widget, + GdkEvent *event, + gpointer *user_data) +{ + struct frame *f = pgtk_any_window_to_frame (event->configure.window); + + if (f && widget == FRAME_GTK_OUTER_WIDGET (f)) + { + if (any_help_event_p) + { + Lisp_Object frame; + if (f) + XSETFRAME (frame, f); + else + frame = Qnil; + help_echo_string = Qnil; + gen_help_event (Qnil, frame, Qnil, Qnil, 0); + } + + if (f->win_gravity == NorthWestGravity) + gtk_window_get_position (GTK_WINDOW (widget), + &f->left_pos, &f->top_pos); + else + { + f->top_pos = event->configure.y; + f->left_pos = event->configure.x; + } + } + return FALSE; +} + +static gboolean +map_event (GtkWidget *widget, + GdkEvent *event, + gpointer *user_data) +{ + struct frame *f = pgtk_any_window_to_frame (event->any.window); + union buffered_input_event inev; + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + if (f) + { + bool iconified = FRAME_ICONIFIED_P (f); + + /* Check if fullscreen was specified before we where mapped the + first time, i.e. from the command line. */ + if (!FRAME_X_OUTPUT (f)->has_been_visible) + { + set_fullscreen_state (f); + } + + if (!iconified) + { + /* The `z-group' is reset every time a frame becomes + invisible. Handle this here. */ + if (FRAME_Z_GROUP (f) == z_group_above) + pgtk_set_z_group (f, Qabove, Qnil); + else if (FRAME_Z_GROUP (f) == z_group_below) + pgtk_set_z_group (f, Qbelow, Qnil); + } + + SET_FRAME_VISIBLE (f, 1); + SET_FRAME_ICONIFIED (f, false); + FRAME_X_OUTPUT (f)->has_been_visible = true; + + if (iconified) + { + inev.ie.kind = DEICONIFY_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + } + } + + if (inev.ie.kind != NO_EVENT) + evq_enqueue (&inev); + return FALSE; +} + +static gboolean +window_state_event (GtkWidget *widget, + GdkEvent *event, + gpointer *user_data) +{ + struct frame *f = pgtk_any_window_to_frame (event->window_state.window); + union buffered_input_event inev; + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + if (f) + { + if (event->window_state.new_window_state & GDK_WINDOW_STATE_FOCUSED) + { + if (FRAME_ICONIFIED_P (f)) + { + /* Gnome shell does not iconify us when C-z is pressed. + It hides the frame. So if our state says we aren't + hidden anymore, treat it as deiconified. */ + SET_FRAME_VISIBLE (f, 1); + SET_FRAME_ICONIFIED (f, false); + FRAME_X_OUTPUT (f)->has_been_visible = true; + inev.ie.kind = DEICONIFY_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + } + } + } + + if (event->window_state.new_window_state + & GDK_WINDOW_STATE_FULLSCREEN) + store_frame_param (f, Qfullscreen, Qfullboth); + else if (event->window_state.new_window_state + & GDK_WINDOW_STATE_MAXIMIZED) + store_frame_param (f, Qfullscreen, Qmaximized); + else + store_frame_param (f, Qfullscreen, Qnil); + + if (event->window_state.new_window_state + & GDK_WINDOW_STATE_ICONIFIED) + SET_FRAME_ICONIFIED (f, true); + else + { + FRAME_X_OUTPUT (f)->has_been_visible = true; + inev.ie.kind = DEICONIFY_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + SET_FRAME_ICONIFIED (f, false); + } + + if (event->window_state.new_window_state + & GDK_WINDOW_STATE_STICKY) + store_frame_param (f, Qsticky, Qt); + else + store_frame_param (f, Qsticky, Qnil); + + if (inev.ie.kind != NO_EVENT) + evq_enqueue (&inev); + return FALSE; +} + +static gboolean +delete_event (GtkWidget *widget, + GdkEvent *event, gpointer *user_data) +{ + struct frame *f = pgtk_any_window_to_frame (event->any.window); + union buffered_input_event inev; + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + if (f) + { + inev.ie.kind = DELETE_WINDOW_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + } + + if (inev.ie.kind != NO_EVENT) + evq_enqueue (&inev); + return TRUE; +} + +/* The focus may have changed. Figure out if it is a real focus change, + by checking both FocusIn/Out and Enter/LeaveNotify events. + + Returns FOCUS_IN_EVENT event in *BUFP. */ + +/* Handle FocusIn and FocusOut state changes for FRAME. + If FRAME has focus and there exists more than one frame, puts + a FOCUS_IN_EVENT into *BUFP. */ + +static void +x_focus_changed (gboolean is_enter, int state, + struct pgtk_display_info *dpyinfo, struct frame *frame, + union buffered_input_event *bufp) +{ + if (is_enter) + { + if (dpyinfo->x_focus_event_frame != frame) + { + x_new_focus_frame (dpyinfo, frame); + dpyinfo->x_focus_event_frame = frame; + + /* Don't stop displaying the initial startup message + for a switch-frame event we don't need. */ + /* When run as a daemon, Vterminal_frame is always NIL. */ + bufp->ie.arg = (((NILP (Vterminal_frame) + || !FRAME_PGTK_P (XFRAME (Vterminal_frame)) + || EQ (Fdaemonp (), Qt)) + && CONSP (Vframe_list) + && !NILP (XCDR (Vframe_list))) ? Qt : Qnil); + bufp->ie.kind = FOCUS_IN_EVENT; + XSETFRAME (bufp->ie.frame_or_window, frame); + } + + frame->output_data.pgtk->focus_state |= state; + + } + else + { + frame->output_data.pgtk->focus_state &= ~state; + + if (dpyinfo->x_focus_event_frame == frame) + { + dpyinfo->x_focus_event_frame = 0; + x_new_focus_frame (dpyinfo, 0); + + bufp->ie.kind = FOCUS_OUT_EVENT; + XSETFRAME (bufp->ie.frame_or_window, frame); + } + + if (frame->pointer_invisible) + pgtk_toggle_invisible_pointer (frame, false); + } +} + +static gboolean +enter_notify_event (GtkWidget *widget, GdkEvent *event, + gpointer *user_data) +{ + union buffered_input_event inev; + struct frame *frame = + pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + if (frame == NULL) + return FALSE; + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame); + struct frame *focus_frame = dpyinfo->x_focus_frame; + int focus_state + = focus_frame ? focus_frame->output_data.pgtk->focus_state : 0; + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + if (event->crossing.detail != GDK_NOTIFY_INFERIOR + && event->crossing.focus && !(focus_state & FOCUS_EXPLICIT)) + x_focus_changed (TRUE, FOCUS_IMPLICIT, dpyinfo, frame, &inev); + if (inev.ie.kind != NO_EVENT) + evq_enqueue (&inev); + return TRUE; +} + +static gboolean +leave_notify_event (GtkWidget *widget, GdkEvent *event, + gpointer *user_data) +{ + union buffered_input_event inev; + struct frame *frame = + pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + if (frame == NULL) + return FALSE; + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame); + struct frame *focus_frame = dpyinfo->x_focus_frame; + int focus_state + = focus_frame ? focus_frame->output_data.pgtk->focus_state : 0; + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (frame); + + if (frame == hlinfo->mouse_face_mouse_frame) + { + /* If we move outside the frame, then we're + certainly no longer on any text in the frame. */ + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = 0; + } + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + if (event->crossing.detail != GDK_NOTIFY_INFERIOR + && event->crossing.focus && !(focus_state & FOCUS_EXPLICIT)) + x_focus_changed (FALSE, FOCUS_IMPLICIT, dpyinfo, frame, &inev); + + if (frame) + { + if (any_help_event_p) + { + Lisp_Object frame_obj; + XSETFRAME (frame_obj, frame); + help_echo_string = Qnil; + gen_help_event (Qnil, frame_obj, Qnil, Qnil, 0); + } + } + + if (inev.ie.kind != NO_EVENT) + evq_enqueue (&inev); + return TRUE; +} + +static gboolean +focus_in_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) +{ + union buffered_input_event inev; + struct frame *frame = + pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + + if (frame == NULL) + return TRUE; + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + x_focus_changed (TRUE, FOCUS_EXPLICIT, + FRAME_DISPLAY_INFO (frame), frame, &inev); + if (inev.ie.kind != NO_EVENT) + evq_enqueue (&inev); + + pgtk_im_focus_in (frame); + + return TRUE; +} + +static gboolean +focus_out_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) +{ + union buffered_input_event inev; + struct frame *frame = + pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + + if (frame == NULL) + return TRUE; + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + x_focus_changed (FALSE, FOCUS_EXPLICIT, + FRAME_DISPLAY_INFO (frame), frame, &inev); + if (inev.ie.kind != NO_EVENT) + evq_enqueue (&inev); + + pgtk_im_focus_out (frame); + + return TRUE; +} + +/* Function to report a mouse movement to the mainstream Emacs code. + The input handler calls this. + + We have received a mouse movement event, which is given in *event. + If the mouse is over a different glyph than it was last time, tell + the mainstream emacs code by setting mouse_moved. If not, ask for + another motion event, so we can check again the next time it moves. */ + +static bool +note_mouse_movement (struct frame *frame, + const GdkEventMotion *event) +{ + XRectangle *r; + struct pgtk_display_info *dpyinfo; + + if (!FRAME_X_OUTPUT (frame)) + return false; + + dpyinfo = FRAME_DISPLAY_INFO (frame); + dpyinfo->last_mouse_movement_time = event->time; + dpyinfo->last_mouse_motion_frame = frame; + dpyinfo->last_mouse_motion_x = event->x; + dpyinfo->last_mouse_motion_y = event->y; + + if (event->window != gtk_widget_get_window (FRAME_GTK_WIDGET (frame))) + { + frame->mouse_moved = true; + dpyinfo->last_mouse_scroll_bar = NULL; + note_mouse_highlight (frame, -1, -1); + dpyinfo->last_mouse_glyph_frame = NULL; + frame->last_mouse_device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (frame), + (GdkEvent *) event); + return true; + } + + + /* Has the mouse moved off the glyph it was on at the last sighting? */ + r = &dpyinfo->last_mouse_glyph; + if (frame != dpyinfo->last_mouse_glyph_frame + || event->x < r->x || event->x >= r->x + r->width + || event->y < r->y || event->y >= r->y + r->height) + { + frame->mouse_moved = true; + dpyinfo->last_mouse_scroll_bar = NULL; + note_mouse_highlight (frame, event->x, event->y); + /* Remember which glyph we're now on. */ + remember_mouse_glyph (frame, event->x, event->y, r); + dpyinfo->last_mouse_glyph_frame = frame; + frame->last_mouse_device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (frame), + (GdkEvent *) event); + return true; + } + + return false; +} + +static gboolean +motion_notify_event (GtkWidget * widget, GdkEvent * event, + gpointer * user_data) +{ + union buffered_input_event inev; + struct frame *f, *frame; + struct pgtk_display_info *dpyinfo; + Mouse_HLInfo *hlinfo; + + /* This is needed to make pointer visible when motion_notify event */ + pending_signals = true; + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + previous_help_echo_string = help_echo_string; + help_echo_string = Qnil; + + frame = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + dpyinfo = FRAME_DISPLAY_INFO (frame); + f = (gui_mouse_grabbed (dpyinfo) ? dpyinfo->last_mouse_frame + : pgtk_any_window_to_frame (gtk_widget_get_window (widget))); + hlinfo = MOUSE_HL_INFO (f); + + if (hlinfo->mouse_face_hidden) + { + hlinfo->mouse_face_hidden = false; + clear_mouse_face (hlinfo); + } + + if (f && xg_event_is_for_scrollbar (f, event, false)) + f = 0; + if (f) + { + /* Maybe generate a SELECT_WINDOW_EVENT for + `mouse-autoselect-window' but don't let popup menus + interfere with this (Bug#1261). */ + if (!NILP (Vmouse_autoselect_window) + /* Don't switch if we're currently in the minibuffer. + This tries to work around problems where the + minibuffer gets unselected unexpectedly, and where + you then have to move your mouse all the way down to + the minibuffer to select it. */ + && !MINI_WINDOW_P (XWINDOW (selected_window)) + /* With `focus-follows-mouse' non-nil create an event + also when the target window is on another frame. */ + && (f == XFRAME (selected_frame) || !NILP (focus_follows_mouse))) + { + static Lisp_Object last_mouse_window; + Lisp_Object window = window_from_coordinates + (f, event->motion.x, event->motion.y, 0, false, false); + + /* A window will be autoselected only when it is not + selected now and the last mouse movement event was + not in it. The remainder of the code is a bit vague + wrt what a "window" is. For immediate autoselection, + the window is usually the entire window but for GTK + where the scroll bars don't count. For delayed + autoselection the window is usually the window's text + area including the margins. */ + if (WINDOWP (window) + && !EQ (window, last_mouse_window) + && !EQ (window, selected_window)) + { + inev.ie.kind = SELECT_WINDOW_EVENT; + inev.ie.frame_or_window = window; + } + + /* Remember the last window where we saw the mouse. */ + last_mouse_window = window; + } + + if (!note_mouse_movement (f, &event->motion)) + help_echo_string = previous_help_echo_string; + } + else + { + /* If we move outside the frame, then we're + certainly no longer on any text in the frame. */ + clear_mouse_face (hlinfo); + } + + /* If the contents of the global variable help_echo_string + has changed, generate a HELP_EVENT. */ + int do_help = 0; + if (!NILP (help_echo_string) || !NILP (previous_help_echo_string)) + do_help = 1; + + if (inev.ie.kind != NO_EVENT) + evq_enqueue (&inev); + + if (do_help > 0) + { + Lisp_Object frame; + + if (f) + XSETFRAME (frame, f); + else + frame = Qnil; + + any_help_event_p = true; + gen_help_event (help_echo_string, frame, help_echo_window, + help_echo_object, help_echo_pos); + } + + return TRUE; +} + +/* Prepare a mouse-event in *RESULT for placement in the input queue. + + If the event is a button press, then note that we have grabbed + the mouse. */ + +static Lisp_Object +construct_mouse_click (struct input_event *result, + const GdkEventButton *event, + struct frame *f) +{ + /* Make the event type NO_EVENT; we'll change that when we decide + otherwise. */ + result->kind = MOUSE_CLICK_EVENT; + result->code = event->button - 1; + result->timestamp = event->time; + result->modifiers = + (pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), event->state) | + (event->type == GDK_BUTTON_RELEASE ? up_modifier : down_modifier)); + + XSETINT (result->x, event->x); + XSETINT (result->y, event->y); + XSETFRAME (result->frame_or_window, f); + result->arg = Qnil; + result->device = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), + (GdkEvent *) event); + return Qnil; +} + +static gboolean +button_event (GtkWidget *widget, + GdkEvent *event, + gpointer *user_data) +{ + union buffered_input_event inev; + struct frame *f, *frame; + struct pgtk_display_info *dpyinfo; + + /* If we decide we want to generate an event to be seen + by the rest of Emacs, we put it here. */ + bool tab_bar_p = false; + bool tool_bar_p = false; + Lisp_Object tab_bar_arg = Qnil; + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + /* ignore double click and triple click. */ + if (event->type != GDK_BUTTON_PRESS && event->type != GDK_BUTTON_RELEASE) + return TRUE; + + frame = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + dpyinfo = FRAME_DISPLAY_INFO (frame); + + dpyinfo->last_mouse_glyph_frame = NULL; + + if (gui_mouse_grabbed (dpyinfo)) + f = dpyinfo->last_mouse_frame; + else + { + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + + if (f && event->button.type == GDK_BUTTON_PRESS + && !FRAME_NO_ACCEPT_FOCUS (f)) + { + /* When clicking into a child frame or when clicking + into a parent frame with the child frame selected and + `no-accept-focus' is not set, select the clicked + frame. */ + struct frame *hf = dpyinfo->highlight_frame; + + if (FRAME_PARENT_FRAME (f) || (hf && frame_ancestor_p (f, hf))) + { + block_input (); + gtk_widget_grab_focus (FRAME_GTK_WIDGET (f)); + + if (FRAME_GTK_OUTER_WIDGET (f)) + gtk_window_present (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); + unblock_input (); + } + } + } + + if (f) + { + /* Is this in the tab-bar? */ + if (WINDOWP (f->tab_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tab_bar_window))) + { + Lisp_Object window; + int x = event->button.x; + int y = event->button.y; + + window = window_from_coordinates (f, x, y, 0, true, true); + tab_bar_p = EQ (window, f->tab_bar_window); + + if (tab_bar_p) + tab_bar_arg = handle_tab_bar_click + (f, x, y, event->type == GDK_BUTTON_PRESS, + pgtk_gtk_to_emacs_modifiers (dpyinfo, event->button.state)); + } + } + + if (f) + { + if (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p) + { + if (ignore_next_mouse_click_timeout) + { + if (event->type == GDK_BUTTON_PRESS + && event->button.time > ignore_next_mouse_click_timeout) + { + ignore_next_mouse_click_timeout = 0; + construct_mouse_click (&inev.ie, &event->button, f); + } + if (event->type == GDK_BUTTON_RELEASE) + ignore_next_mouse_click_timeout = 0; + } + else + construct_mouse_click (&inev.ie, &event->button, f); + + if (!NILP (tab_bar_arg)) + inev.ie.arg = tab_bar_arg; + } + } + + if (event->type == GDK_BUTTON_PRESS) + { + dpyinfo->grabbed |= (1 << event->button.button); + dpyinfo->last_mouse_frame = f; + + if (dpyinfo->last_click_event != NULL) + gdk_event_free (dpyinfo->last_click_event); + dpyinfo->last_click_event = gdk_event_copy (event); + } + else + dpyinfo->grabbed &= ~(1 << event->button.button); + + /* Ignore any mouse motion that happened before this event; + any subsequent mouse-movement Emacs events should reflect + only motion after the ButtonPress/Release. */ + if (f != 0) + f->mouse_moved = false; + + if (inev.ie.kind != NO_EVENT) + evq_enqueue (&inev); + return TRUE; +} + +static gboolean +scroll_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) +{ + union buffered_input_event inev; + struct frame *f, *frame; + struct pgtk_display_info *dpyinfo; + GdkScrollDirection dir; + double delta_x, delta_y; + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + frame = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + dpyinfo = FRAME_DISPLAY_INFO (frame); + + if (gui_mouse_grabbed (dpyinfo)) + f = dpyinfo->last_mouse_frame; + else + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + + inev.ie.kind = NO_EVENT; + inev.ie.timestamp = event->scroll.time; + inev.ie.modifiers = + pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), event->scroll.state); + XSETINT (inev.ie.x, event->scroll.x); + XSETINT (inev.ie.y, event->scroll.y); + XSETFRAME (inev.ie.frame_or_window, f); + inev.ie.arg = Qnil; + + if (gdk_event_is_scroll_stop_event (event)) + { + inev.ie.kind = TOUCH_END_EVENT; + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); + evq_enqueue (&inev); + return TRUE; + } + + if (gdk_event_get_scroll_direction (event, &dir)) + { + switch (dir) + { + case GDK_SCROLL_UP: + inev.ie.kind = WHEEL_EVENT; + inev.ie.modifiers |= up_modifier; + break; + case GDK_SCROLL_DOWN: + inev.ie.kind = WHEEL_EVENT; + inev.ie.modifiers |= down_modifier; + break; + case GDK_SCROLL_LEFT: + inev.ie.kind = HORIZ_WHEEL_EVENT; + inev.ie.modifiers |= up_modifier; + break; + case GDK_SCROLL_RIGHT: + inev.ie.kind = HORIZ_WHEEL_EVENT; + inev.ie.modifiers |= down_modifier; + break; + case GDK_SCROLL_SMOOTH: /* shut up warning */ + break; + } + } + else if (gdk_event_get_scroll_deltas (event, &delta_x, &delta_y)) + { + if (!mwheel_coalesce_scroll_events) + { + inev.ie.kind = ((fabs (delta_x) > fabs (delta_y)) + ? HORIZ_WHEEL_EVENT + : WHEEL_EVENT); + inev.ie.modifiers |= (inev.ie.kind == HORIZ_WHEEL_EVENT + ? (delta_x >= 0 ? up_modifier : down_modifier) + : (delta_y >= 0 ? down_modifier : up_modifier)); + inev.ie.arg = list3 (Qnil, make_float (-delta_x * 100), + make_float (-delta_y * 100)); + } + else + { + dpyinfo->scroll.acc_x += delta_x; + dpyinfo->scroll.acc_y += delta_y; + if (dpyinfo->scroll.acc_y >= dpyinfo->scroll.y_per_line) + { + int nlines = dpyinfo->scroll.acc_y / dpyinfo->scroll.y_per_line; + inev.ie.kind = WHEEL_EVENT; + inev.ie.modifiers |= down_modifier; + inev.ie.arg = list3 (make_fixnum (nlines), + make_float (-dpyinfo->scroll.acc_x * 100), + make_float (-dpyinfo->scroll.acc_y * 100)); + dpyinfo->scroll.acc_y -= dpyinfo->scroll.y_per_line * nlines; + } + else if (dpyinfo->scroll.acc_y <= -dpyinfo->scroll.y_per_line) + { + int nlines = -dpyinfo->scroll.acc_y / dpyinfo->scroll.y_per_line; + inev.ie.kind = WHEEL_EVENT; + inev.ie.modifiers |= up_modifier; + inev.ie.arg = list3 (make_fixnum (nlines), + make_float (-dpyinfo->scroll.acc_x * 100), + make_float (-dpyinfo->scroll.acc_y * 100)); + + dpyinfo->scroll.acc_y -= -dpyinfo->scroll.y_per_line * nlines; + } + else if (dpyinfo->scroll.acc_x >= dpyinfo->scroll.x_per_char + || !mwheel_coalesce_scroll_events) + { + int nchars = dpyinfo->scroll.acc_x / dpyinfo->scroll.x_per_char; + inev.ie.kind = HORIZ_WHEEL_EVENT; + inev.ie.modifiers |= up_modifier; + inev.ie.arg = list3 (make_fixnum (nchars), + make_float (-dpyinfo->scroll.acc_x * 100), + make_float (-dpyinfo->scroll.acc_y * 100)); + + dpyinfo->scroll.acc_x -= dpyinfo->scroll.x_per_char * nchars; + } + else if (dpyinfo->scroll.acc_x <= -dpyinfo->scroll.x_per_char) + { + int nchars = -dpyinfo->scroll.acc_x / dpyinfo->scroll.x_per_char; + inev.ie.kind = HORIZ_WHEEL_EVENT; + inev.ie.modifiers |= down_modifier; + inev.ie.arg = list3 (make_fixnum (nchars), + make_float (-dpyinfo->scroll.acc_x * 100), + make_float (-dpyinfo->scroll.acc_y * 100)); + + dpyinfo->scroll.acc_x -= -dpyinfo->scroll.x_per_char * nchars; + } + } + } + + if (inev.ie.kind != NO_EVENT) + { + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); + evq_enqueue (&inev); + } + return TRUE; +} + +static void +drag_data_received (GtkWidget *widget, GdkDragContext *context, + gint x, gint y, GtkSelectionData *data, + guint info, guint time, gpointer user_data) +{ + struct frame *f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + gchar **uris = gtk_selection_data_get_uris (data); + + if (uris != NULL) + { + for (int i = 0; uris[i] != NULL; i++) + { + union buffered_input_event inev; + Lisp_Object arg = Qnil; + + EVENT_INIT (inev.ie); + inev.ie.kind = NO_EVENT; + inev.ie.arg = Qnil; + + arg = list2 (Qurl, build_string (uris[i])); + + inev.ie.kind = DRAG_N_DROP_EVENT; + inev.ie.modifiers = 0; + XSETINT (inev.ie.x, x); + XSETINT (inev.ie.y, y); + XSETFRAME (inev.ie.frame_or_window, f); + inev.ie.arg = arg; + inev.ie.timestamp = 0; + + evq_enqueue (&inev); + } + } + + gtk_drag_finish (context, TRUE, FALSE, time); +} + +void +pgtk_set_event_handler (struct frame *f) +{ + if (f->tooltip) + { + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "draw", + G_CALLBACK (pgtk_handle_draw), NULL); + return; + } + + gtk_drag_dest_set (FRAME_GTK_WIDGET (f), GTK_DEST_DEFAULT_ALL, NULL, 0, + GDK_ACTION_COPY); + gtk_drag_dest_add_uri_targets (FRAME_GTK_WIDGET (f)); + + if (FRAME_GTK_OUTER_WIDGET (f)) + { + g_signal_connect (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), + "window-state-event", G_CALLBACK (window_state_event), + NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), "delete-event", + G_CALLBACK (delete_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), "event", + G_CALLBACK (pgtk_handle_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), "configure-event", + G_CALLBACK (configure_event), NULL); + } + + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "map-event", + G_CALLBACK (map_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "size-allocate", + G_CALLBACK (size_allocate), f); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "key-press-event", + G_CALLBACK (key_press_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "key-release-event", + G_CALLBACK (key_release_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "focus-in-event", + G_CALLBACK (focus_in_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "focus-out-event", + G_CALLBACK (focus_out_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "enter-notify-event", + G_CALLBACK (enter_notify_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "leave-notify-event", + G_CALLBACK (leave_notify_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "motion-notify-event", + G_CALLBACK (motion_notify_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "button-press-event", + G_CALLBACK (button_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "button-release-event", + G_CALLBACK (button_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "scroll-event", + G_CALLBACK (scroll_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "selection-clear-event", + G_CALLBACK (pgtk_selection_lost), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "configure-event", + G_CALLBACK (configure_event), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "drag-data-received", + G_CALLBACK (drag_data_received), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "draw", + G_CALLBACK (pgtk_handle_draw), NULL); + g_signal_connect (G_OBJECT (FRAME_GTK_WIDGET (f)), "event", + G_CALLBACK (pgtk_handle_event), NULL); +} + +static void +my_log_handler (const gchar * log_domain, GLogLevelFlags log_level, + const gchar * msg, gpointer user_data) +{ + if (!strstr (msg, "g_set_prgname")) + fprintf (stderr, "%s-WARNING **: %s", log_domain, msg); +} + +/* Test whether two display-name strings agree up to the dot that separates + the screen number from the server number. */ +static bool +same_x_server (const char *name1, const char *name2) +{ + bool seen_colon = false; + Lisp_Object sysname = Fsystem_name (); + const char *system_name = SSDATA (sysname); + ptrdiff_t system_name_length = SBYTES (sysname); + ptrdiff_t length_until_period = 0; + + while (system_name[length_until_period] != 0 + && system_name[length_until_period] != '.') + length_until_period++; + + /* Treat `unix' like an empty host name. */ + if (!strncmp (name1, "unix:", 5)) + name1 += 4; + if (!strncmp (name2, "unix:", 5)) + name2 += 4; + /* Treat this host's name like an empty host name. */ + if (!strncmp (name1, system_name, system_name_length) + && name1[system_name_length] == ':') + name1 += system_name_length; + if (!strncmp (name2, system_name, system_name_length) + && name2[system_name_length] == ':') + name2 += system_name_length; + /* Treat this host's domainless name like an empty host name. */ + if (!strncmp (name1, system_name, length_until_period) + && name1[length_until_period] == ':') + name1 += length_until_period; + if (!strncmp (name2, system_name, length_until_period) + && name2[length_until_period] == ':') + name2 += length_until_period; + + for (; *name1 != '\0' && *name1 == *name2; name1++, name2++) + { + if (*name1 == ':') + seen_colon = true; + if (seen_colon && *name1 == '.') + return true; + } + return (seen_colon + && (*name1 == '.' || *name1 == '\0') + && (*name2 == '.' || *name2 == '\0')); +} + +#define GNOME_INTERFACE_SCHEMA "org.gnome.desktop.interface" + +static gdouble pgtk_text_scaling_factor (void) +{ + GSettingsSchemaSource *schema_source = g_settings_schema_source_get_default (); + if (schema_source != NULL) + { + GSettingsSchema *schema = g_settings_schema_source_lookup (schema_source, + GNOME_INTERFACE_SCHEMA, true); + if (schema != NULL) + { + g_settings_schema_unref (schema); + GSettings *set = g_settings_new (GNOME_INTERFACE_SCHEMA); + return g_settings_get_double (set, "text-scaling-factor"); + } + } + return 1; +} + + +/* Open a connection to X display DISPLAY_NAME, and return + the structure that describes the open display. + If we cannot contact the display, return null. */ + +struct pgtk_display_info * +pgtk_term_init (Lisp_Object display_name, char *resource_name) +{ + GdkDisplay *dpy; + struct terminal *terminal; + struct pgtk_display_info *dpyinfo; + static int x_initialized = 0; + static unsigned x_display_id = 0; + static char *initial_display = NULL; + char *dpy_name; + static void *handle = NULL; + Lisp_Object lisp_dpy_name = Qnil; + + block_input (); + + if (!x_initialized) + { + any_help_event_p = false; + + Fset_input_interrupt_mode (Qt); + baud_rate = 19200; + +#ifdef USE_CAIRO + gui_init_fringe (&pgtk_redisplay_interface); +#endif + + ++x_initialized; + } + + dpy_name = SSDATA (display_name); + if (strlen (dpy_name) == 0 && initial_display != NULL) + dpy_name = initial_display; + lisp_dpy_name = build_string (dpy_name); + + { +#define NUM_ARGV 10 + int argc; + char *argv[NUM_ARGV]; + char **argv2 = argv; + guint id; + + if (x_initialized++ > 1) + { + xg_display_open (dpy_name, &dpy); + } + else + { + static char display_opt[] = "--display"; + static char name_opt[] = "--name"; + + for (argc = 0; argc < NUM_ARGV; ++argc) + argv[argc] = 0; + + argc = 0; + argv[argc++] = initial_argv[0]; + + if (strlen (dpy_name) != 0) + { + argv[argc++] = display_opt; + argv[argc++] = dpy_name; + } + + argv[argc++] = name_opt; + argv[argc++] = resource_name; + + /* Work around GLib bug that outputs a faulty warning. See + https://bugzilla.gnome.org/show_bug.cgi?id=563627. */ + id = g_log_set_handler ("GLib", G_LOG_LEVEL_WARNING | G_LOG_FLAG_FATAL + | G_LOG_FLAG_RECURSION, my_log_handler, NULL); + + /* gtk_init does set_locale. Fix locale before and after. */ + fixup_locale (); + unrequest_sigio (); /* See comment in x_display_ok. */ + gtk_init (&argc, &argv2); + request_sigio (); + fixup_locale (); + + + g_log_remove_handler ("GLib", id); + + xg_initialize (); + + dpy = DEFAULT_GDK_DISPLAY (); + + initial_display = g_strdup (gdk_display_get_name (dpy)); + dpy_name = initial_display; + lisp_dpy_name = build_string (dpy_name); + } + } + + /* Detect failure. */ + if (dpy == 0) + { + unblock_input (); + return 0; + } + + + dpyinfo = xzalloc (sizeof *dpyinfo); + pgtk_initialize_display_info (dpyinfo); + terminal = pgtk_create_terminal (dpyinfo); + + { + struct pgtk_display_info *share; + + for (share = x_display_list; share; share = share->next) + if (same_x_server (SSDATA (XCAR (share->name_list_element)), dpy_name)) + break; + if (share) + terminal->kboard = share->terminal->kboard; + else + { + terminal->kboard = allocate_kboard (Qpgtk); + + /* Don't let the initial kboard remain current longer than necessary. + That would cause problems if a file loaded on startup tries to + prompt in the mini-buffer. */ + if (current_kboard == initial_kboard) + current_kboard = terminal->kboard; + } + terminal->kboard->reference_count++; + } + + /* Put this display on the chain. */ + dpyinfo->next = x_display_list; + x_display_list = dpyinfo; + + dpyinfo->name_list_element = Fcons (lisp_dpy_name, Qnil); + dpyinfo->gdpy = dpy; + + /* https://lists.gnu.org/r/emacs-devel/2015-11/msg00194.html */ + dpyinfo->smallest_font_height = 1; + dpyinfo->smallest_char_width = 1; + + /* Set the name of the terminal. */ + terminal->name = xlispstrdup (lisp_dpy_name); + + Lisp_Object system_name = Fsystem_name (); + ptrdiff_t nbytes; + if (INT_ADD_WRAPV (SBYTES (Vinvocation_name), SBYTES (system_name) + 2, + &nbytes)) + memory_full (SIZE_MAX); + dpyinfo->x_id = ++x_display_id; + dpyinfo->x_id_name = xmalloc (nbytes); + char *nametail = lispstpcpy (dpyinfo->x_id_name, Vinvocation_name); + *nametail++ = '@'; + lispstpcpy (nametail, system_name); + + /* Get the scroll bar cursor. */ + /* We must create a GTK cursor, it is required for GTK widgets. */ + dpyinfo->xg_cursor = xg_create_default_cursor (dpyinfo->gdpy); + + dpyinfo->vertical_scroll_bar_cursor + = gdk_cursor_new_for_display (dpyinfo->gdpy, GDK_SB_V_DOUBLE_ARROW); + + dpyinfo->horizontal_scroll_bar_cursor + = gdk_cursor_new_for_display (dpyinfo->gdpy, GDK_SB_H_DOUBLE_ARROW); + + dpyinfo->icon_bitmap_id = -1; + + reset_mouse_highlight (&dpyinfo->mouse_highlight); + + { + GdkScreen *gscr = gdk_display_get_default_screen (dpyinfo->gdpy); + + gdouble dpi = gdk_screen_get_resolution (gscr); + if (dpi < 0) + dpi = 96.0; + + dpi *= pgtk_text_scaling_factor (); + dpyinfo->resx = dpi; + dpyinfo->resy = dpi; + } + + /* smooth scroll setting */ + dpyinfo->scroll.x_per_char = 2; + dpyinfo->scroll.y_per_line = 2; + + dpyinfo->connection = -1; + + if (!handle) + handle = dlopen (NULL, RTLD_LAZY); + +#ifdef GDK_WINDOWING_X11 + if (!strcmp (G_OBJECT_TYPE_NAME (dpy), "GdkX11Display") && handle) + { + void *(*gdk_x11_display_get_xdisplay) (GdkDisplay *) + = dlsym (handle, "gdk_x11_display_get_xdisplay"); + int (*x_connection_number) (void *) + = dlsym (handle, "XConnectionNumber"); + + if (x_connection_number + && gdk_x11_display_get_xdisplay) + dpyinfo->connection + = x_connection_number (gdk_x11_display_get_xdisplay (dpy)); + } +#endif + +#ifdef GDK_WINDOWING_WAYLAND + if (GDK_IS_WAYLAND_DISPLAY (dpy) && handle) + { + struct wl_display *wl_dpy = gdk_wayland_display_get_wl_display (dpy); + int (*display_get_fd) (struct wl_display *) + = dlsym (handle, "wl_display_get_fd"); + + if (display_get_fd) + dpyinfo->connection = display_get_fd (wl_dpy); + } +#endif + + if (dpyinfo->connection >= 0) + { + add_keyboard_wait_descriptor (dpyinfo->connection); +#ifdef F_SETOWN + fcntl (dpyinfo->connection, F_SETOWN, getpid ()); +#endif /* ! defined (F_SETOWN) */ + + if (interrupt_input) + init_sigio (dpyinfo->connection); + } + + dpyinfo->invisible_cursor + = gdk_cursor_new_for_display (dpyinfo->gdpy, GDK_BLANK_CURSOR); + + xsettings_initialize (dpyinfo); + + pgtk_selection_init (); + + pgtk_im_init (dpyinfo); + + g_signal_connect (G_OBJECT (dpyinfo->gdpy), "seat-added", + G_CALLBACK (pgtk_seat_added_cb), dpyinfo); + g_signal_connect (G_OBJECT (dpyinfo->gdpy), "seat-removed", + G_CALLBACK (pgtk_seat_removed_cb), dpyinfo); + pgtk_enumerate_devices (dpyinfo, true); + + unblock_input (); + + return dpyinfo; +} + +/* Get rid of display DPYINFO, deleting all frames on it, + and without sending any more commands to the X server. */ + +static void +pgtk_delete_display (struct pgtk_display_info *dpyinfo) +{ + struct terminal *t; + + /* Close all frames and delete the generic struct terminal for this + X display. */ + for (t = terminal_list; t; t = t->next_terminal) + if (t->type == output_pgtk && t->display_info.pgtk == dpyinfo) + { + delete_terminal (t); + break; + } + + if (x_display_list == dpyinfo) + x_display_list = dpyinfo->next; + else + { + struct pgtk_display_info *tail; + + for (tail = x_display_list; tail; tail = tail->next) + if (tail->next == dpyinfo) + tail->next = tail->next->next; + } + + pgtk_free_devices (dpyinfo); + xfree (dpyinfo); +} + +char * +pgtk_xlfd_to_fontname (const char *xlfd) +/* -------------------------------------------------------------------------- + Convert an X font name (XLFD) to an Gtk font name. + Only family is used. + The string returned is temporarily allocated. + -------------------------------------------------------------------------- */ +{ + char *name = xmalloc (180); + + if (!strncmp (xlfd, "--", 2)) + { + if (sscanf (xlfd, "--%179[^-]-", name) != 1) + name[0] = '\0'; + } + else + { + if (sscanf (xlfd, "-%*[^-]-%179[^-]-", name) != 1) + name[0] = '\0'; + } + + /* stopgap for malformed XLFD input */ + if (strlen (name) == 0) + strcpy (name, "Monospace"); + + return name; +} + +bool +pgtk_defined_color (struct frame *f, + const char *name, + Emacs_Color * color_def, bool alloc, bool makeIndex) +/* -------------------------------------------------------------------------- + Return true if named color found, and set color_def rgb accordingly. + If makeIndex and alloc are nonzero put the color in the color_table, + and set color_def pixel to the resulting index. + If makeIndex is zero, set color_def pixel to ARGB. + Return false if not found + -------------------------------------------------------------------------- */ +{ + int r; + + block_input (); + r = xg_check_special_colors (f, name, color_def); + if (!r) + r = pgtk_parse_color (f, name, color_def); + unblock_input (); + return r; +} + +/* On frame F, translate the color name to RGB values. Use cached + information, if possible. + + Note that there is currently no way to clean old entries out of the + cache. However, it is limited to names in the server's database, + and names we've actually looked up; list-colors-display is probably + the most color-intensive case we're likely to hit. */ + +int +pgtk_parse_color (struct frame *f, const char *color_name, + Emacs_Color * color) +{ + GdkRGBA rgba; + if (gdk_rgba_parse (&rgba, color_name)) + { + color->red = rgba.red * 65535; + color->green = rgba.green * 65535; + color->blue = rgba.blue * 65535; + color->pixel = + (color->red >> 8) << 16 | + (color->green >> 8) << 8 | + (color->blue >> 8) << 0; + return 1; + } + return 0; +} + +/* On frame F, translate pixel colors to RGB values for the NCOLORS + colors in COLORS. On W32, we no longer try to map colors to + a palette. */ +void +pgtk_query_colors (struct frame *f, Emacs_Color * colors, int ncolors) +{ + int i; + + for (i = 0; i < ncolors; i++) + { + unsigned long pixel = colors[i].pixel; + /* Convert to a 16 bit value in range 0 - 0xffff. */ +#define GetRValue(p) (((p) >> 16) & 0xff) +#define GetGValue(p) (((p) >> 8) & 0xff) +#define GetBValue(p) (((p) >> 0) & 0xff) + colors[i].red = GetRValue (pixel) * 257; + colors[i].green = GetGValue (pixel) * 257; + colors[i].blue = GetBValue (pixel) * 257; + } +} + +void +pgtk_query_color (struct frame *f, Emacs_Color * color) +{ + pgtk_query_colors (f, color, 1); +} + +void +pgtk_clear_area (struct frame *f, int x, int y, int width, int height) +{ + cairo_t *cr; + + eassert (width > 0 && height > 0); + + cr = pgtk_begin_cr_clip (f); + pgtk_set_cr_source_with_color (f, FRAME_X_OUTPUT (f)->background_color, + true); + cairo_rectangle (cr, x, y, width, height); + cairo_fill (cr); + pgtk_end_cr_clip (f); +} + + +void +syms_of_pgtkterm (void) +{ + DEFSYM (Qmodifier_value, "modifier-value"); + DEFSYM (Qalt, "alt"); + DEFSYM (Qhyper, "hyper"); + DEFSYM (Qmeta, "meta"); + DEFSYM (Qsuper, "super"); + DEFSYM (Qcontrol, "control"); + DEFSYM (QUTF8_STRING, "UTF8_STRING"); + + DEFSYM (Qfile, "file"); + DEFSYM (Qurl, "url"); + + DEFSYM (Qlatin_1, "latin-1"); + + xg_default_icon_file = + build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); + staticpro (&xg_default_icon_file); + + DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock"); + + + Fput (Qalt, Qmodifier_value, make_fixnum (alt_modifier)); + Fput (Qhyper, Qmodifier_value, make_fixnum (hyper_modifier)); + Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier)); + Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier)); + Fput (Qcontrol, Qmodifier_value, make_fixnum (ctrl_modifier)); + + DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, + doc: /* SKIP: real doc in xterm.c. */); + Vx_ctrl_keysym = Qnil; + + DEFVAR_LISP ("x-alt-keysym", Vx_alt_keysym, + doc: /* SKIP: real doc in xterm.c. */); + Vx_alt_keysym = Qnil; + + DEFVAR_LISP ("x-hyper-keysym", Vx_hyper_keysym, + doc: /* SKIP: real doc in xterm.c. */); + Vx_hyper_keysym = Qnil; + + DEFVAR_LISP ("x-meta-keysym", Vx_meta_keysym, + doc: /* SKIP: real doc in xterm.c. */); + Vx_meta_keysym = Qnil; + + DEFVAR_LISP ("x-super-keysym", Vx_super_keysym, + doc: /* SKIP: real doc in xterm.c. */); + Vx_super_keysym = Qnil; + + DEFVAR_BOOL ("x-use-underline-position-properties", + x_use_underline_position_properties, + doc: /* SKIP: real doc in xterm.c. */); + x_use_underline_position_properties = 1; + + DEFVAR_BOOL ("x-underline-at-descent-line", + x_underline_at_descent_line, + doc: /* SKIP: real doc in xterm.c. */); + x_underline_at_descent_line = 0; + + DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars, + doc: /* SKIP: real doc in xterm.c. */); + Vx_toolkit_scroll_bars = intern_c_string ("gtk"); + + DEFVAR_LISP ("pgtk-wait-for-event-timeout", Vpgtk_wait_for_event_timeout, + doc: /* How long to wait for GTK events. + +Emacs will wait up to this many seconds to receive some GTK events +after making changes which affect the state of the graphical +interface. Under some window managers this can take an indefinite +amount of time, so it is important to limit the wait. + +If set to a non-float value, there will be no wait at all. */); + Vpgtk_wait_for_event_timeout = make_float (0.1); + + DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table, + doc: /* Hash table of character codes indexed by X keysym codes. */); + Vpgtk_keysym_table = + make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE, + DEFAULT_REHASH_THRESHOLD, Qnil, false); + + window_being_scrolled = Qnil; + staticpro (&window_being_scrolled); + + /* Tell Emacs about this window system. */ + Fprovide (Qpgtk, Qnil); +} + +/* Cairo does not allow resizing a surface/context after it is + created, so we need to trash the old context, create a new context + on the next cr_clip_begin with the new dimensions and request a + re-draw. + + This will leave the active context available to present on screen + until a redrawn frame is completed. */ +void +pgtk_cr_update_surface_desired_size (struct frame *f, int width, int height, bool force) +{ + if (FRAME_CR_SURFACE_DESIRED_WIDTH (f) != width + || FRAME_CR_SURFACE_DESIRED_HEIGHT (f) != height + || force) + { + pgtk_cr_destroy_frame_context (f); + FRAME_CR_SURFACE_DESIRED_WIDTH (f) = width; + FRAME_CR_SURFACE_DESIRED_HEIGHT (f) = height; + SET_FRAME_GARBAGED (f); + } +} + + +cairo_t * +pgtk_begin_cr_clip (struct frame *f) +{ + cairo_t *cr = FRAME_CR_CONTEXT (f); + + if (!cr) + { + cairo_surface_t *surface = + gdk_window_create_similar_surface (gtk_widget_get_window + (FRAME_GTK_WIDGET (f)), + CAIRO_CONTENT_COLOR_ALPHA, + FRAME_CR_SURFACE_DESIRED_WIDTH (f), + FRAME_CR_SURFACE_DESIRED_HEIGHT + (f)); + + cr = FRAME_CR_CONTEXT (f) = cairo_create (surface); + cairo_surface_destroy (surface); + } + + cairo_save (cr); + + return cr; +} + +void +pgtk_end_cr_clip (struct frame *f) +{ + cairo_restore (FRAME_CR_CONTEXT (f)); +} + +void +pgtk_set_cr_source_with_gc_foreground (struct frame *f, Emacs_GC *gc, + bool respects_alpha_background) +{ + pgtk_set_cr_source_with_color (f, gc->foreground, + respects_alpha_background); +} + +void +pgtk_set_cr_source_with_gc_background (struct frame *f, Emacs_GC *gc, + bool respects_alpha_background) +{ + pgtk_set_cr_source_with_color (f, gc->background, + respects_alpha_background); +} + +void +pgtk_set_cr_source_with_color (struct frame *f, unsigned long color, + bool respects_alpha_background) +{ + Emacs_Color col; + col.pixel = color; + pgtk_query_color (f, &col); + + if (!respects_alpha_background) + { + cairo_set_source_rgb (FRAME_CR_CONTEXT (f), col.red / 65535.0, + col.green / 65535.0, col.blue / 65535.0); + cairo_set_operator (FRAME_CR_CONTEXT (f), CAIRO_OPERATOR_OVER); + } + else + { + cairo_set_source_rgba (FRAME_CR_CONTEXT (f), col.red / 65535.0, + col.green / 65535.0, col.blue / 65535.0, + f->alpha_background); + cairo_set_operator (FRAME_CR_CONTEXT (f), CAIRO_OPERATOR_SOURCE); + } +} + +void +pgtk_cr_draw_frame (cairo_t * cr, struct frame *f) +{ + cairo_set_source_surface (cr, FRAME_CR_SURFACE (f), 0, 0); + cairo_paint (cr); +} + +static cairo_status_t +pgtk_cr_accumulate_data (void *closure, const unsigned char *data, + unsigned int length) +{ + Lisp_Object *acc = (Lisp_Object *) closure; + + *acc = Fcons (make_unibyte_string ((char const *) data, length), *acc); + + return CAIRO_STATUS_SUCCESS; +} + +void +pgtk_cr_destroy_frame_context (struct frame *f) +{ + if (FRAME_CR_CONTEXT (f) != NULL) + { + cairo_destroy (FRAME_CR_CONTEXT (f)); + FRAME_CR_CONTEXT (f) = NULL; + } +} + +static void +pgtk_cr_destroy (void *cr) +{ + block_input (); + cairo_destroy (cr); + unblock_input (); +} + + + +Lisp_Object +pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) +{ + struct frame *f; + cairo_surface_t *surface; + cairo_t *cr; + int width, height; + void (*surface_set_size_func) (cairo_surface_t *, double, double) = NULL; + Lisp_Object acc = Qnil; + specpdl_ref count = SPECPDL_INDEX (); + + specbind (Qredisplay_dont_pause, Qt); + redisplay_preserve_echo_area (31); + + f = XFRAME (XCAR (frames)); + frames = XCDR (frames); + width = FRAME_PIXEL_WIDTH (f); + height = FRAME_PIXEL_HEIGHT (f); + + block_input (); +#ifdef CAIRO_HAS_PDF_SURFACE + if (surface_type == CAIRO_SURFACE_TYPE_PDF) + { + surface = cairo_pdf_surface_create_for_stream (pgtk_cr_accumulate_data, &acc, + width, height); + surface_set_size_func = cairo_pdf_surface_set_size; + } + else +#endif +#ifdef CAIRO_HAS_PNG_FUNCTIONS + if (surface_type == CAIRO_SURFACE_TYPE_IMAGE) + surface = cairo_image_surface_create (CAIRO_FORMAT_RGB24, width, height); + else +#endif +#ifdef CAIRO_HAS_PS_SURFACE + if (surface_type == CAIRO_SURFACE_TYPE_PS) + { + surface = cairo_ps_surface_create_for_stream (pgtk_cr_accumulate_data, &acc, + width, height); + surface_set_size_func = cairo_ps_surface_set_size; + } + else +#endif +#ifdef CAIRO_HAS_SVG_SURFACE + if (surface_type == CAIRO_SURFACE_TYPE_SVG) + surface = cairo_svg_surface_create_for_stream (pgtk_cr_accumulate_data, &acc, + width, height); + else +#endif + abort (); + + cr = cairo_create (surface); + cairo_surface_destroy (surface); + record_unwind_protect_ptr (pgtk_cr_destroy, cr); + + while (1) + { + cairo_t *saved_cr = FRAME_CR_CONTEXT (f); + FRAME_CR_CONTEXT (f) = cr; + pgtk_clear_area (f, 0, 0, width, height); + expose_frame (f, 0, 0, width, height); + FRAME_CR_CONTEXT (f) = saved_cr; + + if (NILP (frames)) + break; + + cairo_surface_show_page (surface); + f = XFRAME (XCAR (frames)); + frames = XCDR (frames); + width = FRAME_PIXEL_WIDTH (f); + height = FRAME_PIXEL_HEIGHT (f); + if (surface_set_size_func) + (*surface_set_size_func) (surface, width, height); + + unblock_input (); + maybe_quit (); + block_input (); + } + +#ifdef CAIRO_HAS_PNG_FUNCTIONS + if (surface_type == CAIRO_SURFACE_TYPE_IMAGE) + { + cairo_surface_flush (surface); + cairo_surface_write_to_png_stream (surface, pgtk_cr_accumulate_data, &acc); + } +#endif + unblock_input (); + + unbind_to (count, Qnil); + + return CALLN (Fapply, intern ("concat"), Fnreverse (acc)); +} + + +void +init_pgtkterm (void) +{ +} diff --git a/src/pgtkterm.h b/src/pgtkterm.h new file mode 100644 index 00000000000..cc763f00f0c --- /dev/null +++ b/src/pgtkterm.h @@ -0,0 +1,603 @@ +/* Definitions and headers for communication with pure Gtk+3. + Copyright (C) 1989, 1993, 2005, 2008-2022 Free Software Foundation, + Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#ifndef _PGTKTERM_H_ +#define _PGTKTERM_H_ + +#include "dispextern.h" +#include "frame.h" +#include "character.h" +#include "font.h" +#include "sysselect.h" + +#ifdef HAVE_PGTK + +#include <gtk/gtk.h> + +#ifdef CAIRO_HAS_PDF_SURFACE +#include <cairo-pdf.h> +#endif +#ifdef CAIRO_HAS_PS_SURFACE +#include <cairo-ps.h> +#endif +#ifdef CAIRO_HAS_SVG_SURFACE +#include <cairo-svg.h> +#endif + +struct pgtk_bitmap_record +{ + void *img; + char *file; + int refcount; + int height, width, depth; + cairo_pattern_t *pattern; +}; + +struct pgtk_device_t +{ + GdkSeat *seat; + GdkDevice *device; + + Lisp_Object name; + struct pgtk_device_t *next; +}; + +#define RGB_TO_ULONG(r, g, b) (((r) << 16) | ((g) << 8) | (b)) +#define ARGB_TO_ULONG(a, r, g, b) (((a) << 24) | ((r) << 16) | ((g) << 8) | (b)) + +#define ALPHA_FROM_ULONG(color) ((color) >> 24) +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) + +struct scroll_bar +{ + /* These fields are shared by all vectors. */ + union vectorlike_header header; + + /* The window we're a scroll bar for. */ + Lisp_Object window; + + /* The next and previous in the chain of scroll bars in this frame. */ + Lisp_Object next, prev; + + /* Fields from `x_window' down will not be traced by the GC. */ + + /* The X window representing this scroll bar. */ + Window x_window; + + /* The position and size of the scroll bar in pixels, relative to the + frame. */ + int top, left, width, height; + + /* The starting and ending positions of the handle, relative to the + handle area (i.e. zero is the top position, not + SCROLL_BAR_TOP_BORDER). If they're equal, that means the handle + hasn't been drawn yet. + + These are not actually the locations where the beginning and end + are drawn; in order to keep handles from becoming invisible when + editing large files, we establish a minimum height by always + drawing handle bottoms VERTICAL_SCROLL_BAR_MIN_HANDLE pixels below + where they would be normally; the bottom and top are in a + different co-ordinate system. */ + int start, end; + + /* If the scroll bar handle is currently being dragged by the user, + this is the number of pixels from the top of the handle to the + place where the user grabbed it. If the handle isn't currently + being dragged, this is -1. */ + int dragging; + +#if defined (USE_TOOLKIT_SCROLL_BARS) && defined (USE_LUCID) + /* Last scroll bar part seen in xaw_jump_callback and xaw_scroll_callback. */ + enum scroll_bar_part last_seen_part; +#endif + +#if defined (USE_TOOLKIT_SCROLL_BARS) && !defined (USE_GTK) + /* Last value of whole for horizontal scrollbars. */ + int whole; +#endif + + /* True if the scroll bar is horizontal. */ + bool horizontal; +}; + +struct pgtk_display_info +{ + /* Chain of all pgtk_display_info structures. */ + struct pgtk_display_info *next; + + /* The generic display parameters corresponding to this PGTK display. */ + struct terminal *terminal; + + /* This says how to access this display in Gdk. */ + GdkDisplay *gdpy; + + /* This is a cons cell of the form (NAME . FONT-LIST-CACHE). */ + Lisp_Object name_list_element; + + /* Number of frames that are on this display. */ + int reference_count; + + /* Logical identifier of this display. */ + unsigned x_id; + + /* Default name for all frames on this display. */ + char *x_id_name; + + /* The number of fonts loaded. */ + int n_fonts; + + /* Minimum width over all characters in all fonts in font_table. */ + int smallest_char_width; + + /* Minimum font height over all fonts in font_table. */ + int smallest_font_height; + + struct pgtk_bitmap_record *bitmaps; + ptrdiff_t bitmaps_size; + ptrdiff_t bitmaps_last; + + /* DPI resolution of this screen */ + double resx, resy; + + /* Mask of things that cause the mouse to be grabbed */ + int grabbed; + + int n_planes; + + int color_p; + + /* Emacs bitmap-id of the default icon bitmap for this frame. + Or -1 if none has been allocated yet. */ + ptrdiff_t icon_bitmap_id; + + Window root_window; + + /* Xism */ + XrmDatabase rdb; + + /* The cursor to use for vertical scroll bars. */ + Emacs_Cursor vertical_scroll_bar_cursor; + + /* The cursor to use for horizontal scroll bars. */ + Emacs_Cursor horizontal_scroll_bar_cursor; + + /* Information about the range of text currently shown in + mouse-face. */ + Mouse_HLInfo mouse_highlight; + + struct frame *highlight_frame; + struct frame *x_focus_frame; + + /* The last frame mentioned in a FocusIn or FocusOut event. This is + separate from x_focus_frame, because whether or not LeaveNotify + events cause us to lose focus depends on whether or not we have + received a FocusIn event for it. */ + struct frame *x_focus_event_frame; + + /* The frame where the mouse was last time we reported a mouse event. */ + struct frame *last_mouse_frame; + + /* The frame where the mouse was last time we reported a mouse motion. */ + struct frame *last_mouse_motion_frame; + + /* Position where the mouse was last time we reported a motion. + This is a position on last_mouse_motion_frame. */ + int last_mouse_motion_x; + int last_mouse_motion_y; + + /* Where the mouse was last time we reported a mouse position. */ + XRectangle last_mouse_glyph; + + /* Time of last mouse movement. */ + Time last_mouse_movement_time; + + /* The scroll bar in which the last motion event occurred. */ + void *last_mouse_scroll_bar; + + /* The invisible cursor used for pointer blanking. */ + Emacs_Cursor invisible_cursor; + + /* The GDK cursor for scroll bars and popup menus. */ + GdkCursor *xg_cursor; + + /* List of all devices for all seats on this display. */ + struct pgtk_device_t *devices; + + /* The frame where the mouse was last time we reported a mouse position. */ + struct frame *last_mouse_glyph_frame; + + /* The last click event. */ + GdkEvent *last_click_event; + + /* IM context data. */ + struct + { + GtkIMContext *context; + struct frame *focused_frame; + } im; + + struct + { + double acc_x, acc_y; + double x_per_char, y_per_line; + } scroll; + + int connection; +}; + +/* This is a chain of structures for all the PGTK displays currently in use. */ +extern struct pgtk_display_info *x_display_list; + +struct pgtk_output +{ + unsigned long foreground_color; + unsigned long background_color; + void *toolbar; + + /* Cursors */ + Emacs_Cursor current_cursor; + Emacs_Cursor text_cursor; + Emacs_Cursor nontext_cursor; + Emacs_Cursor modeline_cursor; + Emacs_Cursor hand_cursor; + Emacs_Cursor hourglass_cursor; + Emacs_Cursor horizontal_drag_cursor; + Emacs_Cursor vertical_drag_cursor; + Emacs_Cursor left_edge_cursor; + Emacs_Cursor top_left_corner_cursor; + Emacs_Cursor top_edge_cursor; + Emacs_Cursor top_right_corner_cursor; + Emacs_Cursor right_edge_cursor; + Emacs_Cursor bottom_right_corner_cursor; + Emacs_Cursor bottom_edge_cursor; + Emacs_Cursor bottom_left_corner_cursor; + + /* PGTK-specific */ + Emacs_Cursor current_pointer; + + /* border color */ + unsigned long border_pixel; + GtkCssProvider *border_color_css_provider; + + /* scrollbar color */ + GtkCssProvider *scrollbar_foreground_css_provider; + GtkCssProvider *scrollbar_background_css_provider; + + /* Widget whose cursor is hourglass_cursor. This widget is temporarily + mapped to display an hourglass cursor. */ + GtkWidget *hourglass_widget; + + Emacs_GC cursor_xgcv; + + /* lord knows why Emacs needs to know about our Window ids.. */ + Window window_desc, parent_desc; + char explicit_parent; + + /* If >=0, a bitmap index. The indicated bitmap is used for the + icon. */ + ptrdiff_t icon_bitmap; + + struct font *font; + int baseline_offset; + + /* If a fontset is specified for this frame instead of font, this + value contains an ID of the fontset, else -1. */ + int fontset; /* only used with font_backend */ + + unsigned long mouse_color; + unsigned long cursor_color; + unsigned long cursor_foreground_color; + + int icon_top; + int icon_left; + + /* The size of the extra width currently allotted for vertical + scroll bars, in pixels. */ + int vertical_scroll_bar_extra; + + /* The height of the titlebar decoration (included in PGTKWindow's frame). */ + int titlebar_height; + + /* The height of the toolbar if displayed, else 0. */ + int toolbar_height; + + /* This is the Emacs structure for the PGTK display this frame is on. */ + struct pgtk_display_info *display_info; + + /* Non-zero if we are zooming (maximizing) the frame. */ + int zooming; + + /* Non-zero if we are doing an animation, e.g. toggling the tool bar. */ + int in_animation; + + /* The last size hints set. */ + GdkGeometry size_hints; + long hint_flags; + int preferred_width, preferred_height; + + /* The widget of this screen. This is the window of a top widget. */ + GtkWidget *widget; + /* The widget of the edit portion of this screen; the window in + "window_desc" is inside of this. */ + GtkWidget *edit_widget; + /* The widget used for laying out widgets vertically. */ + GtkWidget *vbox_widget; + /* The widget used for laying out widgets horizontally. */ + GtkWidget *hbox_widget; + /* The menubar in this frame. */ + GtkWidget *menubar_widget; + /* The tool bar in this frame */ + GtkWidget *toolbar_widget; + /* True if tool bar is packed into the hbox widget (i.e. vertical). */ + bool_bf toolbar_in_hbox:1; + bool_bf toolbar_is_packed:1; + + GtkTooltip *ttip_widget; + GtkWidget *ttip_lbl; + GtkWindow *ttip_window; + + /* Height of menu bar widget, in pixels. This value + is not meaningful if the menubar is turned off. */ + int menubar_height; + + /* Height of tool bar widget, in pixels. top_height is used if tool bar + at top, bottom_height if tool bar is at the bottom. + Zero if not using an external tool bar or if tool bar is vertical. */ + int toolbar_top_height, toolbar_bottom_height; + + /* Width of tool bar widget, in pixels. left_width is used if tool bar + at left, right_width if tool bar is at the right. + Zero if not using an external tool bar or if tool bar is horizontal. */ + int toolbar_left_width, toolbar_right_width; + +#ifdef USE_CAIRO + /* Cairo drawing contexts. */ + cairo_t *cr_context, *cr_active; + int cr_surface_desired_width, cr_surface_desired_height; + /* Cairo surface for double buffering */ + cairo_surface_t *cr_surface_visible_bell; +#endif + struct atimer *atimer_visible_bell; + + int has_been_visible; + + /* Relief GCs, colors etc. */ + struct relief + { + Emacs_GC xgcv; + unsigned long pixel; + } + black_relief, white_relief; + + /* The background for which the above relief GCs were set up. + They are changed only when a different background is involved. */ + unsigned long relief_background; + + /* Keep track of focus. May be EXPLICIT if we received a FocusIn for this + frame, or IMPLICIT if we received an EnterNotify. + FocusOut and LeaveNotify clears EXPLICIT/IMPLICIT. */ + int focus_state; + + /* Keep track of scale factor. If monitor's scale factor is changed, or + monitor is switched and scale factor is changed, then recreate cairo_t + and cairo_surface_t. I need GTK's such signal, but there isn't, so + I watch it periodically with atimer. */ + double watched_scale_factor; + struct atimer *scale_factor_atimer; +}; + +/* Satisfy term.c. */ +struct x_output +{ + int unused; +}; + +enum +{ + /* Values for focus_state, used as bit mask. + EXPLICIT means we received a FocusIn for the frame and know it has + the focus. IMPLICIT means we received an EnterNotify and the frame + may have the focus if no window manager is running. + FocusOut and LeaveNotify clears EXPLICIT/IMPLICIT. */ + FOCUS_NONE = 0, + FOCUS_IMPLICIT = 1, + FOCUS_EXPLICIT = 2 +}; + +/* This gives the pgtk_display_info structure for the display F is on. */ +#define FRAME_X_OUTPUT(f) ((f)->output_data.pgtk) +#define FRAME_OUTPUT_DATA(f) FRAME_X_OUTPUT (f) + +#define FRAME_DISPLAY_INFO(f) (FRAME_X_OUTPUT (f)->display_info) +#define FRAME_FOREGROUND_COLOR(f) (FRAME_X_OUTPUT (f)->foreground_color) +#define FRAME_BACKGROUND_COLOR(f) (FRAME_X_OUTPUT (f)->background_color) +#define FRAME_CURSOR_COLOR(f) (FRAME_X_OUTPUT (f)->cursor_color) +#define FRAME_POINTER_TYPE(f) (FRAME_X_OUTPUT (f)->current_pointer) +#define FRAME_FONT(f) (FRAME_X_OUTPUT (f)->font) +#define FRAME_GTK_OUTER_WIDGET(f) (FRAME_X_OUTPUT (f)->widget) +#define FRAME_GTK_WIDGET(f) (FRAME_X_OUTPUT (f)->edit_widget) +#define FRAME_WIDGET(f) (FRAME_GTK_OUTER_WIDGET (f) ? \ + FRAME_GTK_OUTER_WIDGET (f) : \ + FRAME_GTK_WIDGET (f)) + +/* aliases */ +#define FRAME_PGTK_VIEW(f) FRAME_GTK_WIDGET (f) +#define FRAME_X_WINDOW(f) FRAME_GTK_OUTER_WIDGET (f) +#define FRAME_NATIVE_WINDOW(f) GTK_WINDOW (FRAME_X_WINDOW (f)) + +#define FRAME_X_DISPLAY(f) (FRAME_DISPLAY_INFO (f)->gdpy) + +#define DEFAULT_GDK_DISPLAY() gdk_display_get_default () + +/* Turning a lisp vector value into a pointer to a struct scroll_bar. */ +#define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) + +#define FRAME_DEFAULT_FACE(f) FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID) +#define FRAME_MENUBAR_HEIGHT(f) (FRAME_X_OUTPUT (f)->menubar_height) +#define FRAME_TOOLBAR_TOP_HEIGHT(f) ((f)->output_data.pgtk->toolbar_top_height) +#define FRAME_TOOLBAR_BOTTOM_HEIGHT(f) \ + ((f)->output_data.pgtk->toolbar_bottom_height) +#define FRAME_TOOLBAR_HEIGHT(f) \ + (FRAME_TOOLBAR_TOP_HEIGHT (f) + FRAME_TOOLBAR_BOTTOM_HEIGHT (f)) +#define FRAME_TOOLBAR_LEFT_WIDTH(f) ((f)->output_data.pgtk->toolbar_left_width) +#define FRAME_TOOLBAR_RIGHT_WIDTH(f) ((f)->output_data.pgtk->toolbar_right_width) +#define FRAME_TOOLBAR_WIDTH(f) \ + (FRAME_TOOLBAR_LEFT_WIDTH (f) + FRAME_TOOLBAR_RIGHT_WIDTH (f)) + +#define FRAME_FONTSET(f) (FRAME_X_OUTPUT (f)->fontset) + +#define FRAME_BASELINE_OFFSET(f) (FRAME_X_OUTPUT (f)->baseline_offset) +#define BLACK_PIX_DEFAULT(f) 0x000000 +#define WHITE_PIX_DEFAULT(f) 0xFFFFFF + +/* First position where characters can be shown (instead of scrollbar, if + it is on left. */ +#define FIRST_CHAR_POSITION(f) \ + (! (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f)) ? 0 \ + : FRAME_SCROLL_BAR_COLS (f)) + +#define FRAME_CR_SURFACE_DESIRED_WIDTH(f) \ + ((f)->output_data.pgtk->cr_surface_desired_width) +#define FRAME_CR_SURFACE_DESIRED_HEIGHT(f) \ + ((f)->output_data.pgtk->cr_surface_desired_height) + +/* Display init/shutdown functions implemented in pgtkterm.c */ +extern struct pgtk_display_info *pgtk_term_init (Lisp_Object display_name, + char *resource_name); +extern void pgtk_term_shutdown (int sig); + +/* Implemented in pgtkterm, published in or needed from pgtkfns. */ +extern void pgtk_clear_frame (struct frame *f); +extern char *pgtk_xlfd_to_fontname (const char *xlfd); + +/* Implemented in pgtkfns. */ +extern void pgtk_set_doc_edited (void); +extern const char *pgtk_get_defaults_value (const char *key); +extern const char *pgtk_get_string_resource (XrmDatabase rdb, + const char *name, + const char *class); +extern void pgtk_implicitly_set_name (struct frame *f, Lisp_Object arg, + Lisp_Object oldval); + +/* Color management implemented in pgtkterm. */ +extern bool pgtk_defined_color (struct frame *f, + const char *name, + Emacs_Color * color_def, bool alloc, + bool makeIndex); +extern void pgtk_query_color (struct frame *f, Emacs_Color * color); +extern void pgtk_query_colors (struct frame *f, Emacs_Color * colors, + int ncolors); +extern int pgtk_parse_color (struct frame *f, const char *color_name, + Emacs_Color * color); + +/* Implemented in pgtkterm.c */ +extern void pgtk_clear_area (struct frame *f, int x, int y, int width, + int height); +extern int pgtk_gtk_to_emacs_modifiers (struct pgtk_display_info *dpyinfo, + int state); +extern void pgtk_clear_under_internal_border (struct frame *f); +extern void pgtk_set_event_handler (struct frame *f); + +/* Implemented in pgtkterm.c */ +extern int x_display_pixel_height (struct pgtk_display_info *); +extern int x_display_pixel_width (struct pgtk_display_info *); + +/* Implemented in pgtkterm.c */ +extern void x_destroy_window (struct frame *f); +extern void pgtk_set_parent_frame (struct frame *f, Lisp_Object, Lisp_Object); +extern void pgtk_set_no_focus_on_map (struct frame *, Lisp_Object, Lisp_Object); +extern void pgtk_set_no_accept_focus (struct frame *, Lisp_Object, Lisp_Object); +extern void pgtk_set_z_group (struct frame *, Lisp_Object, Lisp_Object); + +/* Cairo related functions implemented in pgtkterm.c */ +extern void pgtk_cr_update_surface_desired_size (struct frame *, int, int, bool); +extern cairo_t *pgtk_begin_cr_clip (struct frame *f); +extern void pgtk_end_cr_clip (struct frame *f); +extern void pgtk_set_cr_source_with_gc_foreground (struct frame *, Emacs_GC *, bool); +extern void pgtk_set_cr_source_with_gc_background (struct frame *, Emacs_GC *, bool); +extern void pgtk_set_cr_source_with_color (struct frame *, unsigned long, bool); +extern void pgtk_cr_draw_frame (cairo_t * cr, struct frame *f); +extern void pgtk_cr_destroy_frame_context (struct frame *f); +extern Lisp_Object pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type); + +/* Defined in pgtkmenu.c */ +extern Lisp_Object pgtk_popup_dialog (struct frame *f, Lisp_Object header, + Lisp_Object contents); +extern Lisp_Object pgtk_dialog_show (struct frame *f, Lisp_Object title, + Lisp_Object header, + const char **error_name); +extern void initialize_frame_menubar (struct frame *); + + +/* Symbol initializations implemented in each pgtk sources. */ +extern void syms_of_pgtkterm (void); +extern void syms_of_pgtkfns (void); +extern void syms_of_pgtkmenu (void); +extern void syms_of_pgtkselect (void); +extern void syms_of_pgtkim (void); + +/* Initialization and marking implemented in pgtkterm.c */ +extern void init_pgtkterm (void); +extern void mark_pgtkterm (void); +extern void pgtk_delete_terminal (struct terminal *terminal); + +extern void pgtk_make_frame_visible (struct frame *f); +extern void pgtk_make_frame_invisible (struct frame *f); +extern void x_wm_set_size_hint (struct frame *, long, bool); +extern void x_free_frame_resources (struct frame *); +extern void pgtk_iconify_frame (struct frame *f); +extern void pgtk_focus_frame (struct frame *f, bool noactivate); +extern void pgtk_set_scroll_bar_default_width (struct frame *f); +extern void pgtk_set_scroll_bar_default_height (struct frame *f); +extern Lisp_Object x_get_focus_frame (struct frame *frame); + +extern void pgtk_frame_rehighlight (struct pgtk_display_info *dpyinfo); + +extern void x_change_tab_bar_height (struct frame *, int); + +extern struct pgtk_display_info *check_pgtk_display_info (Lisp_Object object); + +extern void pgtk_default_font_parameter (struct frame *f, Lisp_Object parms); + +extern void pgtk_menu_set_in_use (bool in_use); + + +extern void pgtk_enqueue_string (struct frame *f, gchar * str); +extern void pgtk_enqueue_preedit (struct frame *f, Lisp_Object image_data); +extern void pgtk_im_focus_in (struct frame *f); +extern void pgtk_im_focus_out (struct frame *f); +extern bool pgtk_im_filter_keypress (struct frame *f, GdkEventKey * ev); +extern void pgtk_im_set_cursor_location (struct frame *f, int x, int y, + int width, int height); +extern void pgtk_im_init (struct pgtk_display_info *dpyinfo); +extern void pgtk_im_finish (struct pgtk_display_info *dpyinfo); + +extern bool xg_set_icon (struct frame *, Lisp_Object); +extern bool xg_set_icon_from_xpm_data (struct frame *f, const char **data); + +extern bool pgtk_text_icon (struct frame *f, const char *icon_name); + +extern double pgtk_frame_scale_factor (struct frame *); +extern int pgtk_emacs_to_gtk_modifiers (struct pgtk_display_info *, int); + +#endif /* HAVE_PGTK */ +#endif /* _PGTKTERM_H_ */ diff --git a/src/print.c b/src/print.c index 3a26e5665e5..4a68d15fe02 100644 --- a/src/print.c +++ b/src/print.c @@ -101,7 +101,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; struct buffer *old = current_buffer; \ ptrdiff_t old_point = -1, start_point = -1; \ ptrdiff_t old_point_byte = -1, start_point_byte = -1; \ - ptrdiff_t specpdl_count = SPECPDL_INDEX (); \ + specpdl_ref specpdl_count = SPECPDL_INDEX (); \ bool free_print_buffer = 0; \ bool multibyte \ = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \ @@ -556,7 +556,7 @@ write_string (const char *data, Lisp_Object printcharfun) void temp_output_buffer_setup (const char *bufname) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); register struct buffer *old = current_buffer; register Lisp_Object buf; @@ -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); @@ -669,7 +669,7 @@ a list, a buffer, a window, a frame, etc. A printed representation of an object is text which describes that object. */) (Lisp_Object object, Lisp_Object noescape) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_modification_hooks, Qt); @@ -1387,6 +1387,7 @@ static bool print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, char *buf) { + /* First do all the vectorlike types that have a readable syntax. */ switch (PSEUDOVECTOR_TYPE (XVECTOR (obj))) { case PVEC_BIGNUM: @@ -1398,77 +1399,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, strout (str, len, len, printcharfun); SAFE_FREE (); } - break; - - case PVEC_MARKER: - print_c_string ("#<marker ", printcharfun); - /* Do you think this is necessary? */ - if (XMARKER (obj)->insertion_type != 0) - print_c_string ("(moves after insertion) ", printcharfun); - if (! XMARKER (obj)->buffer) - print_c_string ("in no buffer", printcharfun); - else - { - int len = sprintf (buf, "at %"pD"d in ", marker_position (obj)); - strout (buf, len, len, printcharfun); - print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); - } - printchar ('>', printcharfun); - break; - - case PVEC_OVERLAY: - print_c_string ("#<overlay ", printcharfun); - if (! XMARKER (OVERLAY_START (obj))->buffer) - print_c_string ("in no buffer", printcharfun); - else - { - int len = sprintf (buf, "from %"pD"d to %"pD"d in ", - marker_position (OVERLAY_START (obj)), - marker_position (OVERLAY_END (obj))); - strout (buf, len, len, printcharfun); - print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), - printcharfun); - } - printchar ('>', printcharfun); - break; - - case PVEC_USER_PTR: - { - print_c_string ("#<user-ptr ", printcharfun); - int i = sprintf (buf, "ptr=%p finalizer=%p", - XUSER_PTR (obj)->p, - XUSER_PTR (obj)->finalizer); - strout (buf, i, i, printcharfun); - printchar ('>', printcharfun); - } - break; - - case PVEC_FINALIZER: - print_c_string ("#<finalizer", printcharfun); - if (NILP (XFINALIZER (obj)->function)) - print_c_string (" used", printcharfun); - printchar ('>', printcharfun); - break; - - case PVEC_MISC_PTR: - { - /* This shouldn't happen in normal usage, but let's - print it anyway for the benefit of the debugger. */ - int i = sprintf (buf, "#<ptr %p>", xmint_pointer (obj)); - strout (buf, i, i, printcharfun); - } - break; - - case PVEC_PROCESS: - if (escapeflag) - { - print_c_string ("#<process ", printcharfun); - print_string (XPROCESS (obj)->name, printcharfun); - printchar ('>', printcharfun); - } - else - print_string (XPROCESS (obj)->name, printcharfun); - break; + return true; case PVEC_BOOL_VECTOR: { @@ -1513,47 +1444,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_c_string (" ...", printcharfun); printchar ('\"', printcharfun); } - break; - - case PVEC_SUBR: - print_c_string ("#<subr ", printcharfun); - print_c_string (XSUBR (obj)->symbol_name, printcharfun); - printchar ('>', printcharfun); - break; - - case PVEC_XWIDGET: case PVEC_XWIDGET_VIEW: - print_c_string ("#<xwidget ", printcharfun); - printchar ('>', printcharfun); - break; - - case PVEC_WINDOW: - { - int len = sprintf (buf, "#<window %"pI"d", - XWINDOW (obj)->sequence_number); - strout (buf, len, len, printcharfun); - if (BUFFERP (XWINDOW (obj)->contents)) - { - print_c_string (" on ", printcharfun); - print_string (BVAR (XBUFFER (XWINDOW (obj)->contents), name), - printcharfun); - } - printchar ('>', printcharfun); - } - break; - - case PVEC_TERMINAL: - { - struct terminal *t = XTERMINAL (obj); - int len = sprintf (buf, "#<terminal %d", t->id); - strout (buf, len, len, printcharfun); - if (t->name) - { - print_c_string (" on ", printcharfun); - print_c_string (t->name, printcharfun); - } - printchar ('>', printcharfun); - } - break; + return true; case PVEC_HASH_TABLE: { @@ -1626,6 +1517,277 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_c_string ("))", printcharfun); } + return true; + + case PVEC_RECORD: + { + ptrdiff_t size = PVSIZE (obj); + + /* Don't print more elements than the specified maximum. */ + ptrdiff_t n + = (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size + ? XFIXNAT (Vprint_length) : size); + + print_c_string ("#s(", printcharfun); + for (ptrdiff_t i = 0; i < n; i ++) + { + if (i) printchar (' ', printcharfun); + print_object (AREF (obj, i), printcharfun, escapeflag); + } + if (n < size) + print_c_string (" ...", printcharfun); + printchar (')', printcharfun); + } + return true; + + case PVEC_SUB_CHAR_TABLE: + case PVEC_COMPILED: + case PVEC_CHAR_TABLE: + case PVEC_NORMAL_VECTOR: + { + ptrdiff_t size = ASIZE (obj); + if (COMPILEDP (obj)) + { + printchar ('#', printcharfun); + size &= PSEUDOVECTOR_SIZE_MASK; + } + if (CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)) + { + /* Print a char-table as if it were a vector, + lumping the parent and default slots in with the + character slots. But add #^ as a prefix. */ + + /* Make each lowest sub_char_table start a new line. + Otherwise we'll make a line extremely long, which + results in slow redisplay. */ + if (SUB_CHAR_TABLE_P (obj) + && XSUB_CHAR_TABLE (obj)->depth == 3) + printchar ('\n', printcharfun); + print_c_string ("#^", printcharfun); + if (SUB_CHAR_TABLE_P (obj)) + printchar ('^', printcharfun); + size &= PSEUDOVECTOR_SIZE_MASK; + } + if (size & PSEUDOVECTOR_FLAG) + return false; + + printchar ('[', printcharfun); + + int idx = SUB_CHAR_TABLE_P (obj) ? SUB_CHAR_TABLE_OFFSET : 0; + Lisp_Object tem; + ptrdiff_t real_size = size; + + /* For a sub char-table, print heading non-Lisp data first. */ + if (SUB_CHAR_TABLE_P (obj)) + { + int i = sprintf (buf, "%d %d", XSUB_CHAR_TABLE (obj)->depth, + XSUB_CHAR_TABLE (obj)->min_char); + strout (buf, i, i, printcharfun); + } + + /* Don't print more elements than the specified maximum. */ + if (FIXNATP (Vprint_length) + && XFIXNAT (Vprint_length) < size) + size = XFIXNAT (Vprint_length); + + for (int i = idx; i < size; i++) + { + if (i) printchar (' ', printcharfun); + tem = AREF (obj, i); + print_object (tem, printcharfun, escapeflag); + } + if (size < real_size) + print_c_string (" ...", printcharfun); + printchar (']', printcharfun); + } + return true; + + default: + break; + } + + /* Then do all the pseudovector types that don't have a readable + syntax. First check whether this is handled by + `print-unreadable-function'. */ + if (!NILP (Vprint_unreadable_function) + && FUNCTIONP (Vprint_unreadable_function)) + { + specpdl_ref count = SPECPDL_INDEX (); + /* Bind `print-unreadable-function' to nil to avoid accidental + infinite recursion in the function called. */ + Lisp_Object func = Vprint_unreadable_function; + specbind (Qprint_unreadable_function, Qnil); + Lisp_Object result = CALLN (Ffuncall, func, obj, + escapeflag? Qt: Qnil); + unbind_to (count, Qnil); + + if (!NILP (result)) + { + if (STRINGP (result)) + print_string (result, printcharfun); + /* It's handled, so stop processing here. */ + return true; + } + } + + /* Not handled; print unreadable object. */ + switch (PSEUDOVECTOR_TYPE (XVECTOR (obj))) + { + case PVEC_MARKER: + print_c_string ("#<marker ", printcharfun); + /* Do you think this is necessary? */ + if (XMARKER (obj)->insertion_type != 0) + print_c_string ("(moves after insertion) ", printcharfun); + if (! XMARKER (obj)->buffer) + print_c_string ("in no buffer", printcharfun); + else + { + int len = sprintf (buf, "at %"pD"d in ", marker_position (obj)); + strout (buf, len, len, printcharfun); + print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); + } + printchar ('>', printcharfun); + break; + + case PVEC_SYMBOL_WITH_POS: + { + struct Lisp_Symbol_With_Pos *sp = XSYMBOL_WITH_POS (obj); + if (print_symbols_bare) + print_object (sp->sym, printcharfun, escapeflag); + else + { + print_c_string ("#<symbol ", printcharfun); + if (BARE_SYMBOL_P (sp->sym)) + print_object (sp->sym, printcharfun, escapeflag); + else + print_c_string ("NOT A SYMBOL!!", printcharfun); + if (FIXNUMP (sp->pos)) + { + print_c_string (" at ", printcharfun); + print_object (sp->pos, printcharfun, escapeflag); + } + else + print_c_string (" NOT A POSITION!!", printcharfun); + printchar ('>', printcharfun); + } + } + break; + + case PVEC_OVERLAY: + print_c_string ("#<overlay ", printcharfun); + if (! XMARKER (OVERLAY_START (obj))->buffer) + print_c_string ("in no buffer", printcharfun); + else + { + int len = sprintf (buf, "from %"pD"d to %"pD"d in ", + marker_position (OVERLAY_START (obj)), + marker_position (OVERLAY_END (obj))); + strout (buf, len, len, printcharfun); + print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), + printcharfun); + } + printchar ('>', printcharfun); + break; + + case PVEC_USER_PTR: + { + print_c_string ("#<user-ptr ", printcharfun); + int i = sprintf (buf, "ptr=%p finalizer=%p", + XUSER_PTR (obj)->p, + XUSER_PTR (obj)->finalizer); + strout (buf, i, i, printcharfun); + printchar ('>', printcharfun); + } + break; + + case PVEC_FINALIZER: + print_c_string ("#<finalizer", printcharfun); + if (NILP (XFINALIZER (obj)->function)) + print_c_string (" used", printcharfun); + printchar ('>', printcharfun); + break; + + case PVEC_MISC_PTR: + { + /* This shouldn't happen in normal usage, but let's + print it anyway for the benefit of the debugger. */ + int i = sprintf (buf, "#<ptr %p>", xmint_pointer (obj)); + strout (buf, i, i, printcharfun); + } + break; + + case PVEC_PROCESS: + if (escapeflag) + { + print_c_string ("#<process ", printcharfun); + print_string (XPROCESS (obj)->name, printcharfun); + printchar ('>', printcharfun); + } + else + print_string (XPROCESS (obj)->name, printcharfun); + break; + + case PVEC_SUBR: + print_c_string ("#<subr ", printcharfun); + print_c_string (XSUBR (obj)->symbol_name, printcharfun); + printchar ('>', printcharfun); + break; + + case PVEC_XWIDGET: +#ifdef HAVE_XWIDGETS + { + if (NILP (XXWIDGET (obj)->buffer)) + print_c_string ("#<killed xwidget>", printcharfun); + else + { +#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; + + case PVEC_WINDOW: + { + int len = sprintf (buf, "#<window %"pI"d", + XWINDOW (obj)->sequence_number); + strout (buf, len, len, printcharfun); + if (BUFFERP (XWINDOW (obj)->contents)) + { + print_c_string (" on ", printcharfun); + print_string (BVAR (XBUFFER (XWINDOW (obj)->contents), name), + printcharfun); + } + printchar ('>', printcharfun); + } + break; + + case PVEC_TERMINAL: + { + struct terminal *t = XTERMINAL (obj); + int len = sprintf (buf, "#<terminal %d", t->id); + strout (buf, len, len, printcharfun); + if (t->name) + { + print_c_string (" on ", printcharfun); + print_c_string (t->name, printcharfun); + } + printchar ('>', printcharfun); + } break; case PVEC_BUFFER: @@ -1733,89 +1895,6 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, printchar ('>', printcharfun); break; - case PVEC_RECORD: - { - ptrdiff_t size = PVSIZE (obj); - - /* Don't print more elements than the specified maximum. */ - ptrdiff_t n - = (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size - ? XFIXNAT (Vprint_length) : size); - - print_c_string ("#s(", printcharfun); - for (ptrdiff_t i = 0; i < n; i ++) - { - if (i) printchar (' ', printcharfun); - print_object (AREF (obj, i), printcharfun, escapeflag); - } - if (n < size) - print_c_string (" ...", printcharfun); - printchar (')', printcharfun); - } - break; - - case PVEC_SUB_CHAR_TABLE: - case PVEC_COMPILED: - case PVEC_CHAR_TABLE: - case PVEC_NORMAL_VECTOR: - { - ptrdiff_t size = ASIZE (obj); - if (COMPILEDP (obj)) - { - printchar ('#', printcharfun); - size &= PSEUDOVECTOR_SIZE_MASK; - } - if (CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)) - { - /* Print a char-table as if it were a vector, - lumping the parent and default slots in with the - character slots. But add #^ as a prefix. */ - - /* Make each lowest sub_char_table start a new line. - Otherwise we'll make a line extremely long, which - results in slow redisplay. */ - if (SUB_CHAR_TABLE_P (obj) - && XSUB_CHAR_TABLE (obj)->depth == 3) - printchar ('\n', printcharfun); - print_c_string ("#^", printcharfun); - if (SUB_CHAR_TABLE_P (obj)) - printchar ('^', printcharfun); - size &= PSEUDOVECTOR_SIZE_MASK; - } - if (size & PSEUDOVECTOR_FLAG) - return false; - - printchar ('[', printcharfun); - - int idx = SUB_CHAR_TABLE_P (obj) ? SUB_CHAR_TABLE_OFFSET : 0; - Lisp_Object tem; - ptrdiff_t real_size = size; - - /* For a sub char-table, print heading non-Lisp data first. */ - if (SUB_CHAR_TABLE_P (obj)) - { - int i = sprintf (buf, "%d %d", XSUB_CHAR_TABLE (obj)->depth, - XSUB_CHAR_TABLE (obj)->min_char); - strout (buf, i, i, printcharfun); - } - - /* Don't print more elements than the specified maximum. */ - if (FIXNATP (Vprint_length) - && XFIXNAT (Vprint_length) < size) - size = XFIXNAT (Vprint_length); - - for (int i = idx; i < size; i++) - { - if (i) printchar (' ', printcharfun); - tem = AREF (obj, i); - print_object (tem, printcharfun, escapeflag); - } - if (size < real_size) - print_c_string (" ...", printcharfun); - printchar (']', printcharfun); - } - break; - #ifdef HAVE_MODULES case PVEC_MODULE_FUNCTION: { @@ -1857,6 +1936,22 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, } break; #endif + case PVEC_SQLITE: + { + print_c_string ("#<sqlite ", printcharfun); + int i = sprintf (buf, "db=%p", XSQLITE (obj)->db); + strout (buf, i, i, printcharfun); + if (XSQLITE (obj)->is_statement) + { + i = sprintf (buf, " stmt=%p", XSQLITE (obj)->stmt); + strout (buf, i, i, printcharfun); + } + i = sprintf (buf, " name=%s", XSQLITE (obj)->name); + strout (buf, i, i, printcharfun); + printchar ('>', printcharfun); + } + break; + default: emacs_abort (); } @@ -1903,7 +1998,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) error ("Apparently circular structure being printed"); for (i = 0; i < print_depth; i++) - if (EQ (obj, being_printed[i])) + if (BASE_EQ (obj, being_printed[i])) { int len = sprintf (buf, "#%d", i); strout (buf, len, len, printcharfun); @@ -1965,8 +2060,10 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } else { - int len = sprintf (buf, "%"pI"d", i); - strout (buf, len, len, printcharfun); + char *end = buf + sizeof buf; + char *start = fixnum_to_string (i, buf, end); + ptrdiff_t len = end - start; + strout (start, len, len, printcharfun); } } break; @@ -2076,14 +2173,19 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) Lisp_Object name = SYMBOL_NAME (obj); ptrdiff_t size_byte = SBYTES (name); - /* Set CONFUSING if NAME looks like a number, calling - string_to_number for non-obvious cases. */ char *p = SSDATA (name); bool signedp = *p == '-' || *p == '+'; ptrdiff_t len; - bool confusing = ((c_isdigit (p[signedp]) || p[signedp] == '.') - && !NILP (string_to_number (p, 10, &len)) - && len == size_byte); + bool confusing = + /* Set CONFUSING if NAME looks like a number, calling + string_to_number for non-obvious cases. */ + ((c_isdigit (p[signedp]) || p[signedp] == '.') + && !NILP (string_to_number (p, 10, &len)) + && len == size_byte) + /* We don't escape "." or "?" (unless they're the first + character in the symbol name). */ + || *p == '?' + || *p == '.'; if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj)) @@ -2106,8 +2208,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { if (c == '\"' || c == '\\' || c == '\'' || c == ';' || c == '#' || c == '(' || c == ')' - || c == ',' || c == '.' || c == '`' - || c == '[' || c == ']' || c == '?' || c <= 040 + || c == ',' || c == '`' + || c == '[' || c == ']' || c <= 040 || c == NO_BREAK_SPACE || confusing) { @@ -2407,6 +2509,13 @@ priorities. Values other than nil or t are also treated as `default'. */); Vprint_charset_text_property = Qdefault; + DEFVAR_BOOL ("print-symbols-bare", print_symbols_bare, + doc: /* A flag to control printing of symbols with position. +If the value is nil, print these objects complete with position. +Otherwise print just the bare symbol. */); + print_symbols_bare = false; + DEFSYM (Qprint_symbols_bare, "print-symbols-bare"); + /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ staticpro (&Vprin1_to_string_buffer); @@ -2425,4 +2534,19 @@ priorities. Values other than nil or t are also treated as print_prune_charset_plist = Qnil; staticpro (&print_prune_charset_plist); + + DEFVAR_LISP ("print-unreadable-function", Vprint_unreadable_function, + doc: /* If non-nil, a function to call when printing unreadable objects. +By default, Emacs printing functions (like `prin1') print unreadable +objects as \"#<...>\", where \"...\" describes the object (for +instance, \"#<marker in no buffer>\"). + +If non-nil, it should be a function that will be called with two +arguments: the object to be printed, and the NOESCAPE flag (see +`prin1-to-string'). If this function returns nil, the object will be +printed as usual. If it returns a string, that string will then be +printed. If the function returns anything else, the object will not +be printed. */); + Vprint_unreadable_function = Qnil; + DEFSYM (Qprint_unreadable_function, "print-unreadable-function"); } diff --git a/src/process.c b/src/process.c index 8b587aaa4e1..08a02ad9423 100644 --- a/src/process.c +++ b/src/process.c @@ -261,7 +261,7 @@ static bool process_output_skip; static void start_process_unwind (Lisp_Object); static void create_process (Lisp_Object, char **, Lisp_Object); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) static bool keyboard_bit_set (fd_set *); #endif static void deactivate_process (Lisp_Object); @@ -1752,7 +1752,7 @@ usage: (make-process &rest ARGS) */) { Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem; Lisp_Object xstderr, stderrproc; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (nargs == 0) return Qnil; @@ -2169,10 +2169,11 @@ 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 (); + specpdl_ref count = SPECPDL_INDEX (); /* This may signal an error. */ setup_process_coding_systems (process); @@ -2287,7 +2288,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)); } @@ -2338,7 +2340,6 @@ usage: (make-pipe-process &rest ARGS) */) struct Lisp_Process *p; Lisp_Object name, buffer; Lisp_Object tem; - ptrdiff_t specpdl_count; int inchannel, outchannel; if (nargs == 0) @@ -2349,7 +2350,7 @@ usage: (make-pipe-process &rest ARGS) */) name = Fplist_get (contact, QCname); CHECK_STRING (name); proc = make_process (name); - specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect (remove_process, proc); p = XPROCESS (proc); @@ -2396,7 +2397,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 @@ -2468,7 +2470,7 @@ usage: (make-pipe-process &rest ARGS) */) eassert (p->decoding_carryover == 0); pset_encoding_buf (p, empty_unibyte_string); - specpdl_ptr = specpdl + specpdl_count; + specpdl_ptr = specpdl_ref_to_ptr (specpdl_count); return proc; } @@ -3076,7 +3078,6 @@ usage: (make-serial-process &rest ARGS) */) struct Lisp_Process *p; Lisp_Object name, buffer; Lisp_Object tem, val; - ptrdiff_t specpdl_count; if (nargs == 0) return Qnil; @@ -3098,7 +3099,7 @@ usage: (make-serial-process &rest ARGS) */) name = port; CHECK_STRING (name); proc = make_process (name); - specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect (remove_process, proc); p = XPROCESS (proc); @@ -3131,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); @@ -3175,7 +3177,7 @@ usage: (make-serial-process &rest ARGS) */) Fserial_process_configure (nargs, args); - specpdl_ptr = specpdl + specpdl_count; + specpdl_ptr = specpdl_ref_to_ptr (specpdl_count); return proc; } @@ -3337,9 +3339,9 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, s = -1; struct sockaddr *sa = NULL; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_nothing (); - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); while (!NILP (addrinfos)) { @@ -3524,7 +3526,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, #endif /* !WINDOWSNT */ /* Discard the unwind protect closing S. */ - specpdl_ptr = specpdl + count1; + specpdl_ptr = specpdl_ref_to_ptr (count1); emacs_close (s); s = -1; if (0 <= socket_to_use) @@ -3595,7 +3597,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, { Lisp_Object data = get_file_errno_data (err, contact, xerrno); - pset_status (p, list2 (Fcar (data), Fcdr (data))); + pset_status (p, list2 (Qfailed, data)); unbind_to (count, Qnil); return; } @@ -3617,7 +3619,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, p->outfd = outch; /* Discard the unwind protect for closing S, if any. */ - specpdl_ptr = specpdl + count1; + specpdl_ptr = specpdl_ref_to_ptr (count1); if (p->is_server && p->socktype != SOCK_DGRAM) pset_status (p, Qlisten); @@ -3875,7 +3877,7 @@ usage: (make-network-process &rest ARGS) */) #ifdef HAVE_GETADDRINFO_A struct gaicb *dns_request = NULL; #endif - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (nargs == 0) return Qnil; @@ -4204,7 +4206,7 @@ usage: (make-network-process &rest ARGS) */) if (! postpone_connection) connect_network_socket (proc, addrinfos, use_external_socket_p); - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl_ref_to_ptr (count); return proc; } @@ -4376,7 +4378,6 @@ network_interface_info (Lisp_Object ifname) Lisp_Object elt; int s; bool any = false; - ptrdiff_t count; #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \ && defined HAVE_GETIFADDRS && defined LLADDR) struct ifaddrs *ifap; @@ -4391,7 +4392,7 @@ network_interface_info (Lisp_Object ifname) s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0); if (s < 0) return Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_int (close_file_unwind, s); elt = Qnil; @@ -4640,7 +4641,7 @@ error displays the error message. */) struct addrinfo hints; memset (&hints, 0, sizeof hints); - if (EQ (family, Qnil)) + if (NILP (family)) hints.ai_family = AF_UNSPEC; else if (EQ (family, Qipv4)) hints.ai_family = AF_INET; @@ -4835,7 +4836,6 @@ server_accept_connection (Lisp_Object server, int channel) int s; union u_sockaddr saddr; socklen_t len = sizeof saddr; - ptrdiff_t count; s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC); @@ -4857,7 +4857,7 @@ server_accept_connection (Lisp_Object server, int channel) return; } - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_int (close_file_unwind, s); connect_counter++; @@ -4976,7 +4976,7 @@ server_accept_connection (Lisp_Object server, int channel) eassert (p->pid == 0); /* Discard the unwind protect for closing S. */ - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl_ref_to_ptr (count); p->open_fd[SUBPROCESS_STDIN] = s; p->infd = s; @@ -5173,7 +5173,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS bool retry_for_async; #endif - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Close to the current time if known, an invalid timespec otherwise. */ struct timespec now = invalid_timespec (); @@ -5586,6 +5586,15 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, timeout = make_timespec (0, 0); #endif +#if !defined USABLE_SIGIO && !defined WINDOWSNT + /* If we're polling for input, don't get stuck in select for + more than 25 msec. */ + struct timespec short_timeout = make_timespec (0, 25000000); + if ((read_kbd || !NILP (wait_for_cell)) + && timespec_cmp (short_timeout, timeout) < 0) + timeout = short_timeout; +#endif + /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */ #if defined HAVE_GLIB && !defined HAVE_NS nfds = xg_select (max_desc + 1, @@ -5719,7 +5728,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) /* If we think we have keyboard input waiting, but didn't get SIGIO, go read it. This can happen with X on BSD after logging out. In that case, there really is no input and no SIGIO, @@ -5727,7 +5736,11 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (read_kbd && interrupt_input && keyboard_bit_set (&Available) && ! noninteractive) +#ifdef USABLE_SIGIO handle_input_available_signal (SIGIO); +#else + handle_input_available_signal (SIGPOLL); +#endif #endif /* If checking input just got us a size-change event from X, @@ -5979,7 +5992,8 @@ read_process_output_error_handler (Lisp_Object error_val) cmd_error_internal (error_val, "error in process filter: "); Vinhibit_quit = Qt; update_echo_area (); - Fsleep_for (make_fixnum (2), Qnil); + if (process_error_pause_time > 0) + Fsleep_for (make_fixnum (process_error_pause_time), Qnil); return Qt; } @@ -6009,7 +6023,7 @@ read_process_output (Lisp_Object proc, int channel) struct coding_system *coding = proc_decode_coding_system[channel]; int carryover = p->decoding_carryover; ptrdiff_t readmax = clip_to_bounds (1, read_process_output_max, PTRDIFF_MAX); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object odeactivate; char *chars; @@ -6225,7 +6239,6 @@ Otherwise it discards the output. */) { Lisp_Object old_read_only; ptrdiff_t old_begv, old_zv; - ptrdiff_t old_begv_byte, old_zv_byte; ptrdiff_t before, before_byte; ptrdiff_t opoint_byte; struct buffer *b; @@ -6236,8 +6249,6 @@ Otherwise it discards the output. */) old_read_only = BVAR (current_buffer, read_only); old_begv = BEGV; old_zv = ZV; - old_begv_byte = BEGV_BYTE; - old_zv_byte = ZV_BYTE; bset_read_only (current_buffer, Qnil); @@ -6285,15 +6296,9 @@ Otherwise it discards the output. */) opoint_byte += PT_BYTE - before_byte; } if (old_begv > before) - { - old_begv += PT - before; - old_begv_byte += PT_BYTE - before_byte; - } + old_begv += PT - before; if (old_zv >= before) - { - old_zv += PT - before; - old_zv_byte += PT_BYTE - before_byte; - } + old_zv += PT - before; /* If the restriction isn't what it should be, set it. */ if (old_begv != BEGV || old_zv != ZV) @@ -6406,7 +6411,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, if (p->raw_status_new) update_status (p); if (! EQ (p->status, Qrun)) - error ("Process %s not running", SDATA (p->name)); + error ("Process %s not running: %s", SDATA (p->name), SDATA (status_message (p))); if (p->outfd < 0) error ("Output file descriptor of %s is closed", SDATA (p->name)); @@ -6916,7 +6921,8 @@ the order of the list, until one of them returns non-nil. */) process, current_group); } -DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0, +DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, + "(list (read-process-name \"Kill process\"))", doc: /* Kill process PROCESS. May be process or name of one. See function `interrupt-process' for more details on usage. */) (Lisp_Object process, Lisp_Object current_group) @@ -7019,14 +7025,13 @@ abbr_to_signal (char const *name) return -1; } -DEFUN ("signal-process", Fsignal_process, Ssignal_process, - 2, 2, "sProcess (name or number): \nnSignal code: ", - doc: /* Send PROCESS the signal with code SIGCODE. -PROCESS may also be a number specifying the process id of the -process to signal; in this case, the process need not be a child of -this Emacs. -SIGCODE may be an integer, or a symbol whose name is a signal name. */) - (Lisp_Object process, Lisp_Object sigcode) +DEFUN ("internal-default-signal-process", + Finternal_default_signal_process, + Sinternal_default_signal_process, 2, 3, 0, + doc: /* Default function to send PROCESS the signal with code SIGCODE. +It shall be the last element in list `signal-process-functions'. +See function `signal-process' for more details on usage. */) + (Lisp_Object process, Lisp_Object sigcode, Lisp_Object remote) { pid_t pid; int signo; @@ -7076,6 +7081,23 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) return make_fixnum (kill (pid, signo)); } +DEFUN ("signal-process", Fsignal_process, Ssignal_process, + 2, 3, "sProcess (name or number): \nnSignal code: ", + doc: /* Send PROCESS the signal with code SIGCODE. +PROCESS may also be a number specifying the process id of the +process to signal; in this case, the process need not be a child of +this Emacs. +If PROCESS is a process object which contains the property +`remote-pid', or PROCESS is a number and REMOTE is a remote file name, +PROCESS is interpreted as process on the respective remote host, which +will be the process to signal. +SIGCODE may be an integer, or a symbol whose name is a signal name. */) + (Lisp_Object process, Lisp_Object sigcode, Lisp_Object remote) +{ + return CALLN (Frun_hook_with_args_until_success, Qsignal_process_functions, + process, sigcode, remote); +} + DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0, doc: /* Make PROCESS see end-of-file in its input. EOF comes after any text already sent to it. @@ -7110,7 +7132,7 @@ process has been transmitted to the serial port. */) if (XPROCESS (proc)->raw_status_new) update_status (XPROCESS (proc)); if (! EQ (XPROCESS (proc)->status, Qrun)) - error ("Process %s not running", SDATA (XPROCESS (proc)->name)); + error ("Process %s not running: %s", SDATA (XPROCESS (proc)->name), SDATA (status_message (XPROCESS (proc)))); if (coding && CODING_REQUIRE_FLUSHING (coding)) { @@ -7409,7 +7431,8 @@ exec_sentinel_error_handler (Lisp_Object error_val) cmd_error_internal (error_val, "error in process sentinel: "); Vinhibit_quit = Qt; update_echo_area (); - Fsleep_for (make_fixnum (2), Qnil); + if (process_error_pause_time > 0) + Fsleep_for (make_fixnum (process_error_pause_time), Qnil); return Qt; } @@ -7418,7 +7441,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) { Lisp_Object sentinel, odeactivate; struct Lisp_Process *p = XPROCESS (proc); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); bool outer_running_asynch_code = running_asynch_code; int waiting = waiting_for_user_input_p; @@ -7724,7 +7747,7 @@ delete_gpm_wait_descriptor (int desc) # endif -# ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) /* Return true if *MASK has a bit set that corresponds to one of the keyboard input descriptors. */ @@ -8171,16 +8194,25 @@ DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes, 0, 0, 0, doc: /* Return a list of numerical process IDs of all running processes. If this functionality is unsupported, return nil. +If `default-directory' is remote, return process IDs of the respective remote host. See `process-attributes' for getting attributes of a process given its ID. */) (void) { + Lisp_Object handler + = Ffind_file_name_handler (BVAR (current_buffer, directory), + Qlist_system_processes); + if (!NILP (handler)) + return call1 (handler, Qlist_system_processes); + return list_system_processes (); } DEFUN ("process-attributes", Fprocess_attributes, Sprocess_attributes, 1, 1, 0, doc: /* Return attributes of the process given by its PID, a number. +If `default-directory' is remote, PID is regarded as process +identifier on the respective remote host. Value is an alist where each element is a cons cell of the form @@ -8231,6 +8263,12 @@ integer or floating point values. args -- command line which invoked the process (string). */) ( Lisp_Object pid) { + Lisp_Object handler + = Ffind_file_name_handler (BVAR (current_buffer, directory), + Qprocess_attributes); + if (!NILP (handler)) + return call2 (handler, Qprocess_attributes, pid); + return system_process_attributes (pid); } @@ -8406,6 +8444,8 @@ void syms_of_process (void) { DEFSYM (Qmake_process, "make-process"); + DEFSYM (Qlist_system_processes, "list-system-processes"); + DEFSYM (Qprocess_attributes, "process-attributes"); #ifdef subprocesses @@ -8564,6 +8604,13 @@ These functions are called in the order of the list, until one of them returns non-nil. */); Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process); + DEFVAR_LISP ("signal-process-functions", Vsignal_process_functions, + doc: /* List of functions to be called for `signal-process'. +The arguments of the functions are the same as for `signal-process'. +These functions are called in the order of the list, until one of them +returns non-nil. */); + Vsignal_process_functions = list1 (Qinternal_default_signal_process); + DEFVAR_LISP ("internal--daemon-sockname", Vinternal__daemon_sockname, doc: /* Name of external socket passed to Emacs, or nil if none. */); Vinternal__daemon_sockname = Qnil; @@ -8574,10 +8621,20 @@ Enlarge the value only if the subprocess generates very large (megabytes) amounts of data in one go. */); read_process_output_max = 4096; + DEFVAR_INT ("process-error-pause-time", process_error_pause_time, + doc: /* The number of seconds to pause after handling process errors. +This isn't used for all process-related errors, but is used when a +sentinel or a process filter function has an error. */); + process_error_pause_time = 1; + DEFSYM (Qinternal_default_interrupt_process, "internal-default-interrupt-process"); DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions"); + DEFSYM (Qinternal_default_signal_process, + "internal-default-signal-process"); + DEFSYM (Qsignal_process_functions, "signal-process-functions"); + DEFSYM (Qnull, "null"); DEFSYM (Qpipe_process_p, "pipe-process-p"); @@ -8632,6 +8689,7 @@ amounts of data in one go. */); defsubr (&Scontinue_process); defsubr (&Sprocess_running_child_p); defsubr (&Sprocess_send_eof); + defsubr (&Sinternal_default_signal_process); defsubr (&Ssignal_process); defsubr (&Swaiting_for_user_input_p); defsubr (&Sprocess_type); diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 7c172fe63a2..700a6c357de 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -3963,7 +3963,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, INIT_FAIL_STACK (); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Prevent shrinking and relocation of buffer text if GC happens while we are inside this function. The calls to diff --git a/src/search.c b/src/search.c index 88ee584504f..816a757c188 100644 --- a/src/search.c +++ b/src/search.c @@ -260,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; @@ -278,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, @@ -310,13 +310,13 @@ looking_at_1 (Lisp_Object string, bool posix) s2 = 0; } - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); freeze_buffer_relocation (); freeze_pattern (cache_entry); 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) @@ -326,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) @@ -343,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 (); @@ -400,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, @@ -410,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) { @@ -434,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, @@ -558,7 +568,7 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, struct regexp_cache *cache_entry = compile_pattern (regexp, 0, Qnil, 0, multibyte); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); freeze_buffer_relocation (); freeze_pattern (cache_entry); re_match_object = STRINGP (string) ? string : Qnil; @@ -1188,7 +1198,7 @@ search_buffer_re (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, s2 = 0; } - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); freeze_buffer_relocation (); freeze_pattern (cache_entry); @@ -2817,6 +2827,14 @@ All the elements are markers or nil (nil if the Nth pair didn't match) if the last match was on a buffer; integers or nil if a string was matched. Use `set-match-data' to reinstate the data in this list. +Note that non-matching optional groups at the end of the regexp are +elided instead of being represented with two `nil's each. For instance: + + (progn + (string-match "^\\(a\\)?\\(b\\)\\(c\\)?$" "b") + (match-data)) + => (0 1 nil nil 0 1) + If INTEGERS (the optional first argument) is non-nil, always use integers (rather than markers) to represent buffer positions. In this case, and if the last match was in a buffer, the buffer will get diff --git a/src/sort.c b/src/sort.c new file mode 100644 index 00000000000..c7ccfc23055 --- /dev/null +++ b/src/sort.c @@ -0,0 +1,974 @@ +/* Timsort for sequences. + +Copyright (C) 2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +/* This is a version of the cpython code implementing the TIMSORT + sorting algorithm described in + https://github.com/python/cpython/blob/main/Objects/listsort.txt. + This algorithm identifies and pushes naturally ordered sublists of + the original list, or "runs", onto a stack, and merges them + periodically according to a merge strategy called "powersort". + State is maintained during the sort in a merge_state structure, + which is passed around as an argument to all the subroutines. A + "stretch" structure includes a pointer to the run BASE of length + LEN along with its POWER (a computed integer used by the powersort + merge strategy that depends on this run and the succeeding run.) */ + + +#include <config.h> +#include "lisp.h" + + +/* MAX_MERGE_PENDING is the maximum number of entries in merge_state's + pending-stretch stack. For a list with n elements, this needs at most + floor(log2(n)) + 1 entries even if we didn't force runs to a + minimal length. So the number of bits in a ptrdiff_t is plenty large + enough for all cases. */ + +#define MAX_MERGE_PENDING (sizeof (ptrdiff_t) * 8) + +/* Once we get into galloping mode, we stay there as long as both runs + win at least GALLOP_WIN_MIN consecutive times. */ + +#define GALLOP_WIN_MIN 7 + +/* A small temp array of size MERGESTATE_TEMP_SIZE is used to avoid + malloc when merging small lists. */ + +#define MERGESTATE_TEMP_SIZE 256 + +struct stretch +{ + Lisp_Object *base; + ptrdiff_t len; + int power; +}; + +struct reloc +{ + Lisp_Object **src; + Lisp_Object **dst; + ptrdiff_t *size; + int order; /* -1 while in merge_lo; +1 while in merg_hi; 0 otherwise. */ +}; + + +typedef struct +{ + Lisp_Object *listbase; + ptrdiff_t listlen; + + /* PENDING is a stack of N pending stretches yet to be merged. + Stretch #i starts at address base[i] and extends for len[i] + elements. */ + + int n; + struct stretch pending[MAX_MERGE_PENDING]; + + /* The variable MIN_GALLOP, initialized to GALLOP_WIN_MIN, controls + when we get *into* galloping mode. merge_lo and merge_hi tend to + nudge it higher for random data, and lower for highly structured + data. */ + + ptrdiff_t min_gallop; + + /* 'A' is temporary storage, able to hold ALLOCED elements, to help + with merges. 'A' initially points to TEMPARRAY, and subsequently + to newly allocated memory if needed. */ + + Lisp_Object *a; + ptrdiff_t alloced; + specpdl_ref count; + Lisp_Object temparray[MERGESTATE_TEMP_SIZE]; + + /* If an exception is thrown while merging we might have to relocate + some list elements from temporary storage back into the list. + RELOC keeps track of the information needed to do this. */ + + struct reloc reloc; + + /* PREDICATE is the lisp comparison predicate for the sort. */ + + Lisp_Object predicate; +} merge_state; + + +/* Return true iff (PREDICATE A B) is non-nil. */ + +static inline bool +inorder (const Lisp_Object predicate, const Lisp_Object a, const Lisp_Object b) +{ + return !NILP (call2 (predicate, a, b)); +} + + +/* Sort the list starting at LO and ending at HI using a stable binary + insertion sort algorithm. On entry the sublist [LO, START) (with + START between LO and HIGH) is known to be sorted (pass START == LO + if you are unsure). Even in case of error, the output will be some + permutation of the input (nothing is lost or duplicated). */ + +static void +binarysort (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi, + Lisp_Object *start) +{ + Lisp_Object pred = ms->predicate; + + eassume (lo <= start && start <= hi); + if (lo == start) + ++start; + for (; start < hi; ++start) + { + Lisp_Object *l = lo; + Lisp_Object *r = start; + Lisp_Object pivot = *r; + + eassume (l < r); + do { + Lisp_Object *p = l + ((r - l) >> 1); + if (inorder (pred, pivot, *p)) + r = p; + else + l = p + 1; + } while (l < r); + eassume (l == r); + for (Lisp_Object *p = start; p > l; --p) + p[0] = p[-1]; + *l = pivot; + } +} + + +/* Find and return the length of the "run" (the longest + non-decreasing sequence or the longest strictly decreasing + sequence, with the Boolean *DESCENDING set to 0 in the former + case, or to 1 in the latter) beginning at LO, in the slice [LO, + HI) with LO < HI. The strictness of the definition of + "descending" ensures there are no equal elements to get out of + order so the caller can safely reverse a descending sequence + without violating stability. */ + +static ptrdiff_t +count_run (merge_state *ms, Lisp_Object *lo, const Lisp_Object *hi, + bool *descending) +{ + Lisp_Object pred = ms->predicate; + + eassume (lo < hi); + *descending = 0; + ++lo; + ptrdiff_t n = 1; + if (lo == hi) + return n; + + n = 2; + if (inorder (pred, lo[0], lo[-1])) + { + *descending = 1; + for (lo = lo + 1; lo < hi; ++lo, ++n) + { + if (!inorder (pred, lo[0], lo[-1])) + break; + } + } + else + { + for (lo = lo + 1; lo < hi; ++lo, ++n) + { + if (inorder (pred, lo[0], lo[-1])) + break; + } + } + + return n; +} + + +/* Locate and return the proper insertion position of KEY in a sorted + vector: if the vector contains an element equal to KEY, return the + position immediately to the left of the leftmost equal element. + [GALLOP_RIGHT does the same except it returns the position to the + right of the rightmost equal element (if any).] + + 'A' is a sorted vector of N elements. N must be > 0. + + Elements preceding HINT, a non-negative index less than N, are + skipped. The closer HINT is to the final result, the faster this + runs. + + The return value is the int k in [0, N] such that + + A[k-1] < KEY <= a[k] + + pretending that *(A-1) precedes all values and *(A+N) succeeds all + values. In other words, the first k elements of A should precede + KEY, and the last N-k should follow KEY. */ + +static ptrdiff_t +gallop_left (merge_state *ms, const Lisp_Object key, Lisp_Object *a, + const ptrdiff_t n, const ptrdiff_t hint) +{ + Lisp_Object pred = ms->predicate; + + eassume (a && n > 0 && hint >= 0 && hint < n); + + a += hint; + ptrdiff_t lastofs = 0; + ptrdiff_t ofs = 1; + if (inorder (pred, *a, key)) + { + /* When a[hint] < key, gallop right until + a[hint + lastofs] < key <= a[hint + ofs]. */ + const ptrdiff_t maxofs = n - hint; /* This is one after the end of a. */ + while (ofs < maxofs) + { + if (inorder (pred, a[ofs], key)) + { + lastofs = ofs; + eassume (ofs <= (PTRDIFF_MAX - 1) / 2); + ofs = (ofs << 1) + 1; + } + else + break; /* Here key <= a[hint+ofs]. */ + } + if (ofs > maxofs) + ofs = maxofs; + /* Translate back to offsets relative to &a[0]. */ + lastofs += hint; + ofs += hint; + } + else + { + /* When key <= a[hint], gallop left, until + a[hint - ofs] < key <= a[hint - lastofs]. */ + const ptrdiff_t maxofs = hint + 1; /* Here &a[0] is lowest. */ + while (ofs < maxofs) + { + if (inorder (pred, a[-ofs], key)) + break; + /* Here key <= a[hint - ofs]. */ + lastofs = ofs; + eassume (ofs <= (PTRDIFF_MAX - 1) / 2); + ofs = (ofs << 1) + 1; + } + if (ofs > maxofs) + ofs = maxofs; + /* Translate back to use positive offsets relative to &a[0]. */ + ptrdiff_t k = lastofs; + lastofs = hint - ofs; + ofs = hint - k; + } + a -= hint; + + eassume (-1 <= lastofs && lastofs < ofs && ofs <= n); + /* Now a[lastofs] < key <= a[ofs], so key belongs somewhere to the + right of lastofs but no farther right than ofs. Do a binary + search, with invariant a[lastofs-1] < key <= a[ofs]. */ + ++lastofs; + while (lastofs < ofs) + { + ptrdiff_t m = lastofs + ((ofs - lastofs) >> 1); + + if (inorder (pred, a[m], key)) + lastofs = m + 1; /* Here a[m] < key. */ + else + ofs = m; /* Here key <= a[m]. */ + } + eassume (lastofs == ofs); /* Then a[ofs-1] < key <= a[ofs]. */ + return ofs; +} + + +/* Locate and return the proper position of KEY in a sorted vector + exactly like GALLOP_LEFT, except that if KEY already exists in + A[0:N] find the position immediately to the right of the rightmost + equal value. + + The return value is the int k in [0, N] such that + + A[k-1] <= KEY < A[k]. */ + +static ptrdiff_t +gallop_right (merge_state *ms, const Lisp_Object key, Lisp_Object *a, + const ptrdiff_t n, const ptrdiff_t hint) +{ + Lisp_Object pred = ms->predicate; + + eassume (a && n > 0 && hint >= 0 && hint < n); + + a += hint; + ptrdiff_t lastofs = 0; + ptrdiff_t ofs = 1; + if (inorder (pred, key, *a)) + { + /* When key < a[hint], gallop left until + a[hint - ofs] <= key < a[hint - lastofs]. */ + const ptrdiff_t maxofs = hint + 1; /* Here &a[0] is lowest. */ + while (ofs < maxofs) + { + if (inorder (pred, key, a[-ofs])) + { + lastofs = ofs; + eassume (ofs <= (PTRDIFF_MAX - 1) / 2); + ofs = (ofs << 1) + 1; + } + else /* Here a[hint - ofs] <= key. */ + break; + } + if (ofs > maxofs) + ofs = maxofs; + /* Translate back to use positive offsets relative to &a[0]. */ + ptrdiff_t k = lastofs; + lastofs = hint - ofs; + ofs = hint - k; + } + else + { + /* When a[hint] <= key, gallop right, until + a[hint + lastofs] <= key < a[hint + ofs]. */ + const ptrdiff_t maxofs = n - hint; /* Here &a[n-1] is highest. */ + while (ofs < maxofs) + { + if (inorder (pred, key, a[ofs])) + break; + /* Here a[hint + ofs] <= key. */ + lastofs = ofs; + eassume (ofs <= (PTRDIFF_MAX - 1) / 2); + ofs = (ofs << 1) + 1; + } + if (ofs > maxofs) + ofs = maxofs; + /* Translate back to use offsets relative to &a[0]. */ + lastofs += hint; + ofs += hint; + } + a -= hint; + + eassume (-1 <= lastofs && lastofs < ofs && ofs <= n); + /* Now a[lastofs] <= key < a[ofs], so key belongs somewhere to the + right of lastofs but no farther right than ofs. Do a binary + search, with invariant a[lastofs-1] <= key < a[ofs]. */ + ++lastofs; + while (lastofs < ofs) + { + ptrdiff_t m = lastofs + ((ofs - lastofs) >> 1); + + if (inorder (pred, key, a[m])) + ofs = m; /* Here key < a[m]. */ + else + lastofs = m + 1; /* Here a[m] <= key. */ + } + eassume (lastofs == ofs); /* Now a[ofs-1] <= key < a[ofs]. */ + return ofs; +} + + +static void +merge_init (merge_state *ms, const ptrdiff_t list_size, Lisp_Object *lo, + const Lisp_Object predicate) +{ + eassume (ms != NULL); + + ms->a = ms->temparray; + ms->alloced = MERGESTATE_TEMP_SIZE; + + ms->n = 0; + ms->min_gallop = GALLOP_WIN_MIN; + ms->listlen = list_size; + ms->listbase = lo; + ms->predicate = predicate; + ms->reloc = (struct reloc){NULL, NULL, NULL, 0}; +} + + +/* The dynamically allocated memory may hold lisp objects during + merging. MERGE_MARKMEM marks them so they aren't reaped during + GC. */ + +static void +merge_markmem (void *arg) +{ + merge_state *ms = arg; + eassume (ms != NULL); + + if (ms->reloc.size != NULL && *ms->reloc.size > 0) + { + eassume (ms->reloc.src != NULL); + mark_objects (*ms->reloc.src, *ms->reloc.size); + } +} + + +/* Free all temp storage. If an exception occurs while merging, + relocate any lisp elements in temp storage back to the original + array. */ + +static void +cleanup_mem (void *arg) +{ + merge_state *ms = arg; + eassume (ms != NULL); + + /* If we have an exception while merging, some of the list elements + might only live in temp storage; we copy everything remaining in + the temp storage back into the original list. This ensures that + the original list has all of the original elements, although + their order is unpredictable. */ + + if (ms->reloc.order != 0 && *ms->reloc.size > 0) + { + eassume (*ms->reloc.src != NULL && *ms->reloc.dst != NULL); + ptrdiff_t n = *ms->reloc.size; + ptrdiff_t shift = ms->reloc.order == -1 ? 0 : n - 1; + memcpy (*ms->reloc.dst - shift, *ms->reloc.src, n * word_size); + } + + /* Free any remaining temp storage. */ + xfree (ms->a); +} + + +/* Allocate enough temp memory for NEED array slots. Any previously + allocated memory is first freed, and a cleanup routine is + registered to free memory at the very end of the sort, or on + exception. */ + +static void +merge_getmem (merge_state *ms, const ptrdiff_t need) +{ + eassume (ms != NULL); + + if (ms->a == ms->temparray) + { + /* We only get here if alloc is needed and this is the first + time, so we set up the unwind protection. */ + specpdl_ref count = SPECPDL_INDEX (); + record_unwind_protect_ptr_mark (cleanup_mem, ms, merge_markmem); + ms->count = count; + } + else + { + /* We have previously alloced storage. Since we don't care + what's in the block we don't use realloc which would waste + cycles copying the old data. We just free and alloc + again. */ + xfree (ms->a); + } + ms->a = xmalloc (need * word_size); + ms->alloced = need; +} + + +static inline void +needmem (merge_state *ms, ptrdiff_t na) +{ + if (na > ms->alloced) + merge_getmem (ms, na); +} + + +/* Stably merge (in-place) the NA elements starting at SSA with the NB + elements starting at SSB = SSA + NA. NA and NB must be positive. + Require that SSA[NA-1] belongs at the end of the merge, and NA <= + NB. */ + +static void +merge_lo (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, Lisp_Object *ssb, + ptrdiff_t nb) +{ + Lisp_Object pred = ms->predicate; + + eassume (ms && ssa && ssb && na > 0 && nb > 0); + eassume (ssa + na == ssb); + needmem (ms, na); + memcpy (ms->a, ssa, na * word_size); + Lisp_Object *dest = ssa; + ssa = ms->a; + + ms->reloc = (struct reloc){&ssa, &dest, &na, -1}; + + *dest++ = *ssb++; + --nb; + if (nb == 0) + goto Succeed; + if (na == 1) + goto CopyB; + + ptrdiff_t min_gallop = ms->min_gallop; + for (;;) + { + ptrdiff_t acount = 0; /* The # of consecutive times A won. */ + + ptrdiff_t bcount = 0; /* The # of consecutive times B won. */ + + for (;;) + { + eassume (na > 1 && nb > 0); + if (inorder (pred, *ssb, *ssa)) + { + *dest++ = *ssb++ ; + ++bcount; + acount = 0; + --nb; + if (nb == 0) + goto Succeed; + if (bcount >= min_gallop) + break; + } + else + { + *dest++ = *ssa++; + ++acount; + bcount = 0; + --na; + if (na == 1) + goto CopyB; + if (acount >= min_gallop) + break; + } + } + + /* One run is winning so consistently that galloping may be a + huge speedup. We try that, and continue galloping until (if + ever) neither run appears to be winning consistently + anymore. */ + ++min_gallop; + do { + eassume (na > 1 && nb > 0); + min_gallop -= min_gallop > 1; + ms->min_gallop = min_gallop; + ptrdiff_t k = gallop_right (ms, ssb[0], ssa, na, 0); + acount = k; + if (k) + { + memcpy (dest, ssa, k * word_size); + dest += k; + ssa += k; + na -= k; + if (na == 1) + goto CopyB; + /* While na==0 is impossible for a consistent comparison + function, we shouldn't assume that it is. */ + if (na == 0) + goto Succeed; + } + *dest++ = *ssb++ ; + --nb; + if (nb == 0) + goto Succeed; + + k = gallop_left (ms, ssa[0], ssb, nb, 0); + bcount = k; + if (k) + { + memmove (dest, ssb, k * word_size); + dest += k; + ssb += k; + nb -= k; + if (nb == 0) + goto Succeed; + } + *dest++ = *ssa++; + --na; + if (na == 1) + goto CopyB; + } while (acount >= GALLOP_WIN_MIN || bcount >= GALLOP_WIN_MIN); + ++min_gallop; /* Apply a penalty for leaving galloping mode. */ + ms->min_gallop = min_gallop; + } + Succeed: + ms->reloc = (struct reloc){NULL, NULL, NULL, 0}; + + if (na) + memcpy (dest, ssa, na * word_size); + return; + CopyB: + eassume (na == 1 && nb > 0); + ms->reloc = (struct reloc){NULL, NULL, NULL, 0}; + + /* The last element of ssa belongs at the end of the merge. */ + memmove (dest, ssb, nb * word_size); + dest[nb] = ssa[0]; +} + + +/* Stably merge (in-place) the NA elements starting at SSA with the NB + elements starting at SSB = SSA + NA. NA and NB must be positive. + Require that SSA[NA-1] belongs at the end of the merge, and NA >= + NB. */ + +static void +merge_hi (merge_state *ms, Lisp_Object *ssa, ptrdiff_t na, + Lisp_Object *ssb, ptrdiff_t nb) +{ + Lisp_Object pred = ms->predicate; + + eassume (ms && ssa && ssb && na > 0 && nb > 0); + eassume (ssa + na == ssb); + needmem (ms, nb); + Lisp_Object *dest = ssb; + dest += nb - 1; + memcpy(ms->a, ssb, nb * word_size); + Lisp_Object *basea = ssa; + Lisp_Object *baseb = ms->a; + ssb = ms->a + nb - 1; + ssa += na - 1; + + ms->reloc = (struct reloc){&baseb, &dest, &nb, 1}; + + *dest-- = *ssa--; + --na; + if (na == 0) + goto Succeed; + if (nb == 1) + goto CopyA; + + ptrdiff_t min_gallop = ms->min_gallop; + for (;;) { + ptrdiff_t acount = 0; /* The # of consecutive times A won. */ + ptrdiff_t bcount = 0; /* The # of consecutive times B won. */ + + for (;;) { + eassume (na > 0 && nb > 1); + if (inorder (pred, *ssb, *ssa)) + { + *dest-- = *ssa--; + ++acount; + bcount = 0; + --na; + if (na == 0) + goto Succeed; + if (acount >= min_gallop) + break; + } + else + { + *dest-- = *ssb--; + ++bcount; + acount = 0; + --nb; + if (nb == 1) + goto CopyA; + if (bcount >= min_gallop) + break; + } + } + + /* One run is winning so consistently that galloping may be a huge + speedup. Try that, and continue galloping until (if ever) + neither run appears to be winning consistently anymore. */ + ++min_gallop; + do { + eassume (na > 0 && nb > 1); + min_gallop -= min_gallop > 1; + ms->min_gallop = min_gallop; + ptrdiff_t k = gallop_right (ms, ssb[0], basea, na, na - 1); + k = na - k; + acount = k; + if (k) + { + dest += -k; + ssa += -k; + memmove(dest + 1, ssa + 1, k * word_size); + na -= k; + if (na == 0) + goto Succeed; + } + *dest-- = *ssb--; + --nb; + if (nb == 1) + goto CopyA; + + k = gallop_left (ms, ssa[0], baseb, nb, nb - 1); + k = nb - k; + bcount = k; + if (k) + { + dest += -k; + ssb += -k; + memcpy(dest + 1, ssb + 1, k * word_size); + nb -= k; + if (nb == 1) + goto CopyA; + /* While nb==0 is impossible for a consistent comparison + function we shouldn't assume that it is. */ + if (nb == 0) + goto Succeed; + } + *dest-- = *ssa--; + --na; + if (na == 0) + goto Succeed; + } while (acount >= GALLOP_WIN_MIN || bcount >= GALLOP_WIN_MIN); + ++min_gallop; /* Apply a penalty for leaving galloping mode. */ + ms->min_gallop = min_gallop; + } + Succeed: + ms->reloc = (struct reloc){NULL, NULL, NULL, 0}; + if (nb) + memcpy (dest - nb + 1, baseb, nb * word_size); + return; + CopyA: + eassume (nb == 1 && na > 0); + ms->reloc = (struct reloc){NULL, NULL, NULL, 0}; + /* The first element of ssb belongs at the front of the merge. */ + memmove (dest + 1 - na, ssa + 1 - na, na * word_size); + dest += -na; + ssa += -na; + dest[0] = ssb[0]; +} + + +/* Merge the two runs at stack indices I and I+1. */ + +static void +merge_at (merge_state *ms, const ptrdiff_t i) +{ + eassume (ms != NULL); + eassume (ms->n >= 2); + eassume (i >= 0); + eassume (i == ms->n - 2 || i == ms->n - 3); + + Lisp_Object *ssa = ms->pending[i].base; + ptrdiff_t na = ms->pending[i].len; + Lisp_Object *ssb = ms->pending[i + 1].base; + ptrdiff_t nb = ms->pending[i + 1].len; + eassume (na > 0 && nb > 0); + eassume (ssa + na == ssb); + + /* Record the length of the combined runs. The current run i+1 goes + away after the merge. If i is the 3rd-last run now, slide the + last run (which isn't involved in this merge) over to i+1. */ + ms->pending[i].len = na + nb; + if (i == ms->n - 3) + ms->pending[i + 1] = ms->pending[i + 2]; + --ms->n; + + /* Where does b start in a? Elements in a before that can be + ignored (they are already in place). */ + ptrdiff_t k = gallop_right (ms, *ssb, ssa, na, 0); + eassume (k >= 0); + ssa += k; + na -= k; + if (na == 0) + return; + + /* Where does a end in b? Elements in b after that can be ignored + (they are already in place). */ + nb = gallop_left (ms, ssa[na - 1], ssb, nb, nb - 1); + if (nb == 0) + return; + eassume (nb > 0); + /* Merge what remains of the runs using a temp array with size + min(na, nb) elements. */ + if (na <= nb) + merge_lo (ms, ssa, na, ssb, nb); + else + merge_hi (ms, ssa, na, ssb, nb); +} + + +/* Compute the "power" of the first of two adjacent runs begining at + index S1, with the first having length N1 and the second (starting + at index S1+N1) having length N2. The run has total length N. */ + +static int +powerloop (const ptrdiff_t s1, const ptrdiff_t n1, const ptrdiff_t n2, + const ptrdiff_t n) +{ + eassume (s1 >= 0); + eassume (n1 > 0 && n2 > 0); + eassume (s1 + n1 + n2 <= n); + /* The midpoints a and b are + a = s1 + n1/2 + b = s1 + n1 + n2/2 = a + (n1 + n2)/2 + + These may not be integers because of the "/2", so we work with + 2*a and 2*b instead. It makes no difference to the outcome, + since the bits in the expansion of (2*i)/n are merely shifted one + position from those of i/n. */ + ptrdiff_t a = 2 * s1 + n1; + ptrdiff_t b = a + n1 + n2; + int result = 0; + /* Emulate a/n and b/n one bit a time, until their bits differ. */ + for (;;) + { + ++result; + if (a >= n) + { /* Both quotient bits are now 1. */ + eassume (b >= a); + a -= n; + b -= n; + } + else if (b >= n) + { /* a/n bit is 0 and b/n bit is 1. */ + break; + } /* Otherwise both quotient bits are 0. */ + eassume (a < b && b < n); + a <<= 1; + b <<= 1; + } + return result; +} + + +/* Update the state upon identifying a run of length N2. If there's + already a stretch on the stack, apply the "powersort" merge + strategy: compute the topmost stretch's "power" (depth in a + conceptual binary merge tree) and merge adjacent runs on the stack + with greater power. */ + +static void +found_new_run (merge_state *ms, const ptrdiff_t n2) +{ + eassume (ms != NULL); + if (ms->n) + { + eassume (ms->n > 0); + struct stretch *p = ms->pending; + ptrdiff_t s1 = p[ms->n - 1].base - ms->listbase; + ptrdiff_t n1 = p[ms->n - 1].len; + int power = powerloop (s1, n1, n2, ms->listlen); + while (ms->n > 1 && p[ms->n - 2].power > power) + { + merge_at (ms, ms->n - 2); + } + eassume (ms->n < 2 || p[ms->n - 2].power < power); + p[ms->n - 1].power = power; + } +} + + +/* Unconditionally merge all stretches on the stack until only one + remains. */ + +static void +merge_force_collapse (merge_state *ms) +{ + struct stretch *p = ms->pending; + + eassume (ms != NULL); + while (ms->n > 1) + { + ptrdiff_t n = ms->n - 2; + if (n > 0 && p[n - 1].len < p[n + 1].len) + --n; + merge_at (ms, n); + } +} + + +/* Compute a good value for the minimum run length; natural runs + shorter than this are boosted artificially via binary insertion. + + If N < 64, return N (it's too small to bother with fancy stuff). + Otherwise if N is an exact power of 2, return 32. Finally, return + an int k, 32 <= k <= 64, such that N/k is close to, but strictly + less than, an exact power of 2. */ + +static ptrdiff_t +merge_compute_minrun (ptrdiff_t n) +{ + ptrdiff_t r = 0; /* r will become 1 if any non-zero bits are + shifted off. */ + + eassume (n >= 0); + while (n >= 64) + { + r |= n & 1; + n >>= 1; + } + return n + r; +} + + +static void +reverse_vector (Lisp_Object *s, const ptrdiff_t n) +{ + for (ptrdiff_t i = 0; i < n >> 1; i++) + { + Lisp_Object tem = s[i]; + s[i] = s[n - i - 1]; + s[n - i - 1] = tem; + } +} + +/* Sort the array SEQ with LENGTH elements in the order determined by + PREDICATE. */ + +void +tim_sort (Lisp_Object predicate, Lisp_Object *seq, const ptrdiff_t length) +{ + if (SYMBOLP (predicate)) + { + /* Attempt to resolve the function as far as possible ahead of time, + to avoid having to do it for each call. */ + Lisp_Object fun = XSYMBOL (predicate)->u.s.function; + if (SYMBOLP (fun)) + /* Function was an alias; use slow-path resolution. */ + fun = indirect_function (fun); + /* Don't resolve to an autoload spec; that would be very slow. */ + if (!NILP (fun) && !(CONSP (fun) && EQ (XCAR (fun), Qautoload))) + predicate = fun; + } + + merge_state ms; + Lisp_Object *lo = seq; + + merge_init (&ms, length, lo, predicate); + + /* March over the array once, left to right, finding natural runs, + and extending short natural runs to minrun elements. */ + const ptrdiff_t minrun = merge_compute_minrun (length); + ptrdiff_t nremaining = length; + do { + bool descending; + + /* Identify the next run. */ + ptrdiff_t n = count_run (&ms, lo, lo + nremaining, &descending); + if (descending) + reverse_vector (lo, n); + /* If the run is short, extend it to min(minrun, nremaining). */ + if (n < minrun) + { + const ptrdiff_t force = nremaining <= minrun ? + nremaining : minrun; + binarysort (&ms, lo, lo + force, lo + n); + n = force; + } + eassume (ms.n == 0 || ms.pending[ms.n - 1].base + + ms.pending[ms.n - 1].len == lo); + found_new_run (&ms, n); + /* Push the new run on to the stack. */ + eassume (ms.n < MAX_MERGE_PENDING); + ms.pending[ms.n].base = lo; + ms.pending[ms.n].len = n; + ++ms.n; + /* Advance to find the next run. */ + lo += n; + nremaining -= n; + } while (nremaining); + + merge_force_collapse (&ms); + eassume (ms.n == 1); + eassume (ms.pending[0].len == length); + lo = ms.pending[0].base; + + if (ms.a != ms.temparray) + unbind_to (ms.count, Qnil); +} diff --git a/src/sound.c b/src/sound.c index e2932f103be..93c84a03b1f 100644 --- a/src/sound.c +++ b/src/sound.c @@ -299,11 +299,15 @@ sound_perror (const char *msg) int saved_errno = errno; turn_on_atimers (1); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) { sigset_t unblocked; sigemptyset (&unblocked); +#ifdef USABLE_SIGIO sigaddset (&unblocked, SIGIO); +#else + sigaddset (&unblocked, SIGPOLL); +#endif pthread_sigmask (SIG_UNBLOCK, &unblocked, 0); } #endif @@ -698,7 +702,7 @@ static void vox_configure (struct sound_device *sd) { int val; -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) sigset_t oldset, blocked; #endif @@ -708,9 +712,13 @@ vox_configure (struct sound_device *sd) interrupted by a signal. Block the ones we know to cause troubles. */ turn_on_atimers (0); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) sigemptyset (&blocked); +#ifdef USABLE_SIGIO sigaddset (&blocked, SIGIO); +#else + sigaddset (&blocked, SIGPOLL); +#endif pthread_sigmask (SIG_BLOCK, &blocked, &oldset); #endif @@ -744,7 +752,7 @@ vox_configure (struct sound_device *sd) } turn_on_atimers (1); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) pthread_sigmask (SIG_SETMASK, &oldset, 0); #endif } @@ -760,10 +768,14 @@ vox_close (struct sound_device *sd) /* On GNU/Linux, it seems that the device driver doesn't like to be interrupted by a signal. Block the ones we know to cause troubles. */ -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) sigset_t blocked, oldset; sigemptyset (&blocked); +#ifdef USABLE_SIGIO sigaddset (&blocked, SIGIO); +#else + sigaddset (&blocked, SIGPOLL); +#endif pthread_sigmask (SIG_BLOCK, &blocked, &oldset); #endif turn_on_atimers (0); @@ -772,7 +784,7 @@ vox_close (struct sound_device *sd) ioctl (sd->fd, SNDCTL_DSP_SYNC, NULL); turn_on_atimers (1); -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) pthread_sigmask (SIG_SETMASK, &oldset, 0); #endif @@ -1347,7 +1359,7 @@ Internal use only, use `play-sound' instead. */) (Lisp_Object sound) { Lisp_Object attrs[SOUND_ATTR_SENTINEL]; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef WINDOWSNT unsigned long ui_volume_tmp = UINT_MAX; diff --git a/src/sqlite.c b/src/sqlite.c new file mode 100644 index 00000000000..1ca86699318 --- /dev/null +++ b/src/sqlite.c @@ -0,0 +1,753 @@ +/* Support for accessing SQLite databases. + +Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +This file is based on the emacs-sqlite3 package written by Syohei +YOSHIDA <syohex@gmail.com>, which can be found at: + + https://github.com/syohex/emacs-sqlite3 */ + +#include <config.h> +#include "lisp.h" +#include "coding.h" + +#ifdef HAVE_SQLITE3 + +#include <sqlite3.h> + +#ifdef WINDOWSNT + +# include <windows.h> +# include "w32common.h" +# include "w32.h" + +DEF_DLL_FN (SQLITE_API int, sqlite3_finalize, (sqlite3_stmt*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_close, (sqlite3*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_open_v2, + (const char*, sqlite3**, int, const char*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_reset, (sqlite3_stmt*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_bind_text, + (sqlite3_stmt*, int, const char*, int, void(*)(void*))); +DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int64, + (sqlite3_stmt*, int, sqlite3_int64)); +DEF_DLL_FN (SQLITE_API int, sqlite3_bind_double, (sqlite3_stmt*, int, double)); +DEF_DLL_FN (SQLITE_API int, sqlite3_bind_null, (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int, (sqlite3_stmt*, int, int)); +DEF_DLL_FN (SQLITE_API const char*, sqlite3_errmsg, (sqlite3*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_step, (sqlite3_stmt*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_changes, (sqlite3*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_column_count, (sqlite3_stmt*)); +DEF_DLL_FN (SQLITE_API int, sqlite3_column_type, (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API sqlite3_int64, sqlite3_column_int64, + (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API double, sqlite3_column_double, (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API const void*, sqlite3_column_blob, + (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API int, sqlite3_column_bytes, (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API const unsigned char*, sqlite3_column_text, + (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API const char*, sqlite3_column_name, (sqlite3_stmt*, int)); +DEF_DLL_FN (SQLITE_API int, sqlite3_exec, + (sqlite3*, const char*, int (*callback)(void*,int,char**,char**), + void*, char**)); +DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2, + (sqlite3*, const char*, int, sqlite3_stmt**, const char**)); + +# ifdef HAVE_SQLITE3_LOAD_EXTENSION +DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension, + (sqlite3*, const char*, const char*, char**)); +# undef sqlite3_load_extension +# define sqlite3_load_extension fn_sqlite3_load_extension +# endif + +# undef sqlite3_finalize +# undef sqlite3_close +# undef sqlite3_open_v2 +# undef sqlite3_reset +# undef sqlite3_bind_text +# undef sqlite3_bind_int64 +# undef sqlite3_bind_double +# undef sqlite3_bind_null +# undef sqlite3_bind_int +# undef sqlite3_errmsg +# undef sqlite3_step +# undef sqlite3_changes +# undef sqlite3_column_count +# undef sqlite3_column_type +# undef sqlite3_column_int64 +# undef sqlite3_column_double +# undef sqlite3_column_blob +# undef sqlite3_column_bytes +# undef sqlite3_column_text +# undef sqlite3_column_name +# undef sqlite3_exec +# undef sqlite3_prepare_v2 + +# define sqlite3_finalize fn_sqlite3_finalize +# define sqlite3_close fn_sqlite3_close +# define sqlite3_open_v2 fn_sqlite3_open_v2 +# define sqlite3_reset fn_sqlite3_reset +# define sqlite3_bind_text fn_sqlite3_bind_text +# define sqlite3_bind_int64 fn_sqlite3_bind_int64 +# define sqlite3_bind_double fn_sqlite3_bind_double +# define sqlite3_bind_null fn_sqlite3_bind_null +# define sqlite3_bind_int fn_sqlite3_bind_int +# define sqlite3_errmsg fn_sqlite3_errmsg +# define sqlite3_step fn_sqlite3_step +# define sqlite3_changes fn_sqlite3_changes +# define sqlite3_column_count fn_sqlite3_column_count +# define sqlite3_column_type fn_sqlite3_column_type +# define sqlite3_column_int64 fn_sqlite3_column_int64 +# define sqlite3_column_double fn_sqlite3_column_double +# define sqlite3_column_blob fn_sqlite3_column_blob +# define sqlite3_column_bytes fn_sqlite3_column_bytes +# define sqlite3_column_text fn_sqlite3_column_text +# define sqlite3_column_name fn_sqlite3_column_name +# define sqlite3_exec fn_sqlite3_exec +# define sqlite3_prepare_v2 fn_sqlite3_prepare_v2 + +static bool +load_dll_functions (HMODULE library) +{ + LOAD_DLL_FN (library, sqlite3_finalize); + LOAD_DLL_FN (library, sqlite3_close); + LOAD_DLL_FN (library, sqlite3_open_v2); + LOAD_DLL_FN (library, sqlite3_reset); + LOAD_DLL_FN (library, sqlite3_bind_text); + LOAD_DLL_FN (library, sqlite3_bind_int64); + LOAD_DLL_FN (library, sqlite3_bind_double); + LOAD_DLL_FN (library, sqlite3_bind_null); + LOAD_DLL_FN (library, sqlite3_bind_int); + LOAD_DLL_FN (library, sqlite3_errmsg); + LOAD_DLL_FN (library, sqlite3_step); + LOAD_DLL_FN (library, sqlite3_changes); + LOAD_DLL_FN (library, sqlite3_column_count); + LOAD_DLL_FN (library, sqlite3_column_type); + LOAD_DLL_FN (library, sqlite3_column_int64); + LOAD_DLL_FN (library, sqlite3_column_double); + LOAD_DLL_FN (library, sqlite3_column_blob); + LOAD_DLL_FN (library, sqlite3_column_bytes); + LOAD_DLL_FN (library, sqlite3_column_text); + LOAD_DLL_FN (library, sqlite3_column_name); + LOAD_DLL_FN (library, sqlite3_exec); +# ifdef HAVE_SQLITE3_LOAD_EXTENSION + LOAD_DLL_FN (library, sqlite3_load_extension); +# endif + LOAD_DLL_FN (library, sqlite3_prepare_v2); + return true; +} +#endif /* WINDOWSNT */ + +static bool +init_sqlite_functions (void) +{ +#ifdef WINDOWSNT + static bool sqlite3_initialized; + + if (!sqlite3_initialized) + { + HMODULE library = w32_delayed_load (Qsqlite3); + + if (!library) + message1 ("sqlite3 library was not found"); + else if (load_dll_functions (library)) + { + sqlite3_initialized = true; + Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qt), Vlibrary_cache); + } + else + { + message1 ("sqlite3 library was found, but could not be loaded successfully"); + Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qnil), Vlibrary_cache); + } + } + return sqlite3_initialized; +#else /* !WINDOWSNT */ + return true; +#endif /* !WINDOWSNT */ +} + + +static void +sqlite_free (void *arg) +{ + struct Lisp_Sqlite *ptr = (struct Lisp_Sqlite *)arg; + if (ptr->is_statement) + sqlite3_finalize (ptr->stmt); + else if (ptr->db) + sqlite3_close (ptr->db); + xfree (ptr->name); + xfree (ptr); +} + +static Lisp_Object +encode_string (Lisp_Object string) +{ + if (STRING_MULTIBYTE (string)) + return encode_string_utf_8 (string, Qnil, 0, Qt, Qt); + else + return string; +} + +static Lisp_Object +make_sqlite (bool is_statement, void *db, void *stmt, char *name) +{ + struct Lisp_Sqlite *ptr + = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Sqlite, PVEC_SQLITE); + ptr->is_statement = is_statement; + ptr->finalizer = sqlite_free; + ptr->db = db; + ptr->name = name; + ptr->stmt = stmt; + ptr->eof = false; + return make_lisp_ptr (ptr, Lisp_Vectorlike); +} + +static void +check_sqlite (Lisp_Object db, bool is_statement) +{ + init_sqlite_functions (); + CHECK_SQLITE (db); + if (is_statement && !XSQLITE (db)->is_statement) + xsignal1 (Qerror, build_string ("Invalid set object")); + else if (!is_statement && XSQLITE (db)->is_statement) + xsignal1 (Qerror, build_string ("Invalid database object")); + if (!is_statement && !XSQLITE (db)->db) + xsignal1 (Qerror, build_string ("Database closed")); + else if (is_statement && !XSQLITE (db)->db) + xsignal1 (Qerror, build_string ("Statement closed")); +} + +static int db_count = 0; + +DEFUN ("sqlite-open", Fsqlite_open, Ssqlite_open, 0, 1, 0, + doc: /* Open FILE as an sqlite database. +If FILE is nil, an in-memory database will be opened instead. */) + (Lisp_Object file) +{ + char *name; + if (!init_sqlite_functions ()) + xsignal1 (Qerror, build_string ("sqlite support is not available")); + + if (!NILP (file)) + { + CHECK_STRING (file); + file = ENCODE_FILE (Fexpand_file_name (file, Qnil)); + name = xstrdup (SSDATA (file)); + } + else + /* In-memory database. These have to have different names to + refer to different databases. */ + name = xstrdup (SSDATA (CALLN (Fformat, build_string (":memory:%d"), + make_int (++db_count)))); + + sqlite3 *sdb; + int ret = sqlite3_open_v2 (name, + &sdb, + SQLITE_OPEN_FULLMUTEX + | SQLITE_OPEN_READWRITE + | SQLITE_OPEN_CREATE + | (NILP (file) ? SQLITE_OPEN_MEMORY : 0) +#ifdef SQLITE_OPEN_URI + | SQLITE_OPEN_URI +#endif + | 0, NULL); + + if (ret != SQLITE_OK) + return Qnil; + + return make_sqlite (false, sdb, NULL, name); +} + +DEFUN ("sqlite-close", Fsqlite_close, Ssqlite_close, 1, 1, 0, + doc: /* Close the sqlite database DB. */) + (Lisp_Object db) +{ + check_sqlite (db, false); + sqlite3_close (XSQLITE (db)->db); + XSQLITE (db)->db = NULL; + return Qt; +} + +/* Bind values in a statement like + "insert into foo values (?, ?, ?)". */ +static const char * +bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values) +{ + sqlite3_reset (stmt); + int len; + if (VECTORP (values)) + len = ASIZE (values); + else + len = list_length (values); + + for (int i = 0; i < len; ++i) + { + int ret = SQLITE_MISMATCH; + Lisp_Object value; + if (VECTORP (values)) + value = AREF (values, i); + else + { + value = XCAR (values); + values = XCDR (values); + } + Lisp_Object type = Ftype_of (value); + + if (EQ (type, Qstring)) + { + Lisp_Object encoded = encode_string (value); + ret = sqlite3_bind_text (stmt, i + 1, + SSDATA (encoded), SBYTES (encoded), + NULL); + } + else if (EQ (type, Qinteger)) + { + if (BIGNUMP (value)) + ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value)); + else + ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value)); + } + else if (EQ (type, Qfloat)) + ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value)); + else if (NILP (value)) + ret = sqlite3_bind_null (stmt, i + 1); + else if (EQ (value, Qt)) + ret = sqlite3_bind_int (stmt, i + 1, 1); + else if (EQ (value, Qfalse)) + ret = sqlite3_bind_int (stmt, i + 1, 0); + else + return "invalid argument"; + + if (ret != SQLITE_OK) + return sqlite3_errmsg (db); + } + + return NULL; +} + +DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0, + doc: /* Execute a non-select SQL statement. +If VALUES is non-nil, it should be a vector or a list of values +to bind when executing a statement like + + insert into foo values (?, ?, ...) + +Value is the number of affected rows. */) + (Lisp_Object db, Lisp_Object query, Lisp_Object values) +{ + check_sqlite (db, false); + CHECK_STRING (query); + if (!(NILP (values) || CONSP (values) || VECTORP (values))) + xsignal1 (Qerror, build_string ("VALUES must be a list or a vector")); + + sqlite3 *sdb = XSQLITE (db)->db; + Lisp_Object retval = Qnil; + const char *errmsg = NULL; + Lisp_Object encoded = encode_string (query); + sqlite3_stmt *stmt = NULL; + + /* We only execute the first statement -- if there's several + (separated by a semicolon), the subsequent statements won't be + done. */ + int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), -1, &stmt, NULL); + if (ret != SQLITE_OK) + { + if (stmt != NULL) + { + sqlite3_finalize (stmt); + sqlite3_reset (stmt); + } + + errmsg = sqlite3_errmsg (sdb); + goto exit; + } + + /* Bind ? values. */ + if (!NILP (values)) { + const char *err = bind_values (sdb, stmt, values); + if (err != NULL) + { + errmsg = err; + goto exit; + } + } + + ret = sqlite3_step (stmt); + sqlite3_finalize (stmt); + if (ret != SQLITE_OK && ret != SQLITE_DONE) + { + errmsg = sqlite3_errmsg (sdb); + goto exit; + } + + retval = make_fixnum (sqlite3_changes (sdb)); + + exit: + if (errmsg != NULL) + xsignal1 (ret == SQLITE_LOCKED || ret == SQLITE_BUSY? + Qsqlite_locked_error: Qerror, + build_string (errmsg)); + + return retval; +} + +static Lisp_Object +row_to_value (sqlite3_stmt *stmt) +{ + int len = sqlite3_column_count (stmt); + Lisp_Object values = Qnil; + + for (int i = 0; i < len; ++i) + { + Lisp_Object v = Qnil; + + switch (sqlite3_column_type (stmt, i)) + { + case SQLITE_INTEGER: + v = make_int (sqlite3_column_int64 (stmt, i)); + break; + + case SQLITE_FLOAT: + v = make_float (sqlite3_column_double (stmt, i)); + break; + + case SQLITE_BLOB: + v = + code_convert_string_norecord + (make_unibyte_string (sqlite3_column_blob (stmt, i), + sqlite3_column_bytes (stmt, i)), + Qutf_8, false); + break; + + case SQLITE_NULL: + v = Qnil; + break; + + case SQLITE_TEXT: + v = + code_convert_string_norecord + (make_unibyte_string ((const char *)sqlite3_column_text (stmt, i), + sqlite3_column_bytes (stmt, i)), + Qutf_8, false); + break; + } + + values = Fcons (v, values); + } + + return Fnreverse (values); +} + +static Lisp_Object +column_names (sqlite3_stmt *stmt) +{ + Lisp_Object columns = Qnil; + int count = sqlite3_column_count (stmt); + for (int i = 0; i < count; ++i) + columns = Fcons (build_string (sqlite3_column_name (stmt, i)), columns); + + return Fnreverse (columns); +} + +DEFUN ("sqlite-select", Fsqlite_select, Ssqlite_select, 2, 4, 0, + doc: /* Select data from the database DB that matches QUERY. +If VALUES is non-nil, it should be a list or a vector specifying the +values that will be interpolated into a parameterized statement. + +By default, the return value is a list where the first element is a +list of column names, and the rest of the elements are the matching data. + +RETURN-TYPE can be either nil (which means that the matching data +should be returned as a list of rows), or `full' (the same, but the +first element in the return list will be the column names), or `set', +which means that we return a set object that can be queried with +`sqlite-next' and other functions to get the data. */) + (Lisp_Object db, Lisp_Object query, Lisp_Object values, + Lisp_Object return_type) +{ + check_sqlite (db, false); + CHECK_STRING (query); + + if (!(NILP (values) || CONSP (values) || VECTORP (values))) + xsignal1 (Qerror, build_string ("VALUES must be a list or a vector")); + + sqlite3 *sdb = XSQLITE (db)->db; + Lisp_Object retval = Qnil; + const char *errmsg = NULL; + Lisp_Object encoded = encode_string (query); + + sqlite3_stmt *stmt = NULL; + int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), SBYTES (encoded), + &stmt, NULL); + if (ret != SQLITE_OK) + { + if (stmt) + sqlite3_finalize (stmt); + + goto exit; + } + + /* Query with parameters. */ + if (!NILP (values)) + { + const char *err = bind_values (sdb, stmt, values); + if (err != NULL) + { + sqlite3_finalize (stmt); + errmsg = err; + goto exit; + } + } + + /* Return a handle to get the data. */ + if (EQ (return_type, Qset)) + { + retval = make_sqlite (true, sdb, stmt, XSQLITE (db)->name); + goto exit; + } + + /* Return the data directly. */ + Lisp_Object data = Qnil; + while ((ret = sqlite3_step (stmt)) == SQLITE_ROW) + data = Fcons (row_to_value (stmt), data); + + if (EQ (return_type, Qfull)) + retval = Fcons (column_names (stmt), Fnreverse (data)); + else + retval = Fnreverse (data); + sqlite3_finalize (stmt); + + exit: + if (errmsg != NULL) + xsignal1 (Qerror, build_string (errmsg)); + + return retval; +} + +static Lisp_Object +sqlite_exec (sqlite3 *sdb, const char *query) +{ + int ret = sqlite3_exec (sdb, query, NULL, NULL, NULL); + if (ret != SQLITE_OK) + return Qnil; + + return Qt; +} + +DEFUN ("sqlite-transaction", Fsqlite_transaction, Ssqlite_transaction, 1, 1, 0, + doc: /* Start a transaction in DB. */) + (Lisp_Object db) +{ + check_sqlite (db, false); + return sqlite_exec (XSQLITE (db)->db, "begin"); +} + +DEFUN ("sqlite-commit", Fsqlite_commit, Ssqlite_commit, 1, 1, 0, + doc: /* Commit a transaction in DB. */) + (Lisp_Object db) +{ + check_sqlite (db, false); + return sqlite_exec (XSQLITE (db)->db, "commit"); +} + +DEFUN ("sqlite-rollback", Fsqlite_rollback, Ssqlite_rollback, 1, 1, 0, + doc: /* Roll back a transaction in DB. */) + (Lisp_Object db) +{ + check_sqlite (db, false); + return sqlite_exec (XSQLITE (db)->db, "rollback"); +} + +DEFUN ("sqlite-pragma", Fsqlite_pragma, Ssqlite_pragma, 2, 2, 0, + doc: /* Execute PRAGMA in DB. */) + (Lisp_Object db, Lisp_Object pragma) +{ + check_sqlite (db, false); + CHECK_STRING (pragma); + + return sqlite_exec (XSQLITE (db)->db, + SSDATA (concat2 (build_string ("PRAGMA "), pragma))); +} + +#ifdef HAVE_SQLITE3_LOAD_EXTENSION +DEFUN ("sqlite-load-extension", Fsqlite_load_extension, + Ssqlite_load_extension, 2, 2, 0, + doc: /* Load an SQlite MODULE into DB. +MODULE should be the name of an SQlite module's file, a +shared library in the system-dependent format and having a +system-dependent file-name extension. + +Only modules on Emacs' list of allowed modules can be loaded. */) + (Lisp_Object db, Lisp_Object module) +{ + check_sqlite (db, false); + CHECK_STRING (module); + + /* Add names of useful and free modules here. */ + const char *allowlist[3] = { "pcre", "csvtable", NULL }; + char *name = SSDATA (Ffile_name_nondirectory (module)); + /* Possibly skip past a common prefix. */ + const char *prefix = "libsqlite3_mod_"; + if (!strncmp (name, prefix, strlen (prefix))) + name += strlen (prefix); + + bool do_allow = false; + for (const char **allow = allowlist; *allow; allow++) + { + if (strlen (*allow) < strlen (name) + && !strncmp (*allow, name, strlen (*allow)) + && (!strcmp (name + strlen (*allow), ".so") + || !strcmp (name + strlen (*allow), ".DLL"))) + { + do_allow = true; + break; + } + } + + if (!do_allow) + xsignal (Qerror, build_string ("Module name not on allowlist")); + + int result = sqlite3_load_extension + (XSQLITE (db)->db, + SSDATA (ENCODE_FILE (Fexpand_file_name (module, Qnil))), + NULL, NULL); + if (result == SQLITE_OK) + return Qt; + return Qnil; +} +#endif /* HAVE_SQLITE3_LOAD_EXTENSION */ + +DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0, + doc: /* Return the next result set from SET. */) + (Lisp_Object set) +{ + check_sqlite (set, true); + + int ret = sqlite3_step (XSQLITE (set)->stmt); + if (ret != SQLITE_ROW && ret != SQLITE_OK && ret != SQLITE_DONE) + xsignal1 (Qerror, build_string (sqlite3_errmsg (XSQLITE (set)->db))); + + if (ret == SQLITE_DONE) + { + XSQLITE (set)->eof = true; + return Qnil; + } + + return row_to_value (XSQLITE (set)->stmt); +} + +DEFUN ("sqlite-columns", Fsqlite_columns, Ssqlite_columns, 1, 1, 0, + doc: /* Return the column names of SET. */) + (Lisp_Object set) +{ + check_sqlite (set, true); + return column_names (XSQLITE (set)->stmt); +} + +DEFUN ("sqlite-more-p", Fsqlite_more_p, Ssqlite_more_p, 1, 1, 0, + doc: /* Say whether there are any further results in SET. */) + (Lisp_Object set) +{ + check_sqlite (set, true); + + if (XSQLITE (set)->eof) + return Qnil; + else + return Qt; +} + +DEFUN ("sqlite-finalize", Fsqlite_finalize, Ssqlite_finalize, 1, 1, 0, + doc: /* Mark this SET as being finished. +This will free the resources held by SET. */) + (Lisp_Object set) +{ + check_sqlite (set, true); + sqlite3_finalize (XSQLITE (set)->stmt); + XSQLITE (set)->db = NULL; + return Qt; +} + +#endif /* HAVE_SQLITE3 */ + +DEFUN ("sqlitep", Fsqlitep, Ssqlitep, 1, 1, 0, + doc: /* Say whether OBJECT is an SQlite object. */) + (Lisp_Object object) +{ +#ifdef HAVE_SQLITE3 + return SQLITE (object)? Qt: Qnil; +#else + return Qnil; +#endif +} + +DEFUN ("sqlite-available-p", Fsqlite_available_p, Ssqlite_available_p, 0, 0, 0, + doc: /* Return t if sqlite3 support is available in this instance of Emacs.*/) + (void) +{ +#ifdef HAVE_SQLITE3 +# ifdef WINDOWSNT + Lisp_Object found = Fassq (Qsqlite3, Vlibrary_cache); + if (CONSP (found)) + return XCDR (found); + else + return init_sqlite_functions () ? Qt : Qnil; +# else + return Qt; +#endif +#else + return Qnil; +#endif +} + +void +syms_of_sqlite (void) +{ +#ifdef HAVE_SQLITE3 + defsubr (&Ssqlite_open); + defsubr (&Ssqlite_close); + defsubr (&Ssqlite_execute); + defsubr (&Ssqlite_select); + defsubr (&Ssqlite_transaction); + defsubr (&Ssqlite_commit); + defsubr (&Ssqlite_rollback); + defsubr (&Ssqlite_pragma); +#ifdef HAVE_SQLITE3_LOAD_EXTENSION + defsubr (&Ssqlite_load_extension); +#endif + defsubr (&Ssqlite_next); + defsubr (&Ssqlite_columns); + defsubr (&Ssqlite_more_p); + defsubr (&Ssqlite_finalize); + DEFSYM (Qset, "set"); + DEFSYM (Qfull, "full"); +#endif + defsubr (&Ssqlitep); + defsubr (&Ssqlite_available_p); + + DEFSYM (Qsqlite_locked_error, "sqlite-locked-error"); + Fput (Qsqlite_locked_error, Qerror_conditions, + Fpurecopy (list2 (Qsqlite_locked_error, Qerror))); + Fput (Qsqlite_locked_error, Qerror_message, + build_pure_c_string ("Database locked")); + + DEFSYM (Qsqlitep, "sqlitep"); + DEFSYM (Qfalse, "false"); + DEFSYM (Qsqlite, "sqlite"); + DEFSYM (Qsqlite3, "sqlite3"); +} diff --git a/src/syntax.c b/src/syntax.c index 9df878b8edf..f9022d18d26 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -1074,7 +1074,7 @@ unsigned char const syntax_spec_code[0400] = /* Indexed by syntax code, give the letter that describes it. */ -char const syntax_code_spec[16] = +static char const syntax_code_spec[16] = { ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@', '!', '|' @@ -1101,10 +1101,11 @@ this is probably the wrong function to use, because it can't take `syntax-after' instead. */) (Lisp_Object character) { - int char_int; CHECK_CHARACTER (character); - char_int = XFIXNUM (character); + int char_int = XFIXNAT (character); SETUP_BUFFER_SYNTAX_TABLE (); + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) + char_int = make_char_multibyte (char_int); return make_fixnum (syntax_code_spec[SYNTAX (char_int)]); } diff --git a/src/syntax.h b/src/syntax.h index c1bb9274d00..5949a95a73b 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -147,10 +147,6 @@ extern bool syntax_prefix_flag_p (int c); extern unsigned char const syntax_spec_code[0400]; -/* Indexed by syntax code, give the letter that describes it. */ - -extern char const syntax_code_spec[16]; - /* Convert the byte offset BYTEPOS into a character position, for the object recorded in gl_state with SETUP_SYNTAX_TABLE_FOR_OBJECT. diff --git a/src/sysdep.c b/src/sysdep.c index 1e630835add..87a6365de66 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -664,7 +664,7 @@ sys_subshell (void) #else { char *volatile str_volatile = str; - pid = vfork (); + pid = VFORK (); str = str_volatile; } #endif @@ -678,6 +678,9 @@ sys_subshell (void) #ifdef USABLE_SIGIO saved_handlers[3].code = SIGIO; saved_handlers[4].code = 0; +#elif defined (USABLE_SIGPOLL) + saved_handlers[3].code = SIGPOLL; + saved_handlers[4].code = 0; #else saved_handlers[3].code = 0; #endif @@ -788,6 +791,7 @@ init_sigio (int fd) } #ifndef DOS_NT +#ifdef F_SETOWN static void reset_sigio (int fd) { @@ -795,12 +799,13 @@ reset_sigio (int fd) fcntl (fd, F_SETFL, old_fcntl_flags[fd]); #endif } +#endif /* F_SETOWN */ #endif void request_sigio (void) { -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) sigset_t unblocked; if (noninteractive) @@ -810,7 +815,11 @@ request_sigio (void) # ifdef SIGWINCH sigaddset (&unblocked, SIGWINCH); # endif +# ifdef USABLE_SIGIO sigaddset (&unblocked, SIGIO); +# else + sigaddset (&unblocked, SIGPOLL); +# endif pthread_sigmask (SIG_UNBLOCK, &unblocked, 0); interrupts_deferred = 0; @@ -820,7 +829,7 @@ request_sigio (void) void unrequest_sigio (void) { -#ifdef USABLE_SIGIO +#if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) sigset_t blocked; if (noninteractive) @@ -830,7 +839,11 @@ unrequest_sigio (void) # ifdef SIGWINCH sigaddset (&blocked, SIGWINCH); # endif +# ifdef USABLE_SIGIO sigaddset (&blocked, SIGIO); +# else + sigaddset (&blocked, SIGPOLL); +# endif pthread_sigmask (SIG_BLOCK, &blocked, 0); interrupts_deferred = 1; #endif @@ -1256,9 +1269,12 @@ init_sys_modes (struct tty_display_info *tty_out) /* This code added to insure that, if flow-control is not to be used, we have an unlocked terminal at the start. */ +#ifndef HAIKU /* On Haiku, TCXONC is a no-op and causes spurious + compiler warnings. */ #ifdef TCXONC if (!tty_out->flow_control) ioctl (fileno (tty_out->input), TCXONC, 1); #endif +#endif /* HAIKU */ #ifdef TIOCSTART if (!tty_out->flow_control) ioctl (fileno (tty_out->input), TIOCSTART, 0); #endif @@ -1674,6 +1690,8 @@ emacs_sigaction_init (struct sigaction *action, signal_handler_t handler) sigaddset (&action->sa_mask, SIGQUIT); #ifdef USABLE_SIGIO sigaddset (&action->sa_mask, SIGIO); +#elif defined (USABLE_SIGPOLL) + sigaddset (&action->sa_mask, SIGPOLL); #endif } @@ -2182,6 +2200,16 @@ get_random (void) return val & INTMASK; } +/* Return a random unsigned long. */ +unsigned long int +get_random_ulong (void) +{ + unsigned long int r = 0; + for (int i = 0; i < (ULONG_WIDTH + RAND_BITS - 1) / RAND_BITS; i++) + r = random () ^ (r << RAND_BITS) ^ (r >> (ULONG_WIDTH - RAND_BITS)); + return r; +} + #ifndef HAVE_SNPRINTF /* Approximate snprintf as best we can on ancient hosts that lack it. */ int @@ -2772,6 +2800,7 @@ static const struct speed_struct speeds[] = #ifdef B150 { 150, B150 }, #endif +#ifndef HAVE_TINY_SPEED_T #ifdef B200 { 200, B200 }, #endif @@ -2859,6 +2888,7 @@ static const struct speed_struct speeds[] = #ifdef B4000000 { 4000000, B4000000 }, #endif +#endif /* HAVE_TINY_SPEED_T */ }; /* Convert a numerical speed (e.g., 9600) to a Bnnn constant (e.g., @@ -3120,8 +3150,9 @@ list_system_processes (void) } /* The WINDOWSNT implementation is in w32.c. - The MSDOS implementation is in dosfns.c. */ -#elif !defined (WINDOWSNT) && !defined (MSDOS) + The MSDOS implementation is in dosfns.c. + The Haiku implementation is in haiku.c. */ +#elif !defined (WINDOWSNT) && !defined (MSDOS) && !defined (HAIKU) Lisp_Object list_system_processes (void) @@ -3131,95 +3162,70 @@ list_system_processes (void) #endif /* !defined (WINDOWSNT) */ +#if defined __FreeBSD__ || defined DARWIN_OS || defined __OpenBSD__ -#if defined __FreeBSD__ || defined DARWIN_OS - -static struct timespec -timeval_to_timespec (struct timeval t) -{ - return make_timespec (t.tv_sec, t.tv_usec * 1000); -} static Lisp_Object -make_lisp_timeval (struct timeval t) +make_lisp_s_us (time_t s, long us) { - return make_lisp_time (timeval_to_timespec (t)); + Lisp_Object sec = make_int (s); + Lisp_Object usec = make_fixnum (us); + Lisp_Object hz = make_fixnum (1000000); + Lisp_Object ticks = CALLN (Fplus, CALLN (Ftimes, sec, hz), usec); + return Ftime_convert (Fcons (ticks, hz), Qnil); } -#elif defined __OpenBSD__ +#endif + +#if defined __FreeBSD__ || defined DARWIN_OS static Lisp_Object -make_lisp_timeval (long sec, long usec) +make_lisp_timeval (struct timeval t) { - return make_lisp_time(make_timespec(sec, usec * 1000)); + return make_lisp_s_us (t.tv_sec, t.tv_usec); } #endif #ifdef GNU_LINUX -static struct timespec -time_from_jiffies (unsigned long long tval, long hz) -{ - unsigned long long s = tval / hz; - unsigned long long frac = tval % hz; - int ns; - - if (TYPE_MAXIMUM (time_t) < s) - time_overflow (); - if (LONG_MAX - 1 <= ULLONG_MAX / TIMESPEC_HZ - || frac <= ULLONG_MAX / TIMESPEC_HZ) - ns = frac * TIMESPEC_HZ / hz; - else - { - /* This is reachable only in the unlikely case that HZ * HZ - exceeds ULLONG_MAX. It calculates an approximation that is - guaranteed to be in range. */ - long hz_per_ns = hz / TIMESPEC_HZ + (hz % TIMESPEC_HZ != 0); - ns = frac / hz_per_ns; - } - return make_timespec (s, ns); +static Lisp_Object +time_from_jiffies (unsigned long long ticks, Lisp_Object hz, Lisp_Object form) +{ + return Ftime_convert (Fcons (make_uint (ticks), hz), form); } static Lisp_Object -ltime_from_jiffies (unsigned long long tval, long hz) +put_jiffies (Lisp_Object attrs, Lisp_Object propname, + unsigned long long ticks, Lisp_Object hz) { - struct timespec t = time_from_jiffies (tval, hz); - return make_lisp_time (t); + return Fcons (Fcons (propname, time_from_jiffies (ticks, hz, Qnil)), attrs); } -static struct timespec +static Lisp_Object get_up_time (void) { FILE *fup; - struct timespec up = make_timespec (0, 0); + Lisp_Object up = Qnil; block_input (); fup = emacs_fopen ("/proc/uptime", "r"); if (fup) { - unsigned long long upsec, upfrac; + unsigned long long upsec; + EMACS_UINT upfrac; int upfrac_start, upfrac_end; - if (fscanf (fup, "%llu.%n%llu%n", + if (fscanf (fup, "%llu.%n%"pI"u%n", &upsec, &upfrac_start, &upfrac, &upfrac_end) == 2) { - if (TYPE_MAXIMUM (time_t) < upsec) - { - upsec = TYPE_MAXIMUM (time_t); - upfrac = TIMESPEC_HZ - 1; - } - else - { - int upfraclen = upfrac_end - upfrac_start; - for (; upfraclen < LOG10_TIMESPEC_HZ; upfraclen++) - upfrac *= 10; - for (; LOG10_TIMESPEC_HZ < upfraclen; upfraclen--) - upfrac /= 10; - upfrac = min (upfrac, TIMESPEC_HZ - 1); - } - up = make_timespec (upsec, upfrac); + EMACS_INT hz = 1; + for (int i = upfrac_start; i < upfrac_end; i++) + hz *= 10; + Lisp_Object sec = make_uint (upsec); + Lisp_Object subsec = Fcons (make_fixnum (upfrac), make_fixnum (hz)); + up = Ftime_add (sec, subsec); } fclose (fup); } @@ -3340,11 +3346,9 @@ system_process_attributes (Lisp_Object pid) unsigned long long u_time, s_time, cutime, cstime, start; long priority, niceness, rss; unsigned long minflt, majflt, cminflt, cmajflt, vsize; - struct timespec tnow, tstart, tboot, telapsed, us_time; double pcpu, pmem; Lisp_Object attrs = Qnil; Lisp_Object decoded_cmd; - ptrdiff_t count; CHECK_NUMBER (pid); CONS_TO_INTEGER (pid, pid_t, proc_id); @@ -3369,7 +3373,7 @@ system_process_attributes (Lisp_Object pid) if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); strcpy (fn, procfn); procfn_end = fn + strlen (fn); strcpy (procfn_end, "/stat"); @@ -3429,47 +3433,41 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (majflt)), attrs); attrs = Fcons (Fcons (Qcminflt, INT_TO_INTEGER (cminflt)), attrs); attrs = Fcons (Fcons (Qcmajflt, INT_TO_INTEGER (cmajflt)), attrs); + clocks_per_sec = sysconf (_SC_CLK_TCK); - if (clocks_per_sec < 0) - clocks_per_sec = 100; - attrs = Fcons (Fcons (Qutime, - ltime_from_jiffies (u_time, clocks_per_sec)), - attrs); - attrs = Fcons (Fcons (Qstime, - ltime_from_jiffies (s_time, clocks_per_sec)), - attrs); - attrs = Fcons (Fcons (Qtime, - ltime_from_jiffies (s_time + u_time, - clocks_per_sec)), - attrs); - attrs = Fcons (Fcons (Qcutime, - ltime_from_jiffies (cutime, clocks_per_sec)), - attrs); - attrs = Fcons (Fcons (Qcstime, - ltime_from_jiffies (cstime, clocks_per_sec)), - attrs); - attrs = Fcons (Fcons (Qctime, - ltime_from_jiffies (cstime + cutime, - clocks_per_sec)), - attrs); + if (0 < clocks_per_sec) + { + Lisp_Object hz = make_int (clocks_per_sec); + attrs = put_jiffies (attrs, Qutime, u_time, hz); + attrs = put_jiffies (attrs, Qstime, s_time, hz); + attrs = put_jiffies (attrs, Qtime, s_time + u_time, hz); + attrs = put_jiffies (attrs, Qcutime, cutime, hz); + attrs = put_jiffies (attrs, Qcstime, cstime, hz); + attrs = put_jiffies (attrs, Qctime, cstime + cutime, hz); + + Lisp_Object uptime = get_up_time (); + if (!NILP (uptime)) + { + Lisp_Object now = Ftime_convert (Qnil, hz); + Lisp_Object boot = Ftime_subtract (now, uptime); + Lisp_Object tstart = time_from_jiffies (start, hz, hz); + Lisp_Object lstart = + Ftime_convert (Ftime_add (boot, tstart), Qnil); + attrs = Fcons (Fcons (Qstart, lstart), attrs); + Lisp_Object etime = + Ftime_convert (Ftime_subtract (uptime, tstart), Qnil); + attrs = Fcons (Fcons (Qetime, etime), attrs); + pcpu = (100.0 * (s_time + u_time) + / (clocks_per_sec * float_time (etime))); + attrs = Fcons (Fcons (Qpcpu, make_float (pcpu)), attrs); + } + } + attrs = Fcons (Fcons (Qpri, make_fixnum (priority)), attrs); attrs = Fcons (Fcons (Qnice, make_fixnum (niceness)), attrs); attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (thcount)), attrs); - tnow = current_timespec (); - telapsed = get_up_time (); - tboot = timespec_sub (tnow, telapsed); - tstart = time_from_jiffies (start, clocks_per_sec); - tstart = timespec_add (tboot, tstart); - attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs); attrs = Fcons (Fcons (Qvsize, INT_TO_INTEGER (vsize / 1024)), attrs); attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (4 * rss)), attrs); - telapsed = timespec_sub (tnow, tstart); - attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs); - us_time = time_from_jiffies (u_time + s_time, clocks_per_sec); - pcpu = timespectod (us_time) / timespectod (telapsed); - if (pcpu > 1.0) - pcpu = 1.0; - attrs = Fcons (Fcons (Qpcpu, make_float (100 * pcpu)), attrs); pmem = 4.0 * 100 * rss / procfs_get_total_memory (); if (pmem > 100) pmem = 100; @@ -3491,7 +3489,7 @@ system_process_attributes (Lisp_Object pid) do { cmdline = xpalloc (cmdline, &cmdline_size, 2, STRING_BYTES_BOUND, 1); - set_unwind_protect_ptr (count + 1, xfree, cmdline); + set_unwind_protect_ptr (specpdl_ref_add (count, 1), xfree, cmdline); /* Leave room even if every byte needs escaping below. */ readsize = (cmdline_size >> 1) - nread; @@ -3525,7 +3523,7 @@ system_process_attributes (Lisp_Object pid) nread = cmdsize + 2; cmdline_size = nread + 1; q = cmdline = xrealloc (cmdline, cmdline_size); - set_unwind_protect_ptr (count + 1, xfree, cmdline); + set_unwind_protect_ptr (specpdl_ref_add (count, 1), xfree, cmdline); sprintf (cmdline, "[%.*s]", cmdsize, cmd); } /* Command line is encoded in locale-coding-system; decode it. */ @@ -3574,7 +3572,6 @@ system_process_attributes (Lisp_Object pid) gid_t gid; Lisp_Object attrs = Qnil; Lisp_Object decoded_cmd; - ptrdiff_t count; CHECK_NUMBER (pid); CONS_TO_INTEGER (pid, pid_t, proc_id); @@ -3599,7 +3596,7 @@ system_process_attributes (Lisp_Object pid) if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); strcpy (fn, procfn); procfn_end = fn + strlen (fn); strcpy (procfn_end, "/psinfo"); @@ -3687,7 +3684,6 @@ system_process_attributes (Lisp_Object pid) char *ttyname; size_t len; char args[MAXPATHLEN]; - struct timespec t, now; int mib[4] = {CTL_KERN, KERN_PROC, KERN_PROC_PID}; struct kinfo_proc proc; @@ -3768,35 +3764,30 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qcminflt, make_fixnum (proc.ki_rusage_ch.ru_minflt)), attrs); attrs = Fcons (Fcons (Qcmajflt, make_fixnum (proc.ki_rusage_ch.ru_majflt)), attrs); - attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.ki_rusage.ru_utime)), - attrs); - attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.ki_rusage.ru_stime)), - attrs); - t = timespec_add (timeval_to_timespec (proc.ki_rusage.ru_utime), - timeval_to_timespec (proc.ki_rusage.ru_stime)); - attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs); + Lisp_Object utime = make_lisp_timeval (proc.ki_rusage.ru_utime); + attrs = Fcons (Fcons (Qutime, utime), attrs); + Lisp_Object stime = make_lisp_timeval (proc.ki_rusage.ru_stime); + attrs = Fcons (Fcons (Qstime, stime), attrs); + attrs = Fcons (Fcons (Qtime, Ftime_add (utime, stime)), attrs); - attrs = Fcons (Fcons (Qcutime, - make_lisp_timeval (proc.ki_rusage_ch.ru_utime)), - attrs); - attrs = Fcons (Fcons (Qcstime, - make_lisp_timeval (proc.ki_rusage_ch.ru_utime)), - attrs); - t = timespec_add (timeval_to_timespec (proc.ki_rusage_ch.ru_utime), - timeval_to_timespec (proc.ki_rusage_ch.ru_stime)); - attrs = Fcons (Fcons (Qctime, make_lisp_time (t)), attrs); + Lisp_Object cutime = make_lisp_timeval (proc.ki_rusage_ch.ru_utime); + attrs = Fcons (Fcons (Qcutime, cutime), attrs); + Lisp_Object cstime = make_lisp_timeval (proc.ki_rusage_ch.ru_stime); + attrs = Fcons (Fcons (Qcstime, cstime), attrs); + attrs = Fcons (Fcons (Qctime, Ftime_add (cutime, cstime)), attrs); attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (proc.ki_numthreads)), attrs); attrs = Fcons (Fcons (Qpri, make_fixnum (proc.ki_pri.pri_native)), attrs); attrs = Fcons (Fcons (Qnice, make_fixnum (proc.ki_nice)), attrs); - attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.ki_start)), attrs); + Lisp_Object start = make_lisp_timeval (proc.ki_start); + attrs = Fcons (Fcons (Qstart, start), attrs); attrs = Fcons (Fcons (Qvsize, make_fixnum (proc.ki_size >> 10)), attrs); attrs = Fcons (Fcons (Qrss, make_fixnum (proc.ki_rssize * pagesize >> 10)), attrs); - now = current_timespec (); - t = timespec_sub (now, timeval_to_timespec (proc.ki_start)); - attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs); + Lisp_Object now = Ftime_convert (Qnil, make_fixnum (1000000)); + Lisp_Object etime = Ftime_convert (Ftime_subtract (now, start), Qnil); + attrs = Fcons (Fcons (Qetime, etime), attrs); len = sizeof fscale; if (sysctlbyname ("kern.fscale", &fscale, &len, NULL, 0) == 0) @@ -3856,7 +3847,6 @@ system_process_attributes (Lisp_Object pid) struct kinfo_proc proc; struct passwd *pw; struct group *gr; - struct timespec t; struct uvmexp uvmexp; Lisp_Object attrs = Qnil; @@ -3938,20 +3928,14 @@ system_process_attributes (Lisp_Object pid) /* FIXME: missing cminflt, cmajflt. */ - attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.p_uutime_sec, - proc.p_uutime_usec)), - attrs); - attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.p_ustime_sec, - proc.p_ustime_usec)), - attrs); - t = timespec_add (make_timespec (proc.p_uutime_sec, - proc.p_uutime_usec * 1000), - make_timespec (proc.p_ustime_sec, - proc.p_ustime_usec * 1000)); - attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs); - - attrs = Fcons (Fcons (Qcutime, make_lisp_timeval (proc.p_uctime_sec, - proc.p_uctime_usec)), + Lisp_Object utime = make_lisp_s_us (proc.p_uutime_sec, proc.p_uutime_usec); + attrs = Fcons (Fcons (Qutime, utime), attrs); + Lisp_Object stime = make_lisp_s_us (proc.p_ustime_sec, proc.p_ustime_usec); + attrs = Fcons (Fcons (Qstime, stime), attrs); + attrs = Fcons (Fcons (Qtime, Ftime_add (utime, stime)), attrs); + + attrs = Fcons (Fcons (Qcutime, make_lisp_s_us (proc.p_uctime_sec, + proc.p_uctime_usec)), attrs); /* FIXME: missing cstime and thus ctime. */ @@ -3961,8 +3945,8 @@ system_process_attributes (Lisp_Object pid) /* FIXME: missing thcount (thread count) */ - attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.p_ustart_sec, - proc.p_ustart_usec)), + attrs = Fcons (Fcons (Qstart, make_lisp_s_us (proc.p_ustart_sec, + proc.p_ustart_usec)), attrs); len = (proc.p_vm_tsize + proc.p_vm_dsize + proc.p_vm_ssize) * pagesize >> 10; @@ -3971,10 +3955,11 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qrss, make_fixnum (proc.p_vm_rssize * pagesize >> 10)), attrs); - t = make_timespec (proc.p_ustart_sec, - proc.p_ustart_usec * 1000); - t = timespec_sub (current_timespec (), t); - attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs); + Lisp_Object now = Ftime_convert (Qnil, make_fixnum (1000000)); + Lisp_Object start = make_lisp_s_us (proc.p_ustart_sec, + proc.p_ustart_usec); + Lisp_Object etime = Ftime_convert (Ftime_subtract (now, start), Qnil); + attrs = Fcons (Fcons (Qetime, etime), attrs); len = sizeof (fscale); mib[0] = CTL_KERN; @@ -4027,6 +4012,9 @@ system_process_attributes (Lisp_Object pid) #elif defined DARWIN_OS +#define HAVE_RUSAGE_INFO_CURRENT (__MAC_OS_X_VERSION_MIN_REQUIRED >= 101000) +#define HAVE_PROC_PIDINFO (__MAC_OS_X_VERSION_MIN_REQUIRED >= 1050) + Lisp_Object system_process_attributes (Lisp_Object pid) { @@ -4035,7 +4023,6 @@ system_process_attributes (Lisp_Object pid) struct group *gr; char *ttyname; struct timeval starttime; - struct timespec t, now; dev_t tdev; uid_t uid; gid_t gid; @@ -4130,6 +4117,7 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.kp_eproc.e_tpgid)), attrs); +#if HAVE_RUSAGE_INFO_CURRENT rusage_info_current ri; if (proc_pid_rusage(proc_id, RUSAGE_INFO_CURRENT, (rusage_info_t *) &ri) == 0) { @@ -4143,15 +4131,33 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (ri.ri_pageins)), attrs); } +#else /* !HAVE_RUSAGE_INFO_CURRENT */ + struct rusage *rusage = proc.kp_proc.p_ru; + if (rusage) + { + attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (rusage->ru_minflt)), + attrs); + attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (rusage->ru_majflt)), + attrs); + + Lisp_Object utime = make_lisp_timeval (rusage->ru_utime); + Lisp_Object stime = make_lisp_timeval (rusage->ru_stime); + attrs = Fcons (Fcons (Qutime, utime), attrs); + attrs = Fcons (Fcons (Qstime, stime), attrs); + attrs = Fcons (Fcons (Qtime, Ftime_add (utime, stime)), attrs); + } +#endif /* !HAVE_RUSAGE_INFO_CURRENT */ starttime = proc.kp_proc.p_starttime; attrs = Fcons (Fcons (Qnice, make_fixnum (proc.kp_proc.p_nice)), attrs); - attrs = Fcons (Fcons (Qstart, make_lisp_timeval (starttime)), attrs); + Lisp_Object start = make_lisp_timeval (starttime); + attrs = Fcons (Fcons (Qstart, start), attrs); - now = current_timespec (); - t = timespec_sub (now, timeval_to_timespec (starttime)); - attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs); + Lisp_Object now = Ftime_convert (Qnil, make_fixnum (1000000)); + Lisp_Object etime = Ftime_convert (Ftime_subtract (now, start), Qnil); + attrs = Fcons (Fcons (Qetime, etime), attrs); +#if HAVE_PROC_PIDINFO struct proc_taskinfo taskinfo; if (proc_pidinfo (proc_id, PROC_PIDTASKINFO, 0, &taskinfo, sizeof (taskinfo)) > 0) { @@ -4159,6 +4165,7 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qrss, make_fixnum (taskinfo.pti_resident_size / 1024)), attrs); attrs = Fcons (Fcons (Qthcount, make_fixnum (taskinfo.pti_threadnum)), attrs); } +#endif /* HAVE_PROC_PIDINFO */ #ifdef KERN_PROCARGS2 char args[ARG_MAX]; @@ -4200,8 +4207,9 @@ system_process_attributes (Lisp_Object pid) } /* The WINDOWSNT implementation is in w32.c. - The MSDOS implementation is in dosfns.c. */ -#elif !defined (WINDOWSNT) && !defined (MSDOS) + The MSDOS implementation is in dosfns.c. + The HAIKU implementation is in haiku.c. */ +#elif !defined (WINDOWSNT) && !defined (MSDOS) && !defined (HAIKU) Lisp_Object system_process_attributes (Lisp_Object pid) diff --git a/src/syssignal.h b/src/syssignal.h index 07055c04be6..02fe44a3820 100644 --- a/src/syssignal.h +++ b/src/syssignal.h @@ -22,6 +22,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <signal.h> +#include <attribute.h> + extern void init_signals (void); extern void block_child_signal (sigset_t *); extern void unblock_child_signal (sigset_t const *); diff --git a/src/sysstdio.h b/src/sysstdio.h index 8e1687bc297..727a466be52 100644 --- a/src/sysstdio.h +++ b/src/sysstdio.h @@ -24,9 +24,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <fcntl.h> #include <limits.h> #include <stdio.h> -#include "unlocked-io.h" -extern FILE *emacs_fopen (char const *, char const *); +#include <attribute.h> +#include <unlocked-io.h> + +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 fb1a0a72d64..bf4e0306cdc 100644 --- a/src/systhread.h +++ b/src/systhread.h @@ -21,6 +21,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <stdbool.h> +#include <attribute.h> + #ifdef THREADS_ENABLED #ifdef HAVE_PTHREAD diff --git a/src/systime.h b/src/systime.h index d4b44ccac8b..75088bd4a62 100644 --- a/src/systime.h +++ b/src/systime.h @@ -80,8 +80,7 @@ struct lisp_time /* Clock count as a Lisp integer. */ Lisp_Object ticks; - /* Clock frequency (ticks per second) as a positive Lisp integer. - (TICKS . HZ) is a valid Lisp timestamp unless HZ < 65536. */ + /* Clock frequency (ticks per second) as a positive Lisp integer. */ Lisp_Object hz; }; @@ -92,7 +91,7 @@ extern Lisp_Object timespec_to_lisp (struct timespec); extern bool list4_to_timespec (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, struct timespec *); extern struct timespec lisp_time_argument (Lisp_Object); -extern AVOID time_overflow (void); +extern double float_time (Lisp_Object); extern void init_timefns (void); extern void syms_of_timefns (void); diff --git a/src/term.c b/src/term.c index 5f7e2d19508..bad1127c93b 100644 --- a/src/term.c +++ b/src/term.c @@ -1358,7 +1358,7 @@ term_get_fkeys_1 (void) char *sequence = tgetstr (keys[i].cap, address); if (sequence) Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), - make_vector (1, intern (keys[i].name))); + make_vector (1, intern (keys[i].name)), Qnil); } /* The uses of the "k0" capability are inconsistent; sometimes it @@ -1377,13 +1377,13 @@ term_get_fkeys_1 (void) /* Define f0 first, so that f10 takes precedence in case the key sequences happens to be the same. */ Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), - make_vector (1, intern ("f0"))); + make_vector (1, intern ("f0")), Qnil); Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k_semi), - make_vector (1, intern ("f10"))); + make_vector (1, intern ("f10")), Qnil); } else if (k0) Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), - make_vector (1, intern (k0_name))); + make_vector (1, intern (k0_name)), Qnil); } /* Set up cookies for numbered function keys above f10. */ @@ -1405,8 +1405,10 @@ term_get_fkeys_1 (void) if (sequence) { sprintf (fkey, "f%d", i); - Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), - make_vector (1, intern (fkey))); + Fdefine_key (KVAR (kboard, Vinput_decode_map), + build_string (sequence), + make_vector (1, intern (fkey)), + Qnil); } } } @@ -1422,7 +1424,7 @@ term_get_fkeys_1 (void) char *sequence = tgetstr (cap2, address); \ if (sequence) \ Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), \ - make_vector (1, intern (sym))); \ + make_vector (1, intern (sym)), Qnil); \ } /* if there's no key_next keycap, map key_npage to `next' keysym */ @@ -1630,9 +1632,13 @@ produce_glyphs (struct it *it) } else { - Lisp_Object charset_list = FRAME_TERMINAL (it->f)->charset_list; + struct terminal *t = FRAME_TERMINAL (it->f); + Lisp_Object charset_list = t->charset_list, char_glyph; - if (char_charset (it->char_to_display, charset_list, NULL)) + if (char_charset (it->char_to_display, charset_list, NULL) + && (char_glyph = terminal_glyph_code (t, it->char_to_display), + NILP (char_glyph) + || (FIXNUMP (char_glyph) && XFIXNUM (char_glyph) >= 0))) { it->pixel_width = CHARACTER_WIDTH (it->char_to_display); it->nglyphs = it->pixel_width; @@ -3498,7 +3504,7 @@ tty_menu_show (struct frame *f, int x, int y, int menuflags, int dispwidth, dispheight; int i, j, lines, maxlines; int maxwidth; - ptrdiff_t specpdl_count; + specpdl_ref specpdl_count; eassert (FRAME_TERMCAP_P (f)); @@ -4152,10 +4158,12 @@ use the Bourne shell command 'TERM=...; export TERM' (C-shell:\n\ could return 32767. */ tty->TN_max_colors = 16777216; } - /* Fall back to xterm+direct (semicolon version) if requested - by the COLORTERM environment variable. */ - else if ((bg = getenv("COLORTERM")) != NULL - && strcasecmp(bg, "truecolor") == 0) + /* Fall back to xterm+direct (semicolon version) if Tc is set + (de-facto standard introduced by tmux) or if requested by + the COLORTERM environment variable. */ + else if ((tigetflag ("Tc") > 0) + || ((bg = getenv ("COLORTERM")) != NULL + && strcasecmp (bg, "truecolor") == 0)) { tty->TS_set_foreground = "\033[%?%p1%{8}%<%t3%p1%d%e38;2;%p1%{65536}%/%d;%p1%{256}%/%{255}%&%d;%p1%{255}%&%d%;m"; tty->TS_set_background = "\033[%?%p1%{8}%<%t4%p1%d%e48;2;%p1%{65536}%/%d;%p1%{256}%/%{255}%&%d;%p1%{255}%&%d%;m"; diff --git a/src/termhooks.h b/src/termhooks.h index 080e074526d..8c193914ba8 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -60,7 +60,9 @@ enum output_method output_x_window, output_msdos_raw, output_w32, - output_ns + output_ns, + output_pgtk, + output_haiku }; /* Input queue declarations and hooks. */ @@ -78,10 +80,29 @@ enum event_kind which the key was typed. .timestamp gives a timestamp (in milliseconds) for the keystroke. */ - MULTIBYTE_CHAR_KEYSTROKE_EVENT, /* The multibyte char code is in .code, - perhaps with modifiers applied. - The others are the same as - ASCII_KEYSTROKE_EVENT. */ + MULTIBYTE_CHAR_KEYSTROKE_EVENT, /* The multibyte char code is + in .code, perhaps with + modifiers applied. The + others are the same as + ASCII_KEYSTROKE_EVENT, + except when ARG is a + string, which will be + decoded and the decoded + string's characters will be + used as .code + individually. + + The string can have a + property `coding', which + should be a symbol + describing a coding system + to use to decode the string. + + If it is nil, then the + locale coding system will + be used. If it is t, then + no decoding will take + place. */ NON_ASCII_KEYSTROKE_EVENT, /* .code is a number identifying the function key. A code N represents a key whose name is @@ -119,7 +140,10 @@ enum event_kind .timestamp gives a timestamp (in milliseconds) for the event. .arg may contain the number of - lines to scroll. */ + lines to scroll, or a list of + the form (NUMBER-OF-LINES . (X Y)) where + X and Y are the number of pixels + on each axis to scroll by. */ HORIZ_WHEEL_EVENT, /* A wheel event generated by a second horizontal wheel that is present on some mice. See WHEEL_EVENT. */ @@ -184,6 +208,25 @@ enum event_kind representation of the dropped items. .timestamp gives a timestamp (in milliseconds) for the click. */ +#ifdef HAVE_X_WINDOWS + UNSUPPORTED_DROP_EVENT, /* Event sent when the regular C + drag-and-drop machinery could not + handle a drop to a window. + + .code is the XID of the window that + could not be dropped to. + + .arg is a list of the local value of + XdndSelection, a list of selection + targets, and the intended action to + be taken upon drop, and .timestamp + gives the timestamp where the drop + happened. + + .x and .y give the coordinates of + the drop originating from the root + window. */ +#endif USER_SIGNAL_EVENT, /* A user signal. code is a number identifying it, index into lispy_user_signals. */ @@ -255,6 +298,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 @@ -262,6 +307,43 @@ enum event_kind , FILE_NOTIFY_EVENT #endif + /* Pre-edit text was changed. */ + , PREEDIT_TEXT_EVENT + + /* Either the mouse wheel has been released without it being + clicked, or the user has lifted his finger from a touchpad. + + In the future, this may take into account other multi-touch + events generated from touchscreens and such. */ + , TOUCH_END_EVENT + + /* In a TOUCHSCREEN_UPDATE_EVENT, ARG is a list of elements of the + form (X Y ID), where X and Y are the coordinates of the + touchpoint relative to the top-left corner of the frame, and ID + is a unique number identifying the touchpoint. + + In TOUCHSCREEN_BEGIN_EVENT and TOUCHSCREEN_END_EVENT, ARG is the + unique ID of the touchpoint, and X and Y are the frame-relative + positions of the touchpoint. */ + + , TOUCHSCREEN_UPDATE_EVENT + , TOUCHSCREEN_BEGIN_EVENT + , TOUCHSCREEN_END_EVENT + + /* In a PINCH_EVENT, X and Y are the position of the pointer + relative to the top-left corner of the frame, and arg is a list + of (DX DY SCALE ANGLE), in which: + + - DX and DY are the difference between the positions of the + fingers comprising the current gesture and the last such + gesture in the same sequence. + - SCALE is the division of the current distance between the + fingers and the distance at the start of the gesture. + - DELTA-ANGLE is the delta between the angle of the current + event and the last event in the same sequence, in degrees. A + positive delta represents a change clockwise, and a negative + delta represents a change counter-clockwise. */ + , PINCH_EVENT }; /* Bit width of an enum event_kind tag at the start of structs and unions. */ @@ -310,9 +392,17 @@ struct input_event when building events. Unfortunately some events have to pass much more data than it's reasonable to pack directly into this structure. */ Lisp_Object arg; + + /* The name of the device from which this event originated. + + It can either be a string, or Qt, which means to use the name + "Virtual core pointer" for all events other than keystroke + events, and "Virtual core keyboard" for those. */ + Lisp_Object device; }; -#define EVENT_INIT(event) memset (&(event), 0, sizeof (struct input_event)) +#define EVENT_INIT(event) (memset (&(event), 0, sizeof (struct input_event)), \ + (event).device = Qt) /* Bits in the modifiers member of the input_event structure. Note that reorder_modifiers assumes that the bits are in canonical @@ -442,6 +532,8 @@ struct terminal struct x_display_info *x; /* xterm.h */ struct w32_display_info *w32; /* w32term.h */ struct ns_display_info *ns; /* nsterm.h */ + struct pgtk_display_info *pgtk; /* pgtkterm.h */ + struct haiku_display_info *haiku; /* haikuterm.h */ } display_info; @@ -515,7 +607,7 @@ struct terminal BGCOLOR. */ void (*query_frame_background_color) (struct frame *f, Emacs_Color *bgcolor); -#if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) +#if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (HAVE_PGTK) /* On frame F, translate pixel colors to RGB values for the NCOLORS colors in COLORS. Use cached information, if available. */ @@ -766,6 +858,13 @@ struct terminal frames on the terminal when it calls this hook, so infinite recursion is prevented. */ void (*delete_terminal_hook) (struct terminal *); + + /* Called to determine whether a position is on the toolkit tool bar + or menu bar. May be NULL. It should accept five arguments + FRAME, X, Y, MENU_BAR_P, TOOL_BAR_P, and store true into + MENU_BAR_P if X and Y are in FRAME's toolkit menu bar, and true + into TOOL_BAR_P if X and Y are in FRAME's toolkit tool bar. */ + void (*toolkit_position_hook) (struct frame *, int, int, bool *, bool *); } GCALIGNED_STRUCT; INLINE bool @@ -830,6 +929,12 @@ extern struct terminal *terminal_list; #elif defined (HAVE_NS) #define TERMINAL_FONT_CACHE(t) \ (t->type == output_ns ? t->display_info.ns->name_list_element : Qnil) +#elif defined (HAVE_PGTK) +#define TERMINAL_FONT_CACHE(t) \ + (t->type == output_pgtk ? t->display_info.pgtk->name_list_element : Qnil) +#elif defined (HAVE_HAIKU) +#define TERMINAL_FONT_CACHE(t) \ + (t->type == output_haiku ? t->display_info.haiku->name_list_element : Qnil) #endif extern struct terminal *decode_live_terminal (Lisp_Object); diff --git a/src/terminal.c b/src/terminal.c index 3674eccdbb7..80f3aed7006 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -445,6 +445,10 @@ possible return values. */) return Qpc; case output_ns: return Qns; + case output_pgtk: + return Qpgtk; + case output_haiku: + return Qhaiku; default: emacs_abort (); } @@ -618,6 +622,8 @@ init_initial_terminal (void) emacs_abort (); initial_terminal = create_terminal (output_initial, NULL); + /* Note: menu-bar.el:menu-bar-update-buffers knows about this + special name of the initial terminal. */ initial_terminal->name = xstrdup ("initial_terminal"); initial_terminal->kboard = initial_kboard; initial_terminal->delete_terminal_hook = &delete_initial_terminal; diff --git a/src/textprop.c b/src/textprop.c index 2d1e34d5867..c6c9e102e34 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -792,7 +792,7 @@ The property values are compared with `eq'. */) else { Lisp_Object initial_value, value; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (! NILP (object)) CHECK_BUFFER (object); @@ -879,7 +879,7 @@ first valid position in OBJECT. */) } else { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (! NILP (object)) CHECK_BUFFER (object); @@ -1164,7 +1164,7 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end, buffers is slow and often unnecessary. */ if (BUFFERP (object) && XBUFFER (object) != current_buffer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); set_buffer_internal (XBUFFER (object)); return unbind_to (count, add_text_properties_1 (start, end, properties, @@ -1379,7 +1379,7 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, buffers is slow and often unnecessary. */ if (BUFFERP (object) && XBUFFER (object) != current_buffer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); set_buffer_internal (XBUFFER (object)); return unbind_to (count, @@ -1462,7 +1462,7 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, buffers is slow and often unnecessary. */ if (BUFFERP (object) && XBUFFER (object) != current_buffer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); set_buffer_internal (XBUFFER (object)); @@ -1558,7 +1558,7 @@ Use `set-text-properties' if you want to remove all text properties. */) buffers is slow and often unnecessary. */ if (BUFFERP (object) && XBUFFER (object) != current_buffer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); set_buffer_internal (XBUFFER (object)); return unbind_to (count, @@ -1683,7 +1683,7 @@ Return t if any property was actually removed, nil otherwise. */) buffers is slow and often unnecessary. */ if (BUFFERP (object) && XBUFFER (object) != current_buffer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); set_buffer_internal (XBUFFER (object)); return unbind_to (count, diff --git a/src/thread.c b/src/thread.c index bfcac91982d..626d14aad0a 100644 --- a/src/thread.c +++ b/src/thread.c @@ -83,6 +83,22 @@ release_global_lock (void) sys_mutex_unlock (&global_lock); } +static void +rebind_for_thread_switch (void) +{ + ptrdiff_t distance + = current_thread->m_specpdl_ptr - current_thread->m_specpdl; + specpdl_unrewind (specpdl_ptr, -distance, true); +} + +static void +unbind_for_thread_switch (struct thread_state *thr) +{ + ptrdiff_t distance = thr->m_specpdl_ptr - thr->m_specpdl; + specpdl_unrewind (thr->m_specpdl_ptr, distance, true); +} + + /* You must call this after acquiring the global lock. acquire_global_lock does it for you. */ static void @@ -329,7 +345,7 @@ Note that calls to `mutex-lock' and `mutex-unlock' must be paired. */) (Lisp_Object mutex) { struct Lisp_Mutex *lmutex; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); CHECK_MUTEX (mutex); lmutex = XMUTEX (mutex); @@ -639,7 +655,7 @@ mark_one_thread (struct thread_state *thread) mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr); - mark_stack (thread->m_stack_bottom, stack_top); + mark_c_stack (thread->m_stack_bottom, stack_top); for (struct handler *handler = thread->m_handlerlist; handler; handler = handler->next) @@ -655,6 +671,8 @@ mark_one_thread (struct thread_state *thread) mark_object (tem); } + mark_bytecode (&thread->bc); + /* No need to mark Lisp_Object members like m_last_thing_searched, as mark_threads_callback does that by calling mark_object. */ } @@ -709,7 +727,7 @@ DEFUN ("thread-yield", Fthread_yield, Sthread_yield, 0, 0, 0, static Lisp_Object invoke_thread_function (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); current_thread->result = Ffuncall (1, ¤t_thread->function); return unbind_to (count, Qnil); @@ -774,7 +792,7 @@ run_thread (void *state) xfree (self->m_specpdl - 1); self->m_specpdl = NULL; self->m_specpdl_ptr = NULL; - self->m_specpdl_size = 0; + self->m_specpdl_end = NULL; { struct handler *c, *c_next; @@ -823,6 +841,7 @@ finalize_one_thread (struct thread_state *state) free_search_regs (&state->m_search_regs); free_search_regs (&state->m_saved_search_regs); sys_cond_destroy (&state->thread_condvar); + free_bc_thread (&state->bc); } DEFUN ("make-thread", Fmake_thread, Smake_thread, 1, 2, 0, @@ -846,13 +865,14 @@ If NAME is given, it must be a string; it names the new thread. */) /* Perhaps copy m_last_thing_searched from parent? */ new_thread->m_current_buffer = current_thread->m_current_buffer; - new_thread->m_specpdl_size = 50; - new_thread->m_specpdl = xmalloc ((1 + new_thread->m_specpdl_size) - * sizeof (union specbinding)); - /* Skip the dummy entry. */ - ++new_thread->m_specpdl; + ptrdiff_t size = 50; + union specbinding *pdlvec = xmalloc ((1 + size) * sizeof (union specbinding)); + new_thread->m_specpdl = pdlvec + 1; /* Skip the dummy entry. */ + new_thread->m_specpdl_end = new_thread->m_specpdl + size; new_thread->m_specpdl_ptr = new_thread->m_specpdl; + init_bc_thread (&new_thread->bc); + sys_cond_init (&new_thread->thread_condvar); /* We'll need locking here eventually. */ @@ -1112,6 +1132,7 @@ init_threads (void) sys_mutex_lock (&global_lock); current_thread = &main_thread.s; main_thread.s.thread_id = sys_thread_self (); + init_bc_thread (&main_thread.s.bc); } void diff --git a/src/thread.h b/src/thread.h index 1e7eb86f6ee..82c445ba7e7 100644 --- a/src/thread.h +++ b/src/thread.h @@ -33,6 +33,17 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "sysselect.h" /* FIXME */ #include "systhread.h" +INLINE_HEADER_BEGIN + +/* Byte-code interpreter thread state. */ +struct bc_thread_state { + struct bc_frame *fp; /* current frame pointer */ + + /* start and end of allocated bytecode stack */ + char *stack; + char *stack_end; +}; + struct thread_state { union vectorlike_header header; @@ -92,14 +103,14 @@ struct thread_state struct handler *m_handlerlist_sentinel; #define handlerlist_sentinel (current_thread->m_handlerlist_sentinel) - /* Current number of specbindings allocated in specpdl. */ - ptrdiff_t m_specpdl_size; -#define specpdl_size (current_thread->m_specpdl_size) - /* Pointer to beginning of specpdl. */ union specbinding *m_specpdl; #define specpdl (current_thread->m_specpdl) + /* End of specpld (just beyond the last element). */ + union specbinding *m_specpdl_end; +#define specpdl_end (current_thread->m_specpdl_end) + /* Pointer to first unused element in specpdl. */ union specbinding *m_specpdl_ptr; #define specpdl_ptr (current_thread->m_specpdl_ptr) @@ -181,6 +192,8 @@ struct thread_state /* Threads are kept on a linked list. */ struct thread_state *next_thread; + + struct bc_thread_state bc; } GCALIGNED_STRUCT; INLINE bool @@ -304,4 +317,6 @@ int thread_select (select_func *func, int max_fds, fd_set *rfds, bool thread_check_current_buffer (struct buffer *); +INLINE_HEADER_END + #endif /* THREAD_H */ diff --git a/src/timefns.c b/src/timefns.c index 3e533ca51dc..b061be0a786 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -69,16 +69,6 @@ enum { TM_YEAR_BASE = 1900 }; # define FASTER_TIMEFNS 1 #endif -/* Whether to warn about Lisp timestamps (TICKS . HZ) that may be - instances of obsolete-format timestamps (HI . LO) where HI is - the high-order bits and LO the low-order 16 bits. Currently this - is true, but it should change to false in a future version of - Emacs. Compile with -DWARN_OBSOLETE_TIMESTAMPS=0 to see what the - future will be like. */ -#ifndef WARN_OBSOLETE_TIMESTAMPS -enum { WARN_OBSOLETE_TIMESTAMPS = true }; -#endif - /* Although current-time etc. generate list-format timestamps (HI LO US PS), the plan is to change these functions to generate frequency-based timestamps (TICKS . HZ) in a future release. @@ -352,7 +342,7 @@ init_timefns (void) } /* Report that a time value is out of range for Emacs. */ -void +static AVOID time_overflow (void) { error ("Specified time is not representable"); @@ -817,14 +807,10 @@ decode_time_components (enum timeform form, return decode_ticks_hz (make_integer_mpz (), hz, result, dresult); } -enum { DECODE_SECS_ONLY = WARN_OBSOLETE_TIMESTAMPS + 1 }; - /* Decode a Lisp timestamp SPECIFIED_TIME that represents a time. - FLAGS specifies conversion flags. If FLAGS & DECODE_SECS_ONLY, - ignore and do not validate any sub-second components of an - old-format SPECIFIED_TIME. If FLAGS & WARN_OBSOLETE_TIMESTAMPS, - diagnose what could be obsolete (HIGH . LOW) timestamps. + If DECODE_SECS_ONLY, ignore and do not validate any sub-second + components of an old-format SPECIFIED_TIME. If RESULT is not null, store into *RESULT the converted time; otherwise, store into *DRESULT the number of seconds since the @@ -833,7 +819,7 @@ enum { DECODE_SECS_ONLY = WARN_OBSOLETE_TIMESTAMPS + 1 }; Return the form of SPECIFIED-TIME. Signal an error if unsuccessful. */ static enum timeform -decode_lisp_time (Lisp_Object specified_time, int flags, +decode_lisp_time (Lisp_Object specified_time, bool decode_secs_only, struct lisp_time *result, double *dresult) { Lisp_Object high = make_fixnum (0); @@ -854,7 +840,7 @@ decode_lisp_time (Lisp_Object specified_time, int flags, { Lisp_Object low_tail = XCDR (low); low = XCAR (low); - if (! (flags & DECODE_SECS_ONLY)) + if (! decode_secs_only) { if (CONSP (low_tail)) { @@ -877,9 +863,6 @@ decode_lisp_time (Lisp_Object specified_time, int flags, } else { - if (flags & WARN_OBSOLETE_TIMESTAMPS - && RANGED_FIXNUMP (0, low, (1 << LO_TIME_BITS) - 1)) - message ("obsolete timestamp with cdr %"pI"d", XFIXNUM (low)); form = TIMEFORM_TICKS_HZ; } @@ -896,6 +879,16 @@ decode_lisp_time (Lisp_Object specified_time, int flags, return form; } +/* Convert a Lisp timestamp SPECIFIED_TIME to double. + Signal an error if unsuccessful. */ +double +float_time (Lisp_Object specified_time) +{ + double t; + decode_lisp_time (specified_time, false, 0, &t); + return t; +} + /* Convert Z to time_t, returning true if it fits. */ static bool mpz_time (mpz_t const z, time_t *t) @@ -1008,8 +1001,7 @@ static struct lisp_time lisp_time_struct (Lisp_Object specified_time, enum timeform *pform) { struct lisp_time t; - enum timeform form - = decode_lisp_time (specified_time, WARN_OBSOLETE_TIMESTAMPS, &t, 0); + enum timeform form = decode_lisp_time (specified_time, false, &t, 0); if (pform) *pform = form; return t; @@ -1034,9 +1026,8 @@ lisp_time_argument (Lisp_Object specified_time) static time_t lisp_seconds_argument (Lisp_Object specified_time) { - int flags = WARN_OBSOLETE_TIMESTAMPS | DECODE_SECS_ONLY; struct lisp_time lt; - decode_lisp_time (specified_time, flags, <, 0); + decode_lisp_time (specified_time, true, <, 0); struct timespec t = lisp_to_timespec (lt); if (! timespec_valid_p (t)) time_overflow (); @@ -1087,7 +1078,7 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) if (FLOATP (a) && !isfinite (XFLOAT_DATA (a))) { double da = XFLOAT_DATA (a); - double db = XFLOAT_DATA (Ffloat_time (b)); + double db = float_time (b); return make_float (subtract ? da - db : da + db); } enum timeform aform, bform; @@ -1138,24 +1129,6 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) mpz_t *ihz = &mpz[0]; mpz_mul (*ihz, *fa, *db); - /* When warning about obsolete timestamps, if the smaller - denominator comes from a non-(TICKS . HZ) timestamp and could - generate a (TICKS . HZ) timestamp that would look obsolete, - arrange for the result to have a higher HZ to avoid a - spurious warning by a later consumer of this function's - returned value. */ - verify (1 << LO_TIME_BITS <= ULONG_MAX); - if (WARN_OBSOLETE_TIMESTAMPS - && (da_lt_db ? aform : bform) == TIMEFORM_FLOAT - && (da_lt_db ? bform : aform) != TIMEFORM_TICKS_HZ - && mpz_cmp_ui (*hzmin, 1) > 0 - && mpz_cmp_ui (*hzmin, 1 << LO_TIME_BITS) < 0) - { - mpz_t *hzmin1 = &mpz[2 - da_lt_db]; - mpz_set_ui (*hzmin1, 1 << LO_TIME_BITS); - hzmin = hzmin1; - } - /* iticks = (fb * na) OP (fa * nb), where OP is + or -. */ mpz_t const *na = bignum_integer (iticks, ta.ticks); mpz_mul (*iticks, *fb, *na); @@ -1177,8 +1150,7 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) upwards by multiplying the normalized numerator and denominator so that the resulting denominator becomes at least hzmin. This rescaling avoids returning a timestamp that is less precise - than both a and b, or a timestamp that looks obsolete when that - might be a problem. */ + than both a and b. */ if (!FASTER_TIMEFNS || mpz_cmp (*ihz, *hzmin) < 0) { /* Rescale straightforwardly. Although this might not @@ -1247,16 +1219,16 @@ time_cmp (Lisp_Object a, Lisp_Object b) return da < db ? -1 : da != db; } - struct lisp_time ta = lisp_time_struct (a, 0); - /* Compare nil to nil correctly, and handle other eq values quicker while we're at it. Compare here rather than earlier, to handle - NaNs and check formats. */ + NaNs. This means (time-equal-p X X) does not signal an error if + X is not a valid time value, but that's OK. */ if (EQ (a, b)) return 0; /* Compare (ATICKS . AZ) to (BTICKS . BHZ) by comparing ATICKS * BHZ to BTICKS * AHZ. */ + struct lisp_time ta = lisp_time_struct (a, 0); struct lisp_time tb = lisp_time_struct (b, 0); mpz_t const *za = bignum_integer (&mpz[0], ta.ticks); mpz_t const *zb = bignum_integer (&mpz[1], tb.ticks); @@ -1302,9 +1274,7 @@ If precise time stamps are required, use either `encode-time', or (if you need time as a string) `format-time-string'. */) (Lisp_Object specified_time) { - double t; - decode_lisp_time (specified_time, 0, 0, &t); - return make_float (t); + return make_float (float_time (specified_time)); } /* Write information into buffer S of size MAXSIZE, according to the @@ -1652,12 +1622,11 @@ saving flag to be guessed. As an obsolescent calling convention, if this function is called with 6 or more arguments, the first 6 arguments are SECOND, MINUTE, HOUR, -DAY, MONTH, and YEAR, and specify the components of a decoded time, -where DST assumed to be -1 and FORM is omitted. If there are more -than 6 arguments the *last* argument is used as ZONE and any other -extra arguments are ignored, so that (apply #\\='encode-time -(decode-time ...)) works. In this obsolescent convention, DST and -ZONE default to -1 and nil respectively. +DAY, MONTH, and YEAR, and specify the components of a decoded time. +If there are more than 6 arguments the *last* argument is used as ZONE +and any other extra arguments are ignored, so that (apply +#\\='encode-time (decode-time ...)) works. In this obsolescent +convention, DST and ZONE default to -1 and nil respectively. Years before 1970 are not guaranteed to work. On some systems, year values as low as 1901 do work. @@ -1704,7 +1673,7 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) /* Let SEC = floor (LT.ticks / HZ), with SUBSECTICKS the remainder. */ struct lisp_time lt; - decode_lisp_time (secarg, 0, <, 0); + decode_lisp_time (secarg, false, <, 0); Lisp_Object hz = lt.hz, sec, subsecticks; if (FASTER_TIMEFNS && EQ (hz, make_fixnum (1))) { @@ -1757,9 +1726,7 @@ Truncate the returned value toward minus infinity. If FORM is nil (the default), return the same form as `current-time'. If FORM is a positive integer, return a pair of integers (TICKS . FORM), where TICKS is the number of clock ticks and FORM is the clock frequency -in ticks per second. (Currently the positive integer should be at least -65536 if the returned value is expected to be given to standard functions -expecting Lisp timestamps.) If FORM is t, return (TICKS . PHZ), where +in ticks per second. If FORM is t, return (TICKS . PHZ), where PHZ is a suitable clock frequency in ticks per second. If FORM is `integer', return an integer count of seconds. If FORM is `list', return an integer list (HIGH LOW USEC PSEC), where HIGH has the most @@ -1768,7 +1735,7 @@ bits, and USEC and PSEC are the microsecond and picosecond counts. */) (Lisp_Object time, Lisp_Object form) { struct lisp_time t; - enum timeform input_form = decode_lisp_time (time, 0, &t, 0); + enum timeform input_form = decode_lisp_time (time, false, &t, 0); if (NILP (form)) form = CURRENT_TIME_LIST ? Qlist : Qt; if (EQ (form, Qlist)) diff --git a/src/tparam.h b/src/tparam.h index 6361f138eaa..653f01bdde0 100644 --- a/src/tparam.h +++ b/src/tparam.h @@ -20,6 +20,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef EMACS_TPARAM_H #define EMACS_TPARAM_H +#include <attribute.h> + /* Don't try to include termcap.h. On some systems, configure finds a non-standard termcap.h that the main build won't find. */ diff --git a/src/undo.c b/src/undo.c index 5d705945c4c..36664d16424 100644 --- a/src/undo.c +++ b/src/undo.c @@ -295,7 +295,7 @@ truncate_undo_list (struct buffer *b) /* Make sure that calling undo-outer-limit-function won't cause another GC. */ - ptrdiff_t count = inhibit_garbage_collection (); + specpdl_ref count = inhibit_garbage_collection (); /* Make the buffer current to get its local values of variables such as undo_limit. Also so that Vundo_outer_limit_function can diff --git a/src/verbose.mk.in b/src/verbose.mk.in index 5c6dc746044..4ec7788442d 100644 --- a/src/verbose.mk.in +++ b/src/verbose.mk.in @@ -23,7 +23,9 @@ ifeq (${V},1) AM_V_AR = AM_V_at = AM_V_CC = +AM_V_CXX = AM_V_CCLD = +AM_V_CXXLD = AM_V_ELC = AM_V_ELN = AM_V_GEN = @@ -31,24 +33,47 @@ AM_V_GLOBALS = AM_V_NO_PD = AM_V_RC = else -AM_V_AR = @echo " AR " $@; + +# Whether $(info ...) works. This is to work around a bug in GNU Make +# 4.3 and earlier, which implements $(info MSG) via two system calls +# { write (..., "MSG", 3); write (..., "\n", 1); } +# which looks bad when make -j interleaves two of these at about the same time. +# +# Later versions of GNU Make have the 'notintermediate' feature, +# so assume that $(info ...) works if this feature is present. +# +have_working_info = $(filter notintermediate,$(value .FEATURES)) +# +# The workaround is to use the shell and 'echo' rather than $(info ...). +# The workaround is done only for AM_V_ELC and AM_V_ELN, +# since the bug is not annoying elsewhere. + +AM_V_AR = @$(info $ AR $@) AM_V_at = @ -AM_V_CC = @echo " CC " $@; -AM_V_CCLD = @echo " CCLD " $@; -ifeq ($(HAVE_NATIVE_COMP),yes) -ifeq ($(NATIVE_DISABLED),1) -AM_V_ELC = @echo " ELC " $@; -AM_V_ELN = +AM_V_CC = @$(info $ CC $@) +AM_V_CXX = @$(info $ CXX $@) +AM_V_CCLD = @$(info $ CCLD $@) +AM_V_CXXLD = @$(info $ CXXLD $@) + +ifeq ($(HAVE_NATIVE_COMP)-$(NATIVE_DISABLED)-$(ANCIENT),yes--) +ifneq (,$(have_working_info)) +AM_V_ELC = @$(info $ ELC+ELN $@) +AM_V_ELN = @$(info $ ELN $@) else -AM_V_ELC = @echo " ELC+ELN " $@; -AM_V_ELN = @echo " ELN " $@; +AM_V_ELC = @echo " ELC+ELN " $@; +AM_V_ELN = @echo " ELN " $@; endif else -AM_V_ELC = @echo " ELC " $@; +ifneq (,$(have_working_info)) +AM_V_ELC = @$(info $ ELC $@) +else +AM_V_ELC = @echo " ELC " $@; +endif AM_V_ELN = endif -AM_V_GEN = @echo " GEN " $@; -AM_V_GLOBALS = @echo " GEN " globals.h; + +AM_V_GEN = @$(info $ GEN $@) +AM_V_GLOBALS = @$(info $ GEN globals.h) AM_V_NO_PD = --no-print-directory -AM_V_RC = @echo " RC " $@; +AM_V_RC = @$(info $ RC $@) endif diff --git a/src/w16select.c b/src/w16select.c index f6bc3dd8d47..b878481e469 100644 --- a/src/w16select.c +++ b/src/w16select.c @@ -651,7 +651,7 @@ frame's display, or the first available X display. */) by the X interface code. (On MSDOS, killed text is only put into the clipboard if we run under Windows, so we cannot check the clipboard alone.) */ - if ((EQ (selection, Qnil) || EQ (selection, QPRIMARY)) + if ((NILP (selection) || EQ (selection, QPRIMARY)) && ! NILP (Fsymbol_value (Fintern_soft (build_string ("kill-ring"), Qnil)))) return Qt; diff --git a/src/w32.c b/src/w32.c index 00b8c2515de..0dc874eac40 100644 --- a/src/w32.c +++ b/src/w32.c @@ -2820,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 @@ -3077,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) { @@ -8595,7 +8548,7 @@ fcntl (int s, int cmd, int options) int sys_close (int fd) { - int rc; + int rc = -1; if (fd < 0) { @@ -8650,14 +8603,31 @@ sys_close (int fd) } } - if (fd >= 0 && fd < MAXDESC) - fd_info[fd].flags = 0; - /* Note that sockets do not need special treatment here (at least on NT and Windows 95 using the standard tcp/ip stacks) - it appears that closesocket is equivalent to CloseHandle, which is to be expected because socket handles are fully fledged kernel handles. */ - rc = _close (fd); + if (fd < MAXDESC) + { + if ((fd_info[fd].flags & FILE_DONT_CLOSE) == 0) + { + fd_info[fd].flags = 0; + rc = _close (fd); + } + else + { + /* We don't close here descriptors open by pipe processes + for reading from the pipe, because the reader thread + might be stuck in _sys_read_ahead, and then we will hang + here. If the reader thread exits normally, it will close + the descriptor; otherwise we will leave a zombie thread + hanging around. */ + rc = 0; + /* Leave the flag set for the reader thread to close the + descriptor. */ + fd_info[fd].flags = FILE_DONT_CLOSE; + } + } return rc; } @@ -10945,6 +10915,7 @@ register_aux_fd (int infd) } fd_info[ infd ].cp = cp; fd_info[ infd ].hnd = (HANDLE) _get_osfhandle (infd); + fd_info[ infd ].flags |= FILE_DONT_CLOSE; } #ifdef HAVE_GNUTLS diff --git a/src/w32.h b/src/w32.h index 8a5c4ecbc73..4941170bdcf 100644 --- a/src/w32.h +++ b/src/w32.h @@ -135,6 +135,7 @@ extern filedesc fd_info [ MAXDESC ]; #define FILE_SOCKET 0x0200 #define FILE_NDELAY 0x0400 #define FILE_SERIAL 0x0800 +#define FILE_DONT_CLOSE 0x1000 extern child_process * new_child (void); extern void delete_child (child_process *cp); @@ -161,8 +162,9 @@ extern void prepare_standard_handles (int in, int out, extern void reset_standard_handles (int in, int out, 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 be57d9de4da..a880136d0ac 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; @@ -1193,7 +1217,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) #endif int mask_color; - if (!EQ (Qnil, arg)) + if (!NILP (arg)) f->output_data.w32->mouse_pixel = w32_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); mask_color = FRAME_BACKGROUND_PIXEL (f); @@ -1209,7 +1233,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) /* It's not okay to crash if the user selects a screwy cursor. */ count = x_catch_errors (FRAME_W32_DISPLAY (f)); - if (!EQ (Qnil, Vx_pointer_shape)) + if (!NILP (Vx_pointer_shape)) { CHECK_FIXNUM (Vx_pointer_shape); cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XFIXNUM (Vx_pointer_shape)); @@ -1218,7 +1242,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm); x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s"); - if (!EQ (Qnil, Vx_nontext_pointer_shape)) + if (!NILP (Vx_nontext_pointer_shape)) { CHECK_FIXNUM (Vx_nontext_pointer_shape); nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), @@ -1228,7 +1252,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr); x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s"); - if (!EQ (Qnil, Vx_hourglass_pointer_shape)) + if (!NILP (Vx_hourglass_pointer_shape)) { CHECK_FIXNUM (Vx_hourglass_pointer_shape); hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), @@ -1239,7 +1263,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s"); x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s"); - if (!EQ (Qnil, Vx_mode_pointer_shape)) + if (!NILP (Vx_mode_pointer_shape)) { CHECK_FIXNUM (Vx_mode_pointer_shape); mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), @@ -1249,7 +1273,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm); x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s"); - if (!EQ (Qnil, Vx_sensitive_text_pointer_shape)) + if (!NILP (Vx_sensitive_text_pointer_shape)) { CHECK_FIXNUM (Vx_sensitive_text_pointer_shape); hand_cursor @@ -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); @@ -5114,6 +5173,13 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) my_post_msg (&wmsg, hwnd, msg, wParam, lParam); goto dflt; + case WM_SETTINGCHANGE: + /* Inform the Lisp thread that some system-wide setting has + changed, so if Emacs is interested in some of them, it could + update its internal values. */ + my_post_msg (&wmsg, hwnd, msg, wParam, lParam); + goto dflt; + case WM_SETFOCUS: dpyinfo->faked_key = 0; reset_modifiers (); @@ -5705,7 +5771,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, Lisp_Object name; bool minibuffer_only = false; long window_prompting = 0; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object display; struct w32_display_info *dpyinfo = NULL; Lisp_Object parent, parent_frame; @@ -5952,6 +6018,8 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, NULL, NULL, RES_TYPE_BOOLEAN); gui_default_parameter (f, parameters, Qno_special_glyphs, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); + gui_default_parameter (f, parameters, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); /* Process alpha here (Bug#16619). On XP this fails with child frames. For `no-focus-on-map' frames delay processing of alpha @@ -6089,6 +6157,9 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, gui_default_parameter (f, parameters, Qz_group, Qnil, NULL, NULL, RES_TYPE_SYMBOL); + gui_default_parameter (f, parameters, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); + /* Make the window appear on the frame and enable display, unless the caller says not to. However, with explicit parent, Emacs cannot control visibility, so don't try. */ @@ -6875,7 +6946,7 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) struct frame *f; Lisp_Object frame; Lisp_Object name; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct kboard *kb; bool face_change_before = face_change; @@ -7023,6 +7094,8 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) /* Process alpha here (Bug#17344). */ gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) @@ -7200,10 +7273,9 @@ w32_hide_tip (bool delete) return Qnil; else { - ptrdiff_t count; Lisp_Object was_open = Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_redisplay, Qt); specbind (Qinhibit_quit, Qt); @@ -7244,8 +7316,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, struct text_pos pos; int width, height; int old_windows_or_buffers_changed = windows_or_buffers_changed; - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t count_1; + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object window, size, tip_buf; AUTO_STRING (tip, " *tip*"); @@ -7444,7 +7515,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, /* Insert STRING into the root window's buffer and fit the frame to the buffer. */ - count_1 = SPECPDL_INDEX (); + specpdl_ref count_1 = SPECPDL_INDEX (); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (w->contents)); bset_truncate_lines (current_buffer, Qnil); @@ -7459,7 +7530,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); /* Calculate size of tooltip window. */ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, - make_fixnum (w->pixel_height), Qnil); + make_fixnum (w->pixel_height), Qnil, + Qnil); /* Add the frame's internal border to calculated size. */ width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); @@ -7878,7 +7950,7 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, #endif /* !NTGUI_UNICODE */ { - int count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); w32_dialog_in_progress (Qt); @@ -10257,6 +10329,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 @@ -10315,6 +10441,7 @@ frame_parm_handler w32_frame_parm_handlers[] = w32_set_z_group, 0, /* x_set_override_redirect */ gui_set_no_special_glyphs, + gui_set_alpha_background, }; void @@ -11028,6 +11155,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 60f83a3ef6e..1f93f6d5e05 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -1974,10 +1974,11 @@ w32_decode_weight (int fnweight) if (fnweight >= FW_EXTRABOLD) return 205; if (fnweight >= FW_BOLD) return 200; if (fnweight >= FW_SEMIBOLD) return 180; - if (fnweight >= FW_NORMAL) return 100; - if (fnweight >= FW_LIGHT) return 50; - if (fnweight >= FW_EXTRALIGHT) return 40; - if (fnweight > FW_THIN) return 20; + if (fnweight >= FW_MEDIUM) return 100; + if (fnweight >= FW_NORMAL) return 80; + if (fnweight >= FW_LIGHT) return 50; + if (fnweight >= FW_EXTRALIGHT) return 40; + if (fnweight >= FW_THIN) return 20; return 0; } @@ -1988,10 +1989,11 @@ w32_encode_weight (int n) if (n >= 205) return FW_EXTRABOLD; if (n >= 200) return FW_BOLD; if (n >= 180) return FW_SEMIBOLD; - if (n >= 100) return FW_NORMAL; - if (n >= 50) return FW_LIGHT; - if (n >= 40) return FW_EXTRALIGHT; - if (n >= 20) return FW_THIN; + if (n >= 100) return FW_MEDIUM; + if (n >= 80) return FW_NORMAL; + if (n >= 50) return FW_LIGHT; + if (n >= 40) return FW_EXTRALIGHT; + if (n >= 20) return FW_THIN; return 0; } @@ -2000,14 +2002,15 @@ w32_encode_weight (int n) static Lisp_Object w32_to_fc_weight (int n) { - if (n >= FW_HEAVY) return intern ("black"); - 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_LIGHT) return Qlight; + if (n >= FW_HEAVY) return Qblack; + if (n >= FW_EXTRABOLD) return Qextra_bold; + if (n >= FW_BOLD) return Qbold; + if (n >= FW_SEMIBOLD) return Qsemi_bold; + if (n >= FW_MEDIUM) return Qmedium; + if (n >= FW_NORMAL) return Qnormal; + if (n >= FW_LIGHT) return Qlight; if (n >= FW_EXTRALIGHT) return Qextra_light; - return intern ("thin"); + return Qthin; } /* Fill in all the available details of LOGFONT from FONT_SPEC. */ @@ -2382,7 +2385,6 @@ font_supported_scripts (FONTSIGNATURE * sig) SUBRANGE (108, Qkharoshthi); SUBRANGE (109, Qtai_xuan_jing_symbol); SUBRANGE (110, Qcuneiform); - SUBRANGE (111, Qcuneiform_numbers_and_punctuation); SUBRANGE (111, Qcounting_rod_numeral); SUBRANGE (112, Qsundanese); SUBRANGE (113, Qlepcha); @@ -2658,7 +2660,7 @@ in the font selection dialog. */) ReleaseDC (FRAME_W32_WINDOW (f), hdc); { - int count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object value = Qnil; w32_dialog_in_progress (Qt); @@ -2825,8 +2827,6 @@ syms_of_w32font (void) DEFSYM (Qbuginese, "buginese"); DEFSYM (Qbuhid, "buhid"); DEFSYM (Qcuneiform, "cuneiform"); - DEFSYM (Qcuneiform_numbers_and_punctuation, - "cuneiform-numbers-and-punctuation"); DEFSYM (Qcypriot, "cypriot"); DEFSYM (Qdeseret, "deseret"); DEFSYM (Qglagolitic, "glagolitic"); diff --git a/src/w32image.c b/src/w32image.c index f3374dcfd30..1f7c4921b31 100644 --- a/src/w32image.c +++ b/src/w32image.c @@ -253,6 +253,7 @@ w32_can_use_native_image_api (Lisp_Object type) || EQ (type, Qpng) || EQ (type, Qgif) || EQ (type, Qtiff) + || EQ (type, Qbmp) || EQ (type, Qnative_image))) { /* GDI+ can also display BMP, Exif, ICON, WMF, and EMF images. diff --git a/src/w32inevt.c b/src/w32inevt.c index a2f3a3d293f..6a1d9afacf7 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -420,7 +420,7 @@ w32_console_mouse_position (struct frame **f, *f = get_frame (); *bar_window = Qnil; *part = scroll_bar_above_handle; - SELECTED_FRAME ()->mouse_moved = 0; + (*f)->mouse_moved = 0; XSETINT (*x, movement_pos.X); XSETINT (*y, movement_pos.Y); @@ -436,7 +436,8 @@ mouse_moved_to (int x, int y) /* If we're in the same place, ignore it. */ if (x != movement_pos.X || y != movement_pos.Y) { - SELECTED_FRAME ()->mouse_moved = 1; + struct frame *f = get_frame (); + f->mouse_moved = 1; movement_pos.X = x; movement_pos.Y = y; movement_time = GetTickCount (); @@ -471,13 +472,13 @@ do_mouse_event (MOUSE_EVENT_RECORD *event, int i; /* Mouse didn't move unless MOUSE_MOVED says it did. */ - SELECTED_FRAME ()->mouse_moved = 0; + struct frame *f = get_frame (); + f->mouse_moved = 0; switch (flags) { case MOUSE_MOVED: { - struct frame *f = get_frame (); Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); int mx = event->dwMousePosition.X, my = event->dwMousePosition.Y; @@ -536,7 +537,6 @@ do_mouse_event (MOUSE_EVENT_RECORD *event, case MOUSE_WHEELED: case MOUSE_HWHEELED: { - struct frame *f = get_frame (); /* Mouse positions in console wheel events are reported to ReadConsoleInput relative to the display's top-left corner(!), not relative to the origin of the console screen @@ -588,8 +588,8 @@ do_mouse_event (MOUSE_EVENT_RECORD *event, int x = event->dwMousePosition.X; int y = event->dwMousePosition.Y; - struct frame *f = get_frame (); - emacs_ev->arg = tty_handle_tab_bar_click (f, x, y, (button_state & mask) != 0, + emacs_ev->arg = tty_handle_tab_bar_click (f, x, y, + (button_state & mask) != 0, emacs_ev); emacs_ev->modifiers |= ((button_state & mask) diff --git a/src/w32menu.c b/src/w32menu.c index 42e27babbc9..5cd6c3310e3 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -188,7 +188,7 @@ menubar_selection_callback (struct frame *f, void * client_data) i = 0; while (i < f->menu_bar_items_used) { - if (EQ (AREF (vector, i), Qnil)) + if (NILP (AREF (vector, i))) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; @@ -285,7 +285,7 @@ set_frame_menubar (struct frame *f, bool deep_p) struct buffer *prev = current_buffer; Lisp_Object buffer; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = (Lisp_Object *) alloca (previous_menu_items_used @@ -587,7 +587,7 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, i = 0; while (i < menu_items_used) { - if (EQ (AREF (menu_items, i), Qnil)) + if (NILP (AREF (menu_items, i))) { submenu_stack[submenu_depth++] = save_wv; save_wv = prev_wv; @@ -779,7 +779,7 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, i = 0; while (i < menu_items_used) { - if (EQ (AREF (menu_items, i), Qnil)) + if (NILP (AREF (menu_items, i))) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; diff --git a/src/w32proc.c b/src/w32proc.c index 3a6504c9258..781a19f480f 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1206,6 +1206,7 @@ static DWORD WINAPI reader_thread (void *arg) { child_process *cp; + int fd; /* Our identity */ cp = (child_process *)arg; @@ -1220,12 +1221,13 @@ reader_thread (void *arg) { int rc; - if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_CONNECT) != 0) - rc = _sys_wait_connect (cp->fd); - else if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_LISTEN) != 0) - rc = _sys_wait_accept (cp->fd); + fd = cp->fd; + if (fd >= 0 && (fd_info[fd].flags & FILE_CONNECT) != 0) + rc = _sys_wait_connect (fd); + else if (fd >= 0 && (fd_info[fd].flags & FILE_LISTEN) != 0) + rc = _sys_wait_accept (fd); else - rc = _sys_read_ahead (cp->fd); + rc = _sys_read_ahead (fd); /* Don't bother waiting for the event if we already have been told to exit by delete_child. */ @@ -1238,7 +1240,7 @@ reader_thread (void *arg) { DebPrint (("reader_thread.SetEvent(0x%x) failed with %lu for fd %ld (PID %d)\n", (DWORD_PTR)cp->char_avail, GetLastError (), - cp->fd, cp->pid)); + fd, cp->pid)); return 1; } @@ -1266,6 +1268,13 @@ reader_thread (void *arg) if (cp->status == STATUS_READ_ERROR) break; } + /* If this thread was reading from a pipe process, close the + descriptor used for reading, as sys_close doesn't in that case. */ + if (fd_info[fd].flags == FILE_DONT_CLOSE) + { + fd_info[fd].flags = 0; + _close (fd); + } return 0; } diff --git a/src/w32term.c b/src/w32term.c index ae99d9948e6..7837032304c 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -164,6 +164,10 @@ int last_scroll_bar_drag_pos; /* Keyboard code page - may be changed by language-change events. */ int w32_keyboard_codepage; +/* The number of screen lines to scroll for the default mouse-wheel + scroll amount, given by WHEEL_DELTA. */ +static UINT w32_wheel_scroll_lines; + #ifdef CYGWIN int w32_message_fd = -1; #endif /* CYGWIN */ @@ -272,6 +276,19 @@ XGetGCValues (void *ignore, XGCValues *gc, #endif static void +w32_get_mouse_wheel_vertical_delta (void) +{ + if (os_subtype != OS_SUBTYPE_NT) + return; + + UINT scroll_lines; + BOOL ret = SystemParametersInfo (SPI_GETWHEELSCROLLLINES, 0, + &scroll_lines, 0); + if (ret) + w32_wheel_scroll_lines = scroll_lines; +} + +static void w32_set_clip_rectangle (HDC hdc, RECT *rect) { if (rect) @@ -967,22 +984,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; @@ -2552,6 +2553,10 @@ w32_draw_glyph_string (struct glyph_string *s) if (!s->for_overlaps) { + /* Draw relief if not yet drawn. */ + if (!relief_drawn_p && s->face->box != FACE_NO_BOX) + w32_draw_glyph_string_box (s); + /* Draw underline. */ if (s->face->underline) { @@ -2572,7 +2577,11 @@ w32_draw_glyph_string (struct glyph_string *s) int y; if (s->prev - && s->prev->face->underline == FACE_UNDER_LINE) + && s->prev->face->underline == FACE_UNDER_LINE + && (s->prev->face->underline_at_descent_line_p + == s->face->underline_at_descent_line_p) + && (s->prev->face->underline_pixels_above_descent_line + == s->face->underline_pixels_above_descent_line)) { /* We use the same underline style as the previous one. */ thickness = s->prev->underline_thickness; @@ -2595,7 +2604,8 @@ w32_draw_glyph_string (struct glyph_string *s) val = (WINDOW_BUFFER_LOCAL_VALUE (Qx_underline_at_descent_line, s->w)); underline_at_descent_line - = !(NILP (val) || EQ (val, Qunbound)); + = (!(NILP (val) || EQ (val, Qunbound)) + || s->face->underline_at_descent_line_p); val = (WINDOW_BUFFER_LOCAL_VALUE (Qx_use_underline_position_properties, s->w)); @@ -2609,7 +2619,9 @@ w32_draw_glyph_string (struct glyph_string *s) thickness = 1; if (underline_at_descent_line || !font) - position = (s->height - thickness) - (s->ybase - s->y); + position = ((s->height - thickness) + - (s->ybase - s->y) + - s->face->underline_pixels_above_descent_line); else { /* Get the underline position. This is the @@ -2627,7 +2639,12 @@ w32_draw_glyph_string (struct glyph_string *s) else position = (font->descent + 1) / 2; } - position = max (position, minimum_offset); + + if (!(s->face->underline_at_descent_line_p + /* Ignore minimum_offset if the amount of pixels + was explictly specified. */ + && s->face->underline_pixels_above_descent_line)) + position = max (position, minimum_offset); } /* Check the sanity of thickness and position. We should avoid drawing underline out of the current line area. */ @@ -2695,10 +2712,6 @@ w32_draw_glyph_string (struct glyph_string *s) } } - /* Draw relief if not yet drawn. */ - if (!relief_drawn_p && s->face->box != FACE_NO_BOX) - w32_draw_glyph_string_box (s); - if (s->prev) { struct glyph_string *prev; @@ -3232,32 +3245,94 @@ w32_construct_mouse_wheel (struct input_event *result, W32Msg *msg, { POINT p; int delta; + static int sum_delta_y = 0; result->kind = msg->msg.message == WM_MOUSEHWHEEL ? HORIZ_WHEEL_EVENT : WHEEL_EVENT; result->code = 0; result->timestamp = msg->msg.time; + result->arg = Qnil; /* A WHEEL_DELTA positive value indicates that the wheel was rotated forward, away from the user (up); a negative value indicates that the wheel was rotated backward, toward the user (down). */ delta = GET_WHEEL_DELTA_WPARAM (msg->msg.wParam); + if (delta == 0) + { + result->kind = NO_EVENT; + return Qnil; + } + + /* With multiple monitors, we can legitimately get negative + coordinates, so cast to short to interpret them correctly. */ + p.x = (short) LOWORD (msg->msg.lParam); + p.y = (short) HIWORD (msg->msg.lParam); + + if (eabs (delta) < WHEEL_DELTA) + { + /* This is high-precision mouse wheel, which sends + fine-resolution wheel events. Produce a wheel event only if + the conditions for sending such an event are fulfilled. */ + int scroll_unit = max (w32_wheel_scroll_lines, 1), nlines; + double value_to_report; + + /* w32_wheel_scroll_lines == UINT_MAX means the user asked for + "entire page" to be the scroll unit. We interpret that as + the height of the window under the mouse pointer. */ + if (w32_wheel_scroll_lines == UINT_MAX) + { + Lisp_Object window = window_from_coordinates (f, p.x, p.y, NULL, + false, false); + if (!WINDOWP (window)) + { + result->kind = NO_EVENT; + return Qnil; + } + scroll_unit = XWINDOW (window)->pixel_height; + if (scroll_unit < 1) /* paranoia */ + scroll_unit = 1; + } + + /* If mwheel-coalesce-scroll-events is non-nil, report a wheel event + only when we have accumulated enough delta's for WHEEL_DELTA. */ + if (mwheel_coalesce_scroll_events) + { + /* If the user changed the direction, reset the accumulated + deltas. */ + if ((delta > 0) != (sum_delta_y > 0)) + sum_delta_y = 0; + sum_delta_y += delta; + /* https://docs.microsoft.com/en-us/previous-versions/ms997498(v=msdn.10) */ + if (eabs (sum_delta_y) < WHEEL_DELTA) + { + result->kind = NO_EVENT; + return Qnil; + } + value_to_report = + ((double)FRAME_LINE_HEIGHT (f) * scroll_unit) + / ((double)WHEEL_DELTA / sum_delta_y); + sum_delta_y = 0; + } + else + value_to_report = + ((double)FRAME_LINE_HEIGHT (f) * scroll_unit) + / ((double)WHEEL_DELTA / delta); + nlines = value_to_report / FRAME_LINE_HEIGHT (f) + 0.5; + result->arg = list3 (make_fixnum (nlines), + make_float (0.0), + make_float (value_to_report)); + } /* The up and down modifiers indicate if the wheel was rotated up or down based on WHEEL_DELTA value. */ result->modifiers = (msg->dwModifiers | ((delta < 0 ) ? down_modifier : up_modifier)); - /* With multiple monitors, we can legitimately get negative - coordinates, so cast to short to interpret them correctly. */ - p.x = (short) LOWORD (msg->msg.lParam); - p.y = (short) HIWORD (msg->msg.lParam); /* For the case that F's w32 window is not msg->msg.hwnd. */ ScreenToClient (FRAME_W32_WINDOW (f), &p); XSETINT (result->x, p.x); XSETINT (result->y, p.y); XSETFRAME (result->frame_or_window, f); - result->arg = Qnil; return Qnil; } @@ -4934,6 +5009,14 @@ w32_read_socket (struct terminal *terminal, } break; + case WM_SETTINGCHANGE: + /* We are only interested in changes of the number of lines + to scroll when the vertical mouse wheel is moved. This + is only supported on NT. */ + if (msg.msg.wParam == SPI_SETWHEELSCROLLLINES) + w32_get_mouse_wheel_vertical_delta (); + break; + case WM_KEYDOWN: case WM_SYSKEYDOWN: f = w32_window_to_frame (dpyinfo, msg.msg.hwnd); @@ -7551,6 +7634,8 @@ w32_initialize (void) horizontal_scroll_bar_left_border = horizontal_scroll_bar_right_border = GetSystemMetrics (SM_CYHSCROLL); } + + w32_get_mouse_wheel_vertical_delta (); } void @@ -7659,9 +7744,10 @@ The native image API library used is GDI+ via GDIPLUS.DLL. This library is available only since W2K, therefore this variable is unconditionally set to nil on older systems. */); - /* For now, disabled by default, since this is an experimental feature. */ -#if 0 && HAVE_NATIVE_IMAGE_API - if (os_subtype == OS_9X) + /* Disabled for Cygwin/w32 builds, since they don't link against + -lgdiplus, see configure.ac. */ +#if defined WINDOWSNT && HAVE_NATIVE_IMAGE_API + if (os_subtype == OS_SUBTYPE_9X) w32_use_native_image_api = 0; else w32_use_native_image_api = 1; diff --git a/src/widget.c b/src/widget.c index c13ec504981..4231aa71b53 100644 --- a/src/widget.c +++ b/src/widget.c @@ -260,9 +260,8 @@ set_frame_size (EmacsFrame ew) } static void -update_wm_hints (EmacsFrame ew) +update_wm_hints (Widget wmshell, EmacsFrame ew) { - Widget wmshell = get_wm_shell ((Widget) ew); int cw; int ch; Dimension rounded_width; @@ -272,9 +271,6 @@ update_wm_hints (EmacsFrame ew) int base_width; int base_height; - /* This happens when the frame is just created. */ - if (! wmshell) return; - pixel_to_char_size (ew, ew->core.width, ew->core.height, &char_width, &char_height); char_to_pixel_size (ew, char_width, char_height, @@ -302,10 +298,9 @@ update_wm_hints (EmacsFrame ew) } void -widget_update_wm_size_hints (Widget widget) +widget_update_wm_size_hints (Widget widget, Widget frame) { - EmacsFrame ew = (EmacsFrame) widget; - update_wm_hints (ew); + update_wm_hints (widget, (EmacsFrame) frame); } static void @@ -386,7 +381,8 @@ EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs frame_size_history_plain (f, build_string ("EmacsFrameRealize")); - update_wm_hints (ew); + if (get_wm_shell (widget)) + update_wm_hints (get_wm_shell (widget), ew); } static void @@ -410,7 +406,8 @@ EmacsFrameResize (Widget widget) change_frame_size (f, ew->core.width, ew->core.height, false, true, false); - update_wm_hints (ew); + if (get_wm_shell (widget)) + update_wm_hints (get_wm_shell (widget), ew); update_various_frame_slots (ew); cancel_mouse_face (f); diff --git a/src/widget.h b/src/widget.h index dbf21a64cb9..2906d5ff9ec 100644 --- a/src/widget.h +++ b/src/widget.h @@ -97,6 +97,6 @@ extern struct _DisplayContext *display_context; /* Special entry points */ void EmacsFrameSetCharSize (Widget, int, int); void widget_store_internal_border (Widget widget); -void widget_update_wm_size_hints (Widget widget); +void widget_update_wm_size_hints (Widget widget, Widget frame); #endif /* _EmacsFrame_h */ diff --git a/src/window.c b/src/window.c index 32e486f9f95..4cca60e23d9 100644 --- a/src/window.c +++ b/src/window.c @@ -481,7 +481,9 @@ Return WINDOW. */) DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0, doc: /* Return the selected window. The selected window is the window in which the standard cursor for -selected windows appears and to which many commands apply. */) +selected windows appears and to which many commands apply. + +Also see `old-selected-window' and `minibuffer-selected-window'. */) (void) { return selected_window; @@ -2579,7 +2581,7 @@ window_list (void) if (!CONSP (Vwindow_list)) { Lisp_Object tail, frame; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Vwindow_list = Qnil; /* Don't allow quitting in Fnconc. Otherwise we might end up @@ -2737,7 +2739,7 @@ static Lisp_Object next_window (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames, bool next_p) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); decode_next_window_args (&window, &minibuf, &all_frames); @@ -2891,7 +2893,7 @@ static Lisp_Object window_list_1 (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames) { Lisp_Object tail, list, rest; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); decode_next_window_args (&window, &minibuf, &all_frames); list = Qnil; @@ -3184,14 +3186,6 @@ resize_root_window (Lisp_Object window, Lisp_Object delta, horizontal, ignore, pixelwise); } -void -sanitize_window_sizes (Lisp_Object horizontal) -{ - /* Don't burp in temacs -nw before window.el is loaded. */ - if (!NILP (Fsymbol_function (Qwindow__sanitize_window_sizes))) - call1 (Qwindow__sanitize_window_sizes, horizontal); -} - static Lisp_Object window_pixel_to_total (Lisp_Object frame, Lisp_Object horizontal) @@ -3510,7 +3504,7 @@ select_frame_norecord (Lisp_Object frame) static void run_window_configuration_change_hook (struct frame *f) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object frame, global_wcch = Fdefault_value (Qwindow_configuration_change_hook); XSETFRAME (frame, f); @@ -3543,7 +3537,7 @@ run_window_configuration_change_hook (struct frame *f) if (!NILP (Flocal_variable_p (Qwindow_configuration_change_hook, buffer))) { - ptrdiff_t inner_count = SPECPDL_INDEX (); + specpdl_ref inner_count = SPECPDL_INDEX (); record_unwind_protect (select_window_norecord, selected_window); select_window_norecord (window); run_funs (Fbuffer_local_value (Qwindow_configuration_change_hook, @@ -3580,7 +3574,7 @@ has established the size of the new window. */) (Lisp_Object window) { struct window *w = decode_live_window (window); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); Fset_buffer (w->contents); @@ -3820,7 +3814,7 @@ run_window_change_functions (void) Lisp_Object tail, frame; bool selected_frame_change = !EQ (selected_frame, old_selected_frame); bool run_window_state_change_hook = false; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); window_change_record_frames = false; record_unwind_protect_void (window_change_record); @@ -4017,7 +4011,7 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, { struct window *w = XWINDOW (window); struct buffer *b = XBUFFER (buffer); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); bool samebuf = EQ (buffer, w->contents); wset_buffer (w, buffer); @@ -4237,7 +4231,7 @@ temp_output_buffer_show (register Lisp_Object buf) /* Run temp-buffer-show-hook, with the chosen window selected and its buffer current. */ { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object prev_window, prev_buffer; prev_window = selected_window; XSETBUFFER (prev_buffer, old); @@ -5491,7 +5485,7 @@ window_internal_height (struct window *w) static void window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); n = clip_to_bounds (INT_MIN, n, INT_MAX); @@ -5866,7 +5860,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) /* We moved the window start towards ZV, so PT may be now in the scroll margin at the top. */ - move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS); + if (IT_CHARPOS (it) < PT) + move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS); if (IT_CHARPOS (it) == PT && it.current_y >= this_scroll_margin && it.current_y <= last_y - WINDOW_TAB_LINE_HEIGHT (w) @@ -6216,7 +6211,7 @@ scroll_command (Lisp_Object window, Lisp_Object n, int direction) { struct window *w; bool other_window; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); eassert (eabs (direction) == 1); @@ -6312,10 +6307,12 @@ followed by all visible frames on the current terminal. */) if (NILP (window)) window = display_buffer (Vother_window_scroll_buffer, Qt, Qnil); } + else if (FUNCTIONP (Vother_window_scroll_default)) + /* Nothing specified; try to get a window from the function. */ + window = call0 (Vother_window_scroll_default); else { - /* Nothing specified; look for a neighboring window on the same - frame. */ + /* Otherwise, look for a neighboring window on the same frame. */ window = Fnext_window (selected_window, Qlambda, Qnil); if (EQ (window, selected_window)) @@ -6342,10 +6339,12 @@ as argument a number, nil, or `-'. The next window is usually the one below the current one; or the one at the top if the current one is at the bottom. It is determined by the function `other-window-for-scrolling', -which see. */) +which see. + +Also see the `other-window-scroll-default' variable. */) (Lisp_Object arg) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); scroll_command (Fother_window_for_scrolling (), arg, 1); return unbind_to (count, Qnil); } @@ -6356,7 +6355,7 @@ DEFUN ("scroll-other-window-down", Fscroll_other_window_down, For more details, see the documentation for `scroll-other-window'. */) (Lisp_Object arg) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); scroll_command (Fother_window_for_scrolling (), arg, -1); return unbind_to (count, Qnil); } @@ -8232,7 +8231,6 @@ syms_of_window (void) DEFSYM (Qwindow__resize_root_window_vertically, "window--resize-root-window-vertically"); DEFSYM (Qwindow__resize_mini_frame, "window--resize-mini-frame"); - DEFSYM (Qwindow__sanitize_window_sizes, "window--sanitize-window-sizes"); DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total"); DEFSYM (Qsafe, "safe"); DEFSYM (Qdisplay_buffer, "display-buffer"); @@ -8273,6 +8271,14 @@ is displayed in the `mode-line' face. */); doc: /* If this is a live buffer, \\[scroll-other-window] should scroll its window. */); Vother_window_scroll_buffer = Qnil; + DEFVAR_LISP ("other-window-scroll-default", Vother_window_scroll_default, + doc: /* Function that provides the window to scroll by \\[scroll-other-window]. +The function `other-window-for-scrolling' first tries to use +`minibuffer-scroll-window' and `other-window-scroll-buffer'. +But when both are nil, then by default it uses a neighboring window. +This variable is intended to get another default instead of `next-window'. */); + Vother_window_scroll_default = Qnil; + DEFVAR_BOOL ("auto-window-vscroll", auto_window_vscroll_p, doc: /* Non-nil means to automatically adjust `window-vscroll' to view tall lines. */); auto_window_vscroll_p = true; diff --git a/src/window.h b/src/window.h index af081fe25e9..94c9b7124f3 100644 --- a/src/window.h +++ b/src/window.h @@ -756,7 +756,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) #endif /* True if W is a tab bar window. */ -#if defined (HAVE_WINDOW_SYSTEM) +#if defined (HAVE_WINDOW_SYSTEM) && !defined (HAVE_PGTK) # define WINDOW_TAB_BAR_P(W) \ (WINDOWP (WINDOW_XFRAME (W)->tab_bar_window) \ && (W) == XWINDOW (WINDOW_XFRAME (W)->tab_bar_window)) @@ -1188,7 +1188,6 @@ extern int window_scroll_margin (struct window *, enum margin_unit); extern void temp_output_buffer_show (Lisp_Object); extern void replace_buffer_in_windows (Lisp_Object); extern void replace_buffer_in_windows_safely (Lisp_Object); -extern void sanitize_window_sizes (Lisp_Object horizontal); /* This looks like a setter, but it is a bit special. */ extern void wset_buffer (struct window *, Lisp_Object); extern bool window_outdated (struct window *); diff --git a/src/xdisp.c b/src/xdisp.c index 44f2536880b..2dbc68f657c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -741,10 +741,6 @@ int update_mode_lines; static bool line_number_displayed; -/* The name of the *Messages* buffer, a string. */ - -static Lisp_Object Vmessages_buffer_name; - /* Current, index 0, and last displayed echo area message. Either buffers from echo_buffers, or nil to indicate no message. */ @@ -822,6 +818,9 @@ bool help_echo_showing_p; /* Functions to mark elements as needing redisplay. */ enum { REDISPLAY_SOME = 2}; /* Arbitrary choice. */ +static bool calc_pixel_width_or_height (double *, struct it *, Lisp_Object, + struct font *, bool, int *); + void redisplay_other_windows (void) { @@ -1179,7 +1178,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); @@ -1276,8 +1281,8 @@ window_box_height (struct window *w) if (ml_row && ml_row->mode_line_p) height -= ml_row->height; else - height -= estimate_mode_line_height (f, - CURRENT_MODE_LINE_FACE_ID (w)); + height -= estimate_mode_line_height + (f, CURRENT_MODE_LINE_ACTIVE_FACE_ID (w)); } } @@ -1682,7 +1687,7 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, = window_parameter (w, Qmode_line_format); w->mode_line_height - = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), + = display_mode_line (w, CURRENT_MODE_LINE_ACTIVE_FACE_ID (w), NILP (window_mode_line_format) ? BVAR (current_buffer, mode_line_format) : window_mode_line_format); @@ -2993,7 +2998,7 @@ safe__call (bool inhibit_quit, ptrdiff_t nargs, Lisp_Object func, va_list ap) else { ptrdiff_t i; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object *args; USE_SAFE_ALLOCA; SAFE_ALLOCA_LISP (args, nargs); @@ -3137,11 +3142,11 @@ CHECK_WINDOW_END (struct window *w) will produce glyphs in that row. BASE_FACE_ID is the id of a base face to use. It must be one of - DEFAULT_FACE_ID for normal text, MODE_LINE_FACE_ID, + DEFAULT_FACE_ID for normal text, MODE_LINE_ACTIVE_FACE_ID, MODE_LINE_INACTIVE_FACE_ID, or HEADER_LINE_FACE_ID for displaying mode lines, or TOOL_BAR_FACE_ID for displaying the tool-bar. - If ROW is null and BASE_FACE_ID is equal to MODE_LINE_FACE_ID, + If ROW is null and BASE_FACE_ID is equal to MODE_LINE_ACTIVE_FACE_ID, MODE_LINE_INACTIVE_FACE_ID, or HEADER_LINE_FACE_ID, the iterator will be initialized to use the corresponding mode line glyph row of the desired matrix of W. */ @@ -3187,7 +3192,7 @@ init_iterator (struct it *it, struct window *w, appropriate. */ if (row == NULL) { - if (base_face_id == MODE_LINE_FACE_ID + if (base_face_id == MODE_LINE_ACTIVE_FACE_ID || base_face_id == MODE_LINE_INACTIVE_FACE_ID) row = MATRIX_MODE_LINE_ROW (w->desired_matrix); else if (base_face_id == TAB_LINE_FACE_ID) @@ -3979,6 +3984,12 @@ compute_stop_pos (struct it *it) pos = next_overlay_change (charpos); if (pos < it->stop_charpos) it->stop_charpos = pos; + /* If we are breaking compositions at point, stop at point. */ + if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) + && !NILP (Vauto_composition_mode) + && composition_break_at_point + && charpos < PT && PT < it->stop_charpos) + it->stop_charpos = PT; /* Set up variables for computing the stop position from text property changes. */ @@ -3990,7 +4001,8 @@ compute_stop_pos (struct it *it) chunks. We play safe here by assuming that only SPC, TAB, FF, and NL cannot be in some composition; in particular, most ASCII punctuation characters could be composed into ligatures. */ - if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) + if (!composition_break_at_point + && !NILP (BVAR (current_buffer, enable_multibyte_characters)) && !NILP (Vauto_composition_mode)) { ptrdiff_t endpos = charpos + 10 * TEXT_PROP_DISTANCE_LIMIT; @@ -4299,7 +4311,7 @@ handle_fontified_prop (struct it *it) no amount of fontifying will be able to change it. */ NILP (prop) && IT_CHARPOS (*it) < Z)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; struct buffer *obuf = current_buffer; ptrdiff_t begv = BEGV, zv = ZV; @@ -4494,7 +4506,7 @@ 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 (); + specpdl_ref 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. */ @@ -5151,6 +5163,160 @@ setup_for_ellipsis (struct it *it, int len) it->ellipsis_p = true; } + +static Lisp_Object +find_display_property (Lisp_Object disp, Lisp_Object prop) +{ + if (NILP (disp)) + return Qnil; + /* We have a vector of display specs. */ + if (VECTORP (disp)) + { + for (ptrdiff_t i = 0; i < ASIZE (disp); i++) + { + Lisp_Object elem = AREF (disp, i); + if (CONSP (elem) + && CONSP (XCDR (elem)) + && EQ (XCAR (elem), prop)) + return XCAR (XCDR (elem)); + } + return Qnil; + } + /* We have a list of display specs. */ + else if (CONSP (disp) + && CONSP (XCAR (disp))) + { + while (!NILP (disp)) + { + Lisp_Object elem = XCAR (disp); + if (CONSP (elem) + && CONSP (XCDR (elem)) + && EQ (XCAR (elem), prop)) + return XCAR (XCDR (elem)); + + /* Check that we have a proper list before going to the next + element. */ + if (CONSP (XCDR (disp))) + disp = XCDR (disp); + else + disp = Qnil; + } + return Qnil; + } + /* A simple display spec. */ + else if (CONSP (disp) + && CONSP (XCDR (disp)) + && EQ (XCAR (disp), prop)) + return XCAR (XCDR (disp)); + else + return Qnil; +} + +static Lisp_Object +get_display_property (ptrdiff_t bufpos, Lisp_Object prop, Lisp_Object object) +{ + return find_display_property (Fget_text_property (make_fixnum (bufpos), + Qdisplay, object), + prop); +} + +static void +display_min_width (struct it *it, ptrdiff_t bufpos, + Lisp_Object object, Lisp_Object width_spec) +{ + /* We're being called at the end of the `min-width' sequence, + probably. */ + if (!NILP (it->min_width_property) + && !EQ (width_spec, it->min_width_property)) + { + if (!it->glyph_row) + return; + + /* When called from display_string (i.e., the mode line), + we're being called with a string as the object, and we + may be called with many sub-strings belonging to the same + :propertize run. */ + if ((bufpos == 0 + && !EQ (it->min_width_property, + get_display_property (0, Qmin_width, object))) + /* In a buffer -- check that we're really right after the + sequence of characters covered by this `min-width'. */ + || (bufpos > BEGV + && EQ (it->min_width_property, + get_display_property (bufpos - 1, Qmin_width, object)))) + { + Lisp_Object w = Qnil; + double width; +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (it->f)) + { + struct font *font = NULL; + struct face *face = FACE_FROM_ID (it->f, it->face_id); + font = face->font ? face->font : FRAME_FONT (it->f); + calc_pixel_width_or_height (&width, it, + XCAR (it->min_width_property), + font, true, NULL); + width -= it->current_x - it->min_width_start; + w = list1 (make_int (width)); + } + else +#endif + { + calc_pixel_width_or_height (&width, it, + XCAR (it->min_width_property), + NULL, true, NULL); + width -= (it->current_x - it->min_width_start) / + FRAME_COLUMN_WIDTH (it->f); + w = make_int (width); + } + + /* Insert the stretch glyph. */ + it->object = list3 (Qspace, QCwidth, w); + produce_stretch_glyph (it); + it->min_width_property = Qnil; + } + } + + /* We're at the start of a `min-width' sequence -- record the + position and the property, so that we can later see if we're at + the end. */ + if (CONSP (width_spec)) + { + if (bufpos == BEGV + /* Mode line (see above). */ + || (bufpos == 0 + && !EQ (it->min_width_property, + get_display_property (0, Qmin_width, object))) + /* Buffer. */ + || (bufpos > BEGV + && !EQ (width_spec, + get_display_property (bufpos - 1, Qmin_width, object)))) + { + it->min_width_property = width_spec; + it->min_width_start = it->current_x; + } + } +} + +DEFUN ("get-display-property", Fget_display_property, + Sget_display_property, 2, 4, 0, + doc: /* Get the value of the `display' property PROP at POSITION. +If OBJECT, this should be a buffer or string where the property is +fetched from. If omitted, OBJECT defaults to the current buffer. + +If PROPERTIES, look for value of PROP in PROPERTIES instead of the +properties at POSITION. */) + (Lisp_Object position, Lisp_Object prop, Lisp_Object object, + Lisp_Object properties) +{ + if (NILP (properties)) + properties = Fget_text_property (position, Qdisplay, object); + else + CHECK_LIST (properties); + + return find_display_property (properties, prop); +} + /*********************************************************************** @@ -5199,14 +5365,21 @@ handle_display_prop (struct it *it) propval = get_char_property_and_overlay (make_fixnum (position->charpos), Qdisplay, object, &overlay); + + /* Rest of the code must have OBJECT be either a string or a buffer. */ + if (!STRINGP (it->string)) + object = it->w->contents; + + /* Handle min-width ends. */ + if (!NILP (it->min_width_property) + && NILP (find_display_property (propval, Qmin_width))) + display_min_width (it, bufpos, object, Qnil); + if (NILP (propval)) return HANDLED_NORMALLY; /* Now OVERLAY is the overlay that gave us this property, or nil if it was a text property. */ - if (!STRINGP (it->string)) - object = it->w->contents; - display_replaced = handle_display_spec (it, propval, object, overlay, position, bufpos, FRAME_WINDOW_P (it->f)); @@ -5260,6 +5433,7 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, && !(CONSP (XCAR (spec)) && EQ (XCAR (XCAR (spec)), Qmargin)) && !EQ (XCAR (spec), Qleft_fringe) && !EQ (XCAR (spec), Qright_fringe) + && !EQ (XCAR (spec), Qmin_width) && !NILP (XCAR (spec))) { for (; CONSP (spec); spec = XCDR (spec)) @@ -5377,7 +5551,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, form = Qnil; if (!NILP (form) && !EQ (form, Qt)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Bind `object' to the object having the `display' property, a buffer or string. Bind `position' to the position in the @@ -5454,7 +5628,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, { /* Evaluate IT->font_height with `height' bound to the current specified height to get the new height. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct face *face = FACE_FROM_ID (it->f, it->face_id); specbind (Qheight, face->lface[LFACE_HEIGHT_INDEX]); @@ -5493,6 +5667,17 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, return 0; } + /* Handle `(min-width (WIDTH))'. */ + if (CONSP (spec) + && EQ (XCAR (spec), Qmin_width) + && CONSP (XCDR (spec)) + && CONSP (XCAR (XCDR (spec)))) + { + if (it) + display_min_width (it, bufpos, object, XCAR (XCDR (spec))); + return 0; + } + /* Handle `(slice X Y WIDTH HEIGHT)'. */ if (CONSP (spec) && EQ (XCAR (spec), Qslice)) @@ -5640,8 +5825,15 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, if (CONSP (XCDR (XCDR (spec)))) { Lisp_Object face_name = XCAR (XCDR (XCDR (spec))); - int face_id2 = lookup_derived_face (it->w, it->f, face_name, - FRINGE_FACE_ID, false); + int face_id2; + /* Don't allow quitting from lookup_derived_face, for when + we are displaying a non-selected window, and the buffer's + point was temporarily moved to the window-point. */ + specpdl_ref count1 = SPECPDL_INDEX (); + specbind (Qinhibit_quit, Qt); + face_id2 = lookup_derived_face (it->w, it->f, face_name, + FRINGE_FACE_ID, false); + unbind_to (count1, Qnil); if (face_id2 >= 0) face_id = face_id2; } @@ -5810,7 +6002,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, #ifdef HAVE_WINDOW_SYSTEM else { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); it->what = IT_IMAGE; /* Don't allow quitting from lookup_image, for when we are @@ -6640,6 +6832,27 @@ iterate_out_of_display_property (struct it *it) it->current.string_pos = it->position; } +/* Restore the IT->face_box_p flag, since it could have been + overwritten by the face of the object that we just finished + displaying. Also, set the IT->start_of_box_run_p flag if the + change in faces requires that. */ +static void +restore_face_box_flags (struct it *it, int prev_face_id) +{ + struct face *face = FACE_FROM_ID_OR_NULL (it->f, it->face_id); + + if (face) + { + struct face *prev_face = FACE_FROM_ID_OR_NULL (it->f, prev_face_id); + + if (!(it->start_of_box_run_p && prev_face && prev_face->box)) + it->start_of_box_run_p = (face->box != FACE_NO_BOX + && (prev_face == NULL + || prev_face->box == FACE_NO_BOX)); + it->face_box_p = face->box != FACE_NO_BOX; + } +} + /* Restore IT's settings from IT->stack. Called, for example, when no more overlay strings must be processed, and we return to delivering display elements from a buffer, or when the end of a string from a @@ -6652,6 +6865,7 @@ pop_it (struct it *it) struct iterator_stack_entry *p; bool from_display_prop = it->from_disp_prop_p; ptrdiff_t prev_pos = IT_CHARPOS (*it); + int prev_face_id = it->face_id; eassert (it->sp > 0); --it->sp; @@ -6683,25 +6897,13 @@ pop_it (struct it *it) break; case GET_FROM_BUFFER: { - struct face *face = FACE_FROM_ID_OR_NULL (it->f, it->face_id); - - /* Restore the face_box_p flag, since it could have been - overwritten by the face of the object that we just finished - displaying. */ - if (face) - it->face_box_p = face->box != FACE_NO_BOX; + restore_face_box_flags (it, prev_face_id); it->object = it->w->contents; } break; case GET_FROM_STRING: { - struct face *face = FACE_FROM_ID_OR_NULL (it->f, it->face_id); - - /* Restore the face_box_p flag, since it could have been - overwritten by the face of the object that we just finished - displaying. */ - if (face) - it->face_box_p = face->box != FACE_NO_BOX; + restore_face_box_flags (it, prev_face_id); it->object = it->string; } break; @@ -7196,6 +7398,7 @@ reseat_1 (struct it *it, struct text_pos pos, bool set_stop_p) } /* This make the information stored in it->cmp_it invalidate. */ it->cmp_it.id = -1; + it->min_width_property = Qnil; } @@ -8990,7 +9193,19 @@ next_element_from_buffer (struct it *it) && IT_CHARPOS (*it) >= it->redisplay_end_trigger_charpos) run_redisplay_end_trigger_hook (it); - stop = it->bidi_it.scan_dir < 0 ? -1 : it->end_charpos; + if (composition_break_at_point + && !NILP (BVAR (current_buffer, enable_multibyte_characters)) + && !NILP (Vauto_composition_mode)) + { + /* Limit search for composable characters to point's position. */ + if (it->bidi_it.scan_dir < 0) + stop = (PT <= IT_CHARPOS (*it)) ? PT : -1; + else + stop = (IT_CHARPOS (*it) < PT + && PT < it->end_charpos) ? PT : it->end_charpos; + } + else + stop = it->bidi_it.scan_dir < 0 ? -1 : it->end_charpos; if (CHAR_COMPOSED_P (it, IT_CHARPOS (*it), IT_BYTEPOS (*it), stop) && next_element_from_composition (it)) @@ -9695,6 +9910,18 @@ move_it_in_display_line_to (struct it *it, } else result = MOVE_NEWLINE_OR_CR; + /* If lines are truncated, and the line we moved across is + completely hscrolled out of view, reset the line metrics + to those of the newline we've just processed, so that + glyphs not on display don't affect the line's height. */ + if (it->line_wrap == TRUNCATE + && it->current_x <= it->first_visible_x + && result == MOVE_NEWLINE_OR_CR + && it->char_to_display == '\n') + { + it->max_ascent = it->ascent; + it->max_descent = it->descent; + } /* If we've processed the newline, make sure this flag is reset, as it must only be set when the newline itself is processed. */ @@ -10638,73 +10865,21 @@ in_display_vector_p (struct it *it) && it->dpvec + it->current.dpvec_index != it->dpend); } -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 -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. - -This function exists to allow Lisp programs to adjust the dimensions -of WINDOW to the buffer text it needs to display. - -The optional argument FROM, if non-nil, specifies the first text -position to consider, and defaults to the minimum accessible position -of the buffer. If FROM is t, it stands for the minimum accessible -position that starts a non-empty line. TO, if non-nil, specifies the -last text position and defaults to the maximum accessible position of -the buffer. If TO is t, it stands for the maximum accessible position -that ends a non-empty line. - -The optional argument X-LIMIT, if non-nil, specifies the maximum X -coordinate beyond which the text should be ignored. It is therefore -also the maximum width that the function can return. X-LIMIT nil or -omitted means to use the pixel-width of WINDOW's body. This default -means text of truncated lines wider than the window will be ignored; -specify a large value for X-LIMIT if lines are truncated and you need -to account for the truncated text. Use nil for X-LIMIT if you want to -know how high WINDOW should become in order to fit all of its buffer's -text with the width of WINDOW unaltered. Use the maximum width WINDOW -may assume if you intend to change WINDOW's width. Since calculating -the width of long lines can take some time, it's always a good idea to -make this argument as small as possible; in particular, if the buffer -contains long lines that shall be truncated anyway. - -The optional argument Y-LIMIT, if non-nil, specifies the maximum Y -coordinate beyond which the text is to be ignored; it is therefore -also the maximum height that the function can return (excluding the -height of the mode- or header-line, if any). Y-LIMIT nil or omitted -means consider all of the accessible portion of buffer text up to the -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-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 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_lines) +/* This is like Fwindow_text_pixel_size but assumes that WINDOW's buffer + is the current buffer. Fbuffer_text_pixel_size calls it after it has + set WINDOW's buffer to the buffer specified by its BUFFER_OR_NAME + argument. */ +static Lisp_Object +window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, + Lisp_Object x_limit, Lisp_Object y_limit, + Lisp_Object mode_lines, Lisp_Object ignore_line_at_end) { struct window *w = decode_live_window (window); - Lisp_Object buffer = w->contents; - struct buffer *b; struct it it; - struct buffer *old_b = NULL; ptrdiff_t start, end, bpos; struct text_pos startp; void *itdata = NULL; - int c, max_x = 0, max_y = 0, x = 0, y = 0; - - CHECK_BUFFER (buffer); - b = XBUFFER (buffer); - - if (b != current_buffer) - { - old_b = current_buffer; - set_buffer_internal (b); - } + int c, max_x = 0, max_y = 0, x = 0, y = 0, vertical_offset = 0, doff = 0; if (NILP (from)) { @@ -10730,6 +10905,13 @@ include the height of any of these, if present, in the return value. */) break; } } + else if (CONSP (from)) + { + start = clip_to_bounds (BEGV, fix_position (XCAR (from)), ZV); + bpos = CHAR_TO_BYTE (start); + CHECK_FIXNUM (XCDR (from)); + vertical_offset = XFIXNUM (XCDR (from)); + } else { start = clip_to_bounds (BEGV, fix_position (from), ZV); @@ -10764,8 +10946,10 @@ include the height of any of these, if present, in the return value. */) else end = clip_to_bounds (start, fix_position (to), ZV); - if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX)) + if (RANGED_FIXNUMP (0, x_limit, INT_MAX)) max_x = XFIXNUM (x_limit); + else if (!NILP (x_limit)) + max_x = INT_MAX; if (NILP (y_limit)) max_y = INT_MAX; @@ -10774,7 +10958,9 @@ include the height of any of these, if present, in the return value. */) itdata = bidi_shelve_cache (); start_display (&it, w, startp); + int start_y = it.current_y; + /* It makes no sense to measure dimensions of region of text that crosses the point where bidi reordering changes scan direction. By using unidirectional movement here we at least support the use @@ -10783,16 +10969,96 @@ include the height of any of these, if present, in the return value. */) same directionality. */ it.bidi_p = false; - /* Start at the beginning of the line containing FROM. Otherwise - IT.current_x will be incorrectly set to zero at some arbitrary - non-zero X coordinate. */ - reseat_at_previous_visible_line_start (&it); - it.current_x = it.hpos = 0; - if (IT_CHARPOS (it) != start) - move_it_to (&it, start, -1, -1, -1, MOVE_TO_POS); + int start_x; + if (vertical_offset != 0) + { + int last_y; + it.current_y = 0; + + move_it_by_lines (&it, 0); + + /* `move_it_vertically_backward' is called by move_it_vertically + to move by a negative value (upwards), but it is not always + guaranteed to leave the iterator at or above the position + given by the offset, which this loop ensures. */ + if (vertical_offset < 0) + { + while (it.current_y > vertical_offset) + { + last_y = it.current_y; + move_it_vertically_backward (&it, + (abs (vertical_offset) + + it.current_y)); + + if (it.current_y == last_y) + break; + } + } + else + { + move_it_vertically (&it, vertical_offset); + } + + it.current_y = (WINDOW_TAB_LINE_HEIGHT (w) + + WINDOW_HEADER_LINE_HEIGHT (w)); + start = clip_to_bounds (BEGV, IT_CHARPOS (it), ZV); + start_y = it.current_y; + start_x = it.current_x; + } + else + { + /* Start at the beginning of the line containing FROM. Otherwise + IT.current_x will be incorrectly set to zero at some arbitrary + non-zero X coordinate. */ + reseat_at_previous_visible_line_start (&it); + it.current_x = it.hpos = 0; + if (IT_CHARPOS (it) != start) + { + void *it1data = NULL; + struct it it1; + + SAVE_IT (it1, it, it1data); + move_it_to (&it, start, -1, -1, -1, MOVE_TO_POS); + /* We could have a display property at START, in which case + asking move_it_to to stop at START will overshoot and + stop at position after START. So we try again, stopping + before START, and account for the width of the last + buffer position manually. */ + if (IT_CHARPOS (it) > start && start > BEGV) + { + ptrdiff_t it1pos = IT_CHARPOS (it1); + int it1_x = it1.current_x; + + RESTORE_IT (&it, &it1, it1data); + /* If START - 1 is the beginning of screen line, + move_it_to will not move, so we need to use a + lower-level move_it_in_display_line subroutine, and + tell it to move just 1 pixel, so it stops at the next + display element. */ + if (start - 1 > it1pos) + move_it_to (&it, start - 1, -1, -1, -1, MOVE_TO_POS); + else + move_it_in_display_line (&it, start, it1_x + 1, + MOVE_TO_POS | MOVE_TO_X); + move_it_to (&it, start - 1, -1, -1, -1, MOVE_TO_POS); + start_x = it.current_x; + /* If we didn't change our buffer position, the pixel + width of what's here was not yet accounted for; do it + manually. */ + if (IT_CHARPOS (it) == start - 1) + start_x += it.pixel_width; + } + else + { + start_x = it.current_x; + bidi_unshelve_cache (it1data, true); + } + } + else + start_x = it.current_x; + } /* Now move to TO. */ - int start_x = it.current_x; int move_op = MOVE_TO_POS | MOVE_TO_Y; int to_x = -1; it.current_y = start_y; @@ -10831,8 +11097,16 @@ include the height of any of these, if present, in the return value. */) if (IT_CHARPOS (it) == end) { x += it.pixel_width; - it.max_ascent = max (it.max_ascent, it.ascent); - it.max_descent = max (it.max_descent, it.descent); + + /* DTRT if ignore_line_at_end is t. */ + if (!NILP (ignore_line_at_end)) + doff = (max (it.max_ascent, it.ascent) + + max (it.max_descent, it.descent)); + else + { + it.max_ascent = max (it.max_ascent, it.ascent); + it.max_descent = max (it.max_descent, it.descent); + } } } else @@ -10853,32 +11127,193 @@ include the height of any of these, if present, in the return value. */) /* Subtract height of header-line and tab-line which was counted automatically by start_display. */ - y = it.current_y + it.max_ascent + it.max_descent - - WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w); + if (!NILP (ignore_line_at_end)) + y = (it.current_y + doff + - WINDOW_TAB_LINE_HEIGHT (w) + - WINDOW_HEADER_LINE_HEIGHT (w)); + else + y = (it.current_y + it.max_ascent + it.max_descent + doff + - WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w)); + /* Don't return more than Y-LIMIT. */ if (y > max_y) y = max_y; - if (EQ (mode_lines, Qtab_line) || EQ (mode_lines, 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_lines, Qheader_line) || EQ (mode_lines, 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, Qmode_line) || EQ (mode_lines, Qt)) - /* Add height of mode-line as requested. */ - y = y + WINDOW_MODE_LINE_HEIGHT (w); + 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); + + y = y + display_mode_line (w, CURRENT_MODE_LINE_ACTIVE_FACE_ID (w), + NILP (window_mode_line_format) + ? BVAR (current_buffer, mode_line_format) + : window_mode_line_format); + } bidi_unshelve_cache (itdata, false); + return (!vertical_offset + ? Fcons (make_fixnum (x - start_x), make_fixnum (y)) + : list3i (x - start_x, y, start)); +} + +DEFUN ("window-text-pixel-size", Fwindow_text_pixel_size, Swindow_text_pixel_size, 0, 7, 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 +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. + +If FROM is a cons cell, the return value includes, in addition to the +dimensions, also a third element that provides the buffer position +from which measuring of the text dimensions was actually started. + +This function exists to allow Lisp programs to adjust the dimensions +of WINDOW to the buffer text it needs to display. + +The optional argument FROM, if non-nil, specifies the first text +position to consider, and defaults to the minimum accessible position +of the buffer. If FROM is a cons, its car specifies a buffer +position, and its cdr specifies the vertical offset in pixels from +that position to the first screen line to be measured. If FROM is t, +it stands for the minimum accessible position that starts a non-empty +line. TO, if non-nil, specifies the last text position and defaults +to the maximum accessible position of the buffer. If TO is t, it +stands for the maximum accessible position that ends a non-empty line. + +The optional argument X-LIMIT, if non-nil, specifies the maximum X +coordinate beyond which the text should be ignored. It is therefore +also the maximum width that the function can return. X-LIMIT nil or +omitted means to use the pixel-width of WINDOW's body. This default +means text of truncated lines wider than the window will be ignored; +specify a non-nil value for X-LIMIT if lines are truncated and you need +to account for the truncated text. + +Use nil for X-LIMIT if you want to know how high WINDOW should become in +order to fit all of its buffer's text with the width of WINDOW +unaltered. Use the maximum width WINDOW may assume if you intend to +change WINDOW's width. Use t for the maximum possible value. Since +calculating the width of long lines can take some time, it's always a +good idea to make this argument as small as possible; in particular, if +the buffer contains long lines that shall be truncated anyway. + +The optional argument Y-LIMIT, if non-nil, specifies the maximum Y +coordinate beyond which the text is to be ignored; it is therefore +also the maximum height that the function can return (excluding the +height of the mode- or header-line, if any). Y-LIMIT nil or omitted +means consider all of the accessible portion of buffer text up to the +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-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 any of these, if present, in the return value. + +IGNORE-LINE-AT-END, if non-nil, means to not add the height of the +screen line that includes TO to the returned height of the text. */) + (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit, + Lisp_Object y_limit, Lisp_Object mode_lines, Lisp_Object ignore_line_at_end) +{ + struct window *w = decode_live_window (window); + struct buffer *b = XBUFFER (w->contents); + struct buffer *old_b = NULL; + Lisp_Object value; + + if (b != current_buffer) + { + old_b = current_buffer; + set_buffer_internal_1 (b); + } + + value = window_text_pixel_size (window, from, to, x_limit, y_limit, mode_lines, + ignore_line_at_end); + if (old_b) - set_buffer_internal (old_b); + set_buffer_internal_1 (old_b); + + return value; +} + +DEFUN ("buffer-text-pixel-size", Fbuffer_text_pixel_size, Sbuffer_text_pixel_size, 0, 4, 0, + doc: /* Return size of whole text of BUFFER-OR-NAME in WINDOW. +BUFFER-OR-NAME must specify a live buffer or the name of a live buffer +and defaults to the current buffer. WINDOW must be a 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 +of the buffer specified by BUFFER-OR-NAME. + +The optional arguments X-LIMIT and Y-LIMIT have the same meaning as with +`window-text-pixel-size'. + +Do not use this function if the buffer specified by BUFFER-OR-NAME is +already displayed in WINDOW. `window-text-pixel-size' is cheaper in +that case because it does not have to temporarily show that buffer in +WINDOW. */) + (Lisp_Object buffer_or_name, Lisp_Object window, Lisp_Object x_limit, + Lisp_Object y_limit) +{ + struct window *w = decode_live_window (window); + struct buffer *b = (NILP (buffer_or_name) + ? current_buffer + : XBUFFER (Fget_buffer (buffer_or_name))); + Lisp_Object buffer, value; + specpdl_ref count = SPECPDL_INDEX (); + + XSETBUFFER (buffer, b); + + /* The unwind form of with_echo_area_buffer is what we need here to + make WINDOW temporarily show our buffer. */ + /* FIXME: Can we move this into the `if (!EQ (buffer, w->contents))`? */ + record_unwind_protect (unwind_with_echo_area_buffer, + with_echo_area_buffer_unwind_data (w)); - return Fcons (make_fixnum (x - start_x), make_fixnum (y)); + set_buffer_internal_1 (b); + + if (!EQ (buffer, w->contents)) + { + wset_buffer (w, buffer); + set_marker_both (w->pointm, buffer, BEG, BEG_BYTE); + set_marker_both (w->old_pointm, buffer, BEG, BEG_BYTE); + } + + value = window_text_pixel_size (window, Qnil, Qnil, x_limit, y_limit, Qnil, + Qnil); + + unbind_to (count, Qnil); + + return value; } + DEFUN ("display--line-is-continued-p", Fdisplay__line_is_continued_p, Sdisplay__line_is_continued_p, 0, 0, 0, doc: /* Return non-nil if the current screen line is continued on display. */) @@ -11013,6 +11448,10 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) old_deactivate_mark = Vdeactivate_mark; oldbuf = current_buffer; + /* Sanity check, in case the variable has been set to something + invalid. */ + if (! STRINGP (Vmessages_buffer_name)) + Vmessages_buffer_name = build_string ("*Messages*"); /* Ensure the Messages buffer exists, and switch to it. If we created it, set the major-mode. */ bool newbuffer = NILP (Fget_buffer (Vmessages_buffer_name)); @@ -11083,7 +11522,7 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) we aren't prepared to run modification hooks (we could end up calling modification hooks from another buffer and only with AFTER=t, Bug#21824). */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_modification_hooks, Qt); insert_1_both ("\n", 1, 1, true, false, false); @@ -11538,7 +11977,7 @@ with_echo_area_buffer (struct window *w, int which, { Lisp_Object buffer; bool this_one, the_other, clear_buffer_p, rc; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* If buffers aren't live, make new ones. */ ensure_echo_area_buffers (); @@ -11723,7 +12162,7 @@ setup_echo_area_for_printing (bool multibyte_p) if (Z > BEG) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_read_only, Qt); /* Note that undo recording is always disabled. */ del_range (BEG, Z); @@ -11791,7 +12230,7 @@ display_echo_area (struct window *w) That message would modify the echo area buffer's contents while a redisplay of the buffer is going on, and seriously confuse redisplay. */ - ptrdiff_t count = inhibit_garbage_collection (); + specpdl_ref count = inhibit_garbage_collection (); /* If there is no message, we must call display_echo_area_1 nevertheless because it resizes the window. But we will have to @@ -12171,7 +12610,7 @@ set_message (Lisp_Object string) if (FUNCTIONP (Vset_message_function)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); message = safe_call1 (Vset_message_function, string); unbind_to (count, Qnil); @@ -12249,7 +12688,7 @@ clear_message (bool current_p, bool last_displayed_p) if (FUNCTIONP (Vclear_message_function)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); safe_call (1, Vclear_message_function); unbind_to (count, Qnil); @@ -12384,7 +12823,7 @@ echo_area_display (bool update_frame_p) /* Must update other windows. Likewise as in other cases, don't let this update be interrupted by pending input. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qredisplay_dont_pause, Qt); fset_redisplay (f); redisplay_internal (); @@ -12720,7 +13159,7 @@ gui_consider_frame_title (Lisp_Object frame) char *title; ptrdiff_t len; struct it it; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); FOR_EACH_FRAME (tail, other_frame) { @@ -12881,7 +13320,7 @@ prepare_menu_bars (void) if (all_windows) { Lisp_Object tail, frame; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* True means that update_menu_bar has run its hooks so any further calls to update_menu_bar shouldn't do so again. */ bool menu_bar_hooks_run = false; @@ -12978,7 +13417,7 @@ update_menu_bar (struct frame *f, bool save_match_data, bool hooks_run) || window_buffer_changed (w)) { struct buffer *prev = current_buffer; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_menubar_update, Qt); @@ -13148,7 +13587,7 @@ update_tab_bar (struct frame *f, bool save_match_data) || window_buffer_changed (w)) { struct buffer *prev = current_buffer; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object new_tab_bar; int new_n_tab_bar; @@ -13384,6 +13823,7 @@ display_tab_bar_line (struct it *it, int height) so there's no need to check the face here. */ it->start_of_box_run_p = true; + bool enough = false; while (it->current_x < max_x) { int x, n_glyphs_before, i, nglyphs; @@ -13430,11 +13870,12 @@ display_tab_bar_line (struct it *it, int height) ++i; } + enough = ITERATOR_AT_END_OF_LINE_P (it); + set_iterator_to_next (it, true); + /* Stop at line end. */ - if (ITERATOR_AT_END_OF_LINE_P (it)) + if (enough) break; - - set_iterator_to_next (it, true); } out:; @@ -13517,10 +13958,6 @@ tab_bar_height (struct frame *f, int *n_rows, bool pixelwise) { it.glyph_row = temp_row; display_tab_bar_line (&it, -1); - /* If the tab-bar string includes newlines, get past it, because - display_tab_bar_line doesn't. */ - if (ITERATOR_AT_END_OF_LINE_P (&it)) - set_iterator_to_next (&it, true); } clear_glyph_row (temp_row); @@ -13569,6 +14006,8 @@ redisplay_tab_bar (struct frame *f) struct it it; struct glyph_row *row; + f->tab_bar_redisplayed = true; + /* If frame hasn't a tab-bar window or if it is zero-height, don't do anything. This means you must start with tab-bar-lines non-zero to get the auto-sizing effect. Or in other words, you @@ -13576,9 +14015,16 @@ redisplay_tab_bar (struct frame *f) if (!WINDOWP (f->tab_bar_window) || (w = XWINDOW (f->tab_bar_window), WINDOW_TOTAL_LINES (w) == 0)) - return false; + { + /* Even if we do not display a tab bar initially, still pretend + that we have resized it. This avoids that a later activation + of the tab bar resizes the frame, despite of the fact that the + setting of 'frame-inhibit-implied-resize' should inhibit it + (Bug#52986). */ + f->tab_bar_resized = true; - f->tab_bar_redisplayed = true; + return false; + } /* Set up an iterator for the tab-bar window. */ init_iterator (&it, w, -1, -1, w->desired_matrix->rows, TAB_BAR_FACE_ID); @@ -13646,10 +14092,6 @@ redisplay_tab_bar (struct frame *f) extra -= h; } display_tab_bar_line (&it, height + h); - /* If the tab-bar string includes newlines, get past it, - because display_tab_bar_line doesn't. */ - if (ITERATOR_AT_END_OF_LINE_P (&it)) - set_iterator_to_next (&it, true); } } else @@ -13889,7 +14331,6 @@ 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? 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, @@ -13902,7 +14343,6 @@ note_tab_bar_highlight (struct frame *f, int x, int y) 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. */ @@ -14060,7 +14500,7 @@ update_tool_bar (struct frame *f, bool save_match_data) || window_buffer_changed (w)) { struct buffer *prev = current_buffer; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object frame, new_tool_bar; int new_n_tool_bar; @@ -14494,6 +14934,8 @@ redisplay_tool_bar (struct frame *f) struct it it; struct glyph_row *row; + f->tool_bar_redisplayed = true; + /* If frame hasn't a tool-bar window or if it is zero-height, don't do anything. This means you must start with tool-bar-lines non-zero to get the auto-sizing effect. Or in other words, you @@ -14501,9 +14943,16 @@ redisplay_tool_bar (struct frame *f) if (!WINDOWP (f->tool_bar_window) || (w = XWINDOW (f->tool_bar_window), WINDOW_TOTAL_LINES (w) == 0)) - return false; + { + /* Even if we do not display a tool bar initially, still pretend + that we have resized it already. This avoids that a later + activation of the tool bar resizes the frame, despite of the + fact that a setting of 'frame-inhibit-implied-resize' should + inhibit it (Bug#52986). */ + f->tool_bar_resized = true; - f->tool_bar_redisplayed = true; + return false; + } /* Set up an iterator for the tool-bar window. */ init_iterator (&it, w, -1, -1, w->desired_matrix->rows, TOOL_BAR_FACE_ID); @@ -14720,11 +15169,11 @@ get_tool_bar_item (struct frame *f, int x, int y, struct glyph **glyph, Handle mouse button event on the tool-bar of frame F, at frame-relative coordinates X/Y. DOWN_P is true for a button press, false for button release. MODIFIERS is event modifiers for button - release. */ + release. DEVICE is the device the click came from, or Qt. */ void -handle_tool_bar_click (struct frame *f, int x, int y, bool down_p, - int modifiers) +handle_tool_bar_click_with_device (struct frame *f, int x, int y, bool down_p, + int modifiers, Lisp_Object device) { Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); struct window *w = XWINDOW (f->tool_bar_window); @@ -14781,11 +15230,18 @@ handle_tool_bar_click (struct frame *f, int x, int y, bool down_p, event.frame_or_window = frame; event.arg = key; event.modifiers = modifiers; + event.device = device; kbd_buffer_store_event (&event); f->last_tool_bar_item = -1; } } +void +handle_tool_bar_click (struct frame *f, int x, int y, bool down_p, + int modifiers) +{ + handle_tool_bar_click_with_device (f, x, y, down_p, modifiers, Qt); +} /* Possibly highlight a tool-bar item on frame F when mouse moves to tool-bar window-relative coordinates X/Y. Called from @@ -15602,7 +16058,6 @@ redisplay_internal (void) bool must_finish = false, match_p; struct text_pos tlbufpos, tlendpos; int number_of_visible_frames; - ptrdiff_t count; struct frame *sf; bool polling_stopped_here = false; Lisp_Object tail, frame; @@ -15649,9 +16104,12 @@ redisplay_internal (void) #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) if (popup_activated ()) - { - return; - } + return; +#endif + +#if defined (HAVE_HAIKU) + if (popup_activated_p) + return; #endif /* I don't think this happens but let's be paranoid. */ @@ -15660,7 +16118,7 @@ redisplay_internal (void) /* Record a function that clears redisplaying_p when we leave this function. */ - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_void (unwind_redisplay); redisplaying_p = true; block_buffer_flips (); @@ -16022,7 +16480,8 @@ redisplay_internal (void) /* If highlighting the region, or if the cursor is in the echo area, then we can't just move the cursor. */ else if (NILP (Vshow_trailing_whitespace) - && !cursor_in_echo_area) + && !cursor_in_echo_area + && !composition_break_at_point) { struct it it; struct glyph_row *row; @@ -16457,7 +16916,7 @@ redisplay_preserve_echo_area (int from_where) redisplay_trace ("redisplay_preserve_echo_area (%d)\n", from_where); block_input (); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_void (unwind_redisplay_preserve_echo_area); block_buffer_flips (); unblock_input (); @@ -17331,7 +17790,7 @@ run_window_scroll_functions (Lisp_Object window, struct text_pos startp) if (!NILP (Vwindow_scroll_functions)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); run_hook_with_args_2 (Qwindow_scroll_functions, window, make_fixnum (CHARPOS (startp))); @@ -17826,7 +18285,7 @@ compute_window_start_on_continuation_line (struct window *w) point will not be visible with any window start we compute. */ if (IT_CHARPOS (it) <= PT - || (CHARPOS (start_pos) - IT_CHARPOS (it) + && (CHARPOS (start_pos) - IT_CHARPOS (it) /* PXW: Do we need upper bounds here? */ < WINDOW_TOTAL_LINES (w) * WINDOW_TOTAL_COLS (w))) { @@ -18207,6 +18666,20 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, || (NILP (g->object) && (g->charpos == PT || (g->charpos == 0 && endpos - 1 == PT))); + /* Perhaps the point position is inside + invisible text? In that case, we trust + 'set_cursor_from_row' to do its job and + find the best position for the cursor. */ + if (!exact_match_p) + { + Lisp_Object val = + get_char_property_and_overlay (make_fixnum (PT), + Qinvisible, + Qnil, NULL); + + if (TEXT_PROP_MEANS_INVISIBLE (val) != 0) + exact_match_p = true; + } } if (at_zv_p || exact_match_p) { @@ -18356,6 +18829,33 @@ set_horizontal_scroll_bar (struct window *w) (w, portion, whole, start); } +/* Subroutine of redisplay_window, to determine whether a window-start + point STARTP of WINDOW should be rejected. */ +static bool +window_start_acceptable_p (Lisp_Object window, ptrdiff_t startp) +{ + if (!make_window_start_visible) + return true; + + struct window *w = XWINDOW (window); + struct frame *f = XFRAME (w->frame); + Lisp_Object startpos = make_fixnum (startp); + Lisp_Object invprop, disp_spec; + struct text_pos ignored; + + /* Is STARTP in invisible text? */ + if ((invprop = Fget_char_property (startpos, Qinvisible, window)), + TEXT_PROP_MEANS_INVISIBLE (invprop) != 0) + return false; + + /* Is STARTP covered by a replacing 'display' property? */ + if (!NILP (disp_spec = Fget_char_property (startpos, Qdisplay, window)) + && handle_display_spec (NULL, disp_spec, Qnil, Qnil, &ignored, startp, + FRAME_WINDOW_P (f)) > 0) + return false; + + return true; +} /* Redisplay leaf window WINDOW. JUST_THIS_ONE_P means only selected_window is redisplayed. @@ -18425,7 +18925,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) It indicates that the buffer contents and narrowing are unchanged. */ bool buffer_unchanged_p = false; bool temp_scroll_step = false; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); int rc; int centering_position = -1; bool last_line_misfit = false; @@ -18519,6 +19019,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) && !current_buffer->clip_changed && !current_buffer->prevent_redisplay_optimizations_p && !window_outdated (w) + && !composition_break_at_point && !hscrolling_current_line_p (w)); beg_unchanged = BEG_UNCHANGED; @@ -18687,6 +19188,11 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) else if (CHARPOS (startp) > ZV) SET_TEXT_POS (startp, ZV, ZV_BYTE); + /* Reject the specified start location if it is invisible, and + the buffer wants it always visible. */ + if (!window_start_acceptable_p (window, CHARPOS (startp))) + goto ignore_start; + /* Redisplay, then check if cursor has been set during the redisplay. Give up if new fonts were loaded. */ /* We used to issue a CHECK_MARGINS argument to try_window here, @@ -18793,7 +19299,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) struct glyph_row *row; row = MATRIX_FIRST_TEXT_ROW (w->desired_matrix); - while (MATRIX_ROW_BOTTOM_Y (row) < new_vpos) + while (MATRIX_ROW_BOTTOM_Y (row) < new_vpos + && !row->ends_at_zv_p) ++row; TEMP_SET_PT_BOTH (MATRIX_ROW_START_CHARPOS (row), @@ -18843,6 +19350,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) goto done; } + ignore_start: + /* Handle case where text has not changed, only point, and it has not moved off the frame, and we are not retrying after hscroll. (current_matrix_up_to_date_p is true when retrying.) */ @@ -18864,10 +19373,14 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) } } /* If current starting point was originally the beginning of a line - but no longer is, find a new starting point. */ + but no longer is, or if the starting point is invisible but the + buffer wants it always visible, find a new starting point. */ else if (w->start_at_line_beg - && !(CHARPOS (startp) <= BEGV - || FETCH_BYTE (BYTEPOS (startp) - 1) == '\n')) + && ((CHARPOS (startp) > BEGV + && FETCH_BYTE (BYTEPOS (startp) - 1) != '\n') + || (CHARPOS (startp) >= BEGV + && CHARPOS (startp) <= ZV + && !window_start_acceptable_p (window, CHARPOS (startp))))) { #ifdef GLYPH_DEBUG debug_method_add (w, "recenter 1"); @@ -18943,6 +19456,17 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) goto force_start; } + /* Don't use the same window-start if it is invisible or covered + by a replacing 'display' property and the buffer requested + the window-start to be always visible. */ + if (!window_start_acceptable_p (window, CHARPOS (startp))) + { +#ifdef GLYPH_DEBUG + debug_method_add (w, "recenter 2"); +#endif + goto recenter; + } + #ifdef GLYPH_DEBUG debug_method_add (w, "same window start"); #endif @@ -19348,7 +19872,7 @@ 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 (); + specpdl_ref count1 = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); display_mode_lines (w); @@ -22168,7 +22692,7 @@ extend_face_to_end_of_line (struct it *it) || WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0)) return; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref 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 @@ -22193,7 +22717,7 @@ extend_face_to_end_of_line (struct it *it) && face->underline == FACE_NO_UNDERLINE && !face->overline_p && !face->strike_through_p - && FACE_COLOR_TO_PIXEL (face->background, f) == FRAME_BACKGROUND_PIXEL (f) + && face->background == FRAME_BACKGROUND_PIXEL (f) #ifdef HAVE_WINDOW_SYSTEM && !face->stipple #endif @@ -22427,7 +22951,7 @@ extend_face_to_end_of_line (struct it *it) && (it->glyph_row->used[LEFT_MARGIN_AREA] < WINDOW_LEFT_MARGIN_WIDTH (it->w)) && !it->glyph_row->mode_line_p - && FACE_COLOR_TO_PIXEL (face->background, f) != FRAME_BACKGROUND_PIXEL (f)) + && face->background != FRAME_BACKGROUND_PIXEL (f)) { struct glyph *g = it->glyph_row->glyphs[LEFT_MARGIN_AREA]; struct glyph *e = g + it->glyph_row->used[LEFT_MARGIN_AREA]; @@ -22498,7 +23022,7 @@ extend_face_to_end_of_line (struct it *it) && (it->glyph_row->used[RIGHT_MARGIN_AREA] < WINDOW_RIGHT_MARGIN_WIDTH (it->w)) && !it->glyph_row->mode_line_p - && FACE_COLOR_TO_PIXEL (face->background, f) != FRAME_BACKGROUND_PIXEL (f)) + && face->background != FRAME_BACKGROUND_PIXEL (f)) { struct glyph *g = it->glyph_row->glyphs[RIGHT_MARGIN_AREA]; struct glyph *e = g + it->glyph_row->used[RIGHT_MARGIN_AREA]; @@ -23066,7 +23590,7 @@ display_count_lines_logically (ptrdiff_t start_byte, ptrdiff_t limit_byte, return display_count_lines (start_byte, limit_byte, count, byte_pos_ptr); ptrdiff_t val; - ptrdiff_t pdl_count = SPECPDL_INDEX (); + specpdl_ref pdl_count = SPECPDL_INDEX (); record_unwind_protect (save_restriction_restore, save_restriction_save ()); Fwiden (); val = display_count_lines (start_byte, limit_byte, count, byte_pos_ptr); @@ -23092,7 +23616,7 @@ display_count_lines_visually (struct it *it) return it->lnum + 1; else { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (IT_CHARPOS (*it) <= PT) { @@ -24515,31 +25039,46 @@ 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 -region of OBJECT where there is a character whose `bidi-class' property -is `L', but which was forced to display as `R' by a directional -override, and likewise with characters whose `bidi-class' is `R' -or `AL' that were forced to display as `L'. +region of OBJECT where characters have their bidirectional +properties affected in a way that might make its text look confusingly +on display. For example, characters whose `bidi-class' property is `L', +could be forced to display as `R' by a directional override, and +likewise characters whose `bidi-class' is `R' or `AL' that are +forced to display as `L'. If no such character is found, the function returns nil. OBJECT is a Lisp string or buffer to search for overridden -directionality, and defaults to the current buffer if nil or omitted. +directionality, and defaults to the current buffer if nil. OBJECT can also be a window, in which case the function will search the buffer displayed in that window. Passing the window instead of 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 -the `bidi-class' property of a character. */) - (Lisp_Object from, Lisp_Object to, Lisp_Object object) +intrinsic directionality overridden by directional override 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. Characters whose intrinsic +directionality is weak or neutral, such as numbers or punctuation +characters, can be forced to display in a very different place with +respect of its surrounding characters, so as to make the surrounding +text confuse the user regarding what the text says. + +Also see the `highlight-confusing-reorderings' function, which can be +useful in similar circumstances as this function. */) + (Lisp_Object from, Lisp_Object to, Lisp_Object object, Lisp_Object base_dir) { struct buffer *buf = current_buffer; struct buffer *old = buf; @@ -24636,10 +25175,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); @@ -25238,6 +25776,11 @@ display_menu_bar (struct window *w) if (FRAME_W32_P (f)) return; #endif +#if defined (HAVE_PGTK) + if (FRAME_PGTK_P (f)) + return; +#endif + #if defined (USE_X_TOOLKIT) || defined (USE_GTK) if (FRAME_X_P (f)) return; @@ -25248,6 +25791,11 @@ display_menu_bar (struct window *w) return; #endif /* HAVE_NS */ +#ifdef HAVE_HAIKU + if (FRAME_HAIKU_P (f)) + return; +#endif /* HAVE_HAIKU */ + #if defined (USE_X_TOOLKIT) || defined (USE_GTK) eassert (!FRAME_WINDOW_P (f)); init_iterator (&it, w, -1, -1, f->desired_matrix->rows, MENU_FACE_ID); @@ -25507,7 +26055,7 @@ display_mode_lines (struct window *w) { Lisp_Object old_selected_window = selected_window; Lisp_Object new_frame = w->frame; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); int n = 0; record_unwind_protect (restore_selected_window, selected_window); @@ -25548,7 +26096,8 @@ display_mode_lines (struct window *w) struct window *sel_w = XWINDOW (old_selected_window); /* Select mode line face based on the real selected window. */ - display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w), + display_mode_line (w, + CURRENT_MODE_LINE_ACTIVE_FACE_ID_3 (sel_w, sel_w, w), NILP (window_mode_line_format) ? BVAR (current_buffer, mode_line_format) : window_mode_line_format); @@ -25587,18 +26136,18 @@ display_mode_lines (struct window *w) } -/* Display mode or header/tab line of window W. FACE_ID specifies which - line to display; it is either MODE_LINE_FACE_ID, HEADER_LINE_FACE_ID or - TAB_LINE_FACE_ID. FORMAT is the mode/header/tab line format to - display. Value is the pixel height of the mode/header/tab line - displayed. */ +/* Display mode or header/tab line of window W. FACE_ID specifies + which line to display; it is either MODE_LINE_ACTIVE_FACE_ID, + HEADER_LINE_FACE_ID or TAB_LINE_FACE_ID. FORMAT is the + mode/header/tab line format to display. Value is the pixel height + of the mode/header/tab line displayed. */ static int display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) { struct it it; struct face *face; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); init_iterator (&it, w, -1, -1, NULL, face_id); /* Don't extend on a previously drawn mode-line. @@ -26363,7 +26912,7 @@ are the selected window and the WINDOW's buffer). */) struct buffer *old_buffer = NULL; int face_id; bool no_props = FIXNUMP (face); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object str; int string_start = 0; @@ -26384,8 +26933,8 @@ are the selected window and the WINDOW's buffer). */) face_id = (NILP (face) || EQ (face, Qdefault)) ? DEFAULT_FACE_ID : EQ (face, Qt) ? (EQ (window, selected_window) - ? MODE_LINE_FACE_ID : MODE_LINE_INACTIVE_FACE_ID) - : EQ (face, Qmode_line) ? MODE_LINE_FACE_ID + ? MODE_LINE_ACTIVE_FACE_ID : MODE_LINE_INACTIVE_FACE_ID) + : EQ (face, Qmode_line_active) ? MODE_LINE_ACTIVE_FACE_ID : EQ (face, Qmode_line_inactive) ? MODE_LINE_INACTIVE_FACE_ID : EQ (face, Qheader_line) ? HEADER_LINE_FACE_ID : EQ (face, Qtab_line) ? TAB_LINE_FACE_ID @@ -27076,7 +27625,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, case '@': { - ptrdiff_t count = inhibit_garbage_collection (); + specpdl_ref count = inhibit_garbage_collection (); Lisp_Object curdir = BVAR (current_buffer, directory); Lisp_Object val = Qnil; @@ -27339,6 +27888,21 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st 0, &endptr, it->base_face_id, false, 0); face = FACE_FROM_ID (it->f, it->face_id); it->face_box_p = face->box != FACE_NO_BOX; + + /* If we have a display spec, but there's no Lisp string being + displayed, then check whether we've got one from the + :propertize being passed in and use that. */ + if (NILP (lisp_string)) + { + Lisp_Object display = Fget_text_property (make_fixnum (0), Qdisplay, + face_string); + if (!NILP (display)) + { + Lisp_Object min_width = Fplist_get (display, Qmin_width); + if (!NILP (min_width)) + display_min_width (it, 0, face_string, min_width); + } + } } /* Set max_x to the maximum allowed X position. Don't let it go @@ -28167,6 +28731,22 @@ 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 + && MATRIX_ROW (s->w->current_matrix, + s->w->phys_cursor.vpos)->mouse_face_p + && 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; @@ -28203,7 +28783,20 @@ 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 + && MATRIX_ROW (s->w->current_matrix, + s->w->phys_cursor.vpos)->mouse_face_p + && 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 @@ -28259,6 +28852,18 @@ 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 + && MATRIX_ROW (s->w->current_matrix, + s->w->phys_cursor.vpos)->mouse_face_p + && 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++; @@ -28322,6 +28927,22 @@ 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 + && MATRIX_ROW (s->w->current_matrix, + s->w->phys_cursor.vpos)->mouse_face_p + && 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 @@ -28351,6 +28972,18 @@ 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 + && MATRIX_ROW (s->w->current_matrix, + s->w->phys_cursor.vpos)->mouse_face_p + && 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. */ @@ -28365,9 +28998,21 @@ 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 + && MATRIX_ROW (s->w->current_matrix, + s->w->phys_cursor.vpos)->mouse_face_p + && 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. @@ -28390,6 +29035,18 @@ 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 + && MATRIX_ROW (s->w->current_matrix, + s->w->phys_cursor.vpos)->mouse_face_p + && 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; @@ -28446,6 +29103,7 @@ normal_char_ascent_descent (struct font *font, int c, int *ascent, int *descent) if (get_char_glyph_code (c >= 0 ? c : '{', font, &char2b)) { struct font_metrics *pcm = get_per_char_metric (font, &char2b); + eassume (pcm); if (!(pcm->width == 0 && pcm->rbearing == 0 && pcm->lbearing == 0)) { @@ -28637,7 +29295,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) @@ -28659,7 +29322,29 @@ 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 + && MATRIX_ROW (s->w->current_matrix, + s->w->phys_cursor.vpos)->mouse_face_p + && 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 + } } @@ -29208,7 +29893,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 @@ -29227,7 +29911,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. */ @@ -29560,6 +30243,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) @@ -29736,7 +30421,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) { @@ -29919,7 +30604,8 @@ produce_stretch_glyph (struct it *it) Compute the width of the characters having this `display' property. */ struct it it2; - Lisp_Object object = it->stack[it->sp - 1].string; + Lisp_Object object = + it->sp > 0 ? it->stack[it->sp - 1].string : it->string; unsigned char *p = (STRINGP (object) ? SDATA (object) + IT_STRING_BYTEPOS (*it) : BYTE_POS_ADDR (IT_BYTEPOS (*it))); @@ -30021,7 +30707,8 @@ produce_stretch_glyph (struct it *it) if (width > 0 && height > 0 && it->glyph_row) { Lisp_Object o_object = it->object; - Lisp_Object object = it->stack[it->sp - 1].string; + Lisp_Object object = + it->sp > 0 ? it->stack[it->sp - 1].string : it->string; int n = width; if (!STRINGP (object)) @@ -30836,6 +31523,11 @@ gui_produce_glyphs (struct it *it) it->max_ascent = max (it->max_ascent, font_ascent); it->max_descent = max (it->max_descent, font_descent); } + + if (it->ascent < 0) + it->ascent = 0; + if (it->descent < 0) + it->descent = 0; } else if (it->what == IT_COMPOSITION && it->cmp_it.ch < 0) { @@ -31875,6 +32567,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) { @@ -32146,6 +32852,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); @@ -32219,6 +32928,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 @@ -32228,6 +32946,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 @@ -32239,7 +32958,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 */ } @@ -33195,7 +33918,8 @@ define_frame_cursor1 (struct frame *f, Emacs_Cursor cursor, Lisp_Object pointer) return; /* Do not change cursor shape while dragging mouse. */ - if (EQ (track_mouse, Qdragging) || EQ (track_mouse, Qdropping)) + if (EQ (track_mouse, Qdragging) || EQ (track_mouse, Qdropping) + || EQ (track_mouse, Qdrag_source)) return; if (!NILP (pointer)) @@ -33580,11 +34304,16 @@ note_mouse_highlight (struct frame *f, int x, int y) struct buffer *b; /* When a menu is active, don't highlight because this looks odd. */ -#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (MSDOS) +#if defined (USE_X_TOOLKIT) || (defined (USE_GTK) && !defined (HAVE_PGTK)) || defined (HAVE_NS) || defined (MSDOS) if (popup_activated ()) return; #endif +#if defined (HAVE_HAIKU) + if (popup_activated_p) + return; +#endif + if (!f->glyphs_initialized_p || f->pointer_invisible) return; @@ -34912,9 +35641,11 @@ be let-bound around code that needs to disable messages temporarily. */); defsubr (&Sinvisible_p); defsubr (&Scurrent_bidi_paragraph_direction); defsubr (&Swindow_text_pixel_size); + defsubr (&Sbuffer_text_pixel_size); defsubr (&Smove_point_visually); defsubr (&Sbidi_find_overridden_directionality); defsubr (&Sdisplay__line_is_continued_p); + defsubr (&Sget_display_property); DEFSYM (Qmenu_bar_update_hook, "menu-bar-update-hook"); DEFSYM (Qoverriding_terminal_local_map, "overriding-terminal-local-map"); @@ -35010,6 +35741,7 @@ be let-bound around code that needs to disable messages temporarily. */); DEFSYM (Qdragging, "dragging"); DEFSYM (Qdropping, "dropping"); + DEFSYM (Qdrag_source, "drag-source"); DEFSYM (Qdrag_with_mode_line, "drag-with-mode-line"); DEFSYM (Qdrag_with_header_line, "drag-with-header-line"); @@ -35040,8 +35772,13 @@ be let-bound around code that needs to disable messages temporarily. */); staticpro (&echo_area_buffer[0]); staticpro (&echo_area_buffer[1]); - Vmessages_buffer_name = build_pure_c_string ("*Messages*"); - staticpro (&Vmessages_buffer_name); + DEFVAR_LISP ("messages-buffer-name", Vmessages_buffer_name, + doc: /* The name of the buffer where messages are logged. +This is normally \"\*Messages*\", but can be rebound by packages that +wish to redirect messages to a different buffer. (If the buffer +doesn't exist, it will be created and put into +`messages-buffer-mode'.) */); + Vmessages_buffer_name = build_string ("*Messages*"); mode_line_proptrans_alist = Qnil; staticpro (&mode_line_proptrans_alist); @@ -35382,6 +36119,12 @@ window, nil if it's okay to leave the cursor partially-visible. */); Vmake_cursor_line_fully_visible = Qt; DEFSYM (Qmake_cursor_line_fully_visible, "make-cursor-line-fully-visible"); + DEFVAR_BOOL ("make-window-start-visible", make_window_start_visible, + doc: /* Whether to ensure `window-start' position is never invisible. */); + make_window_start_visible = false; + DEFSYM (Qmake_window_start_visible, "make-window-start-visible"); + Fmake_variable_buffer_local (Qmake_window_start_visible); + DEFSYM (Qclose_tab, "close-tab"); DEFVAR_LISP ("tab-bar-border", Vtab_bar_border, doc: /* Border below tab-bar in pixels. @@ -35823,11 +36566,13 @@ message displayed by its counterpart function specified by Vclear_message_function = Qnil; DEFVAR_LISP ("redisplay--all-windows-cause", Vredisplay__all_windows_cause, - doc: /* */); + doc: /* Code of the cause for redisplaying all windows. +Internal use only. */); Vredisplay__all_windows_cause = Fmake_hash_table (0, NULL); DEFVAR_LISP ("redisplay--mode-lines-cause", Vredisplay__mode_lines_cause, - doc: /* */); + doc: /* Code of the cause for redisplaying mode lines. +Internal use only. */); Vredisplay__mode_lines_cause = Fmake_hash_table (0, NULL); DEFVAR_BOOL ("redisplay--inhibit-bidi", redisplay__inhibit_bidi, @@ -35853,10 +36598,11 @@ mouse stays within the extent of a single glyph (except for images). */); 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 -best except in special circumstances such as running redisplay tests -in batch mode. */); + doc: /* Non-nil means skip redisplay of the initial frame. +The initial frame is the text-mode frame used by Emacs internally during +the early stages of startup. That frame is not displayed anywhere, so +skipping it is best except in special circumstances such as running +redisplay tests in batch mode. */); redisplay_skip_initial_frame = true; DEFVAR_BOOL ("redisplay-skip-fontification-on-input", @@ -35879,6 +36625,12 @@ Otherwise, use custom-tailored code after resizing minibuffer windows to try and display the most important part of the minibuffer. */); /* See bug#43519 for some discussion around this. */ redisplay_adhoc_scroll_in_resize_mini_windows = true; + + DEFVAR_BOOL ("composition-break-at-point", composition_break_at_point, + doc: /* If non-nil, prevent auto-composition of characters around point. +This makes it easier to edit character sequences that are +composed on display. */); + composition_break_at_point = false; } @@ -36031,4 +36783,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 f7ee19195f4..d7f1f4d96e5 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -246,6 +246,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifdef HAVE_NS #define GCGraphicsExposures 0 #endif /* HAVE_NS */ + +#ifdef HAVE_PGTK +#define GCGraphicsExposures 0 +#endif /* HAVE_PGTK */ + +#ifdef HAVE_HAIKU +#define GCGraphicsExposures 0 +#endif /* HAVE_HAIKU */ #endif /* HAVE_WINDOW_SYSTEM */ #include "buffer.h" @@ -467,7 +475,7 @@ x_free_colors (struct frame *f, unsigned long *pixels, int npixels) { /* If display has an immutable color map, freeing colors is not necessary and some servers don't allow it. So don't do it. */ - if (x_mutable_colormap (FRAME_X_VISUAL (f))) + if (x_mutable_colormap (FRAME_X_VISUAL_INFO (f))) { #ifdef DEBUG_X_COLORS unregister_colors (pixels, npixels); @@ -492,7 +500,7 @@ x_free_dpy_colors (Display *dpy, Screen *screen, Colormap cmap, /* If display has an immutable color map, freeing colors is not necessary and some servers don't allow it. So don't do it. */ - if (x_mutable_colormap (dpyinfo->visual)) + if (x_mutable_colormap (&dpyinfo->visual_info)) { #ifdef DEBUG_X_COLORS unregister_colors (pixels, npixels); @@ -555,8 +563,8 @@ x_free_gc (struct frame *f, Emacs_GC *gc) #endif /* HAVE_NTGUI */ -#ifdef HAVE_NS -/* NS emulation of GCs */ +#if defined (HAVE_NS) || defined (HAVE_HAIKU) +/* NS and Haiku emulation of GCs */ static Emacs_GC * x_create_gc (struct frame *f, @@ -575,6 +583,26 @@ x_free_gc (struct frame *f, Emacs_GC *gc) } #endif /* HAVE_NS */ +#ifdef HAVE_PGTK +/* PGTK emulation of GCs */ + +static Emacs_GC * +x_create_gc (struct frame *f, + unsigned long mask, + Emacs_GC *xgcv) +{ + Emacs_GC *gc = xmalloc (sizeof *gc); + *gc = *xgcv; + return gc; +} + +static void +x_free_gc (struct frame *f, Emacs_GC *gc) +{ + xfree (gc); +} +#endif /* HAVE_NS */ + /*********************************************************************** Frames and faces ***********************************************************************/ @@ -860,6 +888,11 @@ parse_hex_color_comp (const char *s, const char *e, unsigned short *dst) static double parse_float_color_comp (const char *s, const char *e) { + /* Only allow decimal float literals without whitespace. */ + for (const char *p = s; p < e; p++) + if (!((*p >= '0' && *p <= '9') + || *p == '.' || *p == '+' || *p == '-' || *p == 'e' || *p == 'E')) + return -1; char *end; double x = strtod (s, &end); return (end == e && x >= 0 && x <= 1) ? x : -1; @@ -1416,52 +1449,6 @@ enum xlfd_field XLFD_LAST }; -/* An enumerator for each possible slant value of a font. Taken from - the XLFD specification. */ - -enum xlfd_slant -{ - XLFD_SLANT_UNKNOWN, - XLFD_SLANT_ROMAN, - XLFD_SLANT_ITALIC, - XLFD_SLANT_OBLIQUE, - XLFD_SLANT_REVERSE_ITALIC, - XLFD_SLANT_REVERSE_OBLIQUE, - XLFD_SLANT_OTHER -}; - -/* Relative font weight according to XLFD documentation. */ - -enum xlfd_weight -{ - XLFD_WEIGHT_UNKNOWN, - XLFD_WEIGHT_ULTRA_LIGHT, /* 10 */ - XLFD_WEIGHT_EXTRA_LIGHT, /* 20 */ - XLFD_WEIGHT_LIGHT, /* 30 */ - XLFD_WEIGHT_SEMI_LIGHT, /* 40: SemiLight, Book, ... */ - XLFD_WEIGHT_MEDIUM, /* 50: Medium, Normal, Regular, ... */ - XLFD_WEIGHT_SEMI_BOLD, /* 60: SemiBold, DemiBold, ... */ - XLFD_WEIGHT_BOLD, /* 70: Bold, ... */ - XLFD_WEIGHT_EXTRA_BOLD, /* 80: ExtraBold, Heavy, ... */ - XLFD_WEIGHT_ULTRA_BOLD /* 90: UltraBold, Black, ... */ -}; - -/* Relative proportionate width. */ - -enum xlfd_swidth -{ - XLFD_SWIDTH_UNKNOWN, - XLFD_SWIDTH_ULTRA_CONDENSED, /* 10 */ - XLFD_SWIDTH_EXTRA_CONDENSED, /* 20 */ - XLFD_SWIDTH_CONDENSED, /* 30: Condensed, Narrow, Compressed, ... */ - XLFD_SWIDTH_SEMI_CONDENSED, /* 40: semicondensed */ - XLFD_SWIDTH_MEDIUM, /* 50: Medium, Normal, Regular, ... */ - XLFD_SWIDTH_SEMI_EXPANDED, /* 60: SemiExpanded, DemiExpanded, ... */ - XLFD_SWIDTH_EXPANDED, /* 70: Expanded... */ - XLFD_SWIDTH_EXTRA_EXPANDED, /* 80: ExtraExpanded, Wide... */ - XLFD_SWIDTH_ULTRA_EXPANDED /* 90: UltraExpanded... */ -}; - /* Order by which font selection chooses fonts. The default values mean `first, find a best match for the font width, then for the font height, then for weight, then for slant.' This variable can be @@ -3183,14 +3170,15 @@ FRAME 0 means change the face on all frames, and change the default */ valid_p = true; - while (!NILP (CAR_SAFE(list))) + while (!NILP (CAR_SAFE (list))) { key = CAR_SAFE (list); list = CDR_SAFE (list); val = CAR_SAFE (list); list = CDR_SAFE (list); - if (NILP (key) || NILP (val)) + if (NILP (key) || (NILP (val) + && !EQ (key, QCposition))) { valid_p = false; break; @@ -4883,7 +4871,7 @@ lookup_named_face (struct window *w, struct frame *f, /* Return the display face-id of the basic face whose canonical face-id is FACE_ID. The return value will usually simply be FACE_ID, unless that - basic face has bee remapped via Vface_remapping_alist. This function is + basic face has been remapped via Vface_remapping_alist. This function is conservative: if something goes wrong, it will simply return FACE_ID rather than signal an error. Window W, if non-NULL, is used to filter face specifications for remapping. */ @@ -4899,7 +4887,7 @@ lookup_basic_face (struct window *w, struct frame *f, int face_id) switch (face_id) { case DEFAULT_FACE_ID: name = Qdefault; break; - case MODE_LINE_FACE_ID: name = Qmode_line; break; + case MODE_LINE_ACTIVE_FACE_ID: name = Qmode_line_active; break; case MODE_LINE_INACTIVE_FACE_ID: name = Qmode_line_inactive; break; case HEADER_LINE_FACE_ID: name = Qheader_line; break; case TAB_LINE_FACE_ID: name = Qtab_line; break; @@ -5373,6 +5361,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 @@ -5606,7 +5598,7 @@ realize_basic_faces (struct frame *f) if (realize_default_face (f)) { - realize_named_face (f, Qmode_line, MODE_LINE_FACE_ID); + realize_named_face (f, Qmode_line_active, MODE_LINE_ACTIVE_FACE_ID); realize_named_face (f, Qmode_line_inactive, MODE_LINE_INACTIVE_FACE_ID); realize_named_face (f, Qtool_bar, TOOL_BAR_FACE_ID); realize_named_face (f, Qfringe, FRINGE_FACE_ID); @@ -5991,6 +5983,8 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] } else if (CONSP (box)) { + bool set_color = false; + /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW being one of `raised' or `sunken'. */ face->box = FACE_SIMPLE_BOX; @@ -6028,6 +6022,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] face->box_color = load_color (f, face, value, LFACE_BOX_INDEX); face->use_box_color_for_shadows_p = true; + set_color = true; } } else if (EQ (keyword, QCstyle)) @@ -6039,7 +6034,9 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] else if (EQ (value, Qflat_button)) { face->box = FACE_SIMPLE_BOX; - face->box_color = face->background; + /* Don't override colors set in this box. */ + if (!set_color) + face->box_color = face->background; } } } @@ -6054,6 +6051,8 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] face->underline = FACE_UNDER_LINE; face->underline_defaulted_p = true; face->underline_color = 0; + face->underline_at_descent_line_p = false; + face->underline_pixels_above_descent_line = 0; } else if (STRINGP (underline)) { @@ -6063,12 +6062,16 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] face->underline_color = load_color (f, face, underline, LFACE_UNDERLINE_INDEX); + face->underline_at_descent_line_p = false; + face->underline_pixels_above_descent_line = 0; } else if (NILP (underline)) { face->underline = FACE_NO_UNDERLINE; face->underline_defaulted_p = false; face->underline_color = 0; + face->underline_at_descent_line_p = false; + face->underline_pixels_above_descent_line = 0; } else if (CONSP (underline)) { @@ -6077,6 +6080,8 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] face->underline = FACE_UNDER_LINE; face->underline_color = 0; face->underline_defaulted_p = true; + face->underline_at_descent_line_p = false; + face->underline_pixels_above_descent_line = 0; /* FIXME? This is also not robust about checking the precise form. See comments in Finternal_set_lisp_face_attribute. */ @@ -6113,6 +6118,13 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] else if (EQ (value, Qwave)) face->underline = FACE_UNDER_WAVE; } + else if (EQ (keyword, QCposition)) + { + face->underline_at_descent_line_p = !NILP (value); + + if (FIXNATP (value)) + face->underline_pixels_above_descent_line = XFIXNAT (value); + } } } @@ -6410,20 +6422,16 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, int face_id; if (base_face_id >= 0) - { - face_id = base_face_id; - /* Make sure the base face ID is usable: if someone freed the - cached faces since we've looked up the base face, we need - to look it up again. */ - if (!FACE_FROM_ID_OR_NULL (f, face_id)) - face_id = lookup_basic_face (w, f, DEFAULT_FACE_ID); - } + face_id = base_face_id; else if (NILP (Vface_remapping_alist)) face_id = DEFAULT_FACE_ID; else face_id = lookup_basic_face (w, f, DEFAULT_FACE_ID); default_face = FACE_FROM_ID_OR_NULL (f, face_id); + /* Make sure the default face ID is usable: if someone freed the + cached faces since we've looked up these faces, we need to look + them up again. */ if (!default_face) { if (FRAME_FACE_CACHE (f)->used == 0) @@ -6615,7 +6623,9 @@ face_at_string_position (struct window *w, Lisp_Object string, else *endptr = -1; - base_face = FACE_FROM_ID (f, base_face_id); + base_face = FACE_FROM_ID_OR_NULL (f, base_face_id); + if (!base_face) + base_face = FACE_FROM_ID (f, lookup_basic_face (w, f, DEFAULT_FACE_ID)); /* Optimize the default case that there is no face property. */ if (NILP (prop) @@ -6934,19 +6944,27 @@ syms_of_xfaces (void) DEFSYM (QCcolor, ":color"); DEFSYM (QCline_width, ":line-width"); DEFSYM (QCstyle, ":style"); + DEFSYM (QCposition, ":position"); DEFSYM (Qline, "line"); DEFSYM (Qwave, "wave"); DEFSYM (Qreleased_button, "released-button"); 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"); @@ -6982,6 +7000,7 @@ syms_of_xfaces (void) DEFSYM (Qborder, "border"); DEFSYM (Qmouse, "mouse"); DEFSYM (Qmode_line_inactive, "mode-line-inactive"); + DEFSYM (Qmode_line_active, "mode-line-active"); DEFSYM (Qvertical_border, "vertical-border"); DEFSYM (Qwindow_divider, "window-divider"); DEFSYM (Qwindow_divider_first_pixel, "window-divider-first-pixel"); diff --git a/src/xfns.c b/src/xfns.c index a61a891e6a1..195af1381b9 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <unistd.h> #include "lisp.h" +#include "character.h" #include "xterm.h" #include "frame.h" #include "window.h" @@ -39,6 +40,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <sys/types.h> #include <sys/stat.h> +#ifdef USE_XCB +#include <xcb/xcb.h> +#include <xcb/xproto.h> +#include <xcb/xcb_aux.h> +#endif + #include "bitmaps/gray.xbm" #include "xsettings.h" @@ -57,6 +64,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <X11/extensions/Xdbe.h> #endif +#ifdef HAVE_XINPUT2 +#include <X11/extensions/XInput2.h> +#endif + #ifdef USE_X_TOOLKIT #include <X11/Shell.h> @@ -599,7 +610,7 @@ x_relative_mouse_position (struct frame *f, int *x, int *y) block_input (); XQueryPointer (FRAME_X_DISPLAY (f), - DefaultRootWindow (FRAME_X_DISPLAY (f)), + FRAME_DISPLAY_INFO (f)->root_window, /* The root window which contains the pointer. */ &root, @@ -676,7 +687,7 @@ x_defined_color (struct frame *f, const char *color_name, is a monochrome frame, return MONO_COLOR regardless of what ARG says. Signal an error if color can't be allocated. */ -static int +static unsigned long x_decode_color (struct frame *f, Lisp_Object color_name, int mono_color) { XColor cdef; @@ -717,6 +728,58 @@ x_set_wait_for_wm (struct frame *f, Lisp_Object new_value, Lisp_Object old_value } static void +x_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ +#ifndef HAVE_GTK3 + unsigned long opaque_region[] = {0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)}; +#endif + + gui_set_alpha_background (f, arg, oldval); + +#ifdef HAVE_XRENDER + /* Setting `alpha_background' to something other than opaque on a + display that doesn't support the required features leads to + confusing results. */ + if (f->alpha_background < 1.0 + && !FRAME_DISPLAY_INFO (f)->alpha_bits + && !FRAME_CHECK_XR_VERSION (f, 0, 2)) + f->alpha_background = 1.0; +#else + f->alpha_background = 1.0; +#endif + +#ifdef USE_GTK + /* This prevents GTK from painting the window's background, which + interferes with transparent background in some environments */ + + if (!FRAME_TOOLTIP_P (f)) + gtk_widget_set_app_paintable (FRAME_GTK_OUTER_WIDGET (f), + f->alpha_background != 1.0); +#endif + + if (!FRAME_DISPLAY_INFO (f)->alpha_bits) + return; + + if (f->alpha_background != 1.0) + { + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + NULL, 0); + } +#ifndef HAVE_GTK3 + else + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &opaque_region, 4); +#endif +} + +static void x_set_tool_bar_position (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) @@ -755,7 +818,19 @@ x_set_inhibit_double_buffering (struct frame *f, and after any potential change. One of the calls will end up being a no-op. */ if (want_double_buffering != was_double_buffered) - font_drop_xrender_surfaces (f); + { + font_drop_xrender_surfaces (f); + + /* Scroll bars decide whether or not to use a back buffer + based on the value of this frame parameter, so destroy + all scroll bars. */ +#ifndef USE_TOOLKIT_SCROLL_BARS + if (FRAME_TERMINAL (f)->condemn_scroll_bars_hook) + FRAME_TERMINAL (f)->condemn_scroll_bars_hook (f); + if (FRAME_TERMINAL (f)->judge_scroll_bars_hook) + FRAME_TERMINAL (f)->judge_scroll_bars_hook (f); +#endif + } if (FRAME_X_DOUBLE_BUFFERED_P (f) && !want_double_buffering) tear_down_x_back_buffer (f); else if (!FRAME_X_DOUBLE_BUFFERED_P (f) && want_double_buffering) @@ -792,7 +867,7 @@ x_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value #else Display *dpy = FRAME_X_DISPLAY (f); PropMotifWmHints hints; - Atom prop = XInternAtom (dpy, "_MOTIF_WM_HINTS", False); + Atom prop = FRAME_DISPLAY_INFO (f)->Xatom_MOTIF_WM_HINTS; memset (&hints, 0, sizeof(hints)); hints.flags = MWM_HINTS_DECORATIONS; @@ -844,6 +919,9 @@ static void x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { struct frame *p = NULL; +#ifdef HAVE_GTK3 + GdkWindow *window; +#endif if (!NILP (new_value) && (!FRAMEP (new_value) @@ -859,7 +937,7 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu block_input (); XReparentWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), - p ? FRAME_X_WINDOW (p) : DefaultRootWindow (FRAME_X_DISPLAY (f)), + p ? FRAME_X_WINDOW (p) : FRAME_DISPLAY_INFO (f)->root_window, f->left_pos, f->top_pos); #ifdef USE_GTK if (EQ (x_gtk_resize_child_frames, Qresize_mode)) @@ -867,6 +945,14 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu (GTK_CONTAINER (FRAME_GTK_OUTER_WIDGET (f)), p ? GTK_RESIZE_IMMEDIATE : GTK_RESIZE_QUEUE); #endif + +#ifdef HAVE_GTK3 + if (p) + { + window = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)); + gdk_x11_window_set_frame_sync_enabled (window, false); + } +#endif unblock_input (); fset_parent_frame (f, new_value); @@ -893,7 +979,7 @@ x_set_no_focus_on_map (struct frame *f, Lisp_Object new_value, Lisp_Object old_v xg_set_no_focus_on_map (f, new_value); #else /* not USE_GTK */ Display *dpy = FRAME_X_DISPLAY (f); - Atom prop = XInternAtom (dpy, "_NET_WM_USER_TIME", False); + Atom prop = FRAME_DISPLAY_INFO (f)->Xatom_net_wm_user_time; Time timestamp = NILP (new_value) ? CurrentTime : 0; XChangeProperty (dpy, FRAME_OUTER_WINDOW (f), prop, @@ -1404,11 +1490,26 @@ x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) F has an x-window. */ static void -x_set_border_pixel (struct frame *f, int pix) +x_set_border_pixel (struct frame *f, unsigned long pix) { unload_color (f, f->output_data.x->border_pixel); f->output_data.x->border_pixel = pix; +#ifdef USE_X_TOOLKIT + if (f->output_data.x->widget && f->border_width > 0) + { + block_input (); + XtVaSetValues (f->output_data.x->widget, XtNborderColor, + (Pixel) pix, NULL); + unblock_input (); + + if (FRAME_VISIBLE_P (f)) + redraw_frame (f); + + return; + } +#endif + if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0) { block_input (); @@ -1434,7 +1535,7 @@ x_set_border_pixel (struct frame *f, int pix) static void x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - int pix; + unsigned long pix; CHECK_STRING (arg); pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); @@ -1842,6 +1943,10 @@ static void x_set_scroll_bar_foreground (struct frame *f, Lisp_Object value, Lisp_Object oldval) { unsigned long pixel; +#ifdef HAVE_GTK3 + XColor color; + char css[64]; +#endif if (STRINGP (value)) pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f)); @@ -1863,6 +1968,28 @@ x_set_scroll_bar_foreground (struct frame *f, Lisp_Object value, Lisp_Object old update_face_from_frame_parameter (f, Qscroll_bar_foreground, value); redraw_frame (f); } + +#ifdef HAVE_GTK3 + if (!FRAME_TOOLTIP_P (f)) + { + if (pixel != -1) + { + color.pixel = pixel; + + XQueryColor (FRAME_X_DISPLAY (f), + FRAME_X_COLORMAP (f), + &color); + + sprintf (css, "scrollbar slider { background-color: #%02x%02x%02x; }", + color.red >> 8, color.green >> 8, color.blue >> 8); + gtk_css_provider_load_from_data (FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider, + css, -1, NULL); + } + else + gtk_css_provider_load_from_data (FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider, + "", -1, NULL); + } +#endif } @@ -1875,6 +2002,10 @@ static void x_set_scroll_bar_background (struct frame *f, Lisp_Object value, Lisp_Object oldval) { unsigned long pixel; +#ifdef HAVE_GTK3 + XColor color; + char css[64]; +#endif if (STRINGP (value)) pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f)); @@ -1910,11 +2041,33 @@ x_set_scroll_bar_background (struct frame *f, Lisp_Object value, Lisp_Object old update_face_from_frame_parameter (f, Qscroll_bar_background, value); redraw_frame (f); } + +#ifdef HAVE_GTK3 + if (!FRAME_TOOLTIP_P (f)) + { + if (pixel != -1) + { + color.pixel = pixel; + + XQueryColor (FRAME_X_DISPLAY (f), + FRAME_X_COLORMAP (f), + &color); + + sprintf (css, "scrollbar trough { background-color: #%02x%02x%02x; }", + color.red >> 8, color.green >> 8, color.blue >> 8); + gtk_css_provider_load_from_data (FRAME_X_OUTPUT (f)->scrollbar_background_css_provider, + css, -1, NULL); + } + else + gtk_css_provider_load_from_data (FRAME_X_OUTPUT (f)->scrollbar_background_css_provider, + "", -1, NULL); + } +#endif } /* Encode Lisp string STRING as a text in a format appropriate for - XICCC (X Inter Client Communication Conventions). + the ICCCM (Inter Client Communication Conventions Manual). If STRING contains only ASCII characters, do no conversion and return the string data of STRING. Otherwise, encode the text by @@ -2320,14 +2473,91 @@ hack_wm_protocols (struct frame *f, Widget widget) } #endif +static void +append_wm_protocols (struct x_display_info *dpyinfo, + struct frame *f) +{ + unsigned char *existing = NULL; + int format = 0; + unsigned long nitems = 0; + Atom type; + Atom *existing_protocols; + Atom protos[10]; + int num_protos = 0; + bool found_wm_ping = false; +#if !defined HAVE_GTK3 && defined HAVE_XSYNC + bool found_wm_sync_request = false; +#endif + unsigned long bytes_after; + + block_input (); + if ((XGetWindowProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_wm_protocols, + 0, 100, False, XA_ATOM, &type, &format, &nitems, + &bytes_after, &existing) == Success) + && format == 32 && type == XA_ATOM) + { + existing_protocols = (Atom *) existing; + + while (nitems) + { + nitems--; + + if (existing_protocols[nitems] + == dpyinfo->Xatom_net_wm_ping) + found_wm_ping = true; +#if !defined HAVE_GTK3 && defined HAVE_XSYNC + else if (existing_protocols[nitems] + == dpyinfo->Xatom_net_wm_sync_request) + found_wm_sync_request = true; +#endif + } + } + + if (existing) + XFree (existing); + + if (!found_wm_ping) + protos[num_protos++] = dpyinfo->Xatom_net_wm_ping; +#if !defined HAVE_GTK3 && defined HAVE_XSYNC + if (!found_wm_sync_request && dpyinfo->xsync_supported_p) + protos[num_protos++] = dpyinfo->Xatom_net_wm_sync_request; +#endif + + if (num_protos) + XChangeProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_wm_protocols, + XA_ATOM, 32, PropModeAppend, + (unsigned char *) protos, + num_protos); + unblock_input (); +} + /* Support routines for XIC (X Input Context). */ #ifdef HAVE_X_I18N -static XFontSet xic_create_xfontset (struct frame *); -static XIMStyle best_xim_style (XIMStyles *); +static void xic_preedit_draw_callback (XIC, XPointer, XIMPreeditDrawCallbackStruct *); +static void xic_preedit_caret_callback (XIC, XPointer, XIMPreeditCaretCallbackStruct *); +static void xic_preedit_done_callback (XIC, XPointer, XPointer); +static int xic_preedit_start_callback (XIC, XPointer, XPointer); + +#ifndef HAVE_XICCALLBACK_CALLBACK +#define XICCallback XIMCallback +#define XICProc XIMProc +#endif + +static XIMCallback Xxic_preedit_draw_callback = { NULL, + (XIMProc) xic_preedit_draw_callback }; +static XIMCallback Xxic_preedit_caret_callback = { NULL, + (XIMProc) xic_preedit_caret_callback }; +static XIMCallback Xxic_preedit_done_callback = { NULL, + (XIMProc) xic_preedit_done_callback }; +static XICCallback Xxic_preedit_start_callback = { NULL, + (XICProc) xic_preedit_start_callback }; #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT /* Create an X fontset on frame F with base font name BASE_FONTNAME. */ @@ -2604,16 +2834,37 @@ xic_free_xfontset (struct frame *f) FRAME_XIC_FONTSET (f) = NULL; } +/* Create XIC for frame F. */ + +static const XIMStyle supported_xim_styles[] = + { + STYLE_NONE, + STYLE_CALLBACK, + STYLE_OVERTHESPOT, + STYLE_OFFTHESPOT, + STYLE_ROOT + }; /* Value is the best input style, given user preferences USER (already checked to be supported by Emacs), and styles supported by the input method XIM. */ static XIMStyle -best_xim_style (XIMStyles *xim) +best_xim_style (struct x_display_info *dpyinfo, + XIMStyles *xim) { - /* Return the default style. This is what GTK3 uses and - should work fine with all modern input methods. */ + int i, j; + int nr_supported = ARRAYELTS (supported_xim_styles); + + if (dpyinfo->preferred_xim_style) + return dpyinfo->preferred_xim_style; + + for (i = 0; i < nr_supported; ++i) + for (j = 0; j < xim->count_styles; ++j) + if (supported_xim_styles[i] == xim->supported_styles[j]) + return supported_xim_styles[i]; + + /* Return the default style. */ return XIMPreeditNothing | XIMStatusNothing; } @@ -2639,7 +2890,8 @@ create_frame_xic (struct frame *f) goto out; /* Determine XIC style. */ - xic_style = best_xim_style (FRAME_X_XIM_STYLES (f)); + xic_style = best_xim_style (FRAME_DISPLAY_INFO (f), + FRAME_X_XIM_STYLES (f)); /* Create X fontset. */ if (xic_style & (XIMPreeditPosition | XIMStatusArea)) @@ -2688,6 +2940,22 @@ create_frame_xic (struct frame *f) goto out; } + if (xic_style & XIMPreeditCallbacks) + { + spot.x = 0; + spot.y = 0; + preedit_attr = XVaCreateNestedList (0, + XNSpotLocation, &spot, + XNPreeditStartCallback, &Xxic_preedit_start_callback, + XNPreeditDoneCallback, &Xxic_preedit_done_callback, + XNPreeditDrawCallback, &Xxic_preedit_draw_callback, + XNPreeditCaretCallback, &Xxic_preedit_caret_callback, + NULL); + + if (!preedit_attr) + goto out; + } + if (preedit_attr && status_attr) xic = XCreateIC (xim, XNInputStyle, xic_style, @@ -2758,15 +3026,49 @@ free_frame_xic (struct frame *f) void xic_set_preeditarea (struct window *w, int x, int y) { - struct frame *f = XFRAME (w->frame); + struct frame *f = WINDOW_XFRAME (w); XVaNestedList attr; XPoint spot; - spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w) + WINDOW_LEFT_MARGIN_WIDTH(w); - spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f)); - attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL); - XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL); - XFree (attr); + if (FRAME_XIC (f)) + { + spot.x = (WINDOW_TO_FRAME_PIXEL_X (w, x) + + WINDOW_LEFT_FRINGE_WIDTH (w) + + WINDOW_LEFT_MARGIN_WIDTH (w)); + spot.y = (WINDOW_TO_FRAME_PIXEL_Y (w, y) + + w->phys_cursor_height); + + if (FRAME_XIC_STYLE (f) & XIMPreeditCallbacks) + attr = XVaCreateNestedList (0, XNSpotLocation, &spot, + XNPreeditStartCallback, &Xxic_preedit_start_callback, + XNPreeditDoneCallback, &Xxic_preedit_done_callback, + XNPreeditDrawCallback, &Xxic_preedit_draw_callback, + XNPreeditCaretCallback, &Xxic_preedit_caret_callback, + NULL); + else + attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL); + XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL); + XFree (attr); + } +#ifdef USE_GTK + if (f->tooltip) + return; + + GdkRectangle rect; + int scale = xg_get_scale (f); + + rect.x = (WINDOW_TO_FRAME_PIXEL_X (w, x) + + WINDOW_LEFT_FRINGE_WIDTH (w) + + WINDOW_LEFT_MARGIN_WIDTH (w)) / scale; + rect.y = (WINDOW_TO_FRAME_PIXEL_Y (w, y) + + FRAME_TOOLBAR_HEIGHT (f) + + FRAME_MENUBAR_HEIGHT (f)) / scale; + rect.width = w->phys_cursor_width / scale; + rect.height = w->phys_cursor_height / scale; + + gtk_im_context_set_cursor_location (FRAME_X_OUTPUT (f)->im_context, + &rect); +#endif } @@ -2812,9 +3114,391 @@ xic_set_statusarea (struct frame *f) XFree (attr); } +static struct frame * +x_xic_to_frame (XIC xic) +{ + Lisp_Object tail, tem; + struct frame *f; + + FOR_EACH_FRAME (tail, tem) + { + f = XFRAME (tem); + + if (FRAME_X_P (f) && FRAME_XIC (f) == xic) + return f; + } + + return NULL; +} + +static int +xic_preedit_start_callback (XIC xic, XPointer client_data, + XPointer call_data) +{ + struct frame *f = x_xic_to_frame (xic); + struct x_output *output; + + if (f) + { + output = FRAME_X_OUTPUT (f); + + output->preedit_size = 0; + output->preedit_active = true; + output->preedit_caret = 0; + + if (output->preedit_chars) + xfree (output->preedit_chars); + + output->preedit_chars = NULL; + } + + return -1; +} + +static void +xic_preedit_caret_callback (XIC xic, XPointer client_data, + XIMPreeditCaretCallbackStruct *call_data) +{ + struct frame *f = x_xic_to_frame (xic); + struct x_output *output; + struct input_event ie; + EVENT_INIT (ie); + + if (f) + { + output = FRAME_X_OUTPUT (f); + + if (!output->preedit_active) + return; + + switch (call_data->direction) + { + case XIMAbsolutePosition: + output->preedit_caret = call_data->position; + break; + case XIMForwardChar: + case XIMForwardWord: + call_data->position = output->preedit_caret++; + break; + case XIMBackwardChar: + case XIMBackwardWord: + call_data->position = max (0, output->preedit_caret--); + break; + default: + call_data->position = output->preedit_caret; + } + + if (output->preedit_chars) + { + ie.kind = PREEDIT_TEXT_EVENT; + XSETFRAME (ie.frame_or_window, f); + ie.arg = make_string_from_utf8 (output->preedit_chars, + output->preedit_size); + + if (SCHARS (ie.arg)) + Fput_text_property (make_fixnum (min (SCHARS (ie.arg) - 1, + max (0, output->preedit_caret))), + make_fixnum (max (SCHARS (ie.arg), + max (0, output->preedit_caret) + 1)), + Qcursor, Qt, ie.arg); + + XSETINT (ie.x, 0); + XSETINT (ie.y, 0); + + kbd_buffer_store_event (&ie); + } + } +} + + +static void +xic_preedit_done_callback (XIC xic, XPointer client_data, + XPointer call_data) +{ + struct frame *f = x_xic_to_frame (xic); + struct x_output *output; + struct input_event ie; + EVENT_INIT (ie); + + if (f) + { + ie.kind = PREEDIT_TEXT_EVENT; + ie.arg = Qnil; + XSETFRAME (ie.frame_or_window, f); + XSETINT (ie.x, 0); + XSETINT (ie.y, 0); + kbd_buffer_store_event (&ie); + + output = FRAME_X_OUTPUT (f); + + if (output->preedit_chars) + xfree (output->preedit_chars); -/* Set X fontset for XIC of frame F, using base font name - BASE_FONTNAME. Called when a new Emacs fontset is chosen. */ + output->preedit_size = 0; + output->preedit_active = false; + output->preedit_chars = NULL; + output->preedit_caret = 0; + } +} + +struct x_xim_text_conversion_data +{ + struct coding_system *coding; + char *source; +}; + +static Lisp_Object +x_xim_text_to_utf8_unix_1 (ptrdiff_t nargs, + Lisp_Object *args) +{ + struct x_xim_text_conversion_data *data; + ptrdiff_t nbytes; + + data = xmint_pointer (args[0]); + nbytes = strlen (data->source); + + data->coding->destination = NULL; + + setup_coding_system (Vlocale_coding_system, + data->coding); + data->coding->mode |= (CODING_MODE_LAST_BLOCK + | CODING_MODE_SAFE_ENCODING); + data->coding->source = (const unsigned char *) data->source; + data->coding->dst_bytes = 2048; + data->coding->destination = xmalloc (2048); + decode_coding_object (data->coding, Qnil, 0, 0, + nbytes, nbytes, Qnil); + + return Qnil; +} + +static Lisp_Object +x_xim_text_to_utf8_unix_2 (Lisp_Object val, + ptrdiff_t nargs, + Lisp_Object *args) +{ + struct x_xim_text_conversion_data *data; + + data = xmint_pointer (args[0]); + + if (data->coding->destination) + xfree (data->coding->destination); + + data->coding->destination = NULL; + + return Qnil; +} + +/* The string returned is not null-terminated. */ +static char * +x_xim_text_to_utf8_unix (XIMText *text, ptrdiff_t *length) +{ + unsigned char *wchar_buf; + ptrdiff_t wchar_actual_length, i; + struct coding_system coding; + struct x_xim_text_conversion_data data; + bool was_waiting_for_input_p; + Lisp_Object arg; + + if (text->encoding_is_wchar) + { + wchar_buf = xmalloc ((text->length + 1) * MAX_MULTIBYTE_LENGTH); + wchar_actual_length = 0; + + for (i = 0; i < text->length; ++i) + wchar_actual_length += CHAR_STRING (text->string.wide_char[i], + wchar_buf + wchar_actual_length); + *length = wchar_actual_length; + + return (char *) wchar_buf; + } + + data.coding = &coding; + data.source = text->string.multi_byte; + + was_waiting_for_input_p = waiting_for_input; + /* Otherwise Fsignal will crash. */ + waiting_for_input = false; + arg = make_mint_ptr (&data); + internal_condition_case_n (x_xim_text_to_utf8_unix_1, 1, &arg, + Qt, x_xim_text_to_utf8_unix_2); + waiting_for_input = was_waiting_for_input_p; + + *length = coding.produced; + return (char *) coding.destination; +} + +static void +xic_preedit_draw_callback (XIC xic, XPointer client_data, + XIMPreeditDrawCallbackStruct *call_data) +{ + struct frame *f = x_xic_to_frame (xic); + struct x_output *output; + ptrdiff_t text_length = 0; + ptrdiff_t charpos; + ptrdiff_t original_size; + char *text; + char *chg_start, *chg_end; + struct input_event ie; + EVENT_INIT (ie); + + if (f) + { + output = FRAME_X_OUTPUT (f); + + if (!output->preedit_active) + return; + + if (call_data->text) + { + text = x_xim_text_to_utf8_unix (call_data->text, &text_length); + + if (!text) + /* Decoding the IM text failed. */ + goto im_abort; + } + else + text = NULL; + + original_size = output->preedit_size; + + /* This is an ordinary insertion: reallocate the buffer to hold + enough for TEXT. */ + if (!call_data->chg_length) + { + if (!text) + goto im_abort; + + if (output->preedit_chars) + output->preedit_chars = xrealloc (output->preedit_chars, + output->preedit_size += text_length); + else + output->preedit_chars = xmalloc (output->preedit_size += text_length); + } + + chg_start = output->preedit_chars; + + /* The IM sent bad data: the buffer is empty, but the change + position is more than 0. */ + if (!output->preedit_chars && call_data->chg_first) + goto im_abort; + + /* Find the byte position for the character position where the + first change is to be made. */ + if (call_data->chg_first) + { + charpos = 0; + + while (charpos < call_data->chg_first) + { + chg_start += BYTES_BY_CHAR_HEAD (*chg_start); + + if ((chg_start - output->preedit_chars) > output->preedit_size) + /* The IM sent bad data: chg_start is larger than the + current buffer. */ + goto im_abort; + ++charpos; + } + } + + if (!call_data->chg_length) + { + if (!text) + goto im_abort; + + memmove (chg_start + text_length, chg_start, + original_size - (chg_start - output->preedit_chars)); + memcpy (chg_start, text, text_length); + } + else + { + if (call_data->chg_length < 1) + goto im_abort; + + charpos = 0; + chg_end = chg_start; + + while (charpos < call_data->chg_length) + { + chg_end += BYTES_BY_CHAR_HEAD (*chg_end); + + if ((chg_end - output->preedit_chars) > output->preedit_size) + /* The IM sent bad data: chg_end ends someplace outside + the current buffer. */ + goto im_abort; + ++charpos; + } + + memmove (chg_start, chg_end, ((output->preedit_chars + + output->preedit_size) - chg_end)); + output->preedit_size -= (chg_end - chg_start); + + if (text) + { + original_size = output->preedit_size; + output->preedit_chars = xrealloc (output->preedit_chars, + output->preedit_size += text_length); + + /* Find chg_start again, since preedit_chars was reallocated. */ + + chg_start = output->preedit_chars; + charpos = 0; + + while (charpos < call_data->chg_first) + { + chg_start += BYTES_BY_CHAR_HEAD (*chg_start); + + if ((chg_start - output->preedit_chars) > output->preedit_size) + /* The IM sent bad data: chg_start is larger than the + current buffer. */ + goto im_abort; + ++charpos; + } + + memmove (chg_start + text_length, chg_start, + original_size - (chg_start - output->preedit_chars)); + memcpy (chg_start, text, text_length); + } + } + + if (text) + xfree (text); + + output->preedit_caret = call_data->caret; + + /* This is okay because this callback is called from the big XIM + event filter, which runs inside XTread_socket. */ + + ie.kind = PREEDIT_TEXT_EVENT; + XSETFRAME (ie.frame_or_window, f); + ie.arg = make_string_from_utf8 (output->preedit_chars, + output->preedit_size); + + if (SCHARS (ie.arg)) + Fput_text_property (make_fixnum (min (SCHARS (ie.arg) - 1, + max (0, output->preedit_caret))), + make_fixnum (min (SCHARS (ie.arg), + max (0, output->preedit_caret) + 1)), + Qcursor, Qt, ie.arg); + + XSETINT (ie.x, 0); + XSETINT (ie.y, 0); + + kbd_buffer_store_event (&ie); + } + + return; + + im_abort: + if (text) + xfree (text); + if (output->preedit_chars) + xfree (output->preedit_chars); + output->preedit_chars = NULL; + output->preedit_size = 0; + output->preedit_active = false; + output->preedit_caret = 0; +} void xic_set_xfontset (struct frame *f, const char *base_fontname) @@ -2851,6 +3535,17 @@ x_mark_frame_dirty (struct frame *f) static void set_up_x_back_buffer (struct frame *f) { +#ifdef HAVE_XRENDER + block_input (); + if (FRAME_X_PICTURE (f) != None) + { + XRenderFreePicture (FRAME_X_DISPLAY (f), + FRAME_X_PICTURE (f)); + FRAME_X_PICTURE (f) = None; + } + unblock_input (); +#endif + #ifdef HAVE_XDBE block_input (); if (FRAME_X_WINDOW (f) && !FRAME_X_DOUBLE_BUFFERED_P (f)) @@ -2865,10 +3560,10 @@ set_up_x_back_buffer (struct frame *f) server ran out of memory or we don't have the right kind of visual, just use single-buffered rendering. */ x_catch_errors (FRAME_X_DISPLAY (f)); - FRAME_X_RAW_DRAWABLE (f) = XdbeAllocateBackBufferName ( - FRAME_X_DISPLAY (f), - FRAME_X_WINDOW (f), - XdbeCopied); + FRAME_X_RAW_DRAWABLE (f) + = XdbeAllocateBackBufferName (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + XdbeCopied); if (x_had_errors_p (FRAME_X_DISPLAY (f))) FRAME_X_RAW_DRAWABLE (f) = FRAME_X_WINDOW (f); x_uncatch_errors_after_check (); @@ -2881,6 +3576,17 @@ set_up_x_back_buffer (struct frame *f) void tear_down_x_back_buffer (struct frame *f) { +#ifdef HAVE_XRENDER + block_input (); + if (FRAME_X_PICTURE (f) != None) + { + XRenderFreePicture (FRAME_X_DISPLAY (f), + FRAME_X_PICTURE (f)); + FRAME_X_PICTURE (f) = None; + } + unblock_input (); +#endif + #ifdef HAVE_XDBE block_input (); if (FRAME_X_WINDOW (f) && FRAME_X_DOUBLE_BUFFERED_P (f)) @@ -2912,6 +3618,80 @@ initial_set_up_x_back_buffer (struct frame *f) unblock_input (); } +#if defined HAVE_XINPUT2 +static void +setup_xi_event_mask (struct frame *f) +{ + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + + block_input (); +#ifndef HAVE_GTK3 + mask.deviceid = XIAllMasterDevices; + + XISetMask (m, XI_ButtonPress); + XISetMask (m, XI_ButtonRelease); + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); +#ifndef USE_GTK + XISetMask (m, XI_FocusIn); + XISetMask (m, XI_FocusOut); + XISetMask (m, XI_KeyPress); + XISetMask (m, XI_KeyRelease); +#endif + XISelectEvents (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + &mask, 1); + + memset (m, 0, l); +#endif /* !HAVE_GTK3 */ + +#ifdef USE_X_TOOLKIT + XISetMask (m, XI_KeyPress); + XISetMask (m, XI_KeyRelease); + XISetMask (m, XI_FocusIn); + XISetMask (m, XI_FocusOut); + + XISelectEvents (FRAME_X_DISPLAY (f), + FRAME_OUTER_WINDOW (f), + &mask, 1); + memset (m, 0, l); +#endif + + mask.deviceid = XIAllDevices; + + XISetMask (m, XI_PropertyEvent); + XISetMask (m, XI_HierarchyChanged); + XISetMask (m, XI_DeviceChanged); +#ifdef HAVE_XINPUT2_2 + if (FRAME_DISPLAY_INFO (f)->xi2_version >= 2) + { + XISetMask (m, XI_TouchBegin); + XISetMask (m, XI_TouchUpdate); + XISetMask (m, XI_TouchEnd); +#ifdef HAVE_XINPUT2_4 + if (FRAME_DISPLAY_INFO (f)->xi2_version >= 4) + { + XISetMask (m, XI_GesturePinchBegin); + XISetMask (m, XI_GesturePinchUpdate); + XISetMask (m, XI_GesturePinchEnd); + } +#endif + } +#endif + XISelectEvents (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + &mask, 1); + unblock_input (); +} +#endif + #ifdef USE_X_TOOLKIT /* Create and set up the X widget for frame F. */ @@ -3086,6 +3866,7 @@ x_window (struct frame *f, long window_prompting) &f->output_data.x->wm_hints); hack_wm_protocols (f, shell_widget); + append_wm_protocols (FRAME_DISPLAY_INFO (f), f); #ifdef X_TOOLKIT_EDITRES XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0); @@ -3137,7 +3918,7 @@ x_window (struct frame *f, long window_prompting) { Display *dpy = FRAME_X_DISPLAY (f); PropMotifWmHints hints; - Atom prop = XInternAtom (dpy, "_MOTIF_WM_HINTS", False); + Atom prop = FRAME_DISPLAY_INFO (f)->Xatom_MOTIF_WM_HINTS; memset (&hints, 0, sizeof(hints)); hints.flags = MWM_HINTS_DECORATIONS; @@ -3161,6 +3942,11 @@ x_window (struct frame *f, long window_prompting) /* This is a no-op, except under Motif. Make sure main areas are set to something reasonable, in case we get an error later. */ lw_set_main_areas (pane_widget, 0, frame_widget); + +#ifdef HAVE_XINPUT2 + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + setup_xi_event_mask (f); +#endif } #else /* not USE_X_TOOLKIT */ @@ -3200,6 +3986,13 @@ x_window (struct frame *f) unblock_input (); } #endif + + append_wm_protocols (FRAME_DISPLAY_INFO (f), f); + +#ifdef HAVE_XINPUT2 + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + setup_xi_event_mask (f); +#endif } #else /*! USE_GTK */ @@ -3231,7 +4024,7 @@ x_window (struct frame *f) f->top_pos, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f), f->border_width, - CopyFromParent, /* depth */ + FRAME_DISPLAY_INFO (f)->n_planes, /* depth */ InputOutput, /* class */ FRAME_X_VISUAL (f), attribute_mask, &attributes); @@ -3254,6 +4047,11 @@ x_window (struct frame *f) } #endif /* HAVE_X_I18N */ +#ifdef HAVE_XINPUT2 + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + setup_xi_event_mask (f); +#endif + validate_x_resource_name (); class_hints.res_name = SSDATA (Vx_resource_name); @@ -3279,6 +4077,8 @@ x_window (struct frame *f) XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2); } + append_wm_protocols (FRAME_DISPLAY_INFO (f), f); + /* x_set_name normally ignores requests to set the name if the requested name is the same as the current name. This is the one place where that assumption isn't correct; f->name is set, but @@ -3297,7 +4097,7 @@ x_window (struct frame *f) { Display *dpy = FRAME_X_DISPLAY (f); PropMotifWmHints hints; - Atom prop = XInternAtom (dpy, "_MOTIF_WM_HINTS", False); + Atom prop = FRAME_DISPLAY_INFO (f)->Xatom_MOTIF_WM_HINTS; memset (&hints, 0, sizeof(hints)); hints.flags = MWM_HINTS_DECORATIONS; @@ -3430,11 +4230,9 @@ x_make_gc (struct frame *f) /* Cursor has cursor-color background, background-color foreground. */ gc_values.foreground = FRAME_BACKGROUND_PIXEL (f); gc_values.background = f->output_data.x->cursor_pixel; - gc_values.fill_style = FillOpaqueStippled; f->output_data.x->cursor_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - (GCForeground | GCBackground - | GCFillStyle | GCLineWidth), + (GCForeground | GCBackground | GCLineWidth), &gc_values); /* Create the gray border tile used when the pointer is not in @@ -3637,9 +4435,7 @@ set_machine_and_pid_properties (struct frame *f) unsigned long xpid = pid; XChangeProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), - XInternAtom (FRAME_X_DISPLAY (f), - "_NET_WM_PID", - False), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_pid, XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &xpid, 1); } @@ -3663,7 +4459,7 @@ This function is an internal primitive--use `make-frame' instead. */) bool minibuffer_only = false; bool undecorated = false, override_redirect = false; long window_prompting = 0; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object display; struct x_display_info *dpyinfo = NULL; Lisp_Object parent, parent_frame; @@ -3967,6 +4763,13 @@ This function is an internal primitive--use `make-frame' instead. */) gui_default_parameter (f, parms, Qno_special_glyphs, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); +#ifdef HAVE_GTK3 + FRAME_OUTPUT_DATA (f)->scrollbar_background_css_provider + = gtk_css_provider_new (); + FRAME_OUTPUT_DATA (f)->scrollbar_foreground_css_provider + = gtk_css_provider_new (); +#endif + x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground, "scrollBarForeground", "ScrollBarForeground", true); @@ -4042,6 +4845,13 @@ This function is an internal primitive--use `make-frame' instead. */) x_icon (f, parms); x_make_gc (f); +#ifdef HAVE_XINPUT2 + if (dpyinfo->supports_xi2) + FRAME_X_OUTPUT (f)->xi_masks + = XIGetSelectedEvents (dpyinfo->display, FRAME_X_WINDOW (f), + &FRAME_X_OUTPUT (f)->num_xi_masks); +#endif + /* Now consider the frame official. */ f->terminal->reference_count++; FRAME_DISPLAY_INFO (f)->reference_count++; @@ -4066,6 +4876,8 @@ This function is an internal primitive--use `make-frame' instead. */) RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); if (!NILP (parent_frame)) { @@ -4181,6 +4993,46 @@ This function is an internal primitive--use `make-frame' instead. */) (unsigned char *) &dpyinfo->client_leader_window, 1); } +#ifdef HAVE_XSYNC + if (dpyinfo->xsync_supported_p) + { +#ifndef HAVE_GTK3 + XSyncValue initial_value; + XSyncCounter counters[2]; + + AUTO_STRING (synchronizeResize, "synchronizeResize"); + AUTO_STRING (SynchronizeResize, "SynchronizeResize"); + + Lisp_Object value = gui_display_get_resource (dpyinfo, + synchronizeResize, + SynchronizeResize, + Qnil, Qnil); + + XSyncIntToValue (&initial_value, 0); + counters[0] + = FRAME_X_BASIC_COUNTER (f) + = XSyncCreateCounter (FRAME_X_DISPLAY (f), + initial_value); + + if (STRINGP (value) && !strcmp (SSDATA (value), "extended")) + counters[1] + = FRAME_X_EXTENDED_COUNTER (f) + = XSyncCreateCounter (FRAME_X_DISPLAY (f), + initial_value); + + FRAME_X_OUTPUT (f)->current_extended_counter_value + = initial_value; + + XChangeProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_sync_request_counter, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &counters, + ((STRINGP (value) + && !strcmp (SSDATA (value), "extended")) ? 2 : 1)); +#endif + } +#endif + unblock_input (); /* Works iff frame has been already mapped. */ @@ -4253,7 +5105,7 @@ DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, if (dpyinfo->n_planes <= 2) return Qnil; - switch (dpyinfo->visual->class) + switch (dpyinfo->visual_info.class) { case StaticColor: case PseudoColor: @@ -4280,7 +5132,7 @@ If omitted or nil, that stands for the selected frame's display. */) if (dpyinfo->n_planes <= 1) return Qnil; - switch (dpyinfo->visual->class) + switch (dpyinfo->visual_info.class) { case StaticColor: case PseudoColor: @@ -4356,14 +5208,17 @@ If omitted or nil, that stands for the selected frame's display. { struct x_display_info *dpyinfo = check_x_display_info (terminal); - int nr_planes = DisplayPlanes (dpyinfo->display, - XScreenNumberOfScreen (dpyinfo->screen)); + if (dpyinfo->visual_info.class != TrueColor + && dpyinfo->visual_info.class != DirectColor) + return make_fixnum (dpyinfo->visual_info.colormap_size); + + int nr_planes = dpyinfo->n_planes; - /* Truncate nr_planes to 24 to avoid integer overflow. - Some displays says 32, but only 24 bits are actually significant. + /* Truncate nr_planes to 24 to avoid integer overflow. Some + displays says 32, but only 24 bits are actually significant. There are only very few and rare video cards that have more than - 24 significant bits. Also 24 bits is more than 16 million colors, - it "should be enough for everyone". */ + 24 significant bits. Also 24 bits is more than 16 million + colors, it "should be enough for everyone". */ if (nr_planes > 24) nr_planes = 24; return make_fixnum (1 << nr_planes); @@ -4416,7 +5271,8 @@ For GNU and Unix system, the first 2 numbers are the version of the X Protocol used on TERMINAL and the 3rd number is the distributor-specific release number. For MS Windows, the 3 numbers report the OS major and minor version and build number. For Nextstep, the first 2 numbers are -hard-coded and the 3rd represents the OS version. +hard-coded and the 3rd represents the OS version. For Haiku, all 3 +numbers are hard-coded. See also the function `x-server-vendor'. @@ -4432,6 +5288,27 @@ If omitted or nil, that stands for the selected frame's display. */) VendorRelease (dpy)); } +DEFUN ("x-server-input-extension-version", Fx_server_input_extension_version, + Sx_server_input_extension_version, 0, 1, 0, + doc: /* Return the version of the X Input Extension supported by TERMINAL. +The value is nil if TERMINAL's X server doesn't support the X Input +Extension extension, or if Emacs doesn't support the version present +on that server. Otherwise, the return value is a list of the the +major and minor versions of the X Input Extension extension running on +that server. */) + (Lisp_Object terminal) +{ +#ifdef HAVE_XINPUT2 + struct x_display_info *dpyinfo = check_x_display_info (terminal); + + return (dpyinfo->supports_xi2 + ? list2i (2, dpyinfo->xi2_version) + : Qnil); +#else + return Qnil; +#endif +} + DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0, doc: /* Return the number of screens on the X server of display TERMINAL. The optional argument TERMINAL specifies which display to ask about. @@ -4535,7 +5412,7 @@ If omitted or nil, that stands for the selected frame's display. struct x_display_info *dpyinfo = check_x_display_info (terminal); Lisp_Object result; - switch (dpyinfo->visual->class) + switch (dpyinfo->visual_info.class) { case StaticGray: result = intern ("static-gray"); @@ -4589,6 +5466,7 @@ On MS Windows, this just returns nil. */) static bool x_get_net_workarea (struct x_display_info *dpyinfo, XRectangle *rect) { +#ifndef USE_XCB Display *dpy = dpyinfo->display; long offset, max_len; Atom target_type, actual_type; @@ -4642,6 +5520,69 @@ x_get_net_workarea (struct x_display_info *dpyinfo, XRectangle *rect) x_uncatch_errors (); return result; +#else + xcb_get_property_cookie_t current_desktop_cookie; + xcb_get_property_cookie_t workarea_cookie; + xcb_get_property_reply_t *reply; + xcb_generic_error_t *error; + bool rc; + uint32_t current_workspace, *values; + + current_desktop_cookie + = xcb_get_property (dpyinfo->xcb_connection, 0, + (xcb_window_t) dpyinfo->root_window, + (xcb_atom_t) dpyinfo->Xatom_net_current_desktop, + XCB_ATOM_CARDINAL, 0, 1); + + workarea_cookie + = xcb_get_property (dpyinfo->xcb_connection, 0, + (xcb_window_t) dpyinfo->root_window, + (xcb_atom_t) dpyinfo->Xatom_net_workarea, + XCB_ATOM_CARDINAL, 0, UINT32_MAX); + + reply = xcb_get_property_reply (dpyinfo->xcb_connection, + current_desktop_cookie, &error); + rc = true; + + if (!reply) + free (error), rc = false; + else + { + if (xcb_get_property_value_length (reply) != 4 + || reply->type != XCB_ATOM_CARDINAL || reply->format != 32) + rc = false; + else + current_workspace = *(uint32_t *) xcb_get_property_value (reply); + + free (reply); + } + + reply = xcb_get_property_reply (dpyinfo->xcb_connection, + workarea_cookie, &error); + + if (!reply) + free (error), rc = false; + else + { + if (rc && reply->type == XCB_ATOM_CARDINAL && reply->format == 32 + && (xcb_get_property_value_length (reply) / sizeof (uint32_t) + >= current_workspace + 4)) + { + values = xcb_get_property_value (reply); + + rect->x = values[current_workspace]; + rect->y = values[current_workspace + 1]; + rect->width = values[current_workspace + 2]; + rect->height = values[current_workspace + 3]; + } + else + rc = false; + + free (reply); + } + + return rc; +#endif } #endif /* !(USE_GTK && HAVE_GTK3) */ @@ -4830,6 +5771,108 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo) int i, n_monitors, primary = -1; RROutput pxid = None; struct MonitorInfo *monitors; + bool randr15_p = false; + +#if RANDR_MAJOR > 1 || (RANDR_MAJOR == 1 && RANDR_MINOR >= 5) + XRRMonitorInfo *rr_monitors; +#ifdef USE_XCB + xcb_get_atom_name_cookie_t *atom_name_cookies; + xcb_get_atom_name_reply_t *reply; + xcb_generic_error_t *error; + int length; +#endif + + /* If RandR 1.5 or later is available, use that instead, as some + video drivers don't report correct dimensions via other versions + of RandR. */ + if (dpyinfo->xrandr_major_version > 1 + || (dpyinfo->xrandr_major_version == 1 + && dpyinfo->xrandr_minor_version >= 5)) + { + XRectangle workarea; + char *name; + + rr_monitors = XRRGetMonitors (dpyinfo->display, + dpyinfo->root_window, + True, &n_monitors); + if (!rr_monitors) + goto fallback; + + monitors = xzalloc (n_monitors * sizeof *monitors); +#ifdef USE_XCB + atom_name_cookies = alloca (n_monitors * sizeof *atom_name_cookies); +#endif + + for (int i = 0; i < n_monitors; ++i) + { + monitors[i].geom.x = rr_monitors[i].x; + monitors[i].geom.y = rr_monitors[i].y; + monitors[i].geom.width = rr_monitors[i].width; + monitors[i].geom.height = rr_monitors[i].height; + monitors[i].mm_width = rr_monitors[i].mwidth; + monitors[i].mm_height = rr_monitors[i].mheight; + +#ifndef USE_XCB + name = XGetAtomName (dpyinfo->display, rr_monitors[i].name); + if (name) + { + monitors[i].name = xstrdup (name); + XFree (name); + } + else + monitors[i].name = xstrdup ("Unknown Monitor"); +#else + atom_name_cookies[i] + = xcb_get_atom_name (dpyinfo->xcb_connection, + (xcb_atom_t) rr_monitors[i].name); +#endif + + if (rr_monitors[i].primary) + primary = i; + + if (rr_monitors[i].primary + && x_get_net_workarea (dpyinfo, &workarea)) + { + monitors[i].work = workarea; + if (!gui_intersect_rectangles (&monitors[i].geom, + &monitors[i].work, + &monitors[i].work)) + monitors[i].work = monitors[i].geom; + } + else + monitors[i].work = monitors[i].geom; + } + +#ifdef USE_XCB + for (int i = 0; i < n_monitors; ++i) + { + reply = xcb_get_atom_name_reply (dpyinfo->xcb_connection, + atom_name_cookies[i], &error); + + if (!reply) + { + monitors[i].name = xstrdup ("Unknown monitor"); + free (error); + } + else + { + length = xcb_get_atom_name_name_length (reply); + name = xmalloc (length + 1); + memcpy (name, xcb_get_atom_name_name (reply), length); + name[length] = '\0'; + monitors[i].name = name; + free (reply); + } + } +#endif + + XRRFreeMonitors (rr_monitors); + randr15_p = true; + goto out; + } + + fallback:; +#endif #define RANDR13_LIBRARY \ (RANDR_MAJOR > 1 || (RANDR_MAJOR == 1 && RANDR_MINOR >= 3)) @@ -4918,12 +5961,16 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo) XRRFreeOutputInfo (info); } XRRFreeScreenResources (resources); - +#if RANDR_MAJOR > 1 || (RANDR_MAJOR == 1 && RANDR_MINOR >= 5) + out: +#endif attributes_list = x_make_monitor_attribute_list (monitors, n_monitors, primary, dpyinfo, - "XRandr"); + (randr15_p + ? "XRandR 1.5" + : "XRandr")); free_monitors (monitors, n_monitors); return attributes_list; } @@ -4938,17 +5985,9 @@ x_get_monitor_attributes (struct x_display_info *dpyinfo) (void) dpy; /* Suppress unused variable warning. */ #ifdef HAVE_XRANDR - int xrr_event_base, xrr_error_base; - bool xrr_ok = false; - xrr_ok = XRRQueryExtension (dpy, &xrr_event_base, &xrr_error_base); - if (xrr_ok) - { - XRRQueryVersion (dpy, &dpyinfo->xrandr_major_version, - &dpyinfo->xrandr_minor_version); - xrr_ok = ((dpyinfo->xrandr_major_version == 1 - && dpyinfo->xrandr_minor_version >= 2) - || dpyinfo->xrandr_major_version > 1); - } + bool xrr_ok = ((dpyinfo->xrandr_major_version == 1 + && dpyinfo->xrandr_minor_version >= 2) + || dpyinfo->xrandr_major_version > 1); if (xrr_ok) attributes_list = x_get_monitor_attributes_xrandr (dpyinfo); @@ -4957,10 +5996,7 @@ x_get_monitor_attributes (struct x_display_info *dpyinfo) #ifdef HAVE_XINERAMA if (NILP (attributes_list)) { - int xin_event_base, xin_error_base; - bool xin_ok = false; - xin_ok = XineramaQueryExtension (dpy, &xin_event_base, &xin_error_base); - if (xin_ok && XineramaIsActive (dpy)) + if (dpyinfo->xinerama_supported_p && XineramaIsActive (dpy)) attributes_list = x_get_monitor_attributes_xinerama (dpyinfo); } #endif /* HAVE_XINERAMA */ @@ -4973,6 +6009,65 @@ x_get_monitor_attributes (struct x_display_info *dpyinfo) #endif /* !USE_GTK */ +#ifdef USE_LUCID +/* This is used by the Lucid menu widget, but it's defined here so we + can make use of a great deal of existing code. */ +static void +xlw_monitor_dimensions_at_pos_1 (struct x_display_info *dpyinfo, + Screen *screen, int src_x, int src_y, + int *x, int *y, int *width, int *height) +{ + Lisp_Object attrs, tem, val; + + attrs = x_get_monitor_attributes (dpyinfo); + + for (tem = attrs; CONSP (tem); tem = XCDR (tem)) + { + int sx, sy, swidth, sheight; + val = assq_no_quit (Qworkarea, XCAR (tem)); + if (!NILP (val)) + { + sx = XFIXNUM (XCAR (XCDR (val))); + sy = XFIXNUM (XCAR (XCDR (XCDR (val)))); + swidth = XFIXNUM (XCAR (XCDR (XCDR (XCDR (val))))); + sheight = XFIXNUM (XCAR (XCDR (XCDR (XCDR (XCDR (val)))))); + + if (sx <= src_x && src_x < (sx + swidth) + && sy <= src_y && src_y < (sy + swidth)) + { + *x = sx; + *y = sy; + *width = swidth; + *height = sheight; + return; + } + } + } + + *x = 0; + *y = 0; + *width = WidthOfScreen (screen); + *height = HeightOfScreen (screen); +} + +void +xlw_monitor_dimensions_at_pos (Display *dpy, Screen *screen, int src_x, + int src_y, int *x, int *y, int *width, int *height) +{ + struct x_display_info *dpyinfo = x_display_info_for_display (dpy); + + if (!dpyinfo) + emacs_abort (); + + block_input (); + xlw_monitor_dimensions_at_pos_1 (dpyinfo, screen, src_x, src_y, + x, y, width, height); + + unblock_input (); +} +#endif + + DEFUN ("x-display-monitor-attributes-list", Fx_display_monitor_attributes_list, Sx_display_monitor_attributes_list, 0, 1, 0, @@ -5545,7 +6640,7 @@ selected frame's display. */) block_input (); XQueryPointer (FRAME_X_DISPLAY (f), - DefaultRootWindow (FRAME_X_DISPLAY (f)), + FRAME_DISPLAY_INFO (f)->root_window, &root, &dummy_window, &x, &y, &dummy, &dummy, (unsigned int *) &dummy); unblock_input (); @@ -5559,7 +6654,7 @@ DEFUN ("x-set-mouse-absolute-pixel-position", Fx_set_mouse_absolute_pixel_positi The coordinates X and Y are interpreted in pixels relative to a position \(0, 0) of the selected frame's display. */) (Lisp_Object x, Lisp_Object y) - { +{ struct frame *f = SELECTED_FRAME (); if (FRAME_INITIAL_P (f) || !FRAME_X_P (f)) @@ -5569,13 +6664,187 @@ The coordinates X and Y are interpreted in pixels relative to a position int yval = check_integer_range (y, INT_MIN, INT_MAX); block_input (); - XWarpPointer (FRAME_X_DISPLAY (f), None, DefaultRootWindow (FRAME_X_DISPLAY (f)), - 0, 0, 0, 0, xval, yval); +#ifdef HAVE_XINPUT2 + int deviceid; + + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + { + XGrabServer (FRAME_X_DISPLAY (f)); + if (XIGetClientPointer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + &deviceid)) + { + XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None, + FRAME_DISPLAY_INFO (f)->root_window, + 0, 0, 0, 0, xval, yval); + } + XUngrabServer (FRAME_X_DISPLAY (f)); + } + else +#endif + XWarpPointer (FRAME_X_DISPLAY (f), None, + FRAME_DISPLAY_INFO (f)->root_window, + 0, 0, 0, 0, xval, yval); unblock_input (); return Qnil; } +DEFUN ("x-begin-drag", Fx_begin_drag, Sx_begin_drag, 1, 5, 0, + doc: /* Begin dragging contents on FRAME, with targets TARGETS. +TARGETS is a list of strings, which defines the X selection targets +that will be available to the drop target. Block until the mouse +buttons are released, then return the action chosen by the target, or +`nil' if the drop was not accepted by the drop target. Dragging +starts when the mouse is pressed on FRAME, and the contents of the +selection `XdndSelection' will be sent to the X window underneath the +mouse pointer (the drop target) when the mouse button is released. +ACTION is a symbol which tells the target what the source will do, and +can be one of the following: + + - `XdndActionCopy', which means to copy the contents from the drag + source (FRAME) to the drop target. + + - `XdndActionMove', which means to first take the contents of + `XdndSelection', and to delete whatever was saved into that + selection afterwards. + +`XdndActionPrivate' is also a valid return value, and means that the +drop target chose to perform an unspecified or unknown action. + +There are also some other valid values of ACTION that depend on +details of both the drop target's implementation details and that of +Emacs. For that reason, they are not mentioned here. Consult +"Drag-and-Drop Protocol for the X Window System" for more details: +https://freedesktop.org/wiki/Specifications/XDND/. + +If RETURN-FRAME is non-nil, this function will return the frame if the +mouse pointer moves onto an Emacs frame, after first moving out of +FRAME. (This is not guaranteed to work on some systems.) If +RETURN-FRAME is the symbol `now', any frame underneath the mouse +pointer will be returned immediately. + +If ACTION is a list and not nil, its elements are assumed to be a cons +of (ITEM . STRING), where ITEM is the name of an action, and STRING is +a string describing ITEM to the user. The drop target is expected to +prompt the user to choose between any of the actions in the list. + +If ACTION is not specified or nil, `XdndActionCopy' is used +instead. + +If ALLOW-CURRENT-FRAME is not specified or nil, then the drop target +is allowed to be FRAME. Otherwise, no action will be taken if the +mouse buttons are released on top of FRAME. */) + (Lisp_Object targets, Lisp_Object action, Lisp_Object frame, + Lisp_Object return_frame, Lisp_Object allow_current_frame) +{ + struct frame *f = decode_window_system_frame (frame); + int ntargets = 0, nnames = 0; + ptrdiff_t len; + char *target_names[2048]; + Atom *target_atoms; + Lisp_Object lval, original, tem, t1, t2; + Atom xaction; + Atom action_list[2048]; + char *name_list[2048]; + char *scratch; + + USE_SAFE_ALLOCA; + + CHECK_LIST (targets); + original = targets; + + for (; CONSP (targets); targets = XCDR (targets)) + { + CHECK_STRING (XCAR (targets)); + maybe_quit (); + + if (ntargets < 2048) + { + scratch = SSDATA (XCAR (targets)); + len = strlen (scratch); + target_names[ntargets] = SAFE_ALLOCA (len + 1); + strncpy (target_names[ntargets], scratch, len + 1); + ntargets++; + } + else + error ("Too many targets"); + } + + CHECK_LIST_END (targets, original); + + if (NILP (action) || EQ (action, QXdndActionCopy)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionCopy; + else if (EQ (action, QXdndActionMove)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionMove; + else if (EQ (action, QXdndActionLink)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionLink; + else if (EQ (action, QXdndActionPrivate)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionPrivate; + else if (EQ (action, QXdndActionAsk)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionAsk; + else if (CONSP (action)) + { + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionAsk; + original = action; + + CHECK_LIST (action); + for (; CONSP (action); action = XCDR (action)) + { + maybe_quit (); + tem = XCAR (action); + CHECK_CONS (tem); + t1 = XCAR (tem); + t2 = XCDR (tem); + CHECK_SYMBOL (t1); + CHECK_STRING (t2); + + if (nnames < 2048) + { + if (EQ (t1, QXdndActionCopy)) + action_list[nnames] = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionCopy; + else if (EQ (t1, QXdndActionMove)) + action_list[nnames] = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionMove; + else if (EQ (t1, QXdndActionLink)) + action_list[nnames] = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionLink; + else if (EQ (t1, QXdndActionAsk)) + action_list[nnames] = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionAsk; + else if (EQ (t1, QXdndActionPrivate)) + action_list[nnames] = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionPrivate; + else + signal_error ("Invalid drag-and-drop action", tem); + + scratch = SSDATA (ENCODE_UTF_8 (t2)); + len = strlen (scratch); + name_list[nnames] = SAFE_ALLOCA (len + 1); + strncpy (name_list[nnames], scratch, len + 1); + + nnames++; + } + else + error ("Too many actions"); + } + CHECK_LIST_END (action, original); + } + else + signal_error ("Invalid drag-and-drop action", action); + + target_atoms = xmalloc (ntargets * sizeof *target_atoms); + + block_input (); + XInternAtoms (FRAME_X_DISPLAY (f), target_names, + ntargets, False, target_atoms); + unblock_input (); + + x_set_dnd_targets (target_atoms, ntargets); + lval = x_dnd_begin_drag_and_drop (f, FRAME_DISPLAY_INFO (f)->last_user_time, + xaction, return_frame, action_list, + (const char **) &name_list, nnames, + !NILP (allow_current_frame)); + + SAFE_FREE (); + return lval; +} + /************************************************************************ X Displays ************************************************************************/ @@ -5606,8 +6875,7 @@ visual_classes[] = the X function with the same name when that doesn't exist. */ int -XScreenNumberOfScreen (scr) - register Screen *scr; +XScreenNumberOfScreen (Screen *scr) { Display *dpy = scr->display; int i; @@ -5675,21 +6943,62 @@ select_visual (struct x_display_info *dpyinfo) SSDATA (ENCODE_SYSTEM (value))); dpyinfo->visual = vinfo.visual; + dpyinfo->visual_info = vinfo; } else { int n_visuals; XVisualInfo *vinfo, vinfo_template; - dpyinfo->visual = DefaultVisualOfScreen (screen); + vinfo_template.screen = XScreenNumberOfScreen (screen); + +#if !defined USE_X_TOOLKIT && !(defined USE_GTK && !defined HAVE_GTK3) \ + && defined HAVE_XRENDER + int i; + XRenderPictFormat *format; + + /* First attempt to find a visual with an alpha mask if + available. That information is only available when the + render extension is present, and we cannot do much with such + a visual if it isn't. */ + if (dpyinfo->xrender_supported_p) + { + + vinfo = XGetVisualInfo (dpy, VisualScreenMask, + &vinfo_template, &n_visuals); + + for (i = 0; i < n_visuals; ++i) + { + format = XRenderFindVisualFormat (dpy, vinfo[i].visual); + + if (format && format->type == PictTypeDirect + && format->direct.alphaMask) + { + dpyinfo->n_planes = vinfo[i].depth; + dpyinfo->visual = vinfo[i].visual; + dpyinfo->visual_info = vinfo[i]; + dpyinfo->pict_format = format; + + XFree (vinfo); + return; + } + } + + if (vinfo) + XFree (vinfo); + } +#endif /* !USE_X_TOOLKIT */ + + /* Visual with alpha channel (or the Render extension) not + available, fallback to default visual. */ + dpyinfo->visual = DefaultVisualOfScreen (screen); vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual); - vinfo_template.screen = XScreenNumberOfScreen (screen); vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask, &vinfo_template, &n_visuals); if (n_visuals <= 0) fatal ("Can't get proper X visual info"); - + dpyinfo->visual_info = *vinfo; dpyinfo->n_planes = vinfo->depth; XFree (vinfo); } @@ -5827,7 +7136,11 @@ void x_sync (struct frame *f) { block_input (); +#ifndef USE_XCB XSync (FRAME_X_DISPLAY (f), False); +#else + xcb_aux_sync (FRAME_DISPLAY_INFO (f)->xcb_connection); +#endif unblock_input (); } @@ -5869,6 +7182,13 @@ If WINDOW-ID is non-nil, change the property of that window instead unsigned char *data; int nelements; Window target_window; +#ifdef USE_XCB + xcb_intern_atom_cookie_t prop_atom_cookie; + xcb_intern_atom_cookie_t target_type_cookie; + xcb_intern_atom_reply_t *reply; + xcb_generic_error_t *generic_error; + bool rc; +#endif CHECK_STRING (prop); @@ -5932,12 +7252,61 @@ If WINDOW-ID is non-nil, change the property of that window instead } block_input (); +#ifndef USE_XCB prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False); if (! NILP (type)) { CHECK_STRING (type); target_type = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (type), False); } +#else + rc = true; + prop_atom_cookie + = xcb_intern_atom (FRAME_DISPLAY_INFO (f)->xcb_connection, + 0, SBYTES (prop), SSDATA (prop)); + + if (!NILP (type)) + { + CHECK_STRING (type); + target_type_cookie + = xcb_intern_atom (FRAME_DISPLAY_INFO (f)->xcb_connection, + 0, SBYTES (type), SSDATA (type)); + } + + reply = xcb_intern_atom_reply (FRAME_DISPLAY_INFO (f)->xcb_connection, + prop_atom_cookie, &generic_error); + + if (reply) + { + prop_atom = (Atom) reply->atom; + free (reply); + } + else + { + free (generic_error); + rc = false; + } + + if (!NILP (type)) + { + reply = xcb_intern_atom_reply (FRAME_DISPLAY_INFO (f)->xcb_connection, + target_type_cookie, &generic_error); + + if (reply) + { + target_type = (Atom) reply->atom; + free (reply); + } + else + { + free (generic_error); + rc = false; + } + } + + if (!rc) + error ("Failed to intern type or property atom"); +#endif XChangeProperty (FRAME_X_DISPLAY (f), target_window, prop_atom, target_type, element_format, PropModeReplace, @@ -6272,7 +7641,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) struct frame *f; Lisp_Object frame; Lisp_Object name; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); bool face_change_before = face_change; if (!dpyinfo->terminal->name) @@ -6434,26 +7803,15 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) gui_default_parameter (f, parms, Qno_special_glyphs, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); - /* Init faces before gui_default_parameter is called for the - scroll-bar-width parameter because otherwise we end up in - init_iterator with a null face cache, which should not happen. */ - init_frame_faces (f); - - f->output_data.x->parent_desc = FRAME_DISPLAY_INFO (f)->root_window; - - gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, - "inhibitDoubleBuffering", "InhibitDoubleBuffering", - RES_TYPE_BOOLEAN); - - gui_figure_window_size (f, parms, false, false); - { +#ifndef USE_XCB XSetWindowAttributes attrs; unsigned long mask; Atom type = FRAME_DISPLAY_INFO (f)->Xatom_net_window_type_tooltip; block_input (); - mask = CWBackPixel | CWOverrideRedirect | CWEventMask | CWCursor; + mask = (CWBackPixel | CWOverrideRedirect | CWEventMask + | CWCursor | CWColormap | CWBorderPixel); if (DoesSaveUnders (dpyinfo->screen)) mask |= CWSaveUnder; @@ -6463,9 +7821,11 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) attrs.override_redirect = True; attrs.save_under = True; attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f); + attrs.colormap = FRAME_X_COLORMAP (f); attrs.cursor = f->output_data.x->current_cursor = f->output_data.x->text_cursor; + attrs.border_pixel = f->output_data.x->border_pixel; /* Arrange for getting MapNotify and UnmapNotify events. */ attrs.event_mask = StructureNotifyMask; tip_window @@ -6476,7 +7836,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) 0, 0, 1, 1, /* Border. */ f->border_width, - CopyFromParent, InputOutput, CopyFromParent, + dpyinfo->n_planes, InputOutput, + FRAME_X_VISUAL (f), mask, &attrs); initial_set_up_x_back_buffer (f); XChangeProperty (FRAME_X_DISPLAY (f), tip_window, @@ -6484,8 +7845,68 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) XA_ATOM, 32, PropModeReplace, (unsigned char *)&type, 1); unblock_input (); +#else + uint32_t value_list[6]; + xcb_atom_t net_wm_window_type_tooltip + = (xcb_atom_t) dpyinfo->Xatom_net_window_type_tooltip; + xcb_visualid_t visual_id + = (xcb_visualid_t) XVisualIDFromVisual (FRAME_X_VISUAL (f)); + + f->output_data.x->current_cursor = f->output_data.x->text_cursor; + /* Values are set in the order of their enumeration in `enum + xcb_cw_t'. */ + value_list[0] = FRAME_BACKGROUND_PIXEL (f); + value_list[1] = f->output_data.x->border_pixel; + value_list[2] = true; + value_list[3] = XCB_EVENT_MASK_STRUCTURE_NOTIFY; + value_list[4] = (xcb_colormap_t) FRAME_X_COLORMAP (f); + value_list[5] = (xcb_cursor_t) f->output_data.x->text_cursor; + + block_input (); + tip_window + = FRAME_X_WINDOW (f) + = (Window) xcb_generate_id (dpyinfo->xcb_connection); + + xcb_create_window (dpyinfo->xcb_connection, + dpyinfo->n_planes, + (xcb_window_t) tip_window, + (xcb_window_t) dpyinfo->root_window, + 0, 0, 1, 1, f->border_width, + XCB_WINDOW_CLASS_INPUT_OUTPUT, + visual_id, + (XCB_CW_BACK_PIXEL + | XCB_CW_BORDER_PIXEL + | XCB_CW_OVERRIDE_REDIRECT + | XCB_CW_EVENT_MASK + | XCB_CW_COLORMAP + | XCB_CW_CURSOR), + &value_list); + + xcb_change_property (dpyinfo->xcb_connection, + XCB_PROP_MODE_REPLACE, + (xcb_window_t) tip_window, + (xcb_atom_t) dpyinfo->Xatom_net_window_type, + (xcb_atom_t) dpyinfo->Xatom_ATOM, + 32, 1, &net_wm_window_type_tooltip); + + initial_set_up_x_back_buffer (f); + unblock_input (); +#endif } + /* Init faces before gui_default_parameter is called for the + scroll-bar-width parameter because otherwise we end up in + init_iterator with a null face cache, which should not happen. */ + init_frame_faces (f); + + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + + gui_figure_window_size (f, parms, false, false); + + f->output_data.x->parent_desc = FRAME_DISPLAY_INFO (f)->root_window; + x_make_gc (f); gui_default_parameter (f, parms, Qauto_raise, Qnil, @@ -6496,6 +7917,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) "cursorType", "CursorType", RES_TYPE_SYMBOL); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) @@ -6513,8 +7936,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) if (FRAME_DISPLAY_INFO (f)->n_planes == 1) disptype = Qmono; - else if (FRAME_DISPLAY_INFO (f)->visual->class == GrayScale - || FRAME_DISPLAY_INFO (f)->visual->class == StaticGray) + else if (FRAME_X_VISUAL_INFO (f)->class == GrayScale + || FRAME_X_VISUAL_INFO (f)->class == StaticGray) disptype = intern ("grayscale"); else disptype = intern ("color"); @@ -6702,13 +8125,13 @@ x_hide_tip (bool delete) } #ifdef USE_GTK - /* Any GTK+ system tooltip can be found via the x_output structure of - tip_last_frame, provided that frame is still live. Any Emacs - tooltip is found via the tip_frame variable. Note that the current - value of x_gtk_use_system_tooltips might not be the same as used - for the tooltip we have to hide, see Bug#30399. */ + /* Any GTK+ system tooltip can be found via the x_output structure + of tip_last_frame, provided that frame is still live. Any Emacs + tooltip is found via the tip_frame variable. Note that the + current value of use_system_tooltips might not be the same as + used for the tooltip we have to hide, see Bug#30399. */ if ((NILP (tip_last_frame) && NILP (tip_frame)) - || (!x_gtk_use_system_tooltips + || (!use_system_tooltips && !delete && !NILP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame)) @@ -6719,10 +8142,9 @@ x_hide_tip (bool delete) return Qnil; else { - ptrdiff_t count; Lisp_Object was_open = Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_redisplay, Qt); specbind (Qinhibit_quit, Qt); @@ -6741,7 +8163,7 @@ x_hide_tip (bool delete) /* When using GTK+ system tooltips (compare Bug#41200) reset tip_last_frame. It will be reassigned when showing the next GTK+ system tooltip. */ - if (x_gtk_use_system_tooltips) + if (use_system_tooltips) tip_last_frame = Qnil; /* Now look whether there's an Emacs tip around. */ @@ -6751,7 +8173,7 @@ x_hide_tip (bool delete) if (FRAME_LIVE_P (f)) { - if (delete || x_gtk_use_system_tooltips) + if (delete || use_system_tooltips) { /* Delete the Emacs tooltip frame when DELETE is true or we change the tooltip type from an Emacs one to @@ -6781,10 +8203,9 @@ x_hide_tip (bool delete) return Qnil; else { - ptrdiff_t count; Lisp_Object was_open = Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_redisplay, Qt); specbind (Qinhibit_quit, Qt); @@ -6879,9 +8300,11 @@ Text larger than the specified size is clipped. */) struct text_pos pos; int width, height; int old_windows_or_buffers_changed = windows_or_buffers_changed; - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t count_1; + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object window, size, tip_buf; + Window child; + XWindowAttributes child_attrs; + int dest_x_return, dest_y_return; AUTO_STRING (tip, " *tip*"); specbind (Qinhibit_redisplay, Qt); @@ -6910,7 +8333,7 @@ Text larger than the specified size is clipped. */) CHECK_FIXNUM (dy); #ifdef USE_GTK - if (x_gtk_use_system_tooltips) + if (use_system_tooltips) { bool ok; @@ -7080,7 +8503,7 @@ Text larger than the specified size is clipped. */) /* Insert STRING into root window's buffer and fit the frame to the buffer. */ - count_1 = SPECPDL_INDEX (); + specpdl_ref count_1 = SPECPDL_INDEX (); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (w->contents)); bset_truncate_lines (current_buffer, Qnil); @@ -7095,7 +8518,8 @@ Text larger than the specified size is clipped. */) try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); /* Calculate size of tooltip window. */ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, - make_fixnum (w->pixel_height), Qnil); + make_fixnum (w->pixel_height), Qnil, + Qnil); /* Add the frame's internal border to calculated size. */ width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); @@ -7105,9 +8529,58 @@ Text larger than the specified size is clipped. */) /* Show tooltip frame. */ block_input (); + /* If the display is composited, then WM_TRANSIENT_FOR must be set + as well, or else the compositing manager won't display + decorations correctly, even though the tooltip window is override + redirect. See + https://specifications.freedesktop.org/wm-spec/1.4/ar01s08.html + + Perhaps WM_TRANSIENT_FOR should be used in place of + override-redirect anyway. The ICCCM only recommends + override-redirect if the pointer will be grabbed. */ + + if (XTranslateCoordinates (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + FRAME_DISPLAY_INFO (f)->root_window, + root_x, root_y, &dest_x_return, + &dest_y_return, &child) + && child != None) + { + /* But only if the child is not override-redirect, which can + happen if the pointer is above a menu. */ + + if (XGetWindowAttributes (FRAME_X_DISPLAY (f), + child, &child_attrs) + || child_attrs.override_redirect) + XDeleteProperty (FRAME_X_DISPLAY (tip_f), + FRAME_X_WINDOW (tip_f), + FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for); + else + XSetTransientForHint (FRAME_X_DISPLAY (tip_f), + FRAME_X_WINDOW (tip_f), child); + } + else + XDeleteProperty (FRAME_X_DISPLAY (tip_f), + FRAME_X_WINDOW (tip_f), + FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for); + +#ifndef USE_XCB XMoveResizeWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f), root_x, root_y, width, height); XMapRaised (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f)); +#else + uint32_t values[] = { root_x, root_y, width, height, XCB_STACK_MODE_ABOVE }; + + xcb_configure_window (FRAME_DISPLAY_INFO (tip_f)->xcb_connection, + (xcb_window_t) FRAME_X_WINDOW (tip_f), + (XCB_CONFIG_WINDOW_X + | XCB_CONFIG_WINDOW_Y + | XCB_CONFIG_WINDOW_WIDTH + | XCB_CONFIG_WINDOW_HEIGHT + | XCB_CONFIG_WINDOW_STACK_MODE), &values); + xcb_map_window (FRAME_DISPLAY_INFO (tip_f)->xcb_connection, + (xcb_window_t) FRAME_X_WINDOW (tip_f)); +#endif unblock_input (); #ifdef USE_CAIRO @@ -7220,7 +8693,7 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, Arg al[10]; int ac = 0; XmString dir_xmstring, pattern_xmstring; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); check_window_system (f); @@ -7316,20 +8789,84 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, result = 0; while (result == 0) { - XEvent event; + XEvent event, copy; +#ifdef HAVE_XINPUT2 + x_menu_wait_for_event (FRAME_X_DISPLAY (f)); +#else x_menu_wait_for_event (0); - XtAppNextEvent (Xt_app_con, &event); - if (event.type == KeyPress - && FRAME_X_DISPLAY (f) == event.xkey.display) - { - KeySym keysym = XLookupKeysym (&event.xkey, 0); +#endif - /* Pop down on C-g. */ - if (keysym == XK_g && (event.xkey.state & ControlMask) != 0) - XtUnmanageChild (dialog); - } + if ( +#ifndef HAVE_XINPUT2 + XtAppPending (Xt_app_con) +#else + XPending (FRAME_X_DISPLAY (f)) +#endif + ) + { +#ifndef HAVE_XINPUT2 + XtAppNextEvent (Xt_app_con, &event); +#else + XNextEvent (FRAME_X_DISPLAY (f), &event); +#endif - (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f)); + copy = event; + if (event.type == KeyPress + && FRAME_X_DISPLAY (f) == event.xkey.display) + { + KeySym keysym = XLookupKeysym (&event.xkey, 0); + + /* Pop down on C-g. */ + if (keysym == XK_g && (event.xkey.state & ControlMask) != 0) + XtUnmanageChild (dialog); + } +#ifdef HAVE_XINPUT2 + else if (event.type == GenericEvent + && FRAME_X_DISPLAY (f) == event.xgeneric.display + && FRAME_DISPLAY_INFO (f)->supports_xi2 + && (event.xgeneric.extension + == FRAME_DISPLAY_INFO (f)->xi2_opcode) + && event.xgeneric.evtype == XI_KeyPress) + { + KeySym keysym; + XIDeviceEvent *xev; + + if (event.xcookie.data) + emacs_abort (); + + if (XGetEventData (FRAME_X_DISPLAY (f), &event.xcookie)) + { + xev = (XIDeviceEvent *) event.xcookie.data; + + copy.xkey.type = KeyPress; + copy.xkey.serial = xev->serial; + copy.xkey.send_event = xev->send_event; + copy.xkey.display = FRAME_X_DISPLAY (f); + copy.xkey.window = xev->event; + copy.xkey.root = xev->root; + copy.xkey.subwindow = xev->child; + copy.xkey.time = xev->time; + copy.xkey.x = lrint (xev->event_x); + copy.xkey.y = lrint (xev->event_y); + copy.xkey.x_root = lrint (xev->root_x); + copy.xkey.y_root = lrint (xev->root_y); + copy.xkey.state = xev->mods.effective; + copy.xkey.keycode = xev->detail; + copy.xkey.same_screen = True; + + keysym = XLookupKeysym (©.xkey, 0); + + if (keysym == XK_g + && (copy.xkey.state & ControlMask) != 0) /* Any escape, ignore modifiers. */ + XtUnmanageChild (dialog); + + XFreeEventData (FRAME_X_DISPLAY (f), &event.xcookie); + } + } +#endif + + (void) x_dispatch_event (©, FRAME_X_DISPLAY (f)); + } } /* Get the result. */ @@ -7374,7 +8911,7 @@ Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file selection box, if specified. If MUSTMATCH is non-nil, the returned file or directory must exist. -This function is defined only on NS, MS Windows, and X Windows with the +This function is defined only on NS, Haiku, MS Windows, and X Windows with the Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored. Otherwise, if ONLY-DIR-P is non-nil, the user can select only directories. On MS Windows 7 and later, the file selection dialog "remembers" the last @@ -7387,7 +8924,7 @@ value of DIR as in previous invocations; this is standard MS Windows behavior. char *fn; Lisp_Object file = Qnil; Lisp_Object decoded_file; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); char *cdef_file; check_window_system (f); @@ -7448,7 +8985,7 @@ nil, it defaults to the selected frame. */) Lisp_Object font; Lisp_Object font_param; char *default_name = NULL; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (popup_activated ()) error ("Trying to use a menu from within a menu-entry"); @@ -7512,27 +9049,11 @@ present and mapped to the usual X keysyms. */) struct frame *f = decode_window_system_frame (frame); Display *dpy = FRAME_X_DISPLAY (f); Lisp_Object have_keys; - int major, minor, op, event, error_code; - block_input (); - - /* Check library version in case we're dynamically linked. */ - major = XkbMajorVersion; - minor = XkbMinorVersion; - if (!XkbLibraryVersion (&major, &minor)) - { - unblock_input (); - return Qlambda; - } + if (!FRAME_DISPLAY_INFO (f)->supports_xkb) + return Qlambda; - /* Check that the server supports XKB. */ - major = XkbMajorVersion; - minor = XkbMinorVersion; - if (!XkbQueryExtension (dpy, &op, &event, &error_code, &major, &minor)) - { - unblock_input (); - return Qlambda; - } + block_input (); /* In this code we check that the keyboard has physical keys with names that start with BKSP (Backspace) and DELE (Delete), and that they @@ -7716,7 +9237,6 @@ Note: Text drawn with the `x' font backend is shown with hollow boxes. */) (Lisp_Object frames) { Lisp_Object rest, tmp; - int count; if (!CONSP (frames)) frames = list1 (frames); @@ -7735,7 +9255,7 @@ Note: Text drawn with the `x' font backend is shown with hollow boxes. */) frames = Fnreverse (tmp); /* Make sure the current matrices are up-to-date. */ - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (32); unbind_to (count, Qnil); @@ -7767,6 +9287,47 @@ DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, #endif /* GTK_CHECK_VERSION (3, 14, 0) */ #endif /* HAVE_GTK3 */ #endif /* USE_GTK */ + +DEFUN ("x-internal-focus-input-context", Fx_internal_focus_input_context, + Sx_internal_focus_input_context, 1, 1, 0, + doc: /* Focus and set the client window of all focused frames' GTK input context. +If FOCUS is nil, focus out and remove the client window instead. +This should be called from a variable watcher for `x-gtk-use-native-input'. */) + (Lisp_Object focus) +{ +#ifdef USE_GTK + struct x_display_info *dpyinfo; + struct frame *f; + GtkWidget *widget; + + block_input (); + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) + { + f = dpyinfo->x_focus_frame; + + if (f) + { + widget = FRAME_GTK_OUTER_WIDGET (f); + + if (!NILP (focus)) + { + gtk_im_context_focus_in (FRAME_X_OUTPUT (f)->im_context); + gtk_im_context_set_client_window (FRAME_X_OUTPUT (f)->im_context, + gtk_widget_get_window (widget)); + } + else + { + gtk_im_context_focus_out (FRAME_X_OUTPUT (f)->im_context); + gtk_im_context_set_client_window (FRAME_X_OUTPUT (f)->im_context, + NULL); + } + } + } + unblock_input (); +#endif + + return Qnil; +} /*********************************************************************** Initialization @@ -7825,8 +9386,66 @@ frame_parm_handler x_frame_parm_handlers[] = x_set_z_group, x_set_override_redirect, gui_set_no_special_glyphs, + x_set_alpha_background, + x_set_shaded, }; +/* Some versions of libX11 don't have symbols for a few functions we + need, so define replacements here. */ + +#ifdef HAVE_XKB +#ifndef HAVE_XKBREFRESHKEYBOARDMAPPING +Status +XkbRefreshKeyboardMapping (XkbMapNotifyEvent *event) +{ + return Success; +} +#endif + +#ifndef HAVE_XKBFREENAMES +void +XkbFreeNames (XkbDescPtr xkb, unsigned int which, Bool free_map) +{ + return; +} +#endif +#endif + +#ifndef HAVE_XDISPLAYCELLS +int +XDisplayCells (Display *dpy, int screen_number) +{ + struct x_display_info *dpyinfo = x_display_info_for_display (dpy); + + if (!dpyinfo) + emacs_abort (); + + /* Not strictly correct, since the display could be using a + non-default visual, but it satisfies the callers we need to care + about. */ + return dpyinfo->visual_info.colormap_size; +} +#endif + +#ifndef HAVE_XDESTROYSUBWINDOWS +int +XDestroySubwindows (Display *dpy, Window w) +{ + Window root, parent, *children; + unsigned int nchildren, i; + + if (XQueryTree (dpy, w, &root, &parent, &children, + &nchildren)) + { + for (i = 0; i < nchildren; ++i) + XDestroyWindow (dpy, children[i]); + XFree (children); + } + + return 0; +} +#endif + void syms_of_xfns (void) { @@ -7850,6 +9469,12 @@ syms_of_xfns (void) DEFSYM (Qreverse_landscape, "reverse-landscape"); #endif + DEFSYM (QXdndActionCopy, "XdndActionCopy"); + DEFSYM (QXdndActionMove, "XdndActionMove"); + DEFSYM (QXdndActionLink, "XdndActionLink"); + DEFSYM (QXdndActionAsk, "XdndActionAsk"); + DEFSYM (QXdndActionPrivate, "XdndActionPrivate"); + Fput (Qundefined_color, Qerror_conditions, pure_list (Qundefined_color, Qerror)); Fput (Qundefined_color, Qerror_message, @@ -8007,12 +9632,6 @@ If more space for files in the file chooser dialog is wanted, set this to nil to turn the additional text off. */); x_gtk_file_dialog_help_text = true; - DEFVAR_BOOL ("x-gtk-use-system-tooltips", x_gtk_use_system_tooltips, - doc: /* If non-nil with a Gtk+ built Emacs, the Gtk+ tooltip is used. -Otherwise use Emacs own tooltip implementation. -When using Gtk+ tooltips, the tooltip face is not used. */); - x_gtk_use_system_tooltips = true; - DEFVAR_LISP ("x-gtk-resize-child-frames", x_gtk_resize_child_frames, doc: /* If non-nil, resize child frames specially with GTK builds. If this is nil, resize child frames like any other frames. This is the @@ -8038,6 +9657,12 @@ eliminated in future versions of Emacs. */); /* Tell Emacs about this window system. */ Fprovide (Qx, Qnil); +#ifdef HAVE_XINPUT2 + DEFSYM (Qxinput2, "xinput2"); + + Fprovide (Qxinput2, Qnil); +#endif + #ifdef USE_X_TOOLKIT Fprovide (intern_c_string ("x-toolkit"), Qnil); #ifdef USE_MOTIF @@ -8095,6 +9720,7 @@ eliminated in future versions of Emacs. */); defsubr (&Sx_server_max_request_size); defsubr (&Sx_server_vendor); defsubr (&Sx_server_version); + defsubr (&Sx_server_input_extension_version); defsubr (&Sx_display_pixel_width); defsubr (&Sx_display_pixel_height); defsubr (&Sx_display_mm_width); @@ -8122,6 +9748,7 @@ eliminated in future versions of Emacs. */); defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); defsubr (&Sx_double_buffered_p); + defsubr (&Sx_begin_drag); tip_timer = Qnil; staticpro (&tip_timer); tip_frame = Qnil; @@ -8142,6 +9769,8 @@ eliminated in future versions of Emacs. */); defsubr (&Sx_select_font); #endif + defsubr (&Sx_internal_focus_input_context); + #ifdef USE_CAIRO defsubr (&Sx_export_frames); #ifdef USE_GTK diff --git a/src/xfont.c b/src/xfont.c index b5765cfa7b8..684c28ab21a 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -1003,6 +1003,32 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y, unblock_input (); } +#if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) + if (with_background + && FRAME_DISPLAY_INFO (s->f)->alpha_bits + && FRAME_CHECK_XR_VERSION (s->f, 0, 2)) + { + x_xr_ensure_picture (s->f); + + if (FRAME_X_PICTURE (s->f) != None) + { + XRenderColor xc; + int height = FONT_HEIGHT (s->font), ascent = FONT_BASE (s->font); + + x_xr_apply_ext_clip (s->f, gc); + x_xrender_color_from_gc_background (s->f, gc, &xc, + s->hl != DRAW_CURSOR); + XRenderFillRectangle (FRAME_X_DISPLAY (s->f), + PictOpSrc, FRAME_X_PICTURE (s->f), + &xc, x, y - ascent, s->width, height); + x_xr_reset_ext_clip (s->f); + x_mark_frame_dirty (s->f); + + with_background = false; + } + } +#endif + if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0) { USE_SAFE_ALLOCA; diff --git a/src/xftfont.c b/src/xftfont.c index f305738410e..e27c6cf3146 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -33,6 +33,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "ftfont.h" #include "pdumper.h" +#ifdef HAVE_XRENDER +#include <X11/extensions/Xrender.h> +#endif + #ifndef FC_LCD_FILTER /* Older fontconfig versions don't have FC_LCD_FILTER. */ # define FC_LCD_FILTER "lcdfilter" @@ -45,19 +49,26 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ struct xftface_info { + bool bg_allocated_p; + bool fg_allocated_p; XftColor xft_fg; /* color for face->foreground */ XftColor xft_bg; /* color for face->background */ }; /* Setup foreground and background colors of GC into FG and BG. If XFTFACE_INFO is not NULL, reuse the colors in it if possible. BG - may be NULL. */ + may be NULL. Return whether or not colors were allocated in + BG_ALLOCATED_P and FG_ALLOCATED_P. */ static void xftfont_get_colors (struct frame *f, struct face *face, GC gc, struct xftface_info *xftface_info, - XftColor *fg, XftColor *bg) + XftColor *fg, XftColor *bg, + bool *bg_allocated_p, bool *fg_allocated_p) { + *bg_allocated_p = false; + *fg_allocated_p = false; + if (xftface_info && face->gc == gc) { *fg = xftface_info->xft_fg; @@ -90,20 +101,39 @@ xftfont_get_colors (struct frame *f, struct face *face, GC gc, { XColor colors[2]; - colors[0].pixel = fg->pixel = xgcv.foreground; + colors[0].pixel = xgcv.foreground; if (bg) - colors[1].pixel = bg->pixel = xgcv.background; + colors[1].pixel = xgcv.background; x_query_colors (f, colors, bg ? 2 : 1); fg->color.alpha = 0xFFFF; fg->color.red = colors[0].red; fg->color.green = colors[0].green; fg->color.blue = colors[0].blue; + + if (!XftColorAllocValue (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &fg->color, fg)) + /* This color should've been allocated when creating the + GC. */ + emacs_abort (); + else + *fg_allocated_p = true; + if (bg) { bg->color.alpha = 0xFFFF; bg->color.red = colors[1].red; bg->color.green = colors[1].green; bg->color.blue = colors[1].blue; + + if (!XftColorAllocValue (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &bg->color, bg)) + emacs_abort (); + else + *bg_allocated_p = true; } } unblock_input (); @@ -356,9 +386,12 @@ xftfont_prepare_face (struct frame *f, struct face *face) } #endif - xftface_info = xmalloc (sizeof *xftface_info); + xftface_info = xzalloc (sizeof *xftface_info); xftfont_get_colors (f, face, face->gc, NULL, - &xftface_info->xft_fg, &xftface_info->xft_bg); + &xftface_info->xft_fg, + &xftface_info->xft_bg, + &xftface_info->bg_allocated_p, + &xftface_info->fg_allocated_p); face->extra = xftface_info; } @@ -377,6 +410,18 @@ xftfont_done_face (struct frame *f, struct face *face) xftface_info = (struct xftface_info *) face->extra; if (xftface_info) { + if (xftface_info->fg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &xftface_info->xft_fg); + + if (xftface_info->bg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &xftface_info->xft_bg); + xfree (xftface_info); face->extra = NULL; } @@ -441,10 +486,10 @@ xftfont_get_xft_draw (struct frame *f) if (! xft_draw) { block_input (); - xft_draw= XftDrawCreate (FRAME_X_DISPLAY (f), - FRAME_X_DRAWABLE (f), - FRAME_X_VISUAL (f), - FRAME_X_COLORMAP (f)); + xft_draw = XftDrawCreate (FRAME_X_DISPLAY (f), + FRAME_X_DRAWABLE (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f)); unblock_input (); eassert (xft_draw != NULL); font_put_frame_data (f, Qxft, xft_draw); @@ -465,13 +510,16 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, XftDraw *xft_draw = xftfont_get_xft_draw (f); FT_UInt *code; XftColor fg, bg; + bool bg_allocated_p, fg_allocated_p; int len = to - from; int i; if (s->font == face->font) xftface_info = (struct xftface_info *) face->extra; xftfont_get_colors (f, face, s->gc, xftface_info, - &fg, with_background ? &bg : NULL); + &fg, with_background ? &bg : NULL, + &bg_allocated_p, &fg_allocated_p); + if (s->num_clips > 0) XftDrawSetClipRectangles (xft_draw, 0, 0, s->clip, s->num_clips); else @@ -496,7 +544,40 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, height = ascent = s->first_glyph->slice.glyphless.lower_yoff - s->first_glyph->slice.glyphless.upper_yoff; - XftDrawRect (xft_draw, &bg, x, y - ascent, s->width, height); + +#if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) + if (with_background + && FRAME_DISPLAY_INFO (s->f)->alpha_bits + && FRAME_CHECK_XR_VERSION (s->f, 0, 2)) + { + x_xr_ensure_picture (s->f); + + if (FRAME_X_PICTURE (s->f) != None) + { + XRenderColor xc; + int height = FONT_HEIGHT (s->font), ascent = FONT_BASE (s->font); + + if (s->num_clips > 0) + XRenderSetPictureClipRectangles (FRAME_X_DISPLAY (s->f), + FRAME_X_PICTURE (s->f), + 0, 0, s->clip, s->num_clips); + else + x_xr_reset_ext_clip (f); + x_xrender_color_from_gc_background (s->f, s->gc, &xc, s->hl != DRAW_CURSOR); + XRenderFillRectangle (FRAME_X_DISPLAY (s->f), + PictOpSrc, FRAME_X_PICTURE (s->f), + &xc, x, y - ascent, s->width, height); + x_xr_reset_ext_clip (f); + x_mark_frame_dirty (s->f); + + with_background = false; + } + else + XftDrawRect (xft_draw, &bg, x, y - ascent, s->width, height); + } + else +#endif + XftDrawRect (xft_draw, &bg, x, y - ascent, s->width, height); } code = alloca (sizeof (FT_UInt) * len); for (i = 0; i < len; i++) @@ -513,6 +594,19 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, FRAME_X_DRAWABLE in order to draw: we cached the drawable in the XftDraw structure. */ x_mark_frame_dirty (f); + + if (bg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &bg); + + if (fg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &fg); + unblock_input (); return len; } diff --git a/src/xgselect.c b/src/xgselect.c index 8afd3f238f0..7252210c686 100644 --- a/src/xgselect.c +++ b/src/xgselect.c @@ -28,11 +28,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "lisp.h" #include "blockinput.h" #include "systime.h" +#include "process.h" static ptrdiff_t threads_holding_glib_lock; static GMainContext *glib_main_context; -void release_select_lock (void) +void +release_select_lock (void) { #if GNUC_PREREQ (4, 7, 0) if (__atomic_sub_fetch (&threads_holding_glib_lock, 1, __ATOMIC_ACQ_REL) == 0) @@ -43,7 +45,8 @@ void release_select_lock (void) #endif } -static void acquire_select_lock (GMainContext *context) +static void +acquire_select_lock (GMainContext *context) { #if GNUC_PREREQ (4, 7, 0) if (__atomic_fetch_add (&threads_holding_glib_lock, 1, __ATOMIC_ACQ_REL) == 0) @@ -93,10 +96,20 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds, int n_gfds, retval = 0, our_fds = 0, max_fds = fds_lim - 1; int i, nfds, tmo_in_millisec, must_free = 0; bool need_to_dispatch; +#ifdef USE_GTK + bool already_has_events; +#endif context = g_main_context_default (); acquire_select_lock (context); +#ifdef USE_GTK + already_has_events = g_main_context_pending (context); +#ifndef HAVE_PGTK + already_has_events = already_has_events && x_gtk_use_native_input; +#endif +#endif + if (rfds) all_rfds = *rfds; else FD_ZERO (&all_rfds); if (wfds) all_wfds = *wfds; @@ -143,10 +156,46 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds, tmop = &tmo; } +#ifndef USE_GTK fds_lim = max_fds + 1; nfds = thread_select (pselect, fds_lim, &all_rfds, have_wfds ? &all_wfds : NULL, efds, tmop, sigmask); +#else + /* On PGTK, when you type a key, the key press event are received, + and one more key press event seems to be received internally. + + The same can happen with GTK native input, which makes input + slow. + + The second event is not sent via the display connection, so the + following is the case: + + - socket read buffer is empty + - a key press event is pending + + In that case, we should not sleep in pselect, and dispatch the + event immediately. (Bug#52761) */ + if (!already_has_events) + { + fds_lim = max_fds + 1; + nfds = thread_select (pselect, fds_lim, + &all_rfds, have_wfds ? &all_wfds : NULL, efds, + tmop, sigmask); + } + else + { + /* Emulate return values */ + nfds = 1; + FD_ZERO (&all_rfds); + if (have_wfds) + FD_ZERO (&all_wfds); + if (efds) + FD_ZERO (efds); + our_fds++; + } +#endif + if (nfds < 0) retval = nfds; else if (nfds > 0) @@ -181,6 +230,21 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds, #else need_to_dispatch = true; #endif + + /* xwidgets make heavy use of GLib subprocesses, which add their own + SIGCHLD handler at arbitrary locations. That doesn't play well + with Emacs's own handler, so once GLib does its thing with its + subprocesses we restore our own SIGCHLD handler (which chains the + GLib handler) here. + + There is an obvious race condition, but we can't really do + anything about that, except hope a SIGCHLD arrives soon to clear + up the situation. */ + +#ifdef HAVE_XWIDGETS + catch_child_signal (); +#endif + if (need_to_dispatch) { acquire_select_lock (context); diff --git a/src/xmenu.c b/src/xmenu.c index 10d6b0f4d72..94cd9dab69b 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -51,6 +51,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "msdos.h" #endif +#ifdef HAVE_XINPUT2 +#include <math.h> +#include <X11/extensions/XInput2.h> +#endif + #ifdef HAVE_X_WINDOWS /* This may include sys/types.h, and that somehow loses if this is not done before the other system files. */ @@ -105,7 +110,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* Flag which when set indicates a dialog or menu has been posted by Xt on behalf of one of the widget sets. */ +#ifndef HAVE_XINPUT2 static int popup_activated_flag; +#else +int popup_activated_flag; +#endif #ifdef USE_X_TOOLKIT @@ -175,8 +184,8 @@ x_menu_wait_for_event (void *data) instead of the small ifdefs below. */ while ( -#ifdef USE_X_TOOLKIT - ! XtAppPending (Xt_app_con) +#if defined USE_X_TOOLKIT + ! (data ? XPending (data) : XtAppPending (Xt_app_con)) #elif defined USE_GTK ! gtk_events_pending () #else @@ -213,6 +222,72 @@ x_menu_wait_for_event (void *data) #endif } } + +#if !defined USE_GTK && !defined USE_X_TOOLKIT && defined HAVE_XINPUT2 +static void +x_menu_translate_generic_event (XEvent *event) +{ + struct x_display_info *dpyinfo; + XEvent copy; + XIDeviceEvent *xev; + + dpyinfo = x_display_info_for_display (event->xgeneric.display); + + if (event->xgeneric.extension == dpyinfo->xi2_opcode) + { + eassert (!event->xcookie.data); + + if (XGetEventData (dpyinfo->display, &event->xcookie)) + { + switch (event->xcookie.evtype) + { + case XI_ButtonPress: + case XI_ButtonRelease: + xev = (XIDeviceEvent *) event->xcookie.data; + copy.xbutton.type = (event->xcookie.evtype == XI_ButtonPress + ? ButtonPress : ButtonRelease); + copy.xbutton.serial = xev->serial; + copy.xbutton.send_event = xev->send_event; + copy.xbutton.display = dpyinfo->display; + copy.xbutton.window = xev->event; + copy.xbutton.root = xev->root; + copy.xbutton.subwindow = xev->child; + copy.xbutton.time = xev->time; + copy.xbutton.x = lrint (xev->event_x); + copy.xbutton.y = lrint (xev->event_y); + copy.xbutton.x_root = lrint (xev->root_x); + copy.xbutton.y_root = lrint (xev->root_y); + copy.xbutton.state = xev->mods.effective; + copy.xbutton.button = xev->detail; + copy.xbutton.same_screen = True; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy.xbutton.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy.xbutton.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy.xbutton.state |= Button3Mask; + } + + XPutBackEvent (dpyinfo->display, ©); + + break; + } + XFreeEventData (dpyinfo->display, &event->xcookie); + } + } +} +#endif + +#if !defined USE_X_TOOLKIT && !defined USE_GTK +static void +x_menu_expose_event (XEvent *event) +{ + x_dispatch_event (event, event->xexpose.display); +} +#endif #endif /* ! MSDOS */ @@ -232,18 +307,25 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, LWLIB_ID id, bool do_timers) { XEvent event; + XEvent copy; +#ifdef HAVE_XINPUT2 + bool cookie_claimed_p = false; + XIDeviceEvent *xev; + struct xi_device_t *device; +#endif while (popup_activated_flag) { if (initial_event) { - event = *initial_event; + copy = event = *initial_event; initial_event = 0; } else { if (do_timers) x_menu_wait_for_event (0); XtAppNextEvent (Xt_app_con, &event); + copy = event; } /* Make sure we don't consider buttons grabbed after menu goes. @@ -263,6 +345,7 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, so Motif thinks this is the case. */ event.xbutton.state = 0; #endif + copy = event; } /* Pop down on C-g and Escape. */ else if (event.type == KeyPress @@ -273,9 +356,114 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, if ((keysym == XK_g && (event.xkey.state & ControlMask) != 0) || keysym == XK_Escape) /* Any escape, ignore modifiers. */ popup_activated_flag = 0; + + copy = event; } +#ifdef HAVE_XINPUT2 + else if (event.type == GenericEvent + && dpyinfo->supports_xi2 + && event.xgeneric.display == dpyinfo->display + && event.xgeneric.extension == dpyinfo->xi2_opcode) + { + if (event.xcookie.data) + { + switch (event.xgeneric.evtype) + { + case XI_ButtonRelease: + { + if (!event.xcookie.data + && XGetEventData (dpyinfo->display, &event.xcookie)) + cookie_claimed_p = true; + + xev = (XIDeviceEvent *) event.xcookie.data; + device = xi_device_from_id (dpyinfo, xev->deviceid); + + dpyinfo->grabbed &= ~(1 << xev->detail); + device->grab &= ~(1 << xev->detail); + + copy.xbutton.type = ButtonRelease; + copy.xbutton.serial = xev->serial; + copy.xbutton.send_event = xev->send_event; + copy.xbutton.display = dpyinfo->display; + copy.xbutton.window = xev->event; + copy.xbutton.root = xev->root; + copy.xbutton.subwindow = xev->child; + copy.xbutton.time = xev->time; + copy.xbutton.x = lrint (xev->event_x); + copy.xbutton.y = lrint (xev->event_y); + copy.xbutton.x_root = lrint (xev->root_x); + copy.xbutton.y_root = lrint (xev->root_y); + copy.xbutton.state = xev->mods.effective; + copy.xbutton.button = xev->detail; + copy.xbutton.same_screen = True; + +#ifdef USE_MOTIF /* Pretending that the event came from a + Btn1Down seems the only way to convince Motif to + activate its callbacks; setting the XmNmenuPost + isn't working. --marcus@sysc.pdx.edu. */ + copy.xbutton.button = 1; + /* Motif only pops down menus when no Ctrl, Alt or Mod + key is pressed and the button is released. So reset key state + so Motif thinks this is the case. */ + copy.xbutton.state = 0; +#endif - x_dispatch_event (&event, event.xany.display); + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy.xbutton.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy.xbutton.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy.xbutton.state |= Button3Mask; + } + + break; + } + case XI_KeyPress: + { + KeySym keysym; + + if (!event.xcookie.data + && XGetEventData (dpyinfo->display, &event.xcookie)) + cookie_claimed_p = true; + + xev = (XIDeviceEvent *) event.xcookie.data; + + copy.xkey.type = KeyPress; + copy.xkey.serial = xev->serial; + copy.xkey.send_event = xev->send_event; + copy.xkey.display = dpyinfo->display; + copy.xkey.window = xev->event; + copy.xkey.root = xev->root; + copy.xkey.subwindow = xev->child; + copy.xkey.time = xev->time; + copy.xkey.x = lrint (xev->event_x); + copy.xkey.y = lrint (xev->event_y); + copy.xkey.x_root = lrint (xev->root_x); + copy.xkey.y_root = lrint (xev->root_y); + copy.xkey.state = xev->mods.effective; + copy.xkey.keycode = xev->detail; + copy.xkey.same_screen = True; + + keysym = XLookupKeysym (©.xkey, 0); + + if ((keysym == XK_g + && (copy.xkey.state & ControlMask) != 0) + || keysym == XK_Escape) /* Any escape, ignore modifiers. */ + popup_activated_flag = 0; + + break; + } + } + } + } + + if (cookie_claimed_p) + XFreeEventData (dpyinfo->display, &event.xcookie); +#endif + + x_dispatch_event (©, copy.xany.display); } } @@ -440,6 +628,24 @@ x_activate_menubar (struct frame *f) XPutBackEvent (f->output_data.x->display_info->display, f->output_data.x->saved_menu_event); #else +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + /* Clear the XI2 grab so Motif or lwlib can set a core grab. + Otherwise some versions of Motif will emit a warning and hang, + and lwlib will fail to destroy the menu window. */ + + if (dpyinfo->supports_xi2 + && xi_frame_selected_for (f, XI_ButtonPress)) + { + for (int i = 0; i < dpyinfo->num_devices; ++i) + { + if (dpyinfo->devices[i].grab) + XIUngrabDevice (dpyinfo->display, + dpyinfo->devices[i].device_id, + CurrentTime); + } + } +#endif XtDispatchEvent (f->output_data.x->saved_menu_event); #endif unblock_input (); @@ -721,7 +927,7 @@ set_frame_menubar (struct frame *f, bool deep_p) struct buffer *prev = current_buffer; Lisp_Object buffer; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = alloca (previous_menu_items_used * sizeof *previous_items); @@ -1261,7 +1467,7 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, GtkWidget *menu; GtkMenuPositionFunc pos_func = 0; /* Pop up at pointer. */ struct next_popup_x_y popup_x_y; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); bool use_pos_func = ! for_click; #ifdef HAVE_GTK3 @@ -1321,6 +1527,24 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, if (i == 5) i = 0; } +#if !defined HAVE_GTK3 && defined HAVE_XINPUT2 + if (FRAME_DISPLAY_INFO (f)->supports_xi2 + && xi_frame_selected_for (f, XI_ButtonPress)) + { + for (int i = 0; i < FRAME_DISPLAY_INFO (f)->num_devices; ++i) + { + if (FRAME_DISPLAY_INFO (f)->devices[i].grab) + { + FRAME_DISPLAY_INFO (f)->devices[i].grab = 0; + + XIUngrabDevice (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->devices[i].device_id, + CurrentTime); + } + } + } +#endif + /* Display the menu. */ gtk_widget_show_all (menu); @@ -1374,6 +1598,23 @@ pop_down_menu (int id) popup_activated_flag = 0; } +#if defined HAVE_XINPUT2 && defined USE_MOTIF +static Bool +server_timestamp_predicate (Display *display, + XEvent *xevent, + XPointer arg) +{ + XID *args = (XID *) arg; + + if (xevent->type == PropertyNotify + && xevent->xproperty.window == args[0] + && xevent->xproperty.atom == args[1]) + return True; + + return False; +} +#endif + /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the menu pops down. menu_item_selection will be set to the selection. */ @@ -1389,6 +1630,10 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, LWLIB_ID menu_id; Widget menu; Window dummy_window; +#if defined HAVE_XINPUT2 && defined USE_MOTIF + XEvent property_dummy; + Atom property_atom; +#endif eassert (FRAME_X_P (f)); @@ -1442,13 +1687,94 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, XtSetArg (av[ac], (char *) XtNgeometry, 0); ac++; XtSetValues (menu, av, ac); +#if defined HAVE_XINPUT2 + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + bool any_xi_grab_p = false; + + /* Clear the XI2 grab, and if any XI2 grab was set, place a core + grab on the frame's edit widget. */ + + if (dpyinfo->supports_xi2) + XGrabServer (dpyinfo->display); + + if (dpyinfo->supports_xi2 + && xi_frame_selected_for (f, XI_ButtonPress)) + { + for (int i = 0; i < dpyinfo->num_devices; ++i) + { + if (dpyinfo->devices[i].grab) + { + any_xi_grab_p = true; + dpyinfo->devices[i].grab = 0; + + XIUngrabDevice (dpyinfo->display, + dpyinfo->devices[i].device_id, + CurrentTime); + } + } + } + + if (any_xi_grab_p) + { +#ifndef USE_MOTIF + XGrabPointer (dpyinfo->display, + FRAME_X_WINDOW (f), + False, (PointerMotionMask + | PointerMotionHintMask + | ButtonReleaseMask + | ButtonPressMask), + GrabModeSync, GrabModeAsync, + None, None, CurrentTime); +#endif + } + +#ifdef USE_MOTIF + if (dpyinfo->supports_xi2) + { + /* Dispatch a PropertyNotify to Xt with the current server time. + Motif tries to set a grab with the timestamp of the last event + processed by Xt, but Xt doesn't consider GenericEvents, so the + timestamp is always less than the last grab time. */ + + property_atom = dpyinfo->Xatom_EMACS_SERVER_TIME_PROP; + + XChangeProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + property_atom, XA_ATOM, 32, + PropModeReplace, (unsigned char *) &property_atom, 1); + + XIfEvent (dpyinfo->display, &property_dummy, server_timestamp_predicate, + (XPointer) &(XID[]) {FRAME_OUTER_WINDOW (f), property_atom}); + + XtDispatchEvent (&property_dummy); + } +#endif + + if (dpyinfo->supports_xi2) + XUngrabServer (dpyinfo->display); +#endif + /* Display the menu. */ lw_popup_menu (menu, &dummy); + +#if defined HAVE_XINPUT2 && defined USE_MOTIF + /* This is needed to prevent XI_Enter events that set an implicit + focus from being sent. */ + if (dpyinfo->supports_xi2) + XSetInputFocus (XtDisplay (menu), XtWindow (menu), + RevertToParent, CurrentTime); +#endif + popup_activated_flag = 1; + +#if defined HAVE_XINPUT2 && !defined USE_MOTIF + if (any_xi_grab_p) + XAllowEvents (dpyinfo->display, AsyncPointer, CurrentTime); +#endif + x_activate_timeout_atimer (); { - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect_int (pop_down_menu, (int) menu_id); @@ -1457,6 +1783,14 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, unbind_to (specpdl_count, Qnil); } + +#if defined HAVE_XINPUT2 && defined USE_MOTIF + /* For some reason input focus isn't always restored to the outer + window after the menu pops down. */ + if (any_xi_grab_p) + XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), + RevertToParent, CurrentTime); +#endif } #endif /* not USE_GTK */ @@ -1479,7 +1813,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, = alloca (menu_items_used * sizeof *subprefix_stack); int submenu_depth = 0; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); eassert (FRAME_X_P (f)); @@ -1766,7 +2100,7 @@ create_and_show_dialog (struct frame *f, widget_value *first_wv) if (menu) { - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect_ptr (pop_down_menu, menu); /* Display the menu. */ @@ -1821,7 +2155,7 @@ create_and_show_dialog (struct frame *f, widget_value *first_wv) /* Process events that apply to the dialog box. Also handle timers. */ { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* xdialog_show_unwind is responsible for popping the dialog box down. */ @@ -1853,7 +2187,7 @@ x_dialog_show (struct frame *f, Lisp_Object title, /* Whether we've seen the boundary between left-hand elts and right-hand. */ bool boundary_seen = false; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); eassert (FRAME_X_P (f)); @@ -2005,7 +2339,7 @@ xw_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) Lisp_Object title; const char *error_name; Lisp_Object selection; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); check_window_system (f); @@ -2126,7 +2460,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, int maxwidth; int dummy_int; unsigned int dummy_uint; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); eassert (FRAME_X_P (f) || FRAME_MSDOS_P (f)); @@ -2328,6 +2662,10 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, #ifndef MSDOS XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f)); +#ifdef HAVE_XINPUT2 + XMenuActivateSetTranslateFunction (x_menu_translate_generic_event); +#endif + XMenuActivateSetExposeFunction (x_menu_expose_event); #endif record_unwind_protect_ptr (pop_down_menu, @@ -2336,6 +2674,23 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, /* Help display under X won't work because XMenuActivate contains a loop that doesn't give Emacs a chance to process it. */ menu_help_frame = f; + +#ifdef HAVE_XINPUT2 + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + /* Clear the XI2 grab so a core grab can be set. */ + + if (dpyinfo->supports_xi2 + && xi_frame_selected_for (f, XI_ButtonPress)) + { + for (int i = 0; i < dpyinfo->num_devices; ++i) + { + if (dpyinfo->devices[i].grab) + XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id, + CurrentTime); + } + } +#endif + status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx, x, y, ButtonReleaseMask, &datap, menu_help_callback); diff --git a/src/xselect.c b/src/xselect.c index cfe028a1696..f855980a300 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -39,6 +39,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <X11/Xproto.h> +static Time pending_dnd_time; + struct prop_location; struct selection_data; @@ -52,7 +54,7 @@ static void unexpect_property_change (struct prop_location *); static void wait_for_property_change (struct prop_location *); static Lisp_Object x_get_window_property_as_lisp_data (struct x_display_info *, Window, Atom, - Lisp_Object, Atom); + Lisp_Object, Atom, bool); static Lisp_Object selection_data_to_lisp_data (struct x_display_info *, const unsigned char *, ptrdiff_t, Atom, int); @@ -98,7 +100,11 @@ static void lisp_data_to_selection_data (struct x_display_info *, Lisp_Object, static int selection_quantum (Display *display) { - long mrs = XMaxRequestSize (display); + long mrs = XExtendedMaxRequestSize (display); + + if (!mrs) + mrs = XMaxRequestSize (display); + return (mrs < MAX_SELECTION_QUANTUM / X_LONG_SIZE + 25 ? (mrs - 25) * X_LONG_SIZE : MAX_SELECTION_QUANTUM); @@ -279,9 +285,13 @@ x_atom_to_symbol (struct x_display_info *dpyinfo, Atom atom) return QTARGETS; if (atom == dpyinfo->Xatom_NULL) return QNULL; + if (atom == dpyinfo->Xatom_XdndSelection) + return QXdndSelection; block_input (); + x_catch_errors (dpyinfo->display); str = XGetAtomName (dpyinfo->display, atom); + x_uncatch_errors (); unblock_input (); TRACE1 ("XGetAtomName --> %s", str); if (! str) return Qnil; @@ -298,7 +308,7 @@ x_atom_to_symbol (struct x_display_info *dpyinfo, Atom atom) Update the Vselection_alist so that we can reply to later requests for our selection. */ -static void +void x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, Lisp_Object frame) { @@ -376,12 +386,15 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, /* Don't allow a quit within the converter. When the user types C-g, he would be surprised if by luck it came during a converter. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); CHECK_SYMBOL (target_type); handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); + if (CONSP (handler_fn)) + handler_fn = XCDR (handler_fn); + if (!NILP (handler_fn)) value = call3 (handler_fn, selection_symbol, (local_request ? Qnil : target_type), @@ -564,7 +577,7 @@ x_reply_selection_request (struct selection_input_event *event, Window window = SELECTION_EVENT_REQUESTOR (event); ptrdiff_t bytes_remaining; int max_bytes = selection_quantum (display); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct selection_data *cs; reply->type = SelectionNotify; @@ -758,10 +771,16 @@ x_handle_selection_request (struct selection_input_event *event) Atom property = SELECTION_EVENT_PROPERTY (event); Lisp_Object local_selection_data; bool success = false; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (!dpyinfo) goto DONE; + /* This is how the XDND protocol recommends dropping text onto a + target that doesn't support XDND. */ + if (SELECTION_EVENT_TIME (event) == pending_dnd_time + 1 + || SELECTION_EVENT_TIME (event) == pending_dnd_time + 2) + selection_symbol = QXdndSelection; + local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo); /* Decline if we don't own any selections. */ @@ -795,11 +814,12 @@ x_handle_selection_request (struct selection_input_event *event) Window requestor = SELECTION_EVENT_REQUESTOR (event); Lisp_Object multprop; ptrdiff_t j, nselections; + struct selection_data cs; if (property == None) goto DONE; multprop = x_get_window_property_as_lisp_data (dpyinfo, requestor, property, - QMULTIPLE, selection); + QMULTIPLE, selection, true); if (!VECTORP (multprop) || ASIZE (multprop) % 2) goto DONE; @@ -811,11 +831,19 @@ x_handle_selection_request (struct selection_input_event *event) Lisp_Object subtarget = AREF (multprop, 2*j); Atom subproperty = symbol_to_x_atom (dpyinfo, AREF (multprop, 2*j+1)); + bool subsuccess = false; if (subproperty != None) - x_convert_selection (selection_symbol, subtarget, - subproperty, true, dpyinfo); + subsuccess = x_convert_selection (selection_symbol, subtarget, + subproperty, true, dpyinfo); + if (!subsuccess) + ASET (multprop, 2*j+1, Qnil); } + /* Save conversion results */ + lisp_data_to_selection_data (dpyinfo, multprop, &cs); + XChangeProperty (dpyinfo->display, requestor, property, + cs.type, cs.format, PropModeReplace, + cs.data, cs.size); success = true; } else @@ -1073,7 +1101,7 @@ wait_for_property_change_unwind (void *loc) static void wait_for_property_change (struct prop_location *location) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Make sure to do unexpect_property_change if we quit or err. */ record_unwind_protect_ptr (wait_for_property_change_unwind, location); @@ -1210,7 +1238,7 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, return x_get_window_property_as_lisp_data (dpyinfo, requestor_window, target_property, target_type, - selection_atom); + selection_atom, false); } /* Subroutines of x_get_window_property_as_lisp_data */ @@ -1461,7 +1489,8 @@ static Lisp_Object x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, Window window, Atom property, Lisp_Object target_type, - Atom selection_atom) + Atom selection_atom, + bool for_multiple) { Atom actual_type; int actual_format; @@ -1477,6 +1506,8 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, &actual_type, &actual_format, &actual_size); if (! data) { + if (for_multiple) + return Qnil; block_input (); bool there_is_a_selection_owner = XGetSelectionOwner (display, selection_atom) != 0; @@ -1499,7 +1530,7 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, } } - if (actual_type == dpyinfo->Xatom_INCR) + if (!for_multiple && actual_type == dpyinfo->Xatom_INCR) { /* That wasn't really the data, just the beginning. */ @@ -1515,11 +1546,14 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, &actual_size); } - block_input (); - TRACE1 (" Delete property %s", XGetAtomName (display, property)); - XDeleteProperty (display, window, property); - XFlush (display); - unblock_input (); + if (!for_multiple) + { + block_input (); + TRACE1 (" Delete property %s", XGetAtomName (display, property)); + XDeleteProperty (display, window, property); + XFlush (display); + unblock_input (); + } /* It's been read. Now convert it to a lisp object in some semi-rational manner. */ @@ -2628,6 +2662,31 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, +/* Return the timestamp where ownership of SELECTION was asserted, or + nil if no local selection is present. */ + +Lisp_Object +x_timestamp_for_selection (struct x_display_info *dpyinfo, + Lisp_Object selection) +{ + Lisp_Object value, local_value; + + local_value = LOCAL_SELECTION (selection, dpyinfo); + + if (NILP (local_value)) + return Qnil; + + value = XCAR (XCDR (XCDR (local_value))); + + return value; +} + +void +x_set_pending_dnd_time (Time time) +{ + pending_dnd_time = time; +} + static void syms_of_xselect_for_pdumper (void); void @@ -2652,11 +2711,18 @@ syms_of_xselect (void) DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist, doc: /* An alist associating X Windows selection-types with functions. These functions are called to convert the selection, with three args: -the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD'); -a desired type to which the selection should be converted; -and the local selection value (whatever was given to +the name of the selection (typically `PRIMARY', `SECONDARY', or +`CLIPBOARD'); a desired type to which the selection should be +converted; and the local selection value (whatever was given to `x-own-selection-internal'). +On X Windows, the function can also be a cons of (PREDICATE +. FUNCTION), where PREDICATE determines whether or not the selection +type will appear in the list of selection types available to other +programs, and FUNCTION is the function which is actually called. +PREDICATE is called with the same arguments as FUNCTION, and should +return a non-nil value if the data type is to appear in that list. + The function should return the value to send to the X server \(typically a string). A return value of nil means that the conversion could not be done. diff --git a/src/xsettings.c b/src/xsettings.c index 33e46d36048..71d02e61525 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -26,7 +26,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <byteswap.h> #include "lisp.h" +#ifndef HAVE_PGTK #include "xterm.h" +#else +#include "gtkutil.h" +#endif #include "xsettings.h" #include "frame.h" #include "keyboard.h" @@ -34,7 +38,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "termhooks.h" #include "pdumper.h" +#ifndef HAVE_PGTK #include <X11/Xproto.h> +#else +typedef unsigned short CARD16; +typedef unsigned int CARD32; +#endif #ifdef HAVE_GSETTINGS #include <glib-object.h> @@ -55,7 +64,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ static char *current_mono_font; static char *current_font; -static struct x_display_info *first_dpyinfo; +static Display_Info *first_dpyinfo; static Lisp_Object current_tool_bar_style; /* Store a config changed event in to the event queue. */ @@ -73,14 +82,18 @@ store_config_changed_event (Lisp_Object arg, Lisp_Object display_name) /* Return true if DPYINFO is still valid. */ static bool -dpyinfo_valid (struct x_display_info *dpyinfo) +dpyinfo_valid (Display_Info *dpyinfo) { bool found = false; if (dpyinfo != NULL) { - struct x_display_info *d; + Display_Info *d; for (d = x_display_list; !found && d; d = d->next) +#ifndef HAVE_PGTK found = d == dpyinfo && d->display == dpyinfo->display; +#else + found = d == dpyinfo && d->gdpy == dpyinfo->gdpy; +#endif } return found; } @@ -149,7 +162,7 @@ map_tool_bar_style (const char *tool_bar_style) static void store_tool_bar_style_changed (const char *newstyle, - struct x_display_info *dpyinfo) + Display_Info *dpyinfo) { Lisp_Object style = map_tool_bar_style (newstyle); if (EQ (current_tool_bar_style, style)) @@ -161,10 +174,12 @@ store_tool_bar_style_changed (const char *newstyle, XCAR (dpyinfo->name_list_element)); } +#ifndef HAVE_PGTK #if defined USE_CAIRO || defined HAVE_XFT #define XSETTINGS_FONT_NAME "Gtk/FontName" #endif #define XSETTINGS_TOOL_BAR_STYLE "Gtk/ToolbarStyle" +#endif enum { SEEN_AA = 0x01, @@ -321,10 +336,11 @@ something_changed_gconfCB (GConfClient *client, #endif /* USE_CAIRO || HAVE_XFT */ +#ifndef HAVE_PGTK /* Find the window that contains the XSETTINGS property values. */ static void -get_prop_window (struct x_display_info *dpyinfo) +get_prop_window (Display_Info *dpyinfo) { Display *dpy = dpyinfo->display; @@ -339,6 +355,9 @@ get_prop_window (struct x_display_info *dpyinfo) XUngrabServer (dpy); } +#endif + +#ifndef HAVE_PGTK #define PAD(nr) (((nr) + 3) & ~3) @@ -566,13 +585,15 @@ parse_settings (unsigned char *prop, return settings_seen; } +#endif +#ifndef HAVE_PGTK /* Read settings from the XSettings property window on display for DPYINFO. Store settings read in SETTINGS. Return true iff successful. */ static bool -read_settings (struct x_display_info *dpyinfo, struct xsettings *settings) +read_settings (Display_Info *dpyinfo, struct xsettings *settings) { Atom act_type; int act_form; @@ -600,12 +621,14 @@ read_settings (struct x_display_info *dpyinfo, struct xsettings *settings) return got_settings; } +#endif +#ifndef HAVE_PGTK /* Apply Xft settings in SETTINGS to the Xft library. Store a Lisp event that Xft settings changed. */ static void -apply_xft_settings (struct x_display_info *dpyinfo, +apply_xft_settings (Display_Info *dpyinfo, struct xsettings *settings) { #ifdef HAVE_XFT @@ -731,12 +754,14 @@ apply_xft_settings (struct x_display_info *dpyinfo, FcPatternDestroy (pat); #endif /* HAVE_XFT */ } +#endif +#ifndef HAVE_PGTK /* Read XSettings from the display for DPYINFO. If SEND_EVENT_P store a Lisp event settings that changed. */ static void -read_and_apply_settings (struct x_display_info *dpyinfo, bool send_event_p) +read_and_apply_settings (Display_Info *dpyinfo, bool send_event_p) { struct xsettings settings; @@ -763,11 +788,13 @@ read_and_apply_settings (struct x_display_info *dpyinfo, bool send_event_p) } #endif } +#endif +#ifndef HAVE_PGTK /* Check if EVENT for the display in DPYINFO is XSettings related. */ void -xft_settings_event (struct x_display_info *dpyinfo, const XEvent *event) +xft_settings_event (Display_Info *dpyinfo, const XEvent *event) { bool check_window_p = false, apply_settings_p = false; @@ -805,6 +832,7 @@ xft_settings_event (struct x_display_info *dpyinfo, const XEvent *event) if (apply_settings_p) read_and_apply_settings (dpyinfo, true); } +#endif /* Initialize GSettings and read startup values. */ @@ -940,10 +968,11 @@ init_gconf (void) #endif /* HAVE_GCONF */ } +#ifndef HAVE_PGTK /* Init Xsettings and read startup values. */ static void -init_xsettings (struct x_display_info *dpyinfo) +init_xsettings (Display_Info *dpyinfo) { Display *dpy = dpyinfo->display; @@ -959,13 +988,16 @@ init_xsettings (struct x_display_info *dpyinfo) unblock_input (); } +#endif void -xsettings_initialize (struct x_display_info *dpyinfo) +xsettings_initialize (Display_Info *dpyinfo) { if (first_dpyinfo == NULL) first_dpyinfo = dpyinfo; init_gconf (); +#ifndef HAVE_PGTK init_xsettings (dpyinfo); +#endif init_gsettings (); } diff --git a/src/xsettings.h b/src/xsettings.h index f75bff4a6ae..ccaa36489d0 100644 --- a/src/xsettings.h +++ b/src/xsettings.h @@ -20,12 +20,22 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef XSETTINGS_H #define XSETTINGS_H +#ifndef HAVE_PGTK +#include "dispextern.h" #include <X11/Xlib.h> +#endif struct x_display_info; +struct pgtk_display_info; + +#ifdef HAVE_PGTK +typedef struct pgtk_display_info Display_Info; +#endif -extern void xsettings_initialize (struct x_display_info *); -extern void xft_settings_event (struct x_display_info *, const XEvent *); +extern void xsettings_initialize (Display_Info *); +#ifndef HAVE_PGTK +extern void xft_settings_event (Display_Info *, const XEvent *); +#endif extern const char *xsettings_get_system_font (void); #ifdef USE_LUCID extern const char *xsettings_get_system_normal_font (void); diff --git a/src/xterm.c b/src/xterm.c index 9a8c3e9ad76..b65de88674f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -20,6 +20,533 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* New display code by Gerd Moellmann <gerd@gnu.org>. */ /* Xt features made by Fred Pierresteguy. */ +/* X window system support for GNU Emacs + + This file is part of the X window system support for GNU Emacs. It + contains subroutines comprising the redisplay interface, setting up + scroll bars and widgets, and handling input. + + Some of what is explained below also applies to the other window + systems that Emacs supports, to varying degrees. YMMV. + + INPUT + + Emacs handles input by running pselect in a loop, which returns + whenever there is input available on the connection to the X + server. On some systems, Emacs also arranges for any new input on + that connection to send an asynchronous signal. Whenever pselect + returns, or such a signal is received and input is not blocked, + XTread_socket is called and translates X11 events read by Xlib into + struct input_events, which are then stored in the keyboard buffer, + to be processed and acted upon at some later time. The function + handle_one_xevent is responsible for handling core events after + they are filtered, and filtering X Input Extension events. It also + performs actions on some special events, such as updating the + dimensions of a frame after a ConfigureNotify is sent by the X + server to inform us that it changed. + + Before such events are translated, an Emacs build with + internationalization enabled (the default since X11R6) will filter + events through an X Input Method (XIM) or GTK, which might decide + to intercept the event and send a different one in its place, for + reasons such as enabling the user to insert international + characters that aren't on his keyboard by typing a sequence of + characters which are. See the function x_filter_event and its + callers for more details. + + Events that cause Emacs to quit are treated specially by the code + that stores them in the keyboard buffer and generally cause an + immediate interrupt. Such an interrupt can lead to a longjmp from + the code that stored the keyboard event, which isn't safe inside + XTread_socket. To avoid this problem, XTread_socket is provided a + special event buffer named hold_quit. When a quit event is + encountered, it is stored inside this special buffer, which will + cause the keyboard code that called XTread_socket to store it at a + later time when it is safe to do so. + + handle_one_xevent will generally have to determine which frame an + event should be attributed to. This is not easy, because events + can come from multiple X windows, and a frame can also have + multiple windows. handle_one_xevent usually calls the function + x_any_window_to_frame, which searches for a frame by toplevel + window and widget windows. There are also some other functions for + searching by specific types of window, such as + x_top_window_to_frame (which only searches for frames by toplevel + window), and x_menubar_window_to_frame (which will only search + through frame menu bars). + + INPUT FOCUS + + Under X, the window where keyboard input is sent is not always + explictly defined. When there is a focus window, it receives what + is referred to as "explicit focus", but when there is none, it + receives "implicit focus" whenever the pointer enters it, and loses + that focus when the pointer leaves. When the toplevel window of a + frame receives an explicit focus event (FocusIn or FocusOut), we + treat that frame as having the current input focus, but when there + is no focus window, we treat each frame as having the input focus + whenever the pointer enters it, and undo that treatment when the + pointer leaves it. See the callers of x_detect_focus_change for + more details. + + REDISPLAY + + The redisplay engine communicates with X through the "redisplay + interface", which is a structure containing pointers to functions + which output graphics to a frame. + + Some of the functions included in the redisplay interface include + `x_clear_frame_area', which is called by the display engine when it + determines that a part of the display has to be cleared, + x_draw_window_cursor, which is called to perform the calculations + necessary to display the cursor glyph with a special "highlight" + (more on that later) and to set the input method spot location. + + Most of the actual display is performed by the function + `x_draw_glyph_string', also included in the redisplay interface. + It takes a list of glyphs of the same type and face, computes the + correct graphics context for the string through the function + `x_set_glyph_string_gc', and draws whichever glyphs it might + contain, along with decorations such as the box face, underline and + overline. That list is referred to as a "glyph string". + + GRAPHICS CONTEXTS + + A graphics context ("GC") is an X server-side object which contains + drawing attributes such as fill style, stipple, and foreground and + background pixel values. + + Usually, one graphics context is computed for each face when it is + about to be displayed for the first time, and this graphics context + is the one which is used for future X drawing operations in a glyph + string with that face. (See `prepare_face_for_display' in + xfaces.c). + + However, when drawing glyph strings for special display elements + such as the cursor, or mouse sensitive text, different GCs may be + used. When displaying the cursor, for example, the frame's cursor + graphics context is used for the common case where the cursor is + drawn with the default font, and the colors of the string's face + are the same as the default face. In all other cases, a temporary + graphics context is created with the foreground and background + colors of the cursor face adjusted to ensure that the cursor can be + distinguished from its surroundings and that the text inside the + cursor stays visible. + + Various graphics contexts are also calculated when the frame is + created by the function `x_make_gcs' in xfns.c, and are adjusted + whenever the foreground or background colors change. The "normal" + graphics context is used for operations performed without a face, + and always corresponds to the foreground and background colors of + the frame's default face, the "reverse" graphics context is used to + draw text in inverse video, and the cursor graphics context is used + to display the cursor in the most common case. + + N.B. that some of the other window systems supported by use an + emulation of graphics contexts to hold the foreground and + background colors used in a glyph string, while the some others + ports compute those colors directly based on the colors of the + string's face and its highlight, but only on X are graphics + contexts a data structure inherent to the window system. + + COLOR ALLOCATION + + In (and only in) X, pixel values for colors are not guaranteed to + correspond to their individual components. The rules for + converting colors into pixel values are defined by the visual class + of each display opened by Emacs. When a display is opened, a + suitable visual is obtained from the X server, and a colormap is + created based on that visual, which is then used for each frame + created. + + The colormap is then used by the X server to convert pixel values + from a frame created by Emacs into actual colors which are output + onto the physical display. + + When the visual class is TrueColor, the colormap will be indexed + based on the red, green, and blue (RGB) components of the pixel + values, and the colormap will be statically allocated so as to + contain linear ramps for each component. As such, most of the + color allocation described below is bypassed, and the pixel values + are computed directly from the color. + + Otherwise, each time Emacs wants a pixel value that corresponds to + a color, Emacs has to ask the X server to obtain the pixel value + that corresponds to a "color cell" containing the color (or a close + approximation) from the colormap. Exactly how this is accomplished + further depends on the visual class, since some visuals have + immutable colormaps which contain color cells with pre-defined + values, while others have colormaps where the color cells are + dynamically allocated by individual X clients. + + With visuals that have a visual class of StaticColor and StaticGray + (where the former is the case), the X server is asked to procure + the pixel value of a color cell that contains the closest + approximation of the color which Emacs wants. On the other hand, + when the visual class is DirectColor, PseudoColor, or GrayScale, + where color cells are dynamically allocated by clients, Emacs asks + the X server to allocate a color cell containing the desired color, + and uses its pixel value. + + (If the color already exists, the X server returns an existing color + cell, but increases its reference count, so it still has to be + freed afterwards.) + + Otherwise, if no color could be allocated (due to the colormap + being full), Emacs looks for a color cell inside the colormap + closest to the desired color, and uses its pixel value instead. + + Since the capacity of a colormap is finite, X clients have to take + special precautions in order to not allocate too many color cells + that are never used. Emacs allocates its color cells when a face + is being realized or when a frame changes its foreground and + background colors, and releases them alongside the face or frame. + See calls to `unload_color' and `load_color' in xterm.c, xfaces.c + and xfns.c for more details. + + The driving logic behind color allocation is in + `x_alloc_nearest_color_1', while the optimization for TrueColor + visuals is in `x_make_truecolor_pixel'. Also see `x_query_colors`, + which is used to determine the color values for given pixel + values. + + In other window systems supported by Emacs, color allocation is + handled by the window system itself, to whom Emacs simply passes 24 + (or 32-bit) RGB values. + + OPTIONAL FEATURES + + While X servers and client libraries tend to come with many + extensions to the core X11R6 protocol, dependencies on anything + other than the core X11R6 protocol and Xlib should be optional at + both compile-time and runtime. Emacs should also not crash + regardless of what combination of X server and client-side features + are present. For example, if you are developing a feature that + will need Xfixes, then add a test in configure.ac for the library + at compile-time which defines `HAVE_XFIXES', like this: + + ### Use Xfixes (-lXfixes) if available + HAVE_XFIXES=no + if test "${HAVE_X11}" = "yes"; then + XFIXES_REQUIRED=4.0.0 + XFIXES_MODULES="xfixes >= $XFIXES_REQUIRED" + EMACS_CHECK_MODULES([XFIXES], [$XFIXES_MODULES]) + if test $HAVE_XFIXES = no; then + # Test old way in case pkg-config doesn't have it (older machines). + AC_CHECK_HEADER(X11/extensions/Xfixes.h, + [AC_CHECK_LIB(Xfixes, XFixesHideCursor, HAVE_XFIXES=yes)]) + if test $HAVE_XFIXES = yes; then + XFIXES_LIBS=-lXfixes + fi + fi + if test $HAVE_XFIXES = yes; then + AC_DEFINE(HAVE_XFIXES, 1, [Define to 1 if you have the Xfixes extension.]) + fi + fi + AC_SUBST(XFIXES_CFLAGS) + AC_SUBST(XFIXES_LIBS) + + Then, make sure to adjust CFLAGS and LIBES in src/Makefile.in and + add the new XFIXES_CFLAGS and XFIXES_LIBS variables to + msdos/sed1v2.inp. (The latter has to be adjusted for any new + variables that are included in CFLAGS and LIBES even if the + libraries are not used by the MS-DOS port.) + + Finally, add some fields in `struct x_display_info' which specify + the major and minor versions of the extension, and whether or not to + support them. They (and their accessors) should be protected by the + `HAVE_XFIXES' preprocessor conditional. Then, these fields should + be set in `x_term_init', and all Xfixes calls must be protected by + not only the preprocessor conditional, but also by checks against + those variables. + + X TOOLKIT SUPPORT + + Emacs supports being built with many different toolkits (and also no + toolkit at all), which provide decorations such as menu bars and + scroll bars, along with handy features like file panels, dialog + boxes, font panels, and popup menus. Those configurations can + roughly be classified as belonging to one of three categories: + + - Using no toolkit at all. + - Using the X Toolkit Intrinsics (Xt). + - Using GTK. + + The no toolkit configuration is the simplest: no toolkit widgets are + used, Emacs uses its own implementation of scroll bars, and the + XMenu library that came with X11R2 and earlier versions of X is used + for popup menus. There is also no complicated window structure to + speak of. + + The Xt configurations come in either the Lucid or Motif flavors. + The former utilizes Emacs's own Xt-based Lucid widget library for + menus, and Xaw (or derivatives such as neXTaw and Xaw3d) for dialog + boxes and, optionally, scroll bars. It does not support file + panels. The latter uses either Motif or LessTif for menu bars, + popup menus, dialogs and file panels. + + The GTK configurations come in the GTK+ 2 or GTK 3 configurations, + where the toolkit provides all the aforementioned decorations and + features. They work mostly the same, though GTK 3 has various small + annoyances that complicate maintenance. + + All of those configurations have various special technicalities + about event handling and the layout of windows inside a frame that + must be kept in mind when writing X code which is run on all of + them. + + The no toolkit configuration has no noteworthy aspects about the + layout of windows inside a frame, since each frame has only one + associated window aside from scroll bars. However, in the Xt + configurations, every widget is a separate window, and there are + quite a few widgets. The "outer widget", a widget of class + ApplicationShell, is the top-level window of a frame. Its window is + accessed via the macro `FRAME_OUTER_WINDOW'. The "edit widget", a + widget class of EmacsFrame, is a child of the outer widget that + controls the size of a frame as known to Emacs, and is the widget + that Emacs draws to during display operations. The "menu bar + widget" is the widget holding the menu bar. + + Special care must be taken when performing operations on a frame. + Properties that are used by the window manager, for example, must be + set on the outer widget. Drawing, on the other hand, must be done + to the edit widget, and button press events on the menu bar widget + must be redirected and not sent to Xt until the Lisp code is run to + update the menu bar. + + The EmacsFrame widget is specific to Emacs and is implemented in + widget.c. See that file for more details. + + In the GTK configurations, GTK widgets do not necessarily correspond + to X windows, since the toolkit might decide to keep only a + client-side record of the widgets for performance reasons. + + Because the GtkFixed widget that holds the "edit area" might not + correspond to an X window, drawing operations may be directly + performed on the outer window, with special care taken to not + overwrite the surrounding GTK widgets. This also means that the + only important window for most purposes is the outer window, which + on GTK builds can usually be accessed using the macro + `FRAME_X_WINDOW'. + + How `handle_one_xevent' is called also depends on the configuration. + Without a toolkit, Emacs performs all event processing by itself, + running XPending and XNextEvent in a loop whenever there is input, + passing the event to `handle_one_xevent'. + + When using Xt, the same is performed, but `handle_one_xevent' may + also decide to call XtDispatchEvent on an event after Emacs finishes + processing it. + + When using GTK, however, `handle_one_xevent' is called from an event + filter installed on the GTK event loop. Unless the event filter + elects to drop the event, it will be passed to GTK right after + leaving the event filter. + + Fortunately, `handle_one_xevent' is provided a `*finish' parameter + that abstracts away all these details. If it is `X_EVENT_DROP', + then the event will not be dispatched to Xt or utilized by GTK. + Code inside `handle_one_xevent' should thus avoid making assumptions + about the event dispatch mechanism and use that parameter + instead. + + FRAME RESIZING + + In the following explanations "frame size" refers to the "native + size" of a frame as reported by the (frame.h) macros + FRAME_PIXEL_WIDTH and FRAME_PIXEL_HEIGHT. These specify the size of + a frame as the values passed to/received from a toolkit and the + window manager. The "text size" Emacs Lisp code uses in functions + like 'set-frame-size' or sees in the ‘width’ and 'height' frame + parameters is only loosely related to the native size. The + necessary translations are provided by the macros + FRAME_TEXT_TO_PIXEL_WIDTH and FRAME_TEXT_TO_PIXEL_HEIGHT as well as + FRAME_PIXEL_TO_TEXT_WIDTH and FRAME_PIXEL_TO_TEXT_HEIGHT (in + frame.h). + + Lisp functions may ask for resizing a frame either explicitly, using + one of the interfaces provided for that purpose like, for example, + 'set-frame-size' or changing the 'height' or 'width' parameter of + that frame, or implicitly, for example, by turning off/on or + changing the width of fringes or scroll bars for that frame. Any + such request passes through the routine 'adjust_frame_size' (in + frame.c) which decides, among others, whether the native frame size + would really change and whether it is allowed to change it at that + moment. Only if 'adjust_frame_size' decides that the corresponding + terminal's 'set_window_size_hook' may be run, it will dispatch + execution to the appropriate function which, for X builds, is + 'x_set_window_size' in this file. + + For GTK builds, 'x_set_window_size' calls 'xg_frame_set_char_size' + in gtkutil.c if the frame has an edit widget and + 'x_set_window_size_1' in this file otherwise. For non-GTK builds, + 'x_set_window_size' always calls 'x_set_window_size_1' directly. + + 'xg_frame_set_char_size' calls the GTK function 'gtk_window_resize' + for the frame's outer widget; x_set_window_size_1 calls the Xlib + function 'XResizeWindow' instead. In either case, if Emacs thinks + that the frame is visible, it will wait for a ConfigureNotify event + (see below) to occur within a timeout of 'x-wait-for-event-timeout' + (the default is 0.1 seconds). If Emacs thinks that the frame is not + visible, it calls 'adjust_frame_size' to run 'resize_frame_windows' + (see below) and hopes for the best. + + Note that if Emacs receives a ConfigureEvent in response to an + earlier resize request, the sizes specified by that event are not + necessarily the sizes Emacs requested. Window manager and toolkit + may override any of the requested sizes for their own reasons. + + On X, size notifications are received as ConfigureNotify events. + The expected reaction to such an event on the Emacs side is to + resize all Emacs windows that are on the frame referred to by the + event. Since resizing Emacs windows and redisplaying their buffers + is a costly operation, Emacs may collapse several subsequent + ConfigureNotify events into one to avoid that Emacs falls behind in + user interactions like resizing a frame by dragging one of its + borders with the mouse. + + Each ConfigureEvent event specifies a window, a width and a height. + The event loop uses 'x_top_window_to_frame' to associate the window + with its frame. Once the frame has been identified, on GTK the + event is dispatched to 'xg_frame_resized'. On Motif/Lucid + 'x_window' has installed 'EmacsFrameResize' as the routine that + handles resize events. In either case, these routines end up + calling the function 'change_frame_size' in dispnew.c. On + non-toolkit builds the effect is to call 'change_frame_size' + directly from the event loop. In either case, the value true is + passed as the DELAY argument. + + 'change_frame_size' is the central function to decide whether it is + safe to process a resize request immediately or it has to be delayed + (usually because its DELAY argument is true). Since resizing a + frame's windows may run arbitrary Lisp code, Emacs cannot generally + process resize requests during redisplay and therefore has to queue + them. If processing the event must be delayed, the new sizes (that + is, the ones requested by the ConfigureEvent) are stored in the + new_width and new_height slots of the respective frame structure, + possibly replacing ones that have been stored there upon the receipt + of a preceding ConfigureEvent. + + Delayed size changes are applied eventually upon calls of the + function 'do_pending_window_change' (in dispnew.c) which is called + by the redisplay code at suitable spots where it's safe to change + sizes. 'do_pending_window_change' calls 'change_frame_size' with + its DELAY argument false in the hope that it is now safe to call the + function 'resize_frame_windows' (in window.c) which is in charge of + adjusting the sizes of all Emacs windows on the frame accordingly. + Note that if 'resize_frame_windows' decides that the windows of a + frame do not fit into the constraints set up by the new frame sizes, + it will resize the windows to some minimum sizes with the effect + that parts of the frame at the right and bottom will appear clipped + off. + + In addition to explicitly passing width and height values in + functions like 'gtk_window_resize' or 'XResizeWindow', Emacs also + sets window manager size hints - a more implicit form of asking for + the size Emacs would like its frames to assume. Some of these hints + only restate the size and the position explicitly requested for a + frame. Another hint specifies the increments in which the window + manager should resize a frame to - either set to the default + character size of a frame or to one pixel for a non-nil value of + 'frame-resize-pixelwise'. See the function 'x_wm_set_size_hint' - + in gtkutil.c for GTK and in this file for other builds - for the + details. + + We have not discussed here a number of special issues like, for + example, how to handle size requests and notifications for maximized + and fullscreen frames or how to resize child frames. Some of these + require special treatment depending on the desktop or window manager + used. + + One thing that might come handy when investigating problems wrt + resizing frames is the variable 'frame-size-history'. Setting this + to a non-nil value, will cause Emacs to start recording frame size + adjustments, usually specified by the function that asked for an + adjustment, a sizes part that records the old and new values of the + frame's width and height and maybe some additional information. The + internal function `frame--size-history' can then be used to display + the value of this variable in a more readable form. + + FRAME RESIZE SYNCHRONIZATION + + The X window system operates asynchronously. That is to say, the + window manager and X server might think a window has been resized + before Emacs has a chance to process the ConfigureNotify event that + was sent. + + When a compositing manager is present, and the X server and Emacs + both support the X synchronization extension, the semi-standard + frame synchronization protocol can be used to notify the compositing + manager of when Emacs has actually finished redisplaying the + contents of a frame after a resize. The compositing manager will + customarily then postpone displaying the contents of the frame until + the redisplay is complete. + + Emacs announces support for this protocol by creating an X + server-side counter object, and setting it as the + `_NET_WM_SYNC_REQUEST_COUNTER' property of the frame's top-level + window. The window manager then initiates the synchronized resize + process by sending Emacs a ClientMessage event before the + ConfigureNotify event where: + + type = ClientMessage + window = the respective client window + message_type = WM_PROTOCOLS + format = 32 + data.l[0] = _NET_WM_SYNC_REQUEST + data.l[1] = timestamp + data.l[2] = low 32 bits of a provided frame counter value + data.l[3] = high 32 bits of a provided frame counter value + data.l[4] = 1 if the the extended frame counter should be updated, + otherwise 0 + + Upon receiving such an event, Emacs constructs and saves a counter + value from the provided low and high 32 bits. Then, when the + display engine tells us that a frame has been completely updated + (presumably because of a redisplay caused by a ConfigureNotify + event), we set the counter to the saved value, telling the + compositing manager that the contents of the window now accurately + reflect the new size. The compositing manager will then display the + contents of the window, and the window manager might also postpone + updating the window decorations until this moment. + + DRAG AND DROP + + Drag and drop in Emacs is implemented in two ways, depending on + which side initiated the drag-and-drop operation. When another X + client initiates a drag, and the user drops something on Emacs, a + `drag-n-drop-event' is sent with the contents of the ClientMessage, + and further processing (i.e. retrieving selection contents and + replying to the initiating client) is performed from Lisp inside + `x-dnd.el'. + + However, dragging contents from Emacs is implemented entirely in C. + X Windows has several competing drag-and-drop protocols, of which + Emacs supports two: the XDND protocol (see + https://freedesktop.org/wiki/Specifications/XDND) and the Motif drag + and drop protocols. These protocols are based on the initiator + owning a special selection, specifying an action the recipient + should perform, grabbing the mouse, and sending various different + client messages to the toplevel window underneath the mouse as it + moves, or when buttons are released. + + The Lisp interface to drag-and-drop is synchronous, and involves + running a nested event loop with some global state until the drag + finishes. When the mouse moves, Emacs looks up the toplevel window + underneath the pointer (the target window) either using a cache + provided by window managers that support the + _NET_WM_CLIENT_LIST_STACKING root window property, or by calling + XTranslateCoordinates in a loop until a toplevel window is found, + and sends various entry, exit, or motion events to the window + containing a list of targets the special selection can be converted + to, and the chosen action that the recipient should perform. The + recipient can then send messages in reply detailing the action it + has actually chosen to perform. Finally, when the mouse buttons are + released over the recipient window, Emacs sends a "drop" message to + the target window, waits for a reply, and returns the action + selected by the recipient to the Lisp code that initiated the + drag-and-drop operation. */ + #include <config.h> #include <stdlib.h> #include <math.h> @@ -33,6 +560,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "xterm.h" #include <X11/cursorfont.h> +#ifdef USE_XCB +#include <xcb/xproto.h> +#include <xcb/xcb.h> +#include <xcb/xcb_aux.h> +#endif + /* If we have Xfixes extension, use it for pointer blanking. */ #ifdef HAVE_XFIXES #include <X11/extensions/Xfixes.h> @@ -42,6 +575,34 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <X11/extensions/Xdbe.h> #endif +#ifdef HAVE_XINPUT2 +#include <X11/extensions/XInput2.h> +#endif + +#ifdef HAVE_XRANDR +#include <X11/extensions/Xrandr.h> +#endif + +#ifdef HAVE_XSYNC +#include <X11/extensions/sync.h> +#endif + +#ifdef HAVE_XINERAMA +#include <X11/extensions/Xinerama.h> +#endif + +#ifdef HAVE_XCOMPOSITE +#include <X11/extensions/Xcomposite.h> +#endif + +#ifdef HAVE_XSHAPE +#include <X11/extensions/shape.h> +#endif + +#ifdef HAVE_XCB_SHAPE +#include <xcb/shape.h> +#endif + /* Load sys/types.h if not already loaded. In some systems loading it twice is suicidal. */ #ifndef makedev @@ -55,6 +616,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <fcntl.h> #include <errno.h> #include <sys/stat.h> +#include <flexmember.h> #include "character.h" #include "coding.h" #include "composite.h" @@ -78,6 +640,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifdef USE_X_TOOLKIT #include <X11/Shell.h> +#include <X11/ShellP.h> #endif #include <unistd.h> @@ -93,13 +656,19 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "../lwlib/xlwmenu.h" #endif +#ifdef HAVE_XWIDGETS +#include <cairo-xlib.h> +#endif + +#ifdef USE_MOTIF +#include <Xm/Xm.h> +#endif + #ifdef USE_X_TOOLKIT /* Include toolkit specific headers for the scroll bar widget. */ - #ifdef USE_TOOLKIT_SCROLL_BARS #if defined USE_MOTIF -#include <Xm/Xm.h> /* For LESSTIF_VERSION */ #include <Xm/ScrollBar.h> #else /* !USE_MOTIF i.e. use Xaw */ @@ -132,6 +701,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <X11/XKBlib.h> #endif +#if defined USE_XCB && defined USE_CAIRO_XCB +#define USE_CAIRO_XCB_SURFACE +#endif + /* Default to using XIM if available. */ #ifdef USE_XIM bool use_xim = true; @@ -139,6 +712,23 @@ bool use_xim = true; bool use_xim = false; /* configure --without-xim */ #endif +#if XCB_SHAPE_MAJOR_VERSION > 1 \ + || (XCB_SHAPE_MAJOR_VERSION == 1 && \ + XCB_SHAPE_MINOR_VERSION >= 1) +#define HAVE_XCB_SHAPE_INPUT_RECTS +#endif + +#ifdef USE_GTK +/* GTK can't tolerate a call to `handle_interrupt' inside an event + signal handler, but we have to store input events inside the + handler for native input to work. + + This acts as a `hold_quit', and it is stored in the keyboard buffer + (thereby causing the call to `handle_interrupt') after the GTK + signal handler exits and control returns to XTread_socket. */ +struct input_event xg_pending_quit_event = { .kind = NO_EVENT }; +#endif + /* Non-zero means that a HELP_EVENT has been generated since Emacs start. */ @@ -175,8 +765,23 @@ static int x_noop_count; static Lisp_Object xg_default_icon_file; #endif +#ifdef HAVE_X_I18N /* Some functions take this as char *, not const char *. */ static char emacs_class[] = EMACS_CLASS; +#endif + +#ifdef USE_GTK +static int current_count; +static int current_finish; +static struct input_event *current_hold_quit; +#endif + +enum +{ + X_EVENT_NORMAL, + X_EVENT_GOTO_OUT, + X_EVENT_DROP +}; enum xembed_info { @@ -223,9 +828,15 @@ static bool x_handle_net_wm_state (struct frame *, const XPropertyEvent *); static void x_check_fullscreen (struct frame *); static void x_check_expected_move (struct frame *, int, int); static void x_sync_with_move (struct frame *, int, int, bool); +#ifndef HAVE_XINPUT2 static int handle_one_xevent (struct x_display_info *, const XEvent *, int *, struct input_event *); +#else +static int handle_one_xevent (struct x_display_info *, + XEvent *, int *, + struct input_event *); +#endif #if ! (defined USE_X_TOOLKIT || defined USE_MOTIF) && defined USE_GTK static int x_dispatch_event (XEvent *, Display *); #endif @@ -233,7 +844,2785 @@ static void x_wm_set_window_state (struct frame *, int); static void x_wm_set_icon_pixmap (struct frame *, ptrdiff_t); static void x_initialize (void); -static bool x_get_current_wm_state (struct frame *, Window, int *, bool *); +static bool x_get_current_wm_state (struct frame *, Window, int *, bool *, bool *); +static void x_update_opaque_region (struct frame *, XEvent *); + +#if !defined USE_TOOLKIT_SCROLL_BARS && defined HAVE_XDBE +static void x_scroll_bar_end_update (struct x_display_info *, struct scroll_bar *); +#endif + +#ifdef HAVE_X_I18N +static int x_filter_event (struct x_display_info *, XEvent *); +#endif + +/* Global state maintained during a drag-and-drop operation. */ + +/* Flag that indicates if a drag-and-drop operation is in progress. */ +bool x_dnd_in_progress; + +/* The frame where the drag-and-drop operation originated. */ +struct frame *x_dnd_frame; + +/* Flag that indicates if a drag-and-drop operation is no longer in + progress, but the nested event loop should continue to run, because + handle_one_xevent is waiting for the drop target to return some + important information. */ +static bool x_dnd_waiting_for_finish; + +/* State of the Motif drop operation. + + 0 means nothing has happened, i.e. the event loop should not wait + for the receiver to send any data. 1 means an XmDROP_START message + was sent to the target, but no response has yet been received. 2 + means a response to our XmDROP_START message was received and the + target accepted the drop, so Emacs should start waiting for the + drop target to convert one of the special selections + XmTRANSFER_SUCCESS or XmTRANSFER_FAILURE. */ +static int x_dnd_waiting_for_motif_finish; + +/* Whether or not F1 was pressed during the drag-and-drop operation. + + Motif programs rely on this to decide whether or not help + information about the drop site should be displayed. */ +static bool x_dnd_xm_use_help; + +/* Whether or not Motif drag initiator info was set up. */ +static bool x_dnd_motif_setup_p; + +/* The target window we are waiting for an XdndFinished message + from. */ +static Window x_dnd_pending_finish_target; + +/* The protocol version of that target window. */ +static int x_dnd_waiting_for_finish_proto; + +/* Whether or not it is OK for something to be dropped on the frame + where the drag-and-drop operation originated. */ +static bool x_dnd_allow_current_frame; + +/* Whether or not to return a frame from `x_dnd_begin_drag_and_drop'. + + 0 means to do nothing. 1 means to wait for the mouse to first exit + `x_dnd_frame'. 2 means to wait for the mouse to move onto a frame, + and 3 means to return `x_dnd_return_frame_object'. */ +static int x_dnd_return_frame; + +/* The frame that should be returned by + `x_dnd_begin_drag_and_drop'. */ +static struct frame *x_dnd_return_frame_object; + +/* The last drop target window the mouse pointer moved over. This can + be different from `x_dnd_last_seen_toplevel' if that window had an + XdndProxy. */ +static Window x_dnd_last_seen_window; + +/* The last toplevel the mouse pointer moved over. */ +static Window x_dnd_last_seen_toplevel; + +/* The window where the drop happened. Normally None, but it is set + when something is actually dropped. */ +static Window x_dnd_end_window; + +/* The XDND protocol version of `x_dnd_last_seen_window'. -1 means it + did not support XDND. */ +static int x_dnd_last_protocol_version; + +/* The Motif drag and drop protocol style of `x_dnd_last_seen_window'. + XM_DRAG_STYLE_NONE means the window does not support the Motif drag + or drop protocol. XM_DRAG_STYLE_DROP_ONLY means the window does + not respond to any drag protocol messages, so only drops should be + sent. Any other value means that the window supports both the drag + and drop protocols. */ +static int x_dnd_last_motif_style; + +/* The timestamp where Emacs last acquired ownership of the + `XdndSelection' selection. */ +static Time x_dnd_selection_timestamp; + +/* The drop target window to which the rectangle below applies. */ +static Window x_dnd_mouse_rect_target; + +/* A rectangle where XDND position messages should not be sent to the + drop target if the mouse pointer lies within. */ +static XRectangle x_dnd_mouse_rect; + +/* The action the drop target actually chose to perform. + + Under XDND, this is set upon receiving the XdndFinished or + XdndStatus messages from the drop target. + + Under Motif, this is changed upon receiving a XmDROP_START message + in reply to our own. + + When dropping on a target that doesn't support any drag-and-drop + protocol, this is set to the atom XdndActionPrivate. */ +static Atom x_dnd_action; + +/* The action we want the drop target to perform. The drop target may + elect to perform some different action, which is guaranteed to be + in `x_dnd_action' upon completion of a drop. */ +static Atom x_dnd_wanted_action; + +/* Array of selection targets available to the drop target. */ +static Atom *x_dnd_targets = NULL; + +/* The number of elements in that array. */ +static int x_dnd_n_targets; + +/* The old window attributes of the root window before the + drag-and-drop operation started. It is used to keep the old event + mask around, since that should be restored after the operation + finishes. */ +static XWindowAttributes x_dnd_old_window_attrs; + +/* Whether or not `x_dnd_cleaup_drag_and_drop' should actually clean + up the drag and drop operation. */ +static bool x_dnd_unwind_flag; + +/* The frame for which `x-dnd-movement-function' should be called. */ +static struct frame *x_dnd_movement_frame; + +/* The coordinates which the movement function should be called + with. */ +static int x_dnd_movement_x, x_dnd_movement_y; + +#ifdef HAVE_XKB +/* The keyboard state during the drag-and-drop operation. */ +static unsigned int x_dnd_keyboard_state; +#endif + +struct x_client_list_window +{ + Window window; + Display *dpy; + int x, y; + int width, height; + bool mapped_p; + long previous_event_mask; + unsigned long wm_state; + + struct x_client_list_window *next; + uint8_t xm_protocol_style; + + int frame_extents_left; + int frame_extents_right; + int frame_extents_top; + int frame_extents_bottom; + +#ifdef HAVE_XSHAPE + int border_width; + + XRectangle *input_rects; + int n_input_rects; + + XRectangle *bounding_rects; + int n_bounding_rects; +#endif +}; + +static struct x_client_list_window *x_dnd_toplevels = NULL; +static bool x_dnd_use_toplevels; + +/* Motif drag-and-drop protocol support. */ + +typedef enum xm_byte_order + { + XM_BYTE_ORDER_LSB_FIRST = 'l', + XM_BYTE_ORDER_MSB_FIRST = 'B', +#ifndef WORDS_BIGENDIAN + XM_BYTE_ORDER_CUR_FIRST = 'l', +#else + XM_BYTE_ORDER_CUR_FIRST = 'B', +#endif + } xm_byte_order; + +#define SWAPCARD32(l) \ + { \ + struct { unsigned t : 32; } bit32; \ + char n, *tp = (char *) &bit32; \ + bit32.t = l; \ + n = tp[0]; tp[0] = tp[3]; tp[3] = n; \ + n = tp[1]; tp[1] = tp[2]; tp[2] = n; \ + l = bit32.t; \ + } + +#define SWAPCARD16(s) \ + { \ + struct { unsigned t : 16; } bit16; \ + char n, *tp = (char *) &bit16; \ + bit16.t = s; \ + n = tp[0]; tp[0] = tp[1]; tp[1] = n; \ + s = bit16.t; \ + } + +typedef struct xm_targets_table_header +{ + /* BYTE */ uint8_t byte_order; + /* BYTE */ uint8_t protocol; + + /* CARD16 */ uint16_t target_list_count; + /* CARD32 */ uint32_t total_data_size; +} xm_targets_table_header; + +typedef struct xm_targets_table_rec +{ + /* CARD16 */ uint16_t n_targets; + /* CARD32 */ uint32_t targets[FLEXIBLE_ARRAY_MEMBER]; +} xm_targets_table_rec; + +typedef struct xm_drop_start_message +{ + /* BYTE */ uint8_t reason; + /* BYTE */ uint8_t byte_order; + + /* CARD16 */ uint16_t side_effects; + /* CARD32 */ uint32_t timestamp; + /* CARD16 */ uint16_t x, y; + /* CARD32 */ uint32_t index_atom; + /* CARD32 */ uint32_t source_window; +} xm_drop_start_message; + +typedef struct xm_drop_start_reply +{ + /* BYTE */ uint8_t reason; + /* BYTE */ uint8_t byte_order; + + /* CARD16 */ uint16_t side_effects; + /* CARD16 */ uint16_t better_x; + /* CARD16 */ uint16_t better_y; +} xm_drop_start_reply; + +typedef struct xm_drag_initiator_info +{ + /* BYTE */ uint8_t byteorder; + /* BYTE */ uint8_t protocol; + + /* CARD16 */ uint16_t table_index; + /* CARD32 */ uint32_t selection; +} xm_drag_initiator_info; + +typedef struct xm_drag_receiver_info +{ + /* BYTE */ uint8_t byteorder; + /* BYTE */ uint8_t protocol; + + /* BYTE */ uint8_t protocol_style; + /* BYTE */ uint8_t unspecified0; + /* CARD32 */ uint32_t unspecified1; + /* CARD32 */ uint32_t unspecified2; + /* CARD32 */ uint32_t unspecified3; +} xm_drag_receiver_info; + +typedef struct xm_top_level_enter_message +{ + /* BYTE */ uint8_t reason; + /* BYTE */ uint8_t byteorder; + + /* CARD16 */ uint16_t zero; + /* CARD32 */ uint32_t timestamp; + /* CARD32 */ uint32_t source_window; + /* CARD32 */ uint32_t index_atom; +} xm_top_level_enter_message; + +typedef struct xm_drag_motion_message +{ + /* BYTE */ uint8_t reason; + /* BYTE */ uint8_t byteorder; + + /* CARD16 */ uint16_t side_effects; + /* CARD32 */ uint32_t timestamp; + /* CARD16 */ uint16_t x, y; +} xm_drag_motion_message; + +typedef struct xm_top_level_leave_message +{ + /* BYTE */ uint8_t reason; + /* BYTE */ uint8_t byteorder; + + /* CARD16 */ uint16_t zero; + /* CARD32 */ uint32_t timestamp; + /* CARD32 */ uint32_t source_window; +} xm_top_level_leave_message; + +#define XM_DRAG_SIDE_EFFECT(op, site, ops, act) \ + ((op) | ((site) << 4) | ((ops) << 8) | ((act) << 12)) + +/* Some of the macros below are temporarily unused. */ + +#define XM_DRAG_SIDE_EFFECT_OPERATION(effect) ((effect) & 0xf) +#define XM_DRAG_SIDE_EFFECT_SITE_STATUS(effect) (((effect) & 0xf0) >> 4) +/* #define XM_DRAG_SIDE_EFFECT_OPERATIONS(effect) (((effect) & 0xf00) >> 8) */ +#define XM_DRAG_SIDE_EFFECT_DROP_ACTION(effect) (((effect) & 0xf000) >> 12) + +#define XM_DRAG_NOOP 0 +#define XM_DRAG_MOVE (1L << 0) +#define XM_DRAG_COPY (1L << 1) +#define XM_DRAG_LINK (1L << 2) + +#define XM_DROP_ACTION_DROP 0 +#define XM_DROP_ACTION_DROP_HELP 1 +#define XM_DROP_ACTION_DROP_CANCEL 2 + +#define XM_DRAG_REASON(originator, code) ((code) | ((originator) << 7)) +#define XM_DRAG_REASON_ORIGINATOR(reason) (((reason) & 0x80) ? 1 : 0) +#define XM_DRAG_REASON_CODE(reason) ((reason) & 0x7f) + +#define XM_DRAG_REASON_DROP_START 5 +#define XM_DRAG_REASON_TOP_LEVEL_ENTER 0 +#define XM_DRAG_REASON_TOP_LEVEL_LEAVE 1 +#define XM_DRAG_REASON_DRAG_MOTION 2 +#define XM_DRAG_ORIGINATOR_INITIATOR 0 +#define XM_DRAG_ORIGINATOR_RECEIVER 1 + +#define XM_DRAG_STYLE_NONE 0 + +#define XM_DRAG_STYLE_DROP_ONLY 1 +#define XM_DRAG_STYLE_DROP_ONLY_REC 3 + +#define XM_DRAG_STYLE_DYNAMIC 5 +#define XM_DRAG_STYLE_DYNAMIC_REC 2 +#define XM_DRAG_STYLE_DYNAMIC_REC1 4 + +#define XM_DRAG_STYLE_IS_DROP_ONLY(n) ((n) == XM_DRAG_STYLE_DROP_ONLY \ + || (n) == XM_DRAG_STYLE_DROP_ONLY_REC) +#define XM_DRAG_STYLE_IS_DYNAMIC(n) ((n) == XM_DRAG_STYLE_DYNAMIC \ + || (n) == XM_DRAG_STYLE_DYNAMIC_REC \ + || (n) == XM_DRAG_STYLE_DYNAMIC_REC1) + +#define XM_DROP_SITE_VALID 3 +/* #define XM_DROP_SITE_INVALID 2 */ +#define XM_DROP_SITE_NONE 1 + +static uint8_t +xm_side_effect_from_action (struct x_display_info *dpyinfo, Atom action) +{ + if (action == dpyinfo->Xatom_XdndActionCopy) + return XM_DRAG_COPY; + else if (action == dpyinfo->Xatom_XdndActionMove) + return XM_DRAG_MOVE; + else if (action == dpyinfo->Xatom_XdndActionLink) + return XM_DRAG_LINK; + + return XM_DRAG_NOOP; +} + +static int +xm_read_targets_table_header (uint8_t *bytes, ptrdiff_t length, + xm_targets_table_header *header_return, + xm_byte_order *byteorder_return) +{ + if (length < 8) + return -1; + + header_return->byte_order = *byteorder_return = *(bytes++); + header_return->protocol = *(bytes++); + + header_return->target_list_count = *(uint16_t *) bytes; + header_return->total_data_size = *(uint32_t *) (bytes + 2); + + if (header_return->byte_order != XM_BYTE_ORDER_CUR_FIRST) + { + SWAPCARD16 (header_return->target_list_count); + SWAPCARD32 (header_return->total_data_size); + } + + header_return->byte_order = XM_BYTE_ORDER_CUR_FIRST; + + return 8; +} + +static xm_targets_table_rec * +xm_read_targets_table_rec (uint8_t *bytes, ptrdiff_t length, + xm_byte_order byteorder) +{ + uint16_t nitems, i; + xm_targets_table_rec *rec; + + if (length < 2) + return NULL; + + nitems = *(uint16_t *) bytes; + + if (length < 2 + nitems * 4) + return NULL; + + if (byteorder != XM_BYTE_ORDER_CUR_FIRST) + SWAPCARD16 (nitems); + + rec = xmalloc (FLEXSIZEOF (struct xm_targets_table_rec, + targets, nitems * 4)); + rec->n_targets = nitems; + + for (i = 0; i < nitems; ++i) + { + rec->targets[i] = ((uint32_t *) (bytes + 2))[i]; + + if (byteorder != XM_BYTE_ORDER_CUR_FIRST) + SWAPCARD32 (rec->targets[i]); + } + + return rec; +} + +static int +xm_find_targets_table_idx (xm_targets_table_header *header, + xm_targets_table_rec **recs, + Atom *sorted_targets, int ntargets) +{ + int j; + uint16_t i; + uint32_t *targets; + + targets = alloca (sizeof *targets * ntargets); + + for (j = 0; j < ntargets; ++j) + targets[j] = sorted_targets[j]; + + for (i = 0; i < header->target_list_count; ++i) + { + if (recs[i]->n_targets == ntargets + && !memcmp (&recs[i]->targets, targets, + sizeof *targets * ntargets)) + return i; + } + + return -1; +} + +static int +x_atoms_compare (const void *a, const void *b) +{ + return *(Atom *) a - *(Atom *) b; +} + +static void +xm_write_targets_table (Display *dpy, Window wdesc, + Atom targets_table_atom, + xm_targets_table_header *header, + xm_targets_table_rec **recs) +{ + uint8_t *header_buffer, *ptr, *rec_buffer; + ptrdiff_t rec_buffer_size; + uint16_t i, j; + + header_buffer = alloca (8); + ptr = header_buffer; + + *(header_buffer++) = header->byte_order; + *(header_buffer++) = header->protocol; + *((uint16_t *) header_buffer) = header->target_list_count; + *((uint32_t *) (header_buffer + 2)) = header->total_data_size; + + rec_buffer = xmalloc (600); + rec_buffer_size = 600; + + XChangeProperty (dpy, wdesc, targets_table_atom, + targets_table_atom, 8, PropModeReplace, + (unsigned char *) ptr, 8); + + for (i = 0; i < header->target_list_count; ++i) + { + if (rec_buffer_size < 2 + recs[i]->n_targets * 4) + { + rec_buffer_size = 2 + recs[i]->n_targets * 4; + rec_buffer = xrealloc (rec_buffer, rec_buffer_size); + } + + *((uint16_t *) rec_buffer) = recs[i]->n_targets; + + for (j = 0; j < recs[i]->n_targets; ++j) + ((uint32_t *) (rec_buffer + 2))[j] = recs[i]->targets[j]; + + XChangeProperty (dpy, wdesc, targets_table_atom, + targets_table_atom, 8, PropModeAppend, + (unsigned char *) rec_buffer, + 2 + recs[i]->n_targets * 4); + } + + xfree (rec_buffer); +} + +static void +xm_write_drag_initiator_info (Display *dpy, Window wdesc, + Atom prop_name, Atom type_name, + xm_drag_initiator_info *info) +{ + uint8_t *buf; + + buf = alloca (8); + buf[0] = info->byteorder; + buf[1] = info->protocol; + + *((uint16_t *) (buf + 2)) = info->table_index; + *((uint32_t *) (buf + 4)) = info->selection; + + XChangeProperty (dpy, wdesc, prop_name, type_name, 8, + PropModeReplace, (unsigned char *) buf, 8); +} + +static Window +xm_get_drag_window (struct x_display_info *dpyinfo) +{ + Atom actual_type; + int rc, actual_format; + unsigned long nitems, bytes_remaining; + unsigned char *tmp_data = NULL; + Window drag_window; + XSetWindowAttributes attrs; + XWindowAttributes wattrs; + Display *temp_display; + + drag_window = None; + rc = XGetWindowProperty (dpyinfo->display, dpyinfo->root_window, + dpyinfo->Xatom_MOTIF_DRAG_WINDOW, + 0, 1, False, XA_WINDOW, &actual_type, + &actual_format, &nitems, &bytes_remaining, + &tmp_data) == Success; + + if (rc) + { + if (actual_type == XA_WINDOW + && actual_format == 32 && nitems == 1) + { + drag_window = *(Window *) tmp_data; + x_catch_errors (dpyinfo->display); + XGetWindowAttributes (dpyinfo->display, + drag_window, &wattrs); + rc = !x_had_errors_p (dpyinfo->display); + x_uncatch_errors_after_check (); + + if (!rc) + drag_window = None; + } + + if (tmp_data) + XFree (tmp_data); + } + + if (drag_window == None) + { + block_input (); + unrequest_sigio (); + temp_display = XOpenDisplay (XDisplayString (dpyinfo->display)); + request_sigio (); + + if (!temp_display) + { + unblock_input (); + return None; + } + + XGrabServer (temp_display); + XSetCloseDownMode (temp_display, RetainPermanent); + attrs.override_redirect = True; + drag_window = XCreateWindow (temp_display, DefaultRootWindow (temp_display), + -1, -1, 1, 1, 0, CopyFromParent, InputOnly, + CopyFromParent, CWOverrideRedirect, &attrs); + XChangeProperty (temp_display, DefaultRootWindow (temp_display), + XInternAtom (temp_display, + "_MOTIF_DRAG_WINDOW", False), + XA_WINDOW, 32, PropModeReplace, + (unsigned char *) &drag_window, 1); + XCloseDisplay (temp_display); + + /* Make sure the drag window created is actually valid for the + current display, and the XOpenDisplay above didn't + accidentally connect to some other display. */ + x_catch_errors (dpyinfo->display); + XGetWindowAttributes (dpyinfo->display, + drag_window, &wattrs); + rc = !x_had_errors_p (dpyinfo->display); + x_uncatch_errors_after_check (); + unblock_input (); + + /* We connected to the wrong display, so just give up. */ + if (!rc) + drag_window = None; + } + + return drag_window; +} + +/* TODO: overflow checks when inserting targets. */ +static int +xm_setup_dnd_targets (struct x_display_info *dpyinfo, + Atom *targets, int ntargets) +{ + Window drag_window; + Atom *targets_sorted, actual_type; + unsigned char *tmp_data = NULL; + unsigned long nitems, bytes_remaining; + int rc, actual_format, idx; + xm_targets_table_header header; + xm_targets_table_rec **recs; + xm_byte_order byteorder; + uint8_t *data; + ptrdiff_t total_bytes, total_items, i; + + drag_window = xm_get_drag_window (dpyinfo); + + if (drag_window == None || ntargets > 64) + return -1; + + targets_sorted = xmalloc (sizeof *targets * ntargets); + memcpy (targets_sorted, targets, + sizeof *targets * ntargets); + qsort (targets_sorted, ntargets, + sizeof (Atom), x_atoms_compare); + + XGrabServer (dpyinfo->display); + rc = XGetWindowProperty (dpyinfo->display, drag_window, + dpyinfo->Xatom_MOTIF_DRAG_TARGETS, + /* Do larger values occur in practice? */ + 0L, 20000L, False, + dpyinfo->Xatom_MOTIF_DRAG_TARGETS, + &actual_type, &actual_format, &nitems, + &bytes_remaining, &tmp_data) == Success; + + if (rc && tmp_data && !bytes_remaining + && actual_type == dpyinfo->Xatom_MOTIF_DRAG_TARGETS + && actual_format == 8) + { + data = (uint8_t *) tmp_data; + if (xm_read_targets_table_header ((uint8_t *) tmp_data, + nitems, &header, + &byteorder) == 8) + { + data += 8; + nitems -= 8; + total_bytes = 0; + total_items = 0; + + /* The extra rec is used to store a new target list if a + preexisting one doesn't already exist. */ + recs = xmalloc ((header.target_list_count + 1) + * sizeof *recs); + + while (total_items < header.target_list_count) + { + recs[total_items] = xm_read_targets_table_rec (data + total_bytes, + nitems, byteorder); + + if (!recs[total_items]) + break; + + total_bytes += 2 + recs[total_items]->n_targets * 4; + nitems -= 2 + recs[total_items]->n_targets * 4; + total_items++; + } + + if (header.target_list_count != total_items + || header.total_data_size != 8 + total_bytes) + { + for (i = 0; i < total_items; ++i) + { + if (recs[i]) + xfree (recs[i]); + else + break; + } + + xfree (recs); + + rc = false; + } + } + else + rc = false; + } + else + rc = false; + + if (tmp_data) + XFree (tmp_data); + + /* Now rc means whether or not the target lists weren't updated and + shouldn't be written to the drag window. */ + + if (!rc) + { + header.byte_order = XM_BYTE_ORDER_CUR_FIRST; + header.protocol = 0; + header.target_list_count = 1; + header.total_data_size = 8 + 2 + ntargets * 4; + + recs = xmalloc (sizeof *recs); + recs[0] = xmalloc (FLEXSIZEOF (struct xm_targets_table_rec, + targets, ntargets * 4)); + + recs[0]->n_targets = ntargets; + + for (i = 0; i < ntargets; ++i) + recs[0]->targets[i] = targets_sorted[i]; + + idx = 0; + } + else + { + idx = xm_find_targets_table_idx (&header, recs, + targets_sorted, + ntargets); + + if (idx == -1) + { + header.target_list_count++; + header.total_data_size += 2 + ntargets * 4; + + recs[header.target_list_count - 1] + = xmalloc (FLEXSIZEOF (struct xm_targets_table_rec, + targets, ntargets * 4)); + recs[header.target_list_count - 1]->n_targets = ntargets; + + for (i = 0; i < ntargets; ++i) + recs[header.target_list_count - 1]->targets[i] = targets_sorted[i]; + + idx = header.target_list_count - 1; + rc = false; + } + } + + if (!rc) + xm_write_targets_table (dpyinfo->display, drag_window, + dpyinfo->Xatom_MOTIF_DRAG_TARGETS, + &header, recs); + + XUngrabServer (dpyinfo->display); + + for (i = 0; i < header.target_list_count; ++i) + xfree (recs[i]); + + xfree (recs); + xfree (targets_sorted); + + return idx; +} + +static void +xm_setup_drag_info (struct x_display_info *dpyinfo, + struct frame *source_frame) +{ + xm_drag_initiator_info drag_initiator_info; + int idx; + + idx = xm_setup_dnd_targets (dpyinfo, x_dnd_targets, + x_dnd_n_targets); + + if (idx != -1) + { + drag_initiator_info.byteorder = XM_BYTE_ORDER_CUR_FIRST; + drag_initiator_info.protocol = 0; + drag_initiator_info.table_index = idx; + drag_initiator_info.selection = dpyinfo->Xatom_XdndSelection; + + xm_write_drag_initiator_info (dpyinfo->display, FRAME_X_WINDOW (source_frame), + dpyinfo->Xatom_XdndSelection, + dpyinfo->Xatom_MOTIF_DRAG_INITIATOR_INFO, + &drag_initiator_info); + + x_dnd_motif_setup_p = true; + } +} + +static void +xm_send_drop_message (struct x_display_info *dpyinfo, Window source, + Window target, xm_drop_start_message *dmsg) +{ + XEvent msg; + + msg.xclient.type = ClientMessage; + msg.xclient.message_type + = dpyinfo->Xatom_MOTIF_DRAG_AND_DROP_MESSAGE; + msg.xclient.format = 8; + msg.xclient.window = target; + msg.xclient.data.b[0] = dmsg->reason; + msg.xclient.data.b[1] = dmsg->byte_order; + *((uint16_t *) &msg.xclient.data.b[2]) = dmsg->side_effects; + *((uint32_t *) &msg.xclient.data.b[4]) = dmsg->timestamp; + *((uint16_t *) &msg.xclient.data.b[8]) = dmsg->x; + *((uint16_t *) &msg.xclient.data.b[10]) = dmsg->y; + *((uint32_t *) &msg.xclient.data.b[12]) = dmsg->index_atom; + *((uint32_t *) &msg.xclient.data.b[16]) = dmsg->source_window; + + x_catch_errors (dpyinfo->display); + XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); + x_uncatch_errors (); +} + +static void +xm_send_top_level_enter_message (struct x_display_info *dpyinfo, Window source, + Window target, xm_top_level_enter_message *dmsg) +{ + XEvent msg; + + msg.xclient.type = ClientMessage; + msg.xclient.message_type + = dpyinfo->Xatom_MOTIF_DRAG_AND_DROP_MESSAGE; + msg.xclient.format = 8; + msg.xclient.window = target; + msg.xclient.data.b[0] = dmsg->reason; + msg.xclient.data.b[1] = dmsg->byteorder; + *((uint16_t *) &msg.xclient.data.b[2]) = dmsg->zero; + *((uint32_t *) &msg.xclient.data.b[4]) = dmsg->timestamp; + *((uint32_t *) &msg.xclient.data.b[8]) = dmsg->source_window; + *((uint32_t *) &msg.xclient.data.b[12]) = dmsg->index_atom; + msg.xclient.data.b[16] = 0; + msg.xclient.data.b[17] = 0; + msg.xclient.data.b[18] = 0; + msg.xclient.data.b[19] = 0; + + x_catch_errors (dpyinfo->display); + XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); + x_uncatch_errors (); +} + +static void +xm_send_drag_motion_message (struct x_display_info *dpyinfo, Window source, + Window target, xm_drag_motion_message *dmsg) +{ + XEvent msg; + + msg.xclient.type = ClientMessage; + msg.xclient.message_type + = dpyinfo->Xatom_MOTIF_DRAG_AND_DROP_MESSAGE; + msg.xclient.format = 8; + msg.xclient.window = target; + msg.xclient.data.b[0] = dmsg->reason; + msg.xclient.data.b[1] = dmsg->byteorder; + *((uint16_t *) &msg.xclient.data.b[2]) = dmsg->side_effects; + *((uint32_t *) &msg.xclient.data.b[4]) = dmsg->timestamp; + *((uint16_t *) &msg.xclient.data.b[8]) = dmsg->x; + *((uint16_t *) &msg.xclient.data.b[10]) = dmsg->y; + msg.xclient.data.b[12] = 0; + msg.xclient.data.b[13] = 0; + msg.xclient.data.b[14] = 0; + msg.xclient.data.b[15] = 0; + msg.xclient.data.b[16] = 0; + msg.xclient.data.b[17] = 0; + msg.xclient.data.b[18] = 0; + msg.xclient.data.b[19] = 0; + + x_catch_errors (dpyinfo->display); + XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); + x_uncatch_errors (); +} + +static void +xm_send_top_level_leave_message (struct x_display_info *dpyinfo, Window source, + Window target, xm_top_level_leave_message *dmsg) +{ + XEvent msg; + xm_drag_motion_message mmsg; + + /* Motif support for TOP_LEVEL_LEAVE has bitrotted, since these days + it assumes every client supports the preregister protocol style, + but we only support drop-only and dynamic. (Interestingly enough + LessTif works fine.) Sending an event with impossible + coordinates serves to get rid of any active drop site that might + still be around in the target drag context. */ + + if (x_dnd_fix_motif_leave) + { + mmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DRAG_MOTION); + mmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + mmsg.side_effects = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_SITE_NONE, XM_DRAG_NOOP, + XM_DROP_ACTION_DROP_CANCEL); + mmsg.timestamp = dmsg->timestamp; + mmsg.x = 65535; + mmsg.y = 65535; + + xm_send_drag_motion_message (dpyinfo, source, target, &mmsg); + } + + msg.xclient.type = ClientMessage; + msg.xclient.message_type + = dpyinfo->Xatom_MOTIF_DRAG_AND_DROP_MESSAGE; + msg.xclient.format = 8; + msg.xclient.window = target; + msg.xclient.data.b[0] = dmsg->reason; + msg.xclient.data.b[1] = dmsg->byteorder; + *((uint16_t *) &msg.xclient.data.b[2]) = dmsg->zero; + *((uint32_t *) &msg.xclient.data.b[4]) = dmsg->timestamp; + *((uint32_t *) &msg.xclient.data.b[8]) = dmsg->source_window; + msg.xclient.data.b[12] = 0; + msg.xclient.data.b[13] = 0; + msg.xclient.data.b[14] = 0; + msg.xclient.data.b[15] = 0; + msg.xclient.data.b[16] = 0; + msg.xclient.data.b[17] = 0; + msg.xclient.data.b[18] = 0; + msg.xclient.data.b[19] = 0; + + x_catch_errors (dpyinfo->display); + XSendEvent (dpyinfo->display, target, False, NoEventMask, &msg); + x_uncatch_errors (); +} + +static int +xm_read_drop_start_reply (const XEvent *msg, xm_drop_start_reply *reply) +{ + const uint8_t *data; + + data = (const uint8_t *) &msg->xclient.data.b[0]; + + if ((XM_DRAG_REASON_ORIGINATOR (data[0]) + != XM_DRAG_ORIGINATOR_RECEIVER) + || (XM_DRAG_REASON_CODE (data[0]) + != XM_DRAG_REASON_DROP_START)) + return 1; + + reply->reason = *(data++); + reply->byte_order = *(data++); + reply->side_effects = *(uint16_t *) data; + reply->better_x = *(uint16_t *) (data + 2); + reply->better_y = *(uint16_t *) (data + 4); + + if (reply->byte_order != XM_BYTE_ORDER_CUR_FIRST) + { + SWAPCARD16 (reply->side_effects); + SWAPCARD16 (reply->better_x); + SWAPCARD16 (reply->better_y); + } + + reply->byte_order = XM_BYTE_ORDER_CUR_FIRST; + + return 0; +} + +static int +xm_read_drag_receiver_info (struct x_display_info *dpyinfo, + Window wdesc, xm_drag_receiver_info *rec) +{ + Atom actual_type; + int rc, actual_format; + unsigned long nitems, bytes_remaining; + unsigned char *tmp_data = NULL; + uint8_t *data; + + x_catch_errors (dpyinfo->display); + rc = XGetWindowProperty (dpyinfo->display, wdesc, + dpyinfo->Xatom_MOTIF_DRAG_RECEIVER_INFO, + 0, 4, False, + dpyinfo->Xatom_MOTIF_DRAG_RECEIVER_INFO, + &actual_type, &actual_format, &nitems, + &bytes_remaining, + &tmp_data) == Success; + + if (x_had_errors_p (dpyinfo->display) + || actual_format != 8 || nitems < 16 || !tmp_data + || actual_type != dpyinfo->Xatom_MOTIF_DRAG_RECEIVER_INFO) + rc = 0; + x_uncatch_errors_after_check (); + + if (rc) + { + data = (uint8_t *) tmp_data; + + rec->byteorder = data[0]; + rec->protocol = data[1]; + rec->protocol_style = data[2]; + rec->unspecified0 = data[3]; + rec->unspecified1 = *(uint32_t *) &data[4]; + rec->unspecified2 = *(uint32_t *) &data[8]; + rec->unspecified3 = *(uint32_t *) &data[12]; + + if (rec->byteorder != XM_BYTE_ORDER_CUR_FIRST) + { + SWAPCARD32 (rec->unspecified1); + SWAPCARD32 (rec->unspecified2); + SWAPCARD32 (rec->unspecified3); + } + + rec->byteorder = XM_BYTE_ORDER_CUR_FIRST; + } + + if (tmp_data) + XFree (tmp_data); + + return !rc; +} + +static void +x_dnd_send_xm_leave_for_drop (struct x_display_info *dpyinfo, + struct frame *f, Window wdesc, + Time timestamp) +{ + xm_top_level_leave_message lmsg; + + lmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_TOP_LEVEL_LEAVE); + lmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + lmsg.zero = 0; + lmsg.timestamp = timestamp; + lmsg.source_window = FRAME_X_WINDOW (f); + + if (x_dnd_motif_setup_p) + xm_send_top_level_leave_message (dpyinfo, FRAME_X_WINDOW (f), + wdesc, &lmsg); +} + +static void +x_dnd_free_toplevels (void) +{ + struct x_client_list_window *last; + struct x_client_list_window *tem = x_dnd_toplevels; + + while (tem) + { + last = tem; + tem = tem->next; + + x_catch_errors (last->dpy); + XSelectInput (last->dpy, last->window, + last->previous_event_mask); +#ifdef HAVE_XSHAPE + XShapeSelectInput (last->dpy, last->window, None); +#endif + x_uncatch_errors (); + +#ifdef HAVE_XSHAPE + if (last->n_input_rects != -1) + xfree (last->input_rects); + if (last->n_bounding_rects != -1) + xfree (last->bounding_rects); +#endif + + xfree (last); + } + + x_dnd_toplevels = NULL; +} + +static int +x_dnd_compute_toplevels (struct x_display_info *dpyinfo) +{ + Atom type; + Window *toplevels; + int format, rc; + unsigned long nitems, bytes_after; + unsigned long i; + unsigned char *data = NULL; + int frame_extents[4]; + +#ifndef USE_XCB + int dest_x, dest_y; + unsigned long *wmstate; + unsigned long wmstate_items, extent_items; + unsigned char *wmstate_data = NULL, *extent_data = NULL; + XWindowAttributes attrs; + Window child; + xm_drag_receiver_info xm_info; +#else + uint32_t *wmstate, *fextents; + uint8_t *xmdata; + xcb_get_window_attributes_cookie_t *window_attribute_cookies; + xcb_translate_coordinates_cookie_t *translate_coordinate_cookies; + xcb_get_property_cookie_t *get_property_cookies; + xcb_get_property_cookie_t *xm_property_cookies; + xcb_get_property_cookie_t *extent_property_cookies; + xcb_get_geometry_cookie_t *get_geometry_cookies; + xcb_get_window_attributes_reply_t attrs, *attrs_reply; + xcb_translate_coordinates_reply_t *coordinates_reply; + xcb_get_property_reply_t *property_reply; + xcb_get_property_reply_t *xm_property_reply; + xcb_get_property_reply_t *extent_property_reply; + xcb_get_geometry_reply_t *geometry_reply; + xcb_generic_error_t *error; +#endif + +#ifdef HAVE_XCB_SHAPE + xcb_shape_get_rectangles_cookie_t *bounding_rect_cookies; + xcb_shape_get_rectangles_reply_t *bounding_rect_reply; + xcb_rectangle_iterator_t bounding_rect_iterator; +#endif + +#ifdef HAVE_XCB_SHAPE_INPUT_RECTS + xcb_shape_get_rectangles_cookie_t *input_rect_cookies; + xcb_shape_get_rectangles_reply_t *input_rect_reply; + xcb_rectangle_iterator_t input_rect_iterator; +#endif + + struct x_client_list_window *tem; +#if defined HAVE_XSHAPE && !defined HAVE_XCB_SHAPE_INPUT_RECTS + int count, ordering; + XRectangle *rects; +#endif + + rc = XGetWindowProperty (dpyinfo->display, dpyinfo->root_window, + dpyinfo->Xatom_net_client_list_stacking, + 0, LONG_MAX, False, XA_WINDOW, &type, + &format, &nitems, &bytes_after, &data); + + if (rc != Success) + return 1; + + if (format != 32 || type != XA_WINDOW) + { + XFree (data); + return 1; + } + + toplevels = (Window *) data; + +#ifdef USE_XCB + window_attribute_cookies + = alloca (sizeof *window_attribute_cookies * nitems); + translate_coordinate_cookies + = alloca (sizeof *translate_coordinate_cookies * nitems); + get_property_cookies + = alloca (sizeof *get_property_cookies * nitems); + xm_property_cookies + = alloca (sizeof *xm_property_cookies * nitems); + extent_property_cookies + = alloca (sizeof *extent_property_cookies * nitems); + get_geometry_cookies + = alloca (sizeof *get_geometry_cookies * nitems); + +#ifdef HAVE_XCB_SHAPE + bounding_rect_cookies + = alloca (sizeof *bounding_rect_cookies * nitems); +#endif + +#ifdef HAVE_XCB_SHAPE_INPUT_RECTS + input_rect_cookies + = alloca (sizeof *input_rect_cookies * nitems); +#endif + + for (i = 0; i < nitems; ++i) + { + window_attribute_cookies[i] + = xcb_get_window_attributes (dpyinfo->xcb_connection, + (xcb_window_t) toplevels[i]); + translate_coordinate_cookies[i] + = xcb_translate_coordinates (dpyinfo->xcb_connection, + (xcb_window_t) toplevels[i], + (xcb_window_t) dpyinfo->root_window, + 0, 0); + get_property_cookies[i] + = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) toplevels[i], + (xcb_atom_t) dpyinfo->Xatom_wm_state, XCB_ATOM_ANY, + 0, 2); + xm_property_cookies[i] + = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) toplevels[i], + (xcb_atom_t) dpyinfo->Xatom_MOTIF_DRAG_RECEIVER_INFO, + (xcb_atom_t) dpyinfo->Xatom_MOTIF_DRAG_RECEIVER_INFO, + 0, 4); + extent_property_cookies[i] + = xcb_get_property (dpyinfo->xcb_connection, 0, + (xcb_window_t) toplevels[i], + (xcb_atom_t) dpyinfo->Xatom_net_frame_extents, + XCB_ATOM_CARDINAL, 0, 4); + get_geometry_cookies[i] + = xcb_get_geometry (dpyinfo->xcb_connection, (xcb_window_t) toplevels[i]); + +#ifdef HAVE_XCB_SHAPE + bounding_rect_cookies[i] + = xcb_shape_get_rectangles (dpyinfo->xcb_connection, + (xcb_window_t) toplevels[i], + XCB_SHAPE_SK_BOUNDING); +#endif + +#ifdef HAVE_XCB_SHAPE_INPUT_RECTS + if (dpyinfo->xshape_major > 1 + || (dpyinfo->xshape_major == 1 + && dpyinfo->xshape_minor >= 1)) + input_rect_cookies[i] + = xcb_shape_get_rectangles (dpyinfo->xcb_connection, + (xcb_window_t) toplevels[i], + XCB_SHAPE_SK_INPUT); +#endif + } +#endif + + /* Actually right because _NET_CLIENT_LIST_STACKING has bottom-up + order. */ + for (i = 0; i < nitems; ++i) + { + frame_extents[0] = 0; + frame_extents[1] = 0; + frame_extents[2] = 0; + frame_extents[3] = 0; + +#ifndef USE_XCB + x_catch_errors (dpyinfo->display); + rc = (XGetWindowAttributes (dpyinfo->display, + toplevels[i], &attrs) + && !x_had_errors_p (dpyinfo->display)); + + if (rc) + rc = (XTranslateCoordinates (dpyinfo->display, toplevels[i], + attrs.root, -attrs.border_width, + -attrs.border_width, &dest_x, + &dest_y, &child) + && !x_had_errors_p (dpyinfo->display)); + if (rc) + rc = ((XGetWindowProperty (dpyinfo->display, + toplevels[i], + dpyinfo->Xatom_wm_state, + 0, 2, False, AnyPropertyType, + &type, &format, &wmstate_items, + &bytes_after, &wmstate_data) + == Success) + && !x_had_errors_p (dpyinfo->display) + && wmstate_data && wmstate_items == 2 && format == 32); + + if (XGetWindowProperty (dpyinfo->display, toplevels[i], + dpyinfo->Xatom_net_frame_extents, + 0, 4, False, XA_CARDINAL, &type, + &format, &extent_items, &bytes_after, + &extent_data) == Success + && !x_had_errors_p (dpyinfo->display) + && extent_data && extent_items >= 4 && format == 32) + { + frame_extents[0] = ((unsigned long *) extent_data)[0]; + frame_extents[1] = ((unsigned long *) extent_data)[1]; + frame_extents[2] = ((unsigned long *) extent_data)[2]; + frame_extents[3] = ((unsigned long *) extent_data)[3]; + } + + if (extent_data) + XFree (extent_data); + + x_uncatch_errors (); +#else + rc = true; + + attrs_reply + = xcb_get_window_attributes_reply (dpyinfo->xcb_connection, + window_attribute_cookies[i], + &error); + + if (!attrs_reply) + { + rc = false; + free (error); + } + + coordinates_reply + = xcb_translate_coordinates_reply (dpyinfo->xcb_connection, + translate_coordinate_cookies[i], + &error); + + if (!coordinates_reply) + { + rc = false; + free (error); + } + + property_reply = xcb_get_property_reply (dpyinfo->xcb_connection, + get_property_cookies[i], + &error); + + if (!property_reply) + { + rc = false; + free (error); + } + + /* These requests don't set rc on failure because they aren't + required. */ + + xm_property_reply = xcb_get_property_reply (dpyinfo->xcb_connection, + xm_property_cookies[i], + &error); + + if (!xm_property_reply) + free (error); + + extent_property_reply = xcb_get_property_reply (dpyinfo->xcb_connection, + extent_property_cookies[i], + &error); + + if (!extent_property_reply) + free (error); + else + { + if (xcb_get_property_value_length (extent_property_reply) == 16 + && extent_property_reply->format == 32 + && extent_property_reply->type == XCB_ATOM_CARDINAL) + { + fextents = xcb_get_property_value (extent_property_reply); + frame_extents[0] = fextents[0]; + frame_extents[1] = fextents[1]; + frame_extents[2] = fextents[2]; + frame_extents[3] = fextents[3]; + } + + free (extent_property_reply); + } + + if (property_reply + && (xcb_get_property_value_length (property_reply) != 8 + || property_reply->format != 32)) + rc = false; + + geometry_reply = xcb_get_geometry_reply (dpyinfo->xcb_connection, + get_geometry_cookies[i], + &error); + + if (!geometry_reply) + { + rc = false; + free (error); + } +#endif + + if (rc) + { +#ifdef USE_XCB + wmstate = (uint32_t *) xcb_get_property_value (property_reply); + attrs = *attrs_reply; +#else + wmstate = (unsigned long *) wmstate_data; +#endif + + tem = xmalloc (sizeof *tem); + tem->window = toplevels[i]; + tem->dpy = dpyinfo->display; + tem->frame_extents_left = frame_extents[0]; + tem->frame_extents_right = frame_extents[1]; + tem->frame_extents_top = frame_extents[2]; + tem->frame_extents_bottom = frame_extents[3]; + +#ifndef USE_XCB + tem->x = dest_x; + tem->y = dest_y; + tem->width = attrs.width + attrs.border_width; + tem->height = attrs.height + attrs.border_width; + tem->mapped_p = (attrs.map_state != IsUnmapped); +#else + tem->x = (coordinates_reply->dst_x + - geometry_reply->border_width); + tem->y = (coordinates_reply->dst_y + - geometry_reply->border_width); + tem->width = (geometry_reply->width + + geometry_reply->border_width); + tem->height = (geometry_reply->height + + geometry_reply->border_width); + tem->mapped_p = (attrs.map_state != XCB_MAP_STATE_UNMAPPED); +#endif + tem->next = x_dnd_toplevels; + tem->previous_event_mask = attrs.your_event_mask; + tem->wm_state = wmstate[0]; + tem->xm_protocol_style = XM_DRAG_STYLE_NONE; + +#ifndef USE_XCB + if (!xm_read_drag_receiver_info (dpyinfo, toplevels[i], &xm_info)) + tem->xm_protocol_style = xm_info.protocol_style; +#else + if (xm_property_reply + && xm_property_reply->format == 8 + && xm_property_reply->type == dpyinfo->Xatom_MOTIF_DRAG_RECEIVER_INFO + && xcb_get_property_value_length (xm_property_reply) >= 4) + { + xmdata = xcb_get_property_value (xm_property_reply); + tem->xm_protocol_style = xmdata[2]; + } +#endif + +#ifdef HAVE_XSHAPE +#ifndef USE_XCB + tem->border_width = attrs.border_width; +#else + tem->border_width = geometry_reply->border_width; +#endif + tem->n_bounding_rects = -1; + tem->n_input_rects = -1; + + if (dpyinfo->xshape_supported_p) + { + x_catch_errors (dpyinfo->display); + XShapeSelectInput (dpyinfo->display, + toplevels[i], + ShapeNotifyMask); + x_uncatch_errors (); + +#ifndef HAVE_XCB_SHAPE + x_catch_errors (dpyinfo->display); + rects = XShapeGetRectangles (dpyinfo->display, + toplevels[i], + ShapeBounding, + &count, &ordering); + rc = x_had_errors_p (dpyinfo->display); + x_uncatch_errors_after_check (); + + /* Does XShapeGetRectangles allocate anything upon an + error? */ + if (!rc) + { + tem->n_bounding_rects = count; + tem->bounding_rects + = xmalloc (sizeof *tem->bounding_rects * count); + memcpy (tem->bounding_rects, rects, + sizeof *tem->bounding_rects * count); + + XFree (rects); + } +#else + bounding_rect_reply = xcb_shape_get_rectangles_reply (dpyinfo->xcb_connection, + bounding_rect_cookies[i], + &error); + + if (bounding_rect_reply) + { + bounding_rect_iterator + = xcb_shape_get_rectangles_rectangles_iterator (bounding_rect_reply); + tem->n_bounding_rects = bounding_rect_iterator.rem + 1; + tem->bounding_rects = xmalloc (tem->n_bounding_rects + * sizeof *tem->bounding_rects); + tem->n_bounding_rects = 0; + + for (; bounding_rect_iterator.rem; xcb_rectangle_next (&bounding_rect_iterator)) + { + tem->bounding_rects[tem->n_bounding_rects].x + = bounding_rect_iterator.data->x; + tem->bounding_rects[tem->n_bounding_rects].y + = bounding_rect_iterator.data->y; + tem->bounding_rects[tem->n_bounding_rects].width + = bounding_rect_iterator.data->width; + tem->bounding_rects[tem->n_bounding_rects].height + = bounding_rect_iterator.data->height; + + tem->n_bounding_rects++; + } + + free (bounding_rect_reply); + } + else + free (error); +#endif + +#ifdef HAVE_XCB_SHAPE_INPUT_RECTS + if (dpyinfo->xshape_major > 1 + || (dpyinfo->xshape_major == 1 + && dpyinfo->xshape_minor >= 1)) + { + input_rect_reply = xcb_shape_get_rectangles_reply (dpyinfo->xcb_connection, + input_rect_cookies[i], + &error); + + if (input_rect_reply) + { + input_rect_iterator + = xcb_shape_get_rectangles_rectangles_iterator (input_rect_reply); + tem->n_input_rects = input_rect_iterator.rem + 1; + tem->input_rects = xmalloc (tem->n_input_rects + * sizeof *tem->input_rects); + tem->n_input_rects = 0; + + for (; input_rect_iterator.rem; xcb_rectangle_next (&input_rect_iterator)) + { + tem->input_rects[tem->n_input_rects].x + = input_rect_iterator.data->x; + tem->input_rects[tem->n_input_rects].y + = input_rect_iterator.data->y; + tem->input_rects[tem->n_input_rects].width + = input_rect_iterator.data->width; + tem->input_rects[tem->n_input_rects].height + = input_rect_iterator.data->height; + + tem->n_input_rects++; + } + + free (input_rect_reply); + } + else + free (error); + } +#else +#ifdef ShapeInput + if (dpyinfo->xshape_major > 1 + || (dpyinfo->xshape_major == 1 + && dpyinfo->xshape_minor >= 1)) + { + x_catch_errors (dpyinfo->display); + rects = XShapeGetRectangles (dpyinfo->display, + toplevels[i], ShapeInput, + &count, &ordering); + rc = x_had_errors_p (dpyinfo->display); + x_uncatch_errors_after_check (); + + /* Does XShapeGetRectangles allocate anything upon + an error? */ + if (!rc) + { + tem->n_input_rects = count; + tem->input_rects + = xmalloc (sizeof *tem->input_rects * count); + memcpy (tem->input_rects, rects, + sizeof *tem->input_rects * count); + + XFree (rects); + } + } +#endif +#endif + } + + /* Handle the common case where the input shape equals the + bounding shape. */ + + if (tem->n_input_rects != -1 + && tem->n_bounding_rects == tem->n_input_rects + && !memcmp (tem->bounding_rects, tem->input_rects, + tem->n_input_rects * sizeof *tem->input_rects)) + { + xfree (tem->input_rects); + tem->n_input_rects = -1; + } + + /* And the common case where there is no input rect and the + bouding rect equals the window dimensions. */ + + if (tem->n_input_rects == -1 + && tem->n_bounding_rects == 1 +#ifdef USE_XCB + && tem->bounding_rects[0].width == (geometry_reply->width + + geometry_reply->border_width) + && tem->bounding_rects[0].height == (geometry_reply->height + + geometry_reply->border_width) + && tem->bounding_rects[0].x == -geometry_reply->border_width + && tem->bounding_rects[0].y == -geometry_reply->border_width +#else + && tem->bounding_rects[0].width == attrs.width + attrs.border_width + && tem->bounding_rects[0].height == attrs.height + attrs.border_width + && tem->bounding_rects[0].x == -attrs.border_width + && tem->bounding_rects[0].y == -attrs.border_width +#endif + ) + { + xfree (tem->bounding_rects); + tem->n_bounding_rects = -1; + } +#endif + + x_catch_errors (dpyinfo->display); + XSelectInput (dpyinfo->display, toplevels[i], + (attrs.your_event_mask + | StructureNotifyMask + | PropertyChangeMask)); + x_uncatch_errors (); + + x_dnd_toplevels = tem; + } + else + { +#ifdef HAVE_XCB_SHAPE + if (dpyinfo->xshape_supported_p) + { + bounding_rect_reply = xcb_shape_get_rectangles_reply (dpyinfo->xcb_connection, + bounding_rect_cookies[i], + &error); + + if (bounding_rect_reply) + free (bounding_rect_reply); + else + free (error); + } +#endif + +#ifdef HAVE_XCB_SHAPE_INPUT_RECTS + if (dpyinfo->xshape_supported_p + && (dpyinfo->xshape_major > 1 + || (dpyinfo->xshape_major == 1 + && dpyinfo->xshape_minor >= 1))) + { + input_rect_reply = xcb_shape_get_rectangles_reply (dpyinfo->xcb_connection, + input_rect_cookies[i], + &error); + + if (input_rect_reply) + free (input_rect_reply); + else + free (error); + } +#endif + } + +#ifdef USE_XCB + if (attrs_reply) + free (attrs_reply); + + if (coordinates_reply) + free (coordinates_reply); + + if (property_reply) + free (property_reply); + + if (xm_property_reply) + free (xm_property_reply); + + if (geometry_reply) + free (geometry_reply); +#endif + +#ifndef USE_XCB + if (wmstate_data) + { + XFree (wmstate_data); + wmstate_data = NULL; + } +#endif + } + + return 0; +} + +#define X_DND_SUPPORTED_VERSION 5 + + +static int x_dnd_get_window_proto (struct x_display_info *, Window); +static Window x_dnd_get_window_proxy (struct x_display_info *, Window); +static void x_dnd_update_state (struct x_display_info *, Time); + +#ifdef USE_XCB +static void +x_dnd_get_proxy_proto (struct x_display_info *dpyinfo, Window wdesc, + Window *proxy_out, int *proto_out) +{ + xcb_get_property_cookie_t xdnd_proto_cookie; + xcb_get_property_cookie_t xdnd_proxy_cookie; + xcb_get_property_reply_t *reply; + xcb_generic_error_t *error; + + if (proxy_out) + *proxy_out = None; + + if (proto_out) + *proto_out = -1; + + if (proxy_out) + xdnd_proxy_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, + (xcb_window_t) wdesc, + (xcb_atom_t) dpyinfo->Xatom_XdndProxy, + XCB_ATOM_WINDOW, 0, 1); + + if (proto_out) + xdnd_proto_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, + (xcb_window_t) wdesc, + (xcb_atom_t) dpyinfo->Xatom_XdndAware, + XCB_ATOM_ATOM, 0, 1); + + if (proxy_out) + { + reply = xcb_get_property_reply (dpyinfo->xcb_connection, + xdnd_proxy_cookie, &error); + + if (!reply) + free (error); + else + { + if (reply->format == 32 + && reply->type == XCB_ATOM_WINDOW + && (xcb_get_property_value_length (reply) >= 4)) + *proxy_out = *(xcb_window_t *) xcb_get_property_value (reply); + + free (reply); + } + } + + if (proto_out) + { + reply = xcb_get_property_reply (dpyinfo->xcb_connection, + xdnd_proto_cookie, &error); + + if (!reply) + free (error); + else + { + if (reply->format == 32 + && reply->type == XCB_ATOM_ATOM + && (xcb_get_property_value_length (reply) >= 4)) + *proto_out = (int) *(xcb_atom_t *) xcb_get_property_value (reply); + + free (reply); + } + } +} +#endif + +#ifdef HAVE_XSHAPE +static bool +x_dnd_get_target_window_2 (XRectangle *rects, int nrects, + int x, int y) +{ + int i; + XRectangle *tem; + + for (i = 0; i < nrects; ++i) + { + tem = &rects[i]; + + if (x >= tem->x && y >= tem->y + && x < tem->x + tem->width + && y < tem->y + tem->height) + return true; + } + + return false; +} +#endif + +static Window +x_dnd_get_target_window_1 (struct x_display_info *dpyinfo, + int root_x, int root_y, int *motif_out, + bool *extents_p) +{ + struct x_client_list_window *tem, *chosen = NULL; + + /* Loop through x_dnd_toplevels until we find the toplevel where + root_x and root_y are. */ + + *motif_out = XM_DRAG_STYLE_NONE; + for (tem = x_dnd_toplevels; tem; tem = tem->next) + { + if (!tem->mapped_p || tem->wm_state != NormalState) + continue; + + /* Test if the coordinates are inside the window's frame + extents, and return None in that case. */ + + *extents_p = true; + if (root_x > tem->x - tem->frame_extents_left + && root_x < tem->x + && root_y > tem->y - tem->frame_extents_top + && root_y < (tem->y + tem->height - 1 + + tem->frame_extents_bottom)) + return None; + + if (root_x > tem->x + tem->width + && root_x < (tem->x + tem->width - 1 + + tem->frame_extents_right) + && root_y > tem->y - tem->frame_extents_top + && root_y < (tem->y + tem->height - 1 + + tem->frame_extents_bottom)) + return None; + + if (root_y > tem->y - tem->frame_extents_top + && root_y < tem->y + && root_x > tem->x - tem->frame_extents_left + && root_x < (tem->x + tem->width - 1 + + tem->frame_extents_right)) + return None; + + if (root_y > tem->y + tem->height + && root_y < (tem->y + tem->height - 1 + + tem->frame_extents_bottom) + && root_x >= tem->x - tem->frame_extents_left + && root_x < (tem->x + tem->width - 1 + + tem->frame_extents_right)) + return None; + *extents_p = false; + + if (root_x >= tem->x && root_y >= tem->y + && root_x < tem->x + tem->width + && root_y < tem->y + tem->height) + { +#ifdef HAVE_XSHAPE + if (tem->n_bounding_rects == -1) +#endif + { + chosen = tem; + break; + } + +#ifdef HAVE_XSHAPE + if (x_dnd_get_target_window_2 (tem->bounding_rects, + tem->n_bounding_rects, + tem->border_width + root_x - tem->x, + tem->border_width + root_y - tem->y)) + { + if (tem->n_input_rects == -1 + || x_dnd_get_target_window_2 (tem->input_rects, + tem->n_input_rects, + tem->border_width + root_x - tem->x, + tem->border_width + root_y - tem->y)) + { + chosen = tem; + break; + } + } +#endif + } + } + + if (chosen) + { + *motif_out = chosen->xm_protocol_style; + return chosen->window; + } + else + *motif_out = XM_DRAG_STYLE_NONE; + + return None; +} + +static int +x_dnd_get_wm_state_and_proto (struct x_display_info *dpyinfo, + Window window, int *wmstate_out, + int *proto_out, int *motif_out, + Window *proxy_out) +{ +#ifndef USE_XCB + Atom type; + int format; + unsigned long nitems, bytes_after; + unsigned char *data = NULL; + xm_drag_receiver_info xm_info; +#else + xcb_get_property_cookie_t wmstate_cookie; + xcb_get_property_cookie_t xdnd_proto_cookie; + xcb_get_property_cookie_t xdnd_proxy_cookie; + xcb_get_property_cookie_t xm_style_cookie; + xcb_get_property_reply_t *reply; + xcb_generic_error_t *error; + uint8_t *xmdata; +#endif + int rc; + +#ifndef USE_XCB + x_catch_errors (dpyinfo->display); + rc = ((XGetWindowProperty (dpyinfo->display, window, + dpyinfo->Xatom_wm_state, + 0, 2, False, AnyPropertyType, + &type, &format, &nitems, + &bytes_after, &data) + == Success) + && !x_had_errors_p (dpyinfo->display) + && data && nitems == 2 && format == 32); + x_uncatch_errors (); + + if (rc) + *wmstate_out = *(unsigned long *) data; + + *proto_out = x_dnd_get_window_proto (dpyinfo, window); + + if (!xm_read_drag_receiver_info (dpyinfo, window, &xm_info)) + *motif_out = xm_info.protocol_style; + else + *motif_out = XM_DRAG_STYLE_NONE; + + *proxy_out = x_dnd_get_window_proxy (dpyinfo, window); + + if (data) + XFree (data); +#else + rc = true; + + wmstate_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, + (xcb_window_t) window, + (xcb_atom_t) dpyinfo->Xatom_wm_state, + XCB_ATOM_ANY, 0, 2); + xdnd_proto_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, + (xcb_window_t) window, + (xcb_atom_t) dpyinfo->Xatom_XdndAware, + XCB_ATOM_ATOM, 0, 1); + xdnd_proxy_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, + (xcb_window_t) window, + (xcb_atom_t) dpyinfo->Xatom_XdndProxy, + XCB_ATOM_WINDOW, 0, 1); + xm_style_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, + (xcb_window_t) window, + (xcb_atom_t) dpyinfo->Xatom_MOTIF_DRAG_RECEIVER_INFO, + (xcb_atom_t) dpyinfo->Xatom_MOTIF_DRAG_RECEIVER_INFO, + 0, 4); + + reply = xcb_get_property_reply (dpyinfo->xcb_connection, + wmstate_cookie, &error); + + if (!reply) + free (error), rc = false; + else + { + if (reply->format != 32 + || xcb_get_property_value_length (reply) != 8) + rc = false; + else + *wmstate_out = *(uint32_t *) xcb_get_property_value (reply); + + free (reply); + } + + reply = xcb_get_property_reply (dpyinfo->xcb_connection, + xdnd_proto_cookie, &error); + + *proto_out = -1; + if (!reply) + free (error); + else + { + if (reply->format == 32 + && xcb_get_property_value_length (reply) >= 4) + *proto_out = *(uint32_t *) xcb_get_property_value (reply); + + free (reply); + } + + *proxy_out = None; + reply = xcb_get_property_reply (dpyinfo->xcb_connection, + xdnd_proxy_cookie, &error); + + if (!reply) + free (error); + else + { + if (reply->format == 32 + && reply->type == XCB_ATOM_WINDOW + && (xcb_get_property_value_length (reply) >= 4)) + *proxy_out = *(xcb_window_t *) xcb_get_property_value (reply); + + free (reply); + } + + *motif_out = XM_DRAG_STYLE_NONE; + + reply = xcb_get_property_reply (dpyinfo->xcb_connection, + xm_style_cookie, &error); + + if (!reply) + free (error); + else + { + if (reply->format == 8 + && reply->type == dpyinfo->Xatom_MOTIF_DRAG_RECEIVER_INFO + && xcb_get_property_value_length (reply) >= 4) + { + xmdata = xcb_get_property_value (reply); + *motif_out = xmdata[2]; + } + + free (reply); + } +#endif + + return rc; +} + +/* From the XDND protocol specification: + + Dropping on windows that do not support XDND + + Since middle clicking is the universal shortcut for pasting + in X, one can drop data into a window that does not support + XDND by: + + 1. After the mouse has been released to trigger the drop, + obtain ownership of XA_PRIMARY. + + 2. Send a ButtonPress event and then a ButtonRelease event to + the deepest subwindow containing the mouse to simulate a + middle click. The times for these events should be the time + of the actual button release +1 and +2, respectively. These + values will not be used by anybody else, so one can + unambiguously recognize the resulting `XConvertSelection' + request. + + 3. If a request for XA_PRIMARY arrives bearing the timestamp + of either the ButtonPress or the ButtonRelease event, treat + it as a request for XdndSelection. Note that you must use + the X data types instead of the MIME types in this case. + (e.g. XA_STRING instead of text/plain). */ +void +x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, + Lisp_Object frame, Lisp_Object value, + Lisp_Object targets, Window target_window, + int root_x, int root_y, Time before) +{ + XEvent event; + int dest_x, dest_y; + Window child_return, child; + + event.xbutton.type = ButtonPress; + event.xbutton.serial = 0; + event.xbutton.send_event = True; + event.xbutton.display = dpyinfo->display; + event.xbutton.root = dpyinfo->root_window; + event.xbutton.x_root = root_x; + event.xbutton.y_root = root_y; + + x_catch_errors (dpyinfo->display); + + child = dpyinfo->root_window; + dest_x = root_x; + dest_y = root_y; + + while (XTranslateCoordinates (dpyinfo->display, child, + child, root_x, root_y, &dest_x, + &dest_y, &child_return) + && child_return != None + && XTranslateCoordinates (dpyinfo->display, child, + child_return, root_x, root_y, + &dest_x, &dest_y, &child)) + { + child = child_return; + root_x = dest_x; + root_y = dest_y; + } + + if (CONSP (value)) + x_own_selection (QPRIMARY, Fnth (make_fixnum (1), value), + frame); + else + x_own_selection (QPRIMARY, Qnil, frame); + + event.xbutton.window = child; + event.xbutton.x = dest_x; + event.xbutton.y = dest_y; + event.xbutton.state = 0; + event.xbutton.button = 2; + event.xbutton.same_screen = True; + event.xbutton.time = before + 1; + event.xbutton.time = before + 2; + + x_set_pending_dnd_time (before); + + XSendEvent (dpyinfo->display, child, + True, ButtonPressMask, &event); + event.xbutton.type = ButtonRelease; + XSendEvent (dpyinfo->display, child, + True, ButtonReleaseMask, &event); + + x_uncatch_errors (); +} + +static void +x_dnd_send_unsupported_drop (struct x_display_info *dpyinfo, Window target_window, + int root_x, int root_y, Time before) +{ + struct input_event ie; + Lisp_Object targets, arg; + int i; + char **atom_names, *name; + + EVENT_INIT (ie); + targets = Qnil; + atom_names = alloca (sizeof *atom_names * x_dnd_n_targets); + + if (!XGetAtomNames (dpyinfo->display, x_dnd_targets, + x_dnd_n_targets, atom_names)) + return; + + x_dnd_action = dpyinfo->Xatom_XdndActionPrivate; + + for (i = x_dnd_n_targets; i > 0; --i) + { + targets = Fcons (build_string (atom_names[i - 1]), + targets); + XFree (atom_names[i - 1]); + } + + name = XGetAtomName (dpyinfo->display, + x_dnd_wanted_action); + + if (name) + { + arg = intern (name); + XFree (name); + } + else + arg = Qnil; + + ie.kind = UNSUPPORTED_DROP_EVENT; + ie.code = (unsigned) target_window; + ie.arg = list3 (assq_no_quit (QXdndSelection, + dpyinfo->terminal->Vselection_alist), + targets, arg); + ie.timestamp = before; + + XSETINT (ie.x, root_x); + XSETINT (ie.y, root_y); + XSETFRAME (ie.frame_or_window, x_dnd_frame); + + kbd_buffer_store_event (&ie); +} + +static Window +x_dnd_get_target_window (struct x_display_info *dpyinfo, + int root_x, int root_y, int *proto_out, + int *motif_out, Window *toplevel_out) +{ + Window child_return, child, dummy, proxy; + int dest_x_return, dest_y_return, rc, proto, motif; + bool extents_p; +#if defined HAVE_XCOMPOSITE && (XCOMPOSITE_MAJOR > 0 || XCOMPOSITE_MINOR > 2) + Window overlay_window; + XWindowAttributes attrs; +#endif + int wmstate; + + child_return = dpyinfo->root_window; + dest_x_return = root_x; + dest_y_return = root_y; + + proto = -1; + *motif_out = XM_DRAG_STYLE_NONE; + *toplevel_out = None; + + if (x_dnd_use_toplevels) + { + extents_p = false; + child = x_dnd_get_target_window_1 (dpyinfo, root_x, + root_y, motif_out, + &extents_p); + + if (!x_dnd_allow_current_frame + && FRAME_X_WINDOW (x_dnd_frame) == child) + *motif_out = XM_DRAG_STYLE_NONE; + + *toplevel_out = child; + + if (child != None) + { +#ifndef USE_XCB + proxy = x_dnd_get_window_proxy (dpyinfo, child); +#else + x_dnd_get_proxy_proto (dpyinfo, child, &proxy, proto_out); +#endif + + if (proxy != None) + { + proto = x_dnd_get_window_proto (dpyinfo, proxy); + + if (proto != -1) + { + *proto_out = proto; + return proxy; + } + } + +#ifndef USE_XCB + *proto_out = x_dnd_get_window_proto (dpyinfo, child); +#endif + return child; + } + + if (extents_p) + { + *proto_out = -1; + *motif_out = XM_DRAG_STYLE_NONE; + *toplevel_out = None; + + return None; + } + + /* Then look at the composite overlay window. */ +#if defined HAVE_XCOMPOSITE && (XCOMPOSITE_MAJOR > 0 || XCOMPOSITE_MINOR > 2) + if (dpyinfo->composite_supported_p + && (dpyinfo->composite_major > 0 + || dpyinfo->composite_minor > 2)) + { + if (XGetSelectionOwner (dpyinfo->display, + dpyinfo->Xatom_NET_WM_CM_Sn) != None) + { + x_catch_errors (dpyinfo->display); + overlay_window = XCompositeGetOverlayWindow (dpyinfo->display, + dpyinfo->root_window); + XCompositeReleaseOverlayWindow (dpyinfo->display, + dpyinfo->root_window); + if (!x_had_errors_p (dpyinfo->display)) + { + XGetWindowAttributes (dpyinfo->display, overlay_window, &attrs); + + if (attrs.map_state == IsViewable) + { + proxy = x_dnd_get_window_proxy (dpyinfo, overlay_window); + + if (proxy != None) + { + proto = x_dnd_get_window_proto (dpyinfo, proxy); + + if (proto != -1) + { + *proto_out = proto; + *toplevel_out = overlay_window; + x_uncatch_errors_after_check (); + + return proxy; + } + } + } + } + x_uncatch_errors_after_check (); + } + } +#endif + + /* Now look for an XdndProxy on the root window. */ + + proxy = x_dnd_get_window_proxy (dpyinfo, dpyinfo->root_window); + + if (proxy != None) + { + proto = x_dnd_get_window_proto (dpyinfo, dpyinfo->root_window); + + if (proto != -1) + { + *toplevel_out = dpyinfo->root_window; + *proto_out = proto; + return proxy; + } + } + + /* No toplevel was found and the overlay and root windows were + not proxies, so return None. */ + *proto_out = -1; + *toplevel_out = dpyinfo->root_window; + return None; + } + + /* Not strictly necessary, but satisfies GCC. */ + child = dpyinfo->root_window; + + while (child_return != None) + { + child = child_return; + + x_catch_errors (dpyinfo->display); + rc = XTranslateCoordinates (dpyinfo->display, + child_return, child_return, + dest_x_return, dest_y_return, + &dest_x_return, &dest_y_return, + &child_return); + + if (x_had_errors_p (dpyinfo->display) || !rc) + { + x_uncatch_errors_after_check (); + break; + } + + if (child_return) + { + if (x_dnd_get_wm_state_and_proto (dpyinfo, child_return, + &wmstate, &proto, &motif, + &proxy) + /* `proto' and `motif' are set by x_dnd_get_wm_state + even if getting the wm state failed. */ + || proto != -1 || motif != XM_DRAG_STYLE_NONE) + { + *proto_out = proto; + *motif_out = motif; + *toplevel_out = child_return; + x_uncatch_errors (); + + return child_return; + } + + if (proxy != None) + { + proto = x_dnd_get_window_proto (dpyinfo, proxy); + + if (proto != -1) + { + *proto_out = proto; + *toplevel_out = child_return; + + x_uncatch_errors (); + return proxy; + } + } + + rc = XTranslateCoordinates (dpyinfo->display, + child, child_return, + dest_x_return, dest_y_return, + &dest_x_return, &dest_y_return, + &dummy); + + if (x_had_errors_p (dpyinfo->display) || !rc) + { + x_uncatch_errors_after_check (); + *proto_out = -1; + *toplevel_out = dpyinfo->root_window; + return None; + } + } + + x_uncatch_errors_after_check (); + } + +#if defined HAVE_XCOMPOSITE && (XCOMPOSITE_MAJOR > 0 || XCOMPOSITE_MINOR > 2) + if (child != dpyinfo->root_window) + { +#endif + if (child != None) + { + proxy = x_dnd_get_window_proxy (dpyinfo, child); + + if (proxy) + { + proto = x_dnd_get_window_proto (dpyinfo, proxy); + + if (proto != -1) + { + *proto_out = proto; + *toplevel_out = child; + return proxy; + } + } + } + + *proto_out = x_dnd_get_window_proto (dpyinfo, child); + return child; +#if defined HAVE_XCOMPOSITE && (XCOMPOSITE_MAJOR > 0 || XCOMPOSITE_MINOR > 2) + } + else if (dpyinfo->composite_supported_p + && (dpyinfo->composite_major > 0 + || dpyinfo->composite_minor > 2)) + { + /* Only do this if a compositing manager is present. */ + if (XGetSelectionOwner (dpyinfo->display, + dpyinfo->Xatom_NET_WM_CM_Sn) != None) + { + x_catch_errors (dpyinfo->display); + overlay_window = XCompositeGetOverlayWindow (dpyinfo->display, + dpyinfo->root_window); + XCompositeReleaseOverlayWindow (dpyinfo->display, + dpyinfo->root_window); + if (!x_had_errors_p (dpyinfo->display)) + { + XGetWindowAttributes (dpyinfo->display, overlay_window, &attrs); + + if (attrs.map_state == IsViewable) + { + proxy = x_dnd_get_window_proxy (dpyinfo, overlay_window); + + if (proxy != None) + { + proto = x_dnd_get_window_proto (dpyinfo, proxy); + + if (proto != -1) + { + *proto_out = proto; + *toplevel_out = overlay_window; + x_uncatch_errors_after_check (); + + return proxy; + } + } + } + } + x_uncatch_errors_after_check (); + } + } + + if (child != None) + { + proxy = x_dnd_get_window_proxy (dpyinfo, child); + + if (proxy) + { + proto = x_dnd_get_window_proto (dpyinfo, proxy); + + if (proto != -1) + { + *toplevel_out = child; + *proto_out = proto; + return proxy; + } + } + } + + *proto_out = x_dnd_get_window_proto (dpyinfo, child); + *toplevel_out = child; + return child; +#endif +} + +static Window +x_dnd_get_window_proxy (struct x_display_info *dpyinfo, Window wdesc) +{ + int rc, actual_format; + unsigned long actual_size, bytes_remaining; + unsigned char *tmp_data = NULL; + XWindowAttributes attrs; + Atom actual_type; + Window proxy; + + proxy = None; + x_catch_errors (dpyinfo->display); + rc = XGetWindowProperty (dpyinfo->display, wdesc, + dpyinfo->Xatom_XdndProxy, + 0, 1, False, XA_WINDOW, + &actual_type, &actual_format, + &actual_size, &bytes_remaining, + &tmp_data); + + if (!x_had_errors_p (dpyinfo->display) + && rc == Success + && tmp_data + && actual_type == XA_WINDOW + && actual_format == 32 + && actual_size == 1) + { + proxy = *(Window *) tmp_data; + + /* Verify the proxy window exists. */ + XGetWindowAttributes (dpyinfo->display, proxy, &attrs); + + if (x_had_errors_p (dpyinfo->display)) + proxy = None; + } + + if (tmp_data) + XFree (tmp_data); + x_uncatch_errors_after_check (); + + return proxy; +} + +static int +x_dnd_get_window_proto (struct x_display_info *dpyinfo, Window wdesc) +{ + Atom actual, value; + unsigned char *tmp_data = NULL; + int rc, format; + unsigned long n, left; + bool had_errors; + + if (wdesc == None || (!x_dnd_allow_current_frame + && wdesc == FRAME_OUTER_WINDOW (x_dnd_frame))) + return -1; + + x_catch_errors (dpyinfo->display); + rc = XGetWindowProperty (dpyinfo->display, wdesc, dpyinfo->Xatom_XdndAware, + 0, 1, False, XA_ATOM, &actual, &format, &n, &left, + &tmp_data); + had_errors = x_had_errors_p (dpyinfo->display); + x_uncatch_errors_after_check (); + + if (had_errors || rc != Success || actual != XA_ATOM || format != 32 || n < 1 + || !tmp_data) + { + if (tmp_data) + XFree (tmp_data); + return -1; + } + + value = (int) *(Atom *) tmp_data; + XFree (tmp_data); + + return min (X_DND_SUPPORTED_VERSION, (int) value); +} + +static void +x_dnd_send_enter (struct frame *f, Window target, int supported) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + int i; + XEvent msg; + + if (x_top_window_to_frame (dpyinfo, target)) + return; + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndEnter; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = (((unsigned int) min (X_DND_SUPPORTED_VERSION, + supported) << 24) + | (x_dnd_n_targets > 3 ? 1 : 0)); + msg.xclient.data.l[2] = 0; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + for (i = 0; i < min (3, x_dnd_n_targets); ++i) + msg.xclient.data.l[i + 2] = x_dnd_targets[i]; + + if (x_dnd_n_targets > 3) + XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + dpyinfo->Xatom_XdndTypeList, XA_ATOM, 32, + PropModeReplace, (unsigned char *) x_dnd_targets, + x_dnd_n_targets); + + x_catch_errors (dpyinfo->display); + XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); + x_uncatch_errors (); +} + +static void +x_dnd_send_position (struct frame *f, Window target, int supported, + unsigned short root_x, unsigned short root_y, + Time timestamp, Atom action, int button, + unsigned state) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + XEvent msg; + struct frame *target_frame; + int dest_x, dest_y; + Window child_return; + + target_frame = x_top_window_to_frame (dpyinfo, target); + + if (target_frame && XTranslateCoordinates (dpyinfo->display, + dpyinfo->root_window, + FRAME_X_WINDOW (target_frame), + root_x, root_y, &dest_x, + &dest_y, &child_return)) + { + x_dnd_movement_frame = target_frame; + x_dnd_movement_x = dest_x; + x_dnd_movement_y = dest_y; + return; + } + + if (target == x_dnd_mouse_rect_target + && x_dnd_mouse_rect.width + && x_dnd_mouse_rect.height) + { + if (root_x >= x_dnd_mouse_rect.x + && root_x < (x_dnd_mouse_rect.x + + x_dnd_mouse_rect.width) + && root_y >= x_dnd_mouse_rect.y + && root_y < (x_dnd_mouse_rect.y + + x_dnd_mouse_rect.height)) + return; + } + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndPosition; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = 0; + + if (supported >= 5) + { + if (button >= 4 && button <= 8) + { + msg.xclient.data.l[1] |= (1 << 9); + msg.xclient.data.l[1] |= (button - 4) << 7; + } + else if (button) + return; + + msg.xclient.data.l[1] |= state & 0x3f; + } + else if (button) + return; + + msg.xclient.data.l[2] = (root_x << 16) | root_y; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + if (supported >= 3) + msg.xclient.data.l[3] = timestamp; + + if (supported >= 4) + msg.xclient.data.l[4] = action; + + x_catch_errors (dpyinfo->display); + XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); + x_uncatch_errors (); +} + +static void +x_dnd_send_leave (struct frame *f, Window target) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + XEvent msg; + + if (x_top_window_to_frame (dpyinfo, target)) + return; + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndLeave; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = 0; + msg.xclient.data.l[2] = 0; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + x_catch_errors (dpyinfo->display); + XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); + x_uncatch_errors (); +} + +static bool +x_dnd_send_drop (struct frame *f, Window target, Time timestamp, + int supported) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + XEvent msg; + struct input_event ie; + struct frame *self_frame; + int root_x, root_y, win_x, win_y, i; + unsigned int mask; + Window root, child; + Lisp_Object lval; + char **atom_names; + char *name; + + self_frame = x_top_window_to_frame (dpyinfo, target); + + if (self_frame) + { + if (!x_dnd_allow_current_frame + && self_frame == x_dnd_frame) + return false; + + /* Send a special drag-and-drop event when dropping on top of an + Emacs frame to avoid all the overhead involved with sending + client events. */ + EVENT_INIT (ie); + + if (XQueryPointer (dpyinfo->display, FRAME_X_WINDOW (self_frame), + &root, &child, &root_x, &root_y, &win_x, &win_y, + &mask)) + { + ie.kind = DRAG_N_DROP_EVENT; + XSETFRAME (ie.frame_or_window, self_frame); + + lval = Qnil; + atom_names = alloca (x_dnd_n_targets * sizeof *atom_names); + name = XGetAtomName (dpyinfo->display, x_dnd_wanted_action); + + if (!XGetAtomNames (dpyinfo->display, x_dnd_targets, + x_dnd_n_targets, atom_names)) + { + XFree (name); + return false; + } + + for (i = x_dnd_n_targets; i != 0; --i) + { + lval = Fcons (intern (atom_names[i - 1]), lval); + XFree (atom_names[i - 1]); + } + + lval = Fcons (intern (name), lval); + lval = Fcons (QXdndSelection, lval); + ie.arg = lval; + ie.timestamp = CurrentTime; + + XSETINT (ie.x, win_x); + XSETINT (ie.y, win_y); + + XFree (name); + kbd_buffer_store_event (&ie); + + return false; + } + } + else if (x_dnd_action == None) + { + x_dnd_send_leave (f, target); + return false; + } + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndDrop; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = 0; + msg.xclient.data.l[2] = 0; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + if (supported >= 1) + msg.xclient.data.l[2] = timestamp; + + x_catch_errors (dpyinfo->display); + XSendEvent (FRAME_X_DISPLAY (f), target, False, NoEventMask, &msg); + x_uncatch_errors (); + return true; +} + +void +x_set_dnd_targets (Atom *targets, int ntargets) +{ + if (x_dnd_targets) + xfree (x_dnd_targets); + + x_dnd_targets = targets; + x_dnd_n_targets = ntargets; +} + +static void +x_dnd_cleanup_drag_and_drop (void *frame) +{ + struct frame *f = frame; + xm_drop_start_message dmsg; + + if (!x_dnd_unwind_flag) + return; + + if (x_dnd_in_progress) + { + eassert (x_dnd_frame); + + block_input (); + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (x_dnd_frame, + x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style) + && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE + && x_dnd_motif_setup_p) + { + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; + dmsg.timestamp = FRAME_DISPLAY_INFO (f)->last_user_time; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_ACTION_DROP_CANCEL); + dmsg.x = 0; + dmsg.y = 0; + dmsg.index_atom = FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection; + dmsg.source_window = FRAME_X_WINDOW (f); + + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, + x_dnd_last_seen_window, + FRAME_DISPLAY_INFO (f)->last_user_time); + xm_send_drop_message (FRAME_DISPLAY_INFO (f), FRAME_X_WINDOW (f), + x_dnd_last_seen_window, &dmsg); + } + unblock_input (); + + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + } + + x_set_dnd_targets (NULL, 0); + x_dnd_waiting_for_finish = false; + + if (x_dnd_use_toplevels) + x_dnd_free_toplevels (); + + FRAME_DISPLAY_INFO (f)->grabbed = 0; +#ifdef USE_GTK + current_hold_quit = NULL; +#endif + x_dnd_return_frame_object = NULL; + x_dnd_movement_frame = NULL; + + block_input (); + /* Restore the old event mask. */ + XSelectInput (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + x_dnd_old_window_attrs.your_event_mask); + +#ifdef HAVE_XKB + if (FRAME_DISPLAY_INFO (f)->supports_xkb) + XkbSelectEvents (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + XkbStateNotifyMask, 0); +#endif + unblock_input (); + + x_dnd_frame = NULL; +} /* Flush display of frame F. */ @@ -251,6 +3640,38 @@ x_flush (struct frame *f) unblock_input (); } +static void +x_drop_xrender_surfaces (struct frame *f) +{ + font_drop_xrender_surfaces (f); + +#ifdef HAVE_XRENDER + if (f && FRAME_X_DOUBLE_BUFFERED_P (f) + && FRAME_X_PICTURE (f) != None) + { + XRenderFreePicture (FRAME_X_DISPLAY (f), + FRAME_X_PICTURE (f)); + FRAME_X_PICTURE (f) = None; + } +#endif +} + +#ifdef HAVE_XRENDER +void +x_xr_ensure_picture (struct frame *f) +{ + if (FRAME_X_PICTURE (f) == None && FRAME_X_PICTURE_FORMAT (f)) + { + XRenderPictureAttributes attrs; + attrs.clip_mask = None; + XRenderPictFormat *fmt = FRAME_X_PICTURE_FORMAT (f); + + FRAME_X_PICTURE (f) = XRenderCreatePicture (FRAME_X_DISPLAY (f), + FRAME_X_RAW_DRAWABLE (f), + fmt, CPClipMask, &attrs); + } +} +#endif /* Remove calls to XFlush by defining XFlush to an empty replacement. Calls to XFlush should be unnecessary because the X output buffer @@ -294,14 +3715,102 @@ record_event (char *locus, int type) #endif -#ifdef USE_CAIRO +#ifdef HAVE_XINPUT2 +bool +xi_frame_selected_for (struct frame *f, unsigned long event) +{ + XIEventMask *masks; + int i; -#define FRAME_CR_CONTEXT(f) ((f)->output_data.x->cr_context) -#define FRAME_CR_SURFACE_DESIRED_WIDTH(f) \ - ((f)->output_data.x->cr_surface_desired_width) -#define FRAME_CR_SURFACE_DESIRED_HEIGHT(f) \ - ((f)->output_data.x->cr_surface_desired_height) + masks = FRAME_X_OUTPUT (f)->xi_masks; + + if (!masks) + return false; + + for (i = 0; i < FRAME_X_OUTPUT (f)->num_xi_masks; ++i) + { + if (masks[i].mask_len >= XIMaskLen (event) + && XIMaskIsSet (masks[i].mask, event)) + return true; + } + + return false; +} +#endif + +static void +x_toolkit_position (struct frame *f, int x, int y, + bool *menu_bar_p, bool *tool_bar_p) +{ +#ifdef USE_GTK + GdkRectangle test_rect; + int scale; + + y += (FRAME_MENUBAR_HEIGHT (f) + + FRAME_TOOLBAR_TOP_HEIGHT (f)); + x += FRAME_TOOLBAR_LEFT_WIDTH (f); + + if (FRAME_EXTERNAL_MENU_BAR (f)) + *menu_bar_p = (x >= 0 && x < FRAME_PIXEL_WIDTH (f) + && y >= 0 && y < FRAME_MENUBAR_HEIGHT (f)); + + if (FRAME_X_OUTPUT (f)->toolbar_widget) + { + scale = xg_get_scale (f); + test_rect.x = x / scale; + test_rect.y = y / scale; + test_rect.width = 1; + test_rect.height = 1; + + *tool_bar_p = gtk_widget_intersect (FRAME_X_OUTPUT (f)->toolbar_widget, + &test_rect, NULL); + } +#elif defined USE_X_TOOLKIT + *menu_bar_p = (x > 0 && x < FRAME_PIXEL_WIDTH (f) + && (y < 0 && y >= -FRAME_MENUBAR_HEIGHT (f))); +#else + *menu_bar_p = (WINDOWP (f->menu_bar_window) + && (x > 0 && x < FRAME_PIXEL_WIDTH (f) + && (y > 0 && y < FRAME_MENU_BAR_HEIGHT (f)))); +#endif +} + +static void +x_update_opaque_region (struct frame *f, XEvent *configure) +{ +#ifndef HAVE_GTK3 + unsigned long opaque_region[] = {0, 0, + (configure + ? configure->xconfigure.width + : FRAME_PIXEL_WIDTH (f)), + (configure + ? configure->xconfigure.height + : FRAME_PIXEL_HEIGHT (f))}; +#endif + if (!FRAME_DISPLAY_INFO (f)->alpha_bits) + return; + + block_input (); + if (f->alpha_background < 1.0) + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + NULL, 0); +#ifndef HAVE_GTK3 + else + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &opaque_region, 4); +#endif + unblock_input (); +} + + +#if defined USE_CAIRO || defined HAVE_XRENDER static struct x_gc_ext_data * x_gc_get_ext_data (struct frame *f, GC gc, int create_if_not_found_p) { @@ -334,6 +3843,346 @@ x_extension_initialize (struct x_display_info *dpyinfo) dpyinfo->ext_codes = ext_codes; } +#endif + +#ifdef USE_CAIRO + +#define FRAME_CR_CONTEXT(f) ((f)->output_data.x->cr_context) +#define FRAME_CR_SURFACE_DESIRED_WIDTH(f) \ + ((f)->output_data.x->cr_surface_desired_width) +#define FRAME_CR_SURFACE_DESIRED_HEIGHT(f) \ + ((f)->output_data.x->cr_surface_desired_height) + +#endif /* HAVE_CAIRO */ + +#ifdef HAVE_XINPUT2 + +/* Free all XI2 devices on dpyinfo. */ +static void +x_free_xi_devices (struct x_display_info *dpyinfo) +{ +#ifdef HAVE_XINPUT2_2 + struct xi_touch_point_t *tem, *last; +#endif + + block_input (); + + if (dpyinfo->num_devices) + { + for (int i = 0; i < dpyinfo->num_devices; ++i) + { +#ifdef HAVE_XINPUT2_1 + xfree (dpyinfo->devices[i].valuators); +#endif + +#ifdef HAVE_XINPUT2_2 + tem = dpyinfo->devices[i].touchpoints; + while (tem) + { + last = tem; + tem = tem->next; + xfree (last); + } +#endif + } + + xfree (dpyinfo->devices); + dpyinfo->devices = NULL; + dpyinfo->num_devices = 0; + } + + unblock_input (); +} + +static void +xi_populate_device_from_info (struct xi_device_t *xi_device, + XIDeviceInfo *device) +{ +#ifdef HAVE_XINPUT2_1 + struct xi_scroll_valuator_t *valuator; + int actual_valuator_count; + XIScrollClassInfo *info; +#endif +#ifdef HAVE_XINPUT2_2 + XITouchClassInfo *touch_info; +#endif + int c; + + xi_device->device_id = device->deviceid; + xi_device->grab = 0; + +#ifdef HAVE_XINPUT2_1 + actual_valuator_count = 0; + xi_device->valuators = + xmalloc (sizeof *xi_device->valuators * device->num_classes); +#endif +#ifdef HAVE_XINPUT2_2 + xi_device->touchpoints = NULL; +#endif + + xi_device->use = device->use; +#ifdef HAVE_XINPUT2_2 + xi_device->direct_p = false; +#endif + xi_device->name = build_string (device->name); + + for (c = 0; c < device->num_classes; ++c) + { + switch (device->classes[c]->type) + { +#ifdef HAVE_XINPUT2_1 + case XIScrollClass: + { + info = (XIScrollClassInfo *) device->classes[c]; + + valuator = &xi_device->valuators[actual_valuator_count++]; + valuator->horizontal + = (info->scroll_type == XIScrollTypeHorizontal); + valuator->invalid_p = true; + valuator->emacs_value = DBL_MIN; + valuator->increment = info->increment; + valuator->number = info->number; + valuator->pending_enter_reset = false; + + break; + } +#endif +#ifdef HAVE_XINPUT2_2 + case XITouchClass: + { + touch_info = (XITouchClassInfo *) device->classes[c]; + xi_device->direct_p = touch_info->mode == XIDirectTouch; + } +#endif + default: + break; + } + } + +#ifdef HAVE_XINPUT2_1 + xi_device->scroll_valuator_count = actual_valuator_count; +#endif +} + +/* The code below handles the tracking of scroll valuators on XInput + 2, in order to support scroll wheels that report information more + granular than a screen line. + + On X, when the XInput 2 extension is being utilized, the states of + the mouse wheels in each axis are stored as absolute values inside + "valuators" attached to each mouse device. To obtain the delta of + the scroll wheel from a motion event (which is used to report that + some valuator has changed), it is necessary to iterate over every + valuator that changed, and compare its previous value to the + current value of the valuator. + + Each individual valuator also has an "interval", which is the + amount you must divide that delta by in order to obtain a delta in + the terms of scroll units. + + This delta however is still intermediate, to make driver + implementations easier. The XInput developers recommend (and most + programs use) the following algorithm to convert from scroll unit + deltas to pixel deltas: + + pixels_scrolled = pow (window_height, 2.0 / 3.0) * delta; */ + +/* Setup valuator tracking for XI2 master devices on + DPYINFO->display. */ + +/* This function's name is a misnomer: these days, it keeps a + client-side record of all devices, which includes basic information + about the device and also touchscreen tracking information, instead + of just scroll valuators. */ + +static void +x_init_master_valuators (struct x_display_info *dpyinfo) +{ + int ndevices, actual_devices; + XIDeviceInfo *infos; + + actual_devices = 0; + block_input (); + x_free_xi_devices (dpyinfo); + infos = XIQueryDevice (dpyinfo->display, + XIAllDevices, + &ndevices); + + if (!ndevices) + { + XIFreeDeviceInfo (infos); + unblock_input (); + return; + } + + dpyinfo->devices = xmalloc (sizeof *dpyinfo->devices * ndevices); + + for (int i = 0; i < ndevices; ++i) + { + if (infos[i].enabled) + xi_populate_device_from_info (&dpyinfo->devices[actual_devices++], + &infos[i]); + } + + dpyinfo->num_devices = actual_devices; + XIFreeDeviceInfo (infos); + unblock_input (); +} + +#ifdef HAVE_XINPUT2_1 +/* Return the delta of the scroll valuator VALUATOR_NUMBER under + DEVICE in the display DPYINFO with VALUE. The valuator's valuator + will be set to VALUE afterwards. In case no scroll valuator is + found, or if the valuator state is invalid (see the comment under + XI_Enter in handle_one_xevent). Otherwise, the valuator is + returned in VALUATOR_RETURN. */ +static double +x_get_scroll_valuator_delta (struct x_display_info *dpyinfo, + struct xi_device_t *device, + int valuator_number, double value, + struct xi_scroll_valuator_t **valuator_return) +{ + struct xi_scroll_valuator_t *sv; + double delta; + int i; + + for (i = 0; i < device->scroll_valuator_count; ++i) + { + sv = &device->valuators[i]; + + if (sv->number == valuator_number) + { + *valuator_return = sv; + + if (sv->increment == 0) + return DBL_MAX; + + if (sv->invalid_p) + { + sv->current_value = value; + sv->invalid_p = false; + + return DBL_MAX; + } + else + { + delta = (sv->current_value - value) / sv->increment; + sv->current_value = value; + + return delta; + } + } + } + + return DBL_MAX; +} + +#endif + +struct xi_device_t * +xi_device_from_id (struct x_display_info *dpyinfo, int deviceid) +{ + for (int i = 0; i < dpyinfo->num_devices; ++i) + { + if (dpyinfo->devices[i].device_id == deviceid) + return &dpyinfo->devices[i]; + } + + return NULL; +} + +#ifdef HAVE_XINPUT2_2 + +static void +xi_link_touch_point (struct xi_device_t *device, + int detail, double x, double y) +{ + struct xi_touch_point_t *touchpoint; + + touchpoint = xmalloc (sizeof *touchpoint); + touchpoint->next = device->touchpoints; + touchpoint->x = x; + touchpoint->y = y; + touchpoint->number = detail; + + device->touchpoints = touchpoint; +} + +static bool +xi_unlink_touch_point (int detail, + struct xi_device_t *device) +{ + struct xi_touch_point_t *last, *tem; + + for (last = NULL, tem = device->touchpoints; tem; + last = tem, tem = tem->next) + { + if (tem->number == detail) + { + if (!last) + device->touchpoints = tem->next; + else + last->next = tem->next; + + xfree (tem); + return true; + } + } + + return false; +} + +static struct xi_touch_point_t * +xi_find_touch_point (struct xi_device_t *device, int detail) +{ + struct xi_touch_point_t *point; + + for (point = device->touchpoints; point; point = point->next) + { + if (point->number == detail) + return point; + } + + return NULL; +} + +#endif /* HAVE_XINPUT2_2 */ + +#ifdef HAVE_XINPUT2_1 + +static void +xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id, + bool pending_only) +{ + struct xi_device_t *device = xi_device_from_id (dpyinfo, id); + struct xi_scroll_valuator_t *valuator; + + if (!device) + return; + + if (!device->scroll_valuator_count) + return; + + for (int i = 0; i < device->scroll_valuator_count; ++i) + { + valuator = &device->valuators[i]; + + if (pending_only && !valuator->pending_enter_reset) + continue; + + valuator->pending_enter_reset = false; + valuator->invalid_p = true; + valuator->emacs_value = 0.0; + } + + return; +} + +#endif /* HAVE_XINPUT2_1 */ + +#endif + +#ifdef USE_CAIRO void x_cr_destroy_frame_context (struct frame *f) @@ -385,11 +4234,19 @@ x_begin_cr_clip (struct frame *f, GC gc) { int width = FRAME_CR_SURFACE_DESIRED_WIDTH (f); int height = FRAME_CR_SURFACE_DESIRED_HEIGHT (f); - cairo_surface_t *surface - = cairo_xlib_surface_create (FRAME_X_DISPLAY (f), - FRAME_X_RAW_DRAWABLE (f), - FRAME_X_VISUAL (f), - width, height); + cairo_surface_t *surface; +#ifdef USE_CAIRO_XCB_SURFACE + if (FRAME_DISPLAY_INFO (f)->xcb_visual) + surface = cairo_xcb_surface_create (FRAME_DISPLAY_INFO (f)->xcb_connection, + (xcb_drawable_t) FRAME_X_RAW_DRAWABLE (f), + FRAME_DISPLAY_INFO (f)->xcb_visual, + width, height); + else +#endif + surface = cairo_xlib_surface_create (FRAME_X_DISPLAY (f), + FRAME_X_RAW_DRAWABLE (f), + FRAME_X_VISUAL (f), + width, height); cr = FRAME_CR_CONTEXT (f) = cairo_create (surface); cairo_surface_destroy (surface); @@ -409,29 +4266,65 @@ x_end_cr_clip (struct frame *f) } void -x_set_cr_source_with_gc_foreground (struct frame *f, GC gc) +x_set_cr_source_with_gc_foreground (struct frame *f, GC gc, + bool respect_alpha_background) { XGCValues xgcv; XColor color; + unsigned int depth; XGetGCValues (FRAME_X_DISPLAY (f), gc, GCForeground, &xgcv); color.pixel = xgcv.foreground; x_query_colors (f, &color, 1); - cairo_set_source_rgb (FRAME_CR_CONTEXT (f), color.red / 65535.0, - color.green / 65535.0, color.blue / 65535.0); + depth = FRAME_DISPLAY_INFO (f)->n_planes; + + if (f->alpha_background < 1.0 && depth == 32 + && respect_alpha_background) + { + cairo_set_source_rgba (FRAME_CR_CONTEXT (f), color.red / 65535.0, + color.green / 65535.0, color.blue / 65535.0, + f->alpha_background); + + cairo_set_operator (FRAME_CR_CONTEXT (f), CAIRO_OPERATOR_SOURCE); + } + else + { + cairo_set_source_rgb (FRAME_CR_CONTEXT (f), color.red / 65535.0, + color.green / 65535.0, color.blue / 65535.0); + cairo_set_operator (FRAME_CR_CONTEXT (f), CAIRO_OPERATOR_OVER); + } } void -x_set_cr_source_with_gc_background (struct frame *f, GC gc) +x_set_cr_source_with_gc_background (struct frame *f, GC gc, + bool respect_alpha_background) { XGCValues xgcv; XColor color; + unsigned int depth; XGetGCValues (FRAME_X_DISPLAY (f), gc, GCBackground, &xgcv); color.pixel = xgcv.background; + x_query_colors (f, &color, 1); - cairo_set_source_rgb (FRAME_CR_CONTEXT (f), color.red / 65535.0, - color.green / 65535.0, color.blue / 65535.0); + + depth = FRAME_DISPLAY_INFO (f)->n_planes; + + if (f->alpha_background < 1.0 && depth == 32 + && respect_alpha_background) + { + cairo_set_source_rgba (FRAME_CR_CONTEXT (f), color.red / 65535.0, + color.green / 65535.0, color.blue / 65535.0, + f->alpha_background); + + cairo_set_operator (FRAME_CR_CONTEXT (f), CAIRO_OPERATOR_SOURCE); + } + else + { + cairo_set_source_rgb (FRAME_CR_CONTEXT (f), color.red / 65535.0, + color.green / 65535.0, color.blue / 65535.0); + cairo_set_operator (FRAME_CR_CONTEXT (f), CAIRO_OPERATOR_OVER); + } } static const cairo_user_data_key_t xlib_surface_key, saved_drawable_key; @@ -458,6 +4351,9 @@ x_try_cr_xlib_drawable (struct frame *f, GC gc) switch (cairo_surface_get_type (surface)) { case CAIRO_SURFACE_TYPE_XLIB: +#ifdef USE_CAIRO_XCB_SURFACE + case CAIRO_SURFACE_TYPE_XCB: +#endif cairo_surface_flush (surface); return true; @@ -613,7 +4509,7 @@ x_cr_draw_image (struct frame *f, GC gc, cairo_pattern_t *image, cairo_rectangle (cr, dest_x, dest_y, width, height); else { - x_set_cr_source_with_gc_background (f, gc); + x_set_cr_source_with_gc_background (f, gc, false); cairo_rectangle (cr, dest_x, dest_y, width, height); cairo_fill_preserve (cr); } @@ -630,7 +4526,7 @@ x_cr_draw_image (struct frame *f, GC gc, cairo_pattern_t *image, } else { - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, false); cairo_clip (cr); cairo_mask (cr, image); } @@ -681,7 +4577,7 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) int width, height; void (*surface_set_size_func) (cairo_surface_t *, double, double) = NULL; Lisp_Object acc = Qnil; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (31); @@ -767,11 +4663,37 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) #endif /* USE_CAIRO */ +#if defined HAVE_XRENDER +void +x_xr_apply_ext_clip (struct frame *f, GC gc) +{ + eassert (FRAME_X_PICTURE (f) != None); + + struct x_gc_ext_data *data = x_gc_get_ext_data (f, gc, 1); + + if (data->n_clip_rects) + XRenderSetPictureClipRectangles (FRAME_X_DISPLAY (f), + FRAME_X_PICTURE (f), + 0, 0, data->clip_rects, + data->n_clip_rects); +} + +void +x_xr_reset_ext_clip (struct frame *f) +{ + XRenderPictureAttributes attrs = { .clip_mask = None }; + + XRenderChangePicture (FRAME_X_DISPLAY (f), + FRAME_X_PICTURE (f), + CPClipMask, &attrs); +} +#endif + static void x_set_clip_rectangles (struct frame *f, GC gc, XRectangle *rectangles, int n) { XSetClipRectangles (FRAME_X_DISPLAY (f), gc, 0, 0, rectangles, n, Unsorted); -#ifdef USE_CAIRO +#if defined USE_CAIRO || defined HAVE_XRENDER eassert (n >= 0 && n <= MAX_CLIP_RECTS); { @@ -787,7 +4709,7 @@ static void x_reset_clip_rectangles (struct frame *f, GC gc) { XSetClipMask (FRAME_X_DISPLAY (f), gc, None); -#ifdef USE_CAIRO +#if defined USE_CAIRO || defined HAVE_XRENDER { struct x_gc_ext_data *gc_ext = x_gc_get_ext_data (f, gc, 0); @@ -797,8 +4719,71 @@ x_reset_clip_rectangles (struct frame *f, GC gc) #endif } +#ifdef HAVE_XRENDER +# if !defined USE_CAIRO && (RENDER_MAJOR > 0 || RENDER_MINOR >= 2) +static void +x_xrender_color_from_gc_foreground (struct frame *f, GC gc, XRenderColor *color, + bool apply_alpha_background) +{ + XGCValues xgcv; + XColor xc; + + XGetGCValues (FRAME_X_DISPLAY (f), gc, GCForeground, &xgcv); + xc.pixel = xgcv.foreground; + x_query_colors (f, &xc, 1); + + color->alpha = (apply_alpha_background + ? 65535 * f->alpha_background + : 65535); + + if (color->alpha == 65535) + { + color->red = xc.red; + color->blue = xc.blue; + color->green = xc.green; + } + else + { + color->red = (xc.red * color->alpha) / 65535; + color->blue = (xc.blue * color->alpha) / 65535; + color->green = (xc.green * color->alpha) / 65535; + } +} +# endif + +void +x_xrender_color_from_gc_background (struct frame *f, GC gc, XRenderColor *color, + bool apply_alpha_background) +{ + XGCValues xgcv; + XColor xc; + + XGetGCValues (FRAME_X_DISPLAY (f), gc, GCBackground, &xgcv); + xc.pixel = xgcv.background; + x_query_colors (f, &xc, 1); + + color->alpha = (apply_alpha_background + ? 65535 * f->alpha_background + : 65535); + + if (color->alpha == 65535) + { + color->red = xc.red; + color->blue = xc.blue; + color->green = xc.green; + } + else + { + color->red = (xc.red * color->alpha) / 65535; + color->blue = (xc.blue * color->alpha) / 65535; + color->green = (xc.green * color->alpha) / 65535; + } +} +#endif + static void -x_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) +x_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height, + bool respect_alpha_background) { #ifdef USE_CAIRO Display *dpy = FRAME_X_DISPLAY (f); @@ -814,7 +4799,7 @@ x_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) regarded as Pixmap of unspecified size filled with ones. */ || (xgcv.stipple & ((Pixmap) 7 << (sizeof (Pixmap) * CHAR_BIT - 3)))) { - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, respect_alpha_background); cairo_rectangle (cr, x, y, width, height); cairo_fill (cr); } @@ -822,25 +4807,139 @@ x_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) { eassert (xgcv.fill_style == FillOpaqueStippled); eassert (xgcv.stipple != None); - x_set_cr_source_with_gc_background (f, gc); + x_set_cr_source_with_gc_background (f, gc, respect_alpha_background); cairo_rectangle (cr, x, y, width, height); cairo_fill_preserve (cr); cairo_pattern_t *pattern = x_bitmap_stipple (f, xgcv.stipple); if (pattern) { - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, respect_alpha_background); cairo_clip (cr); cairo_mask (cr, pattern); } } x_end_cr_clip (f); #else +#if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) + if (respect_alpha_background + && f->alpha_background != 1.0 + && FRAME_DISPLAY_INFO (f)->alpha_bits + && FRAME_CHECK_XR_VERSION (f, 0, 2)) + { + x_xr_ensure_picture (f); + + if (FRAME_X_PICTURE (f) != None) + { + XRenderColor xc; + +#if RENDER_MAJOR > 0 || (RENDER_MINOR >= 10) + XGCValues xgcv; + XRenderPictureAttributes attrs; + XRenderColor alpha; + Picture stipple, fill; +#endif + + x_xr_apply_ext_clip (f, gc); + +#if RENDER_MAJOR > 0 || (RENDER_MINOR >= 10) + XGetGCValues (FRAME_X_DISPLAY (f), + gc, GCFillStyle | GCStipple, &xgcv); + + if (xgcv.fill_style == FillOpaqueStippled + && FRAME_CHECK_XR_VERSION (f, 0, 10)) + { + x_xrender_color_from_gc_background (f, gc, &alpha, true); + x_xrender_color_from_gc_foreground (f, gc, &xc, true); + attrs.repeat = RepeatNormal; + + stipple = XRenderCreatePicture (FRAME_X_DISPLAY (f), + xgcv.stipple, + XRenderFindStandardFormat (FRAME_X_DISPLAY (f), + PictStandardA1), + CPRepeat, &attrs); + + XRenderFillRectangle (FRAME_X_DISPLAY (f), PictOpSrc, + FRAME_X_PICTURE (f), + &alpha, x, y, width, height); + + fill = XRenderCreateSolidFill (FRAME_X_DISPLAY (f), &xc); + + XRenderComposite (FRAME_X_DISPLAY (f), PictOpOver, fill, stipple, + FRAME_X_PICTURE (f), 0, 0, x, y, x, y, width, height); + + XRenderFreePicture (FRAME_X_DISPLAY (f), stipple); + XRenderFreePicture (FRAME_X_DISPLAY (f), fill); + } + else +#endif + { + x_xrender_color_from_gc_foreground (f, gc, &xc, true); + XRenderFillRectangle (FRAME_X_DISPLAY (f), + PictOpSrc, FRAME_X_PICTURE (f), + &xc, x, y, width, height); + } + x_xr_reset_ext_clip (f); + x_mark_frame_dirty (f); + + return; + } + } +#endif XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), gc, x, y, width, height); #endif } + +static void +x_clear_rectangle (struct frame *f, GC gc, int x, int y, int width, int height, + bool respect_alpha_background) +{ +#ifdef USE_CAIRO + cairo_t *cr; + + cr = x_begin_cr_clip (f, gc); + x_set_cr_source_with_gc_background (f, gc, respect_alpha_background); + cairo_rectangle (cr, x, y, width, height); + cairo_fill (cr); + x_end_cr_clip (f); +#else +#if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) + if (respect_alpha_background + && f->alpha_background != 1.0 + && FRAME_DISPLAY_INFO (f)->alpha_bits + && FRAME_CHECK_XR_VERSION (f, 0, 2)) + { + x_xr_ensure_picture (f); + + if (FRAME_X_PICTURE (f) != None) + { + XRenderColor xc; + + x_xr_apply_ext_clip (f, gc); + x_xrender_color_from_gc_background (f, gc, &xc, true); + XRenderFillRectangle (FRAME_X_DISPLAY (f), + PictOpSrc, FRAME_X_PICTURE (f), + &xc, x, y, width, height); + x_xr_reset_ext_clip (f); + x_mark_frame_dirty (f); + + return; + } + } +#endif + + XGCValues xgcv; + Display *dpy = FRAME_X_DISPLAY (f); + XGetGCValues (dpy, gc, GCBackground | GCForeground, &xgcv); + XSetForeground (dpy, gc, xgcv.background); + XFillRectangle (dpy, FRAME_X_DRAWABLE (f), + gc, x, y, width, height); + XSetForeground (dpy, gc, xgcv.foreground); +#endif +} + static void x_draw_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) { @@ -848,7 +4947,7 @@ x_draw_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) cairo_t *cr; cr = x_begin_cr_clip (f, gc); - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, false); cairo_rectangle (cr, x + 0.5, y + 0.5, width, height); cairo_set_line_width (cr, 1); cairo_stroke (cr); @@ -866,15 +4965,19 @@ x_clear_window (struct frame *f) cairo_t *cr; cr = x_begin_cr_clip (f, NULL); - x_set_cr_source_with_gc_background (f, f->output_data.x->normal_gc); + x_set_cr_source_with_gc_background (f, f->output_data.x->normal_gc, true); cairo_paint (cr); x_end_cr_clip (f); #else - if (FRAME_X_DOUBLE_BUFFERED_P (f)) +#ifndef USE_GTK + if (FRAME_X_DOUBLE_BUFFERED_P (f) || (f->alpha_background != 1.0)) +#endif x_clear_area (f, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); +#ifndef USE_GTK else XClearWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); #endif +#endif } #ifdef USE_CAIRO @@ -885,7 +4988,7 @@ x_fill_trapezoid_for_relief (struct frame *f, GC gc, int x, int y, cairo_t *cr; cr = x_begin_cr_clip (f, gc); - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, false); cairo_move_to (cr, top_p ? x : x + height, y); cairo_line_to (cr, x, y + height); cairo_line_to (cr, top_p ? x + width - height : x + width, y + height); @@ -912,7 +5015,7 @@ x_erase_corners_for_relief (struct frame *f, GC gc, int x, int y, int i; cr = x_begin_cr_clip (f, gc); - x_set_cr_source_with_gc_background (f, gc); + x_set_cr_source_with_gc_background (f, gc, false); for (i = 0; i < CORNER_LAST; i++) if (corners & (1 << i)) { @@ -945,7 +5048,7 @@ x_draw_horizontal_wave (struct frame *f, GC gc, int x, int y, int xoffset, n; cr = x_begin_cr_clip (f, gc); - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, false); cairo_rectangle (cr, x, y, width, height); cairo_clip (cr); @@ -1067,7 +5170,7 @@ x_set_frame_alpha (struct frame *f) /* return unless necessary */ { - unsigned char *data; + unsigned char *data = NULL; Atom actual; int rc, format; unsigned long n, left; @@ -1077,16 +5180,19 @@ x_set_frame_alpha (struct frame *f) &actual, &format, &n, &left, &data); - if (rc == Success && actual != None) + if (rc == Success && actual != None && data) { - unsigned long value = *(unsigned long *)data; - XFree (data); + unsigned long value = *(unsigned long *) data; if (value == opac) { x_uncatch_errors (); + XFree (data); return; } } + + if (data) + XFree (data); } XChangeProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity, @@ -1125,7 +5231,7 @@ x_draw_vertical_window_border (struct window *w, int x, int y0, int y1) face->foreground); #ifdef USE_CAIRO - x_fill_rectangle (f, f->output_data.x->normal_gc, x, y0, 1, y1 - y0); + x_fill_rectangle (f, f->output_data.x->normal_gc, x, y0, 1, y1 - y0, false); #else XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), f->output_data.x->normal_gc, x, y0, x, y1); @@ -1158,13 +5264,13 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) { XSetForeground (display, f->output_data.x->normal_gc, color_first); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0, y0, 1, y1 - y0); + x0, y0, 1, y1 - y0, false); XSetForeground (display, f->output_data.x->normal_gc, color); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0 + 1, y0, x1 - x0 - 2, y1 - y0); + x0 + 1, y0, x1 - x0 - 2, y1 - y0, false); XSetForeground (display, f->output_data.x->normal_gc, color_last); x_fill_rectangle (f, f->output_data.x->normal_gc, - x1 - 1, y0, 1, y1 - y0); + x1 - 1, y0, 1, y1 - y0, false); } else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) /* A horizontal divider, at least three pixels high: Draw first and @@ -1172,13 +5278,13 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) { XSetForeground (display, f->output_data.x->normal_gc, color_first); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0, y0, x1 - x0, 1); + x0, y0, x1 - x0, 1, false); XSetForeground (display, f->output_data.x->normal_gc, color); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0, y0 + 1, x1 - x0, y1 - y0 - 2); + x0, y0 + 1, x1 - x0, y1 - y0 - 2, false); XSetForeground (display, f->output_data.x->normal_gc, color_last); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0, y1 - 1, x1 - x0, 1); + x0, y1 - 1, x1 - x0, 1, false); } else { @@ -1186,7 +5292,7 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) differently. */ XSetForeground (display, f->output_data.x->normal_gc, color); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0, y0, x1 - x0, y1 - y0); + x0, y0, x1 - x0, y1 - y0, false); } } @@ -1262,11 +5368,70 @@ x_update_end (struct frame *f) static void XTframe_up_to_date (struct frame *f) { +#if defined HAVE_XSYNC && !defined HAVE_GTK3 + XSyncValue add; + XSyncValue current; + Bool overflow_p; +#elif defined HAVE_XSYNC + GtkWidget *widget; + GdkWindow *window; + GdkFrameClock *clock; +#endif + eassert (FRAME_X_P (f)); block_input (); FRAME_MOUSE_UPDATE (f); if (!buffer_flipping_blocked_p () && FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); + +#ifdef HAVE_XSYNC +#ifndef HAVE_GTK3 + if (FRAME_X_OUTPUT (f)->sync_end_pending_p + && FRAME_X_BASIC_COUNTER (f) != None) + { + XSyncSetCounter (FRAME_X_DISPLAY (f), + FRAME_X_BASIC_COUNTER (f), + FRAME_X_OUTPUT (f)->pending_basic_counter_value); + FRAME_X_OUTPUT (f)->sync_end_pending_p = false; + } + + if (FRAME_X_OUTPUT (f)->ext_sync_end_pending_p + && FRAME_X_EXTENDED_COUNTER (f) != None) + { + current = FRAME_X_OUTPUT (f)->current_extended_counter_value; + + if (XSyncValueLow32 (current) % 2) + XSyncIntToValue (&add, 1); + else + XSyncIntToValue (&add, 2); + + XSyncValueAdd (&FRAME_X_OUTPUT (f)->current_extended_counter_value, + current, add, &overflow_p); + + if (overflow_p) + emacs_abort (); + + XSyncSetCounter (FRAME_X_DISPLAY (f), + FRAME_X_EXTENDED_COUNTER (f), + FRAME_X_OUTPUT (f)->current_extended_counter_value); + + FRAME_X_OUTPUT (f)->ext_sync_end_pending_p = false; + } +#else + if (FRAME_X_OUTPUT (f)->xg_sync_end_pending_p) + { + widget = FRAME_GTK_OUTER_WIDGET (f); + window = gtk_widget_get_window (widget); + eassert (window); + clock = gdk_window_get_frame_clock (window); + eassert (clock); + + gdk_frame_clock_request_phase (clock, + GDK_FRAME_CLOCK_PHASE_AFTER_PAINT); + FRAME_X_OUTPUT (f)->xg_sync_end_pending_p = false; + } +#endif +#endif unblock_input (); } @@ -1311,10 +5476,10 @@ x_clear_under_internal_border (struct frame *f) GC gc = f->output_data.x->normal_gc; XSetForeground (display, gc, color); - x_fill_rectangle (f, gc, 0, margin, width, border); - x_fill_rectangle (f, gc, 0, 0, border, height); - x_fill_rectangle (f, gc, width - border, 0, border, height); - x_fill_rectangle (f, gc, 0, height - border, width, border); + x_fill_rectangle (f, gc, 0, margin, width, border, false); + x_fill_rectangle (f, gc, 0, 0, border, height, false); + x_fill_rectangle (f, gc, width - border, 0, border, height, false); + x_fill_rectangle (f, gc, 0, height - border, width, border, false); XSetForeground (display, gc, FRAME_FOREGROUND_PIXEL (f)); } else @@ -1381,9 +5546,9 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row) GC gc = f->output_data.x->normal_gc; XSetForeground (display, gc, color); - x_fill_rectangle (f, gc, 0, y, width, height); + x_fill_rectangle (f, gc, 0, y, width, height, true); x_fill_rectangle (f, gc, FRAME_PIXEL_WIDTH (f) - width, y, - width, height); + width, height, true); XSetForeground (display, gc, FRAME_FOREGROUND_PIXEL (f)); } else @@ -1417,9 +5582,10 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring if (face->stipple) XSetFillStyle (display, face->gc, FillOpaqueStippled); else - XSetForeground (display, face->gc, face->background); + XSetBackground (display, face->gc, face->background); - x_fill_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny); + x_clear_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny, + true); if (!face->stipple) XSetForeground (display, face->gc, face->foreground); @@ -1458,15 +5624,40 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring { Drawable drawable = FRAME_X_DRAWABLE (f); char *bits; - Pixmap pixmap, clipmask = (Pixmap) 0; - int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f)); + Pixmap pixmap, clipmask = None; + int depth = FRAME_DISPLAY_INFO (f)->n_planes; XGCValues gcv; + unsigned long background = face->background; + XColor bg; +#ifdef HAVE_XRENDER + Picture picture = None; + XRenderPictureAttributes attrs; + + memset (&attrs, 0, sizeof attrs); +#endif if (p->wd > 8) bits = (char *) (p->bits + p->dh); else bits = (char *) p->bits + p->dh; + if (FRAME_DISPLAY_INFO (f)->alpha_bits + && f->alpha_background < 1.0) + { + bg.pixel = background; + x_query_colors (f, &bg, 1); + bg.red *= f->alpha_background; + bg.green *= f->alpha_background; + bg.blue *= f->alpha_background; + + background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f), + bg.red, bg.green, bg.blue); + background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask; + background |= (((unsigned long) (f->alpha_background * 0xffff) + >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) + << FRAME_DISPLAY_INFO (f)->alpha_offset); + } + /* Draw the bitmap. I believe these small pixmaps can be cached by the server. */ pixmap = XCreatePixmapFromBitmapData (display, drawable, bits, p->wd, p->h, @@ -1474,7 +5665,15 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring ? (p->overlay_p ? face->background : f->output_data.x->cursor_pixel) : face->foreground), - face->background, depth); + background, depth); + +#ifdef HAVE_XRENDER + if (FRAME_X_PICTURE_FORMAT (f) + && (x_xr_ensure_picture (f), FRAME_X_PICTURE (f))) + picture = XRenderCreatePicture (display, pixmap, + FRAME_X_PICTURE_FORMAT (f), + 0, &attrs); +#endif if (p->overlay_p) { @@ -1482,14 +5681,43 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring FRAME_DISPLAY_INFO (f)->root_window, bits, p->wd, p->h, 1, 0, 1); - gcv.clip_mask = clipmask; - gcv.clip_x_origin = p->x; - gcv.clip_y_origin = p->y; - XChangeGC (display, gc, GCClipMask | GCClipXOrigin | GCClipYOrigin, &gcv); + +#ifdef HAVE_XRENDER + if (picture != None) + { + attrs.clip_mask = clipmask; + attrs.clip_x_origin = p->x; + attrs.clip_y_origin = p->y; + + XRenderChangePicture (display, FRAME_X_PICTURE (f), + CPClipMask | CPClipXOrigin | CPClipYOrigin, + &attrs); + } + else +#endif + { + gcv.clip_mask = clipmask; + gcv.clip_x_origin = p->x; + gcv.clip_y_origin = p->y; + XChangeGC (display, gc, GCClipMask | GCClipXOrigin | GCClipYOrigin, &gcv); + } } - XCopyArea (display, pixmap, drawable, gc, 0, 0, - p->wd, p->h, p->x, p->y); +#ifdef HAVE_XRENDER + if (picture != None) + { + x_xr_apply_ext_clip (f, gc); + XRenderComposite (display, PictOpSrc, picture, + None, FRAME_X_PICTURE (f), + 0, 0, 0, 0, p->x, p->y, p->wd, p->h); + x_xr_reset_ext_clip (f); + + XRenderFreePicture (display, picture); + } + else +#endif + XCopyArea (display, pixmap, drawable, gc, 0, 0, + p->wd, p->h, p->x, p->y); XFreePixmap (display, pixmap); if (p->overlay_p) @@ -1516,6 +5744,85 @@ static void x_scroll_bar_clear (struct frame *); static void x_check_font (struct frame *, struct font *); #endif +static void +x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time) +{ +#ifndef USE_GTK + struct frame *focus_frame = dpyinfo->x_focus_frame; + struct x_output *output; +#endif + +#ifdef ENABLE_CHECKING + eassert (time <= X_ULONG_MAX); +#endif + dpyinfo->last_user_time = time; + +#ifndef USE_GTK + if (focus_frame + && (dpyinfo->last_user_time + > (dpyinfo->last_user_check_time + 2000))) + { + output = FRAME_X_OUTPUT (focus_frame); + + if (!x_wm_supports (focus_frame, + dpyinfo->Xatom_net_wm_user_time_window)) + { + if (output->user_time_window == None) + output->user_time_window = FRAME_OUTER_WINDOW (focus_frame); + else if (output->user_time_window != FRAME_OUTER_WINDOW (focus_frame)) + { + XDestroyWindow (dpyinfo->display, + output->user_time_window); + XDeleteProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (focus_frame), + dpyinfo->Xatom_net_wm_user_time_window); + output->user_time_window = FRAME_OUTER_WINDOW (focus_frame); + } + } + else + { + if (output->user_time_window == FRAME_OUTER_WINDOW (focus_frame) + || output->user_time_window == None) + { + XSetWindowAttributes attrs; + memset (&attrs, 0, sizeof attrs); + + output->user_time_window + = XCreateWindow (dpyinfo->display, + FRAME_X_WINDOW (focus_frame), + -1, -1, 1, 1, 0, 0, InputOnly, + CopyFromParent, 0, &attrs); + + XDeleteProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (focus_frame), + dpyinfo->Xatom_net_wm_user_time); + XChangeProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (focus_frame), + dpyinfo->Xatom_net_wm_user_time_window, + XA_WINDOW, 32, PropModeReplace, + (unsigned char *) &output->user_time_window, + 1); + } + } + + dpyinfo->last_user_check_time = time; + } + + if (focus_frame) + { + while (FRAME_PARENT_FRAME (focus_frame)) + focus_frame = FRAME_PARENT_FRAME (focus_frame); + + if (FRAME_X_OUTPUT (focus_frame)->user_time_window != None) + XChangeProperty (dpyinfo->display, + FRAME_X_OUTPUT (focus_frame)->user_time_window, + dpyinfo->Xatom_net_wm_user_time, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &time, 1); + } +#endif +} + /* Set S->gc to a suitable GC for drawing glyph string S in cursor face. */ @@ -1575,22 +5882,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 @@ -1748,12 +6039,7 @@ x_compute_glyph_string_overhangs (struct glyph_string *s) static void x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h) { - Display *display = FRAME_X_DISPLAY (s->f); - XGCValues xgcv; - XGetGCValues (display, s->gc, GCForeground | GCBackground, &xgcv); - XSetForeground (display, s->gc, xgcv.background); - x_fill_rectangle (s->f, s->gc, x, y, w, h); - XSetForeground (display, s->gc, xgcv.foreground); + x_clear_rectangle (s->f, s->gc, x, y, w, h, s->hl != DRAW_CURSOR); } @@ -1779,9 +6065,10 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p) /* Fill background with a stipple pattern. */ XSetFillStyle (display, s->gc, FillOpaqueStippled); x_fill_rectangle (s->f, s->gc, s->x, - s->y + box_line_width, - s->background_width, - s->height - 2 * box_line_width); + s->y + box_line_width, + s->background_width, + s->height - 2 * box_line_width, + s->hl != DRAW_CURSOR); XSetFillStyle (display, s->gc, FillSolid); s->background_filled_p = true; } @@ -1876,7 +6163,8 @@ x_draw_glyph_string_foreground (struct glyph_string *s) x_fill_rectangle (s->f, s->gc, s->x, s->y + box_line_width, s->background_width, - s->height - 2 * box_line_width); + s->height - 2 * box_line_width, + false); XSetFillStyle (display, s->gc, FillSolid); } else @@ -2299,8 +6587,7 @@ x_color_cells (Display *dpy, int *ncells) if (dpyinfo->color_cells == NULL) { - Screen *screen = dpyinfo->screen; - int ncolor_cells = XDisplayCells (dpy, XScreenNumberOfScreen (screen)); + int ncolor_cells = dpyinfo->visual_info.colormap_size; int i; dpyinfo->color_cells = xnmalloc (ncolor_cells, @@ -2326,12 +6613,12 @@ void x_query_colors (struct frame *f, XColor *colors, int ncolors) { struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + int i; if (dpyinfo->red_bits > 0) { /* For TrueColor displays, we can decompose the RGB value directly. */ - int i; unsigned int rmult, gmult, bmult; unsigned int rmask, gmask, bmask; @@ -2387,12 +6674,45 @@ x_query_colors (struct frame *f, XColor *colors, int ncolors) XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), colors, ncolors); } -/* Store F's background color into *BGCOLOR. */ +/* Store F's real background color into *BGCOLOR. */ static void x_query_frame_background_color (struct frame *f, XColor *bgcolor) { - bgcolor->pixel = FRAME_BACKGROUND_PIXEL (f); + unsigned long background = FRAME_BACKGROUND_PIXEL (f); +#ifndef USE_CAIRO + XColor bg; +#endif + + if (FRAME_DISPLAY_INFO (f)->alpha_bits) + { +#ifdef USE_CAIRO + background = (background & ~FRAME_DISPLAY_INFO (f)->alpha_mask); + background |= (((unsigned long) (f->alpha_background * 0xffff) + >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) + << FRAME_DISPLAY_INFO (f)->alpha_offset); +#else + if (FRAME_DISPLAY_INFO (f)->alpha_bits + && f->alpha_background < 1.0) + { + bg.pixel = background; + x_query_colors (f, &bg, 1); + bg.red *= f->alpha_background; + bg.green *= f->alpha_background; + bg.blue *= f->alpha_background; + + background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f), + bg.red, bg.green, bg.blue); + background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask; + background |= (((unsigned long) (f->alpha_background * 0xffff) + >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) + << FRAME_DISPLAY_INFO (f)->alpha_offset); + } +#endif + } + + bgcolor->pixel = background; + x_query_colors (f, bgcolor, 1); } @@ -2404,8 +6724,9 @@ x_query_frame_background_color (struct frame *f, XColor *bgcolor) and names we've actually looked up; list-colors-display is probably the most color-intensive case we're likely to hit. */ -Status x_parse_color (struct frame *f, const char *color_name, - XColor *color) +Status +x_parse_color (struct frame *f, const char *color_name, + XColor *color) { /* Don't pass #RGB strings directly to XParseColor, because that follows the X convention of zero-extending each channel @@ -2434,6 +6755,10 @@ Status x_parse_color (struct frame *f, const char *color_name, } } + /* Some X servers send BadValue on empty color names. */ + if (!strlen (color_name)) + return 0; + if (XParseColor (dpy, cmap, color_name, color) == 0) /* No caching of negative results, currently. */ return 0; @@ -2455,40 +6780,112 @@ Status x_parse_color (struct frame *f, const char *color_name, static bool x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) { + struct x_display_info *dpyinfo = x_display_info_for_display (dpy); bool rc; + eassume (dpyinfo); rc = XAllocColor (dpy, cmap, color) != 0; + + if (dpyinfo->visual_info.class == DirectColor) + return rc; + if (rc == 0) { /* If we got to this point, the colormap is full, so we're going - to try to get the next closest color. The algorithm used is + to try and get the next closest color. The algorithm used is a least-squares matching, which is what X uses for closest color matching with StaticColor visuals. */ - int nearest, i; - int max_color_delta = 255; - int max_delta = 3 * max_color_delta; - int nearest_delta = max_delta + 1; - int ncells; - const XColor *cells = x_color_cells (dpy, &ncells); - for (nearest = i = 0; i < ncells; ++i) + const XColor *cells; + int no_cells; + int nearest; + long nearest_delta, trial_delta; + int x; + Status status; + bool retry = false; + int ncolor_cells, i; + bool temp_allocated; + XColor temp; + + start: + cells = x_color_cells (dpy, &no_cells); + temp_allocated = false; + + nearest = 0; + /* I'm assuming CSE so I'm not going to condense this. */ + nearest_delta = ((((color->red >> 8) - (cells[0].red >> 8)) + * ((color->red >> 8) - (cells[0].red >> 8))) + + (((color->green >> 8) - (cells[0].green >> 8)) + * ((color->green >> 8) - (cells[0].green >> 8))) + + (((color->blue >> 8) - (cells[0].blue >> 8)) + * ((color->blue >> 8) - (cells[0].blue >> 8)))); + for (x = 1; x < no_cells; x++) { - int dred = (color->red >> 8) - (cells[i].red >> 8); - int dgreen = (color->green >> 8) - (cells[i].green >> 8); - int dblue = (color->blue >> 8) - (cells[i].blue >> 8); - int delta = dred * dred + dgreen * dgreen + dblue * dblue; - - if (delta < nearest_delta) + trial_delta = ((((color->red >> 8) - (cells[x].red >> 8)) + * ((color->red >> 8) - (cells[x].red >> 8))) + + (((color->green >> 8) - (cells[x].green >> 8)) + * ((color->green >> 8) - (cells[x].green >> 8))) + + (((color->blue >> 8) - (cells[x].blue >> 8)) + * ((color->blue >> 8) - (cells[x].blue >> 8)))); + if (trial_delta < nearest_delta) { - nearest = i; - nearest_delta = delta; + /* We didn't decide to use this color, so free it. */ + if (temp_allocated) + { + XFreeColors (dpy, cmap, &temp.pixel, 1, 0); + temp_allocated = false; + } + + temp.red = cells[x].red; + temp.green = cells[x].green; + temp.blue = cells[x].blue; + status = XAllocColor (dpy, cmap, &temp); + + if (status) + { + temp_allocated = true; + nearest = x; + nearest_delta = trial_delta; + } } } - - color->red = cells[nearest].red; + color->red = cells[nearest].red; color->green = cells[nearest].green; - color->blue = cells[nearest].blue; - rc = XAllocColor (dpy, cmap, color) != 0; + color->blue = cells[nearest].blue; + + if (!temp_allocated) + status = XAllocColor (dpy, cmap, color); + else + { + *color = temp; + status = 1; + } + + if (status == 0 && !retry) + { + /* Our private cache of color cells is probably out of date. + Refresh it here, and try to allocate the nearest color + from the new colormap. */ + + retry = true; + xfree (dpyinfo->color_cells); + + ncolor_cells = dpyinfo->visual_info.colormap_size; + + dpyinfo->color_cells = xnmalloc (ncolor_cells, + sizeof *dpyinfo->color_cells); + dpyinfo->ncolor_cells = ncolor_cells; + + for (i = 0; i < ncolor_cells; ++i) + dpyinfo->color_cells[i].pixel = i; + + XQueryColors (dpy, dpyinfo->cmap, + dpyinfo->color_cells, ncolor_cells); + + goto start; + } + + rc = status != 0; } else { @@ -2559,7 +6956,7 @@ x_copy_color (struct frame *f, unsigned long pixel) necessary and some servers don't allow it. Since we won't free a color once we've allocated it, we don't need to re-allocate it to maintain the server's reference count. */ - if (!x_mutable_colormap (FRAME_X_VISUAL (f))) + if (!x_mutable_colormap (FRAME_X_VISUAL_INFO (f))) return pixel; color.pixel = pixel; @@ -2787,7 +7184,7 @@ x_draw_relief_rect (struct frame *f, if (left_p) { x_fill_rectangle (f, top_left_gc, left_x, top_y, - vwidth, bottom_y + 1 - top_y); + vwidth, bottom_y + 1 - top_y, false); if (top_p) corners |= 1 << CORNER_TOP_LEFT; if (bot_p) @@ -2796,7 +7193,7 @@ x_draw_relief_rect (struct frame *f, if (right_p) { x_fill_rectangle (f, bottom_right_gc, right_x + 1 - vwidth, top_y, - vwidth, bottom_y + 1 - top_y); + vwidth, bottom_y + 1 - top_y, false); if (top_p) corners |= 1 << CORNER_TOP_RIGHT; if (bot_p) @@ -2806,7 +7203,7 @@ x_draw_relief_rect (struct frame *f, { if (!right_p) x_fill_rectangle (f, top_left_gc, left_x, top_y, - right_x + 1 - left_x, hwidth); + right_x + 1 - left_x, hwidth, false); else x_fill_trapezoid_for_relief (f, top_left_gc, left_x, top_y, right_x + 1 - left_x, hwidth, 1); @@ -2815,7 +7212,7 @@ x_draw_relief_rect (struct frame *f, { if (!left_p) x_fill_rectangle (f, bottom_right_gc, left_x, bottom_y + 1 - hwidth, - right_x + 1 - left_x, hwidth); + right_x + 1 - left_x, hwidth, false); else x_fill_trapezoid_for_relief (f, bottom_right_gc, left_x, bottom_y + 1 - hwidth, @@ -2823,10 +7220,10 @@ x_draw_relief_rect (struct frame *f, } if (left_p && vwidth > 1) x_fill_rectangle (f, bottom_right_gc, left_x, top_y, - 1, bottom_y + 1 - top_y); + 1, bottom_y + 1 - top_y, false); if (top_p && hwidth > 1) x_fill_rectangle (f, bottom_right_gc, left_x, top_y, - right_x + 1 - left_x, 1); + right_x + 1 - left_x, 1, false); if (corners) { XSetBackground (FRAME_X_DISPLAY (f), top_left_gc, @@ -2948,21 +7345,25 @@ x_draw_box_rect (struct glyph_string *s, /* Top. */ x_fill_rectangle (s->f, s->gc, - left_x, top_y, right_x - left_x + 1, hwidth); + left_x, top_y, right_x - left_x + 1, hwidth, + false); /* Left. */ if (left_p) x_fill_rectangle (s->f, s->gc, - left_x, top_y, vwidth, bottom_y - top_y + 1); + left_x, top_y, vwidth, bottom_y - top_y + 1, + false); /* Bottom. */ x_fill_rectangle (s->f, s->gc, - left_x, bottom_y - hwidth + 1, right_x - left_x + 1, hwidth); + left_x, bottom_y - hwidth + 1, right_x - left_x + 1, hwidth, + false); /* Right. */ if (right_p) x_fill_rectangle (s->f, s->gc, - right_x - vwidth + 1, top_y, vwidth, bottom_y - top_y + 1); + right_x - vwidth + 1, top_y, vwidth, bottom_y - top_y + 1, + false); XSetForeground (display, s->gc, xgcv.foreground); x_reset_clip_rectangles (s->f, s->gc); @@ -3046,14 +7447,15 @@ x_composite_image (struct glyph_string *s, Pixmap dest, { Display *display = FRAME_X_DISPLAY (s->f); #ifdef HAVE_XRENDER - if (s->img->picture) + if (s->img->picture && FRAME_X_PICTURE_FORMAT (s->f)) { Picture destination; XRenderPictFormat *default_format; XRenderPictureAttributes attr; + /* Pacify GCC. */ + memset (&attr, 0, sizeof attr); - default_format = XRenderFindVisualFormat (display, - DefaultVisual (display, 0)); + default_format = FRAME_X_PICTURE_FORMAT (s->f); destination = XRenderCreatePicture (display, dest, default_format, 0, &attr); @@ -3376,7 +7778,7 @@ x_draw_glyph_string_bg_rect (struct glyph_string *s, int x, int y, int w, int h) /* Fill background with a stipple pattern. */ XSetFillStyle (display, s->gc, FillOpaqueStippled); - x_fill_rectangle (s->f, s->gc, x, y, w, h); + x_fill_rectangle (s->f, s->gc, x, y, w, h, true); XSetFillStyle (display, s->gc, FillSolid); } else @@ -3432,8 +7834,7 @@ x_draw_image_glyph_string (struct glyph_string *s) /* Create a pixmap as large as the glyph string. Fill it with the background color. Copy the image to it, using its mask. Copy the temporary pixmap to the display. */ - Screen *screen = FRAME_X_SCREEN (s->f); - int depth = DefaultDepthOfScreen (screen); + int depth = FRAME_DISPLAY_INFO (s->f)->n_planes; /* Create a pixmap as large as the glyph string. */ pixmap = XCreatePixmap (display, FRAME_X_DRAWABLE (s->f), @@ -3458,12 +7859,35 @@ x_draw_image_glyph_string (struct glyph_string *s) else { XGCValues xgcv; - XGetGCValues (display, s->gc, GCForeground | GCBackground, - &xgcv); - XSetForeground (display, s->gc, xgcv.background); - XFillRectangle (display, pixmap, s->gc, - 0, 0, s->background_width, s->height); - XSetForeground (display, s->gc, xgcv.foreground); +#if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) + if (FRAME_DISPLAY_INFO (s->f)->alpha_bits + && s->f->alpha_background != 1.0 + && FRAME_CHECK_XR_VERSION (s->f, 0, 2) + && FRAME_X_PICTURE_FORMAT (s->f)) + { + XRenderColor xc; + XRenderPictureAttributes attrs; + Picture pict; + memset (&attrs, 0, sizeof attrs); + + pict = XRenderCreatePicture (display, pixmap, + FRAME_X_PICTURE_FORMAT (s->f), + 0, &attrs); + x_xrender_color_from_gc_background (s->f, s->gc, &xc, true); + XRenderFillRectangle (FRAME_X_DISPLAY (s->f), PictOpSrc, pict, + &xc, 0, 0, s->background_width, s->height); + XRenderFreePicture (display, pict); + } + else +#endif + { + XGetGCValues (display, s->gc, GCForeground | GCBackground, + &xgcv); + XSetForeground (display, s->gc, xgcv.background); + XFillRectangle (display, pixmap, s->gc, + 0, 0, s->background_width, s->height); + XSetForeground (display, s->gc, xgcv.foreground); + } } } else @@ -3582,7 +8006,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s) { /* Fill background with a stipple pattern. */ XSetFillStyle (display, gc, FillOpaqueStippled); - x_fill_rectangle (s->f, gc, x, y, w, h); + x_fill_rectangle (s->f, gc, x, y, w, h, true); XSetFillStyle (display, gc, FillSolid); } else @@ -3590,7 +8014,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s) XGCValues xgcv; XGetGCValues (display, gc, GCForeground | GCBackground, &xgcv); XSetForeground (display, gc, xgcv.background); - x_fill_rectangle (s->f, gc, x, y, w, h); + x_fill_rectangle (s->f, gc, x, y, w, h, true); XSetForeground (display, gc, xgcv.foreground); } @@ -3645,7 +8069,7 @@ x_get_scale_factor(Display *disp, int *scale_x, int *scale_y) */ static void -x_draw_underwave (struct glyph_string *s) +x_draw_underwave (struct glyph_string *s, int decoration_width) { Display *display = FRAME_X_DISPLAY (s->f); @@ -3658,7 +8082,7 @@ x_draw_underwave (struct glyph_string *s) #ifdef USE_CAIRO x_draw_horizontal_wave (s->f, s->gc, s->x, s->ybase - wave_height + 3, - s->width, wave_height, wave_length); + decoration_width, wave_height, wave_length); #else /* not USE_CAIRO */ int dx, dy, x0, y0, width, x1, y1, x2, y2, xmax, thickness = scale_y;; bool odd; @@ -3668,7 +8092,7 @@ x_draw_underwave (struct glyph_string *s) dy = wave_height - 1; x0 = s->x; y0 = s->ybase + wave_height / 2 - scale_y; - width = s->width; + width = decoration_width; xmax = x0 + width; /* Find and set clipping rectangle */ @@ -3818,20 +8242,39 @@ x_draw_glyph_string (struct glyph_string *s) if (!s->for_overlaps) { + int area_x, area_y, area_width, area_height; + int area_max_x, decoration_width; + + /* Prevent the underline from overwriting surrounding areas + and the fringe. */ + window_box (s->w, s->area, &area_x, &area_y, + &area_width, &area_height); + area_max_x = area_x + area_width - 1; + + decoration_width = s->width; + if (!s->row->mode_line_p + && !s->row->tab_line_p + && area_max_x < (s->x + decoration_width - 1)) + decoration_width -= (s->x + decoration_width - 1) - area_max_x; + + /* Draw relief if not yet drawn. */ + if (!relief_drawn_p && s->face->box != FACE_NO_BOX) + x_draw_glyph_string_box (s); + /* Draw underline. */ if (s->face->underline) { if (s->face->underline == FACE_UNDER_WAVE) { if (s->face->underline_defaulted_p) - x_draw_underwave (s); + x_draw_underwave (s, decoration_width); else { Display *display = FRAME_X_DISPLAY (s->f); XGCValues xgcv; XGetGCValues (display, s->gc, GCForeground, &xgcv); XSetForeground (display, s->gc, s->face->underline_color); - x_draw_underwave (s); + x_draw_underwave (s, decoration_width); XSetForeground (display, s->gc, xgcv.foreground); } } @@ -3840,8 +8283,12 @@ x_draw_glyph_string (struct glyph_string *s) unsigned long thickness, position; int y; - if (s->prev && - s->prev->face->underline == FACE_UNDER_LINE) + if (s->prev + && s->prev->face->underline == FACE_UNDER_LINE + && (s->prev->face->underline_at_descent_line_p + == s->face->underline_at_descent_line_p) + && (s->prev->face->underline_pixels_above_descent_line + == s->face->underline_pixels_above_descent_line)) { /* We use the same underline style as the previous one. */ thickness = s->prev->underline_thickness; @@ -3864,7 +8311,8 @@ x_draw_glyph_string (struct glyph_string *s) val = (WINDOW_BUFFER_LOCAL_VALUE (Qx_underline_at_descent_line, s->w)); underline_at_descent_line - = !(NILP (val) || EQ (val, Qunbound)); + = (!(NILP (val) || EQ (val, Qunbound)) + || s->face->underline_at_descent_line_p); val = (WINDOW_BUFFER_LOCAL_VALUE (Qx_use_underline_position_properties, s->w)); @@ -3877,7 +8325,9 @@ x_draw_glyph_string (struct glyph_string *s) else thickness = 1; if (underline_at_descent_line) - position = (s->height - thickness) - (s->ybase - s->y); + position = ((s->height - thickness) + - (s->ybase - s->y) + - s->face->underline_pixels_above_descent_line); else { /* Get the underline position. This is the @@ -3897,12 +8347,16 @@ x_draw_glyph_string (struct glyph_string *s) else position = minimum_offset; } - position = max (position, minimum_offset); + + /* Ignore minimum_offset if the amount of pixels was + explictly specified. */ + if (!s->face->underline_pixels_above_descent_line) + position = max (position, minimum_offset); } /* Check the sanity of thickness and position. We should avoid drawing underline out of the current line area. */ - if (s->y + s->height <= s->ybase + position) - position = (s->height - 1) - (s->ybase - s->y); + if (s->y + s->height <= s->ybase + position) + position = (s->height - 1) - (s->ybase - s->y); if (s->y + s->height < s->ybase + position + thickness) thickness = (s->y + s->height) - (s->ybase + position); s->underline_thickness = thickness; @@ -3910,7 +8364,8 @@ x_draw_glyph_string (struct glyph_string *s) y = s->ybase + position; if (s->face->underline_defaulted_p) x_fill_rectangle (s->f, s->gc, - s->x, y, s->width, thickness); + s->x, y, decoration_width, thickness, + false); else { Display *display = FRAME_X_DISPLAY (s->f); @@ -3918,7 +8373,8 @@ x_draw_glyph_string (struct glyph_string *s) XGetGCValues (display, s->gc, GCForeground, &xgcv); XSetForeground (display, s->gc, s->face->underline_color); x_fill_rectangle (s->f, s->gc, - s->x, y, s->width, thickness); + s->x, y, decoration_width, thickness, + false); XSetForeground (display, s->gc, xgcv.foreground); } } @@ -3930,7 +8386,7 @@ x_draw_glyph_string (struct glyph_string *s) if (s->face->overline_color_defaulted_p) x_fill_rectangle (s->f, s->gc, s->x, s->y + dy, - s->width, h); + decoration_width, h, false); else { Display *display = FRAME_X_DISPLAY (s->f); @@ -3938,7 +8394,7 @@ x_draw_glyph_string (struct glyph_string *s) XGetGCValues (display, s->gc, GCForeground, &xgcv); XSetForeground (display, s->gc, s->face->overline_color); x_fill_rectangle (s->f, s->gc, s->x, s->y + dy, - s->width, h); + decoration_width, h, false); XSetForeground (display, s->gc, xgcv.foreground); } } @@ -3960,7 +8416,7 @@ x_draw_glyph_string (struct glyph_string *s) if (s->face->strike_through_color_defaulted_p) x_fill_rectangle (s->f, s->gc, s->x, glyph_y + dy, - s->width, h); + s->width, h, false); else { Display *display = FRAME_X_DISPLAY (s->f); @@ -3968,15 +8424,11 @@ x_draw_glyph_string (struct glyph_string *s) XGetGCValues (display, s->gc, GCForeground, &xgcv); XSetForeground (display, s->gc, s->face->strike_through_color); x_fill_rectangle (s->f, s->gc, s->x, glyph_y + dy, - s->width, h); + decoration_width, h, false); XSetForeground (display, s->gc, xgcv.foreground); } } - /* Draw relief if not yet drawn. */ - if (!relief_drawn_p && s->face->box != FACE_NO_BOX) - x_draw_glyph_string_box (s); - if (s->prev) { struct glyph_string *prev; @@ -4078,20 +8530,49 @@ x_clear_area (struct frame *f, int x, int y, int width, int height) eassert (width > 0 && height > 0); cr = x_begin_cr_clip (f, NULL); - x_set_cr_source_with_gc_background (f, f->output_data.x->normal_gc); + x_set_cr_source_with_gc_background (f, f->output_data.x->normal_gc, + true); cairo_rectangle (cr, x, y, width, height); cairo_fill (cr); x_end_cr_clip (f); #else - if (FRAME_X_DOUBLE_BUFFERED_P (f)) - XFillRectangle (FRAME_X_DISPLAY (f), - FRAME_X_DRAWABLE (f), - f->output_data.x->reverse_gc, - x, y, width, height); +#ifndef USE_GTK + if (FRAME_X_DOUBLE_BUFFERED_P (f) + || f->alpha_background != 1.0) +#endif + { +#if defined HAVE_XRENDER && \ + (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) + x_xr_ensure_picture (f); + if (FRAME_DISPLAY_INFO (f)->alpha_bits + && FRAME_X_PICTURE (f) != None + && f->alpha_background != 1.0 + && FRAME_CHECK_XR_VERSION (f, 0, 2)) + { + XRenderColor xc; + GC gc = f->output_data.x->normal_gc; + + x_xr_apply_ext_clip (f, gc); + x_xrender_color_from_gc_background (f, gc, &xc, true); + XRenderFillRectangle (FRAME_X_DISPLAY (f), + PictOpSrc, FRAME_X_PICTURE (f), + &xc, x, y, width, height); + x_xr_reset_ext_clip (f); + x_mark_frame_dirty (f); + } + else +#endif + XFillRectangle (FRAME_X_DISPLAY (f), + FRAME_X_DRAWABLE (f), + f->output_data.x->reverse_gc, + x, y, width, height); + } +#ifndef USE_GTK else x_clear_area1 (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), x, y, width, height, False); #endif +#endif } @@ -4138,6 +8619,7 @@ x_show_hourglass (struct frame *f) if (!x->hourglass_window) { +#ifndef USE_XCB unsigned long mask = CWCursor; XSetWindowAttributes attrs; #ifdef USE_GTK @@ -4150,10 +8632,41 @@ x_show_hourglass (struct frame *f) x->hourglass_window = XCreateWindow (dpy, parent, 0, 0, 32000, 32000, 0, 0, InputOnly, CopyFromParent, mask, &attrs); +#else + uint32_t cursor = (uint32_t) x->hourglass_cursor; +#ifdef USE_GTK + xcb_window_t parent = (xcb_window_t) FRAME_X_WINDOW (f); +#else + xcb_window_t parent = (xcb_window_t) FRAME_OUTER_WINDOW (f); +#endif + x->hourglass_window + = (Window) xcb_generate_id (FRAME_DISPLAY_INFO (f)->xcb_connection); + + xcb_create_window (FRAME_DISPLAY_INFO (f)->xcb_connection, + XCB_COPY_FROM_PARENT, + (xcb_window_t) x->hourglass_window, + parent, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f), 0, + XCB_WINDOW_CLASS_INPUT_OUTPUT, + XCB_COPY_FROM_PARENT, XCB_CW_CURSOR, + &cursor); +#endif } +#ifndef USE_XCB XMapRaised (dpy, x->hourglass_window); - XFlush (dpy); + /* Ensure that the spinning hourglass is shown. */ + flush_frame (f); +#else + uint32_t value = XCB_STACK_MODE_ABOVE; + + xcb_configure_window (FRAME_DISPLAY_INFO (f)->xcb_connection, + (xcb_window_t) x->hourglass_window, + XCB_CONFIG_WINDOW_STACK_MODE, &value); + xcb_map_window (FRAME_DISPLAY_INFO (f)->xcb_connection, + (xcb_window_t) x->hourglass_window); + xcb_flush (FRAME_DISPLAY_INFO (f)->xcb_connection); +#endif } } } @@ -4168,10 +8681,16 @@ x_hide_hourglass (struct frame *f) /* Watch out for newly created frames. */ if (x->hourglass_window) { +#ifndef USE_XCB XUnmapWindow (FRAME_X_DISPLAY (f), x->hourglass_window); /* Sync here because XTread_socket looks at the hourglass_p flag that is reset to zero below. */ XSync (FRAME_X_DISPLAY (f), False); +#else + xcb_unmap_window (FRAME_DISPLAY_INFO (f)->xcb_connection, + (xcb_window_t) x->hourglass_window); + xcb_aux_sync (FRAME_DISPLAY_INFO (f)->xcb_connection); +#endif x->hourglass_p = false; } } @@ -4181,48 +8700,15 @@ x_hide_hourglass (struct frame *f) static void XTflash (struct frame *f) { - block_input (); + GC gc; + XGCValues values; + fd_set fds; + int fd; - { -#ifdef USE_GTK - /* Use Gdk routines to draw. This way, we won't draw over scroll bars - when the scroll bars and the edit widget share the same X window. */ - GdkWindow *window = gtk_widget_get_window (FRAME_GTK_WIDGET (f)); -#ifdef HAVE_GTK3 -#if GTK_CHECK_VERSION (3, 22, 0) - cairo_region_t *region = gdk_window_get_visible_region (window); - GdkDrawingContext *context = gdk_window_begin_draw_frame (window, region); - cairo_t *cr = gdk_drawing_context_get_cairo_context (context); -#else - cairo_t *cr = gdk_cairo_create (window); -#endif - cairo_set_source_rgb (cr, 1, 1, 1); - cairo_set_operator (cr, CAIRO_OPERATOR_DIFFERENCE); -#define XFillRectangle(d, win, gc, x, y, w, h) \ - do { \ - cairo_rectangle (cr, x, y, w, h); \ - cairo_fill (cr); \ - } \ - while (false) -#else /* ! HAVE_GTK3 */ - GdkGCValues vals; - GdkGC *gc; - vals.foreground.pixel = (FRAME_FOREGROUND_PIXEL (f) - ^ FRAME_BACKGROUND_PIXEL (f)); - vals.function = GDK_XOR; - gc = gdk_gc_new_with_values (window, - &vals, GDK_GC_FUNCTION | GDK_GC_FOREGROUND); -#define XFillRectangle(d, win, gc, x, y, w, h) \ - gdk_draw_rectangle (window, gc, true, x, y, w, h) -#endif /* ! HAVE_GTK3 */ -#else /* ! USE_GTK */ - GC gc; - - /* Create a GC that will use the GXxor function to flip foreground - pixels into background pixels. */ - { - XGCValues values; + block_input (); + if (FRAME_X_VISUAL_INFO (f)->class == TrueColor) + { values.function = GXxor; values.foreground = (FRAME_FOREGROUND_PIXEL (f) ^ FRAME_BACKGROUND_PIXEL (f)); @@ -4230,101 +8716,96 @@ XTflash (struct frame *f) gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), GCFunction | GCForeground, &values); } -#endif + else + gc = FRAME_X_OUTPUT (f)->normal_gc; + + + /* Get the height not including a menu bar widget. */ + int height = FRAME_PIXEL_HEIGHT (f); + /* Height of each line to flash. */ + int flash_height = FRAME_LINE_HEIGHT (f); + /* These will be the left and right margins of the rectangles. */ + int flash_left = FRAME_INTERNAL_BORDER_WIDTH (f); + int flash_right = FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f); + int width = flash_right - flash_left; + + /* If window is tall, flash top and bottom line. */ + if (height > 3 * FRAME_LINE_HEIGHT (f)) { - /* Get the height not including a menu bar widget. */ - int height = FRAME_PIXEL_HEIGHT (f); - /* Height of each line to flash. */ - int flash_height = FRAME_LINE_HEIGHT (f); - /* These will be the left and right margins of the rectangles. */ - int flash_left = FRAME_INTERNAL_BORDER_WIDTH (f); - int flash_right = FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f); - int width = flash_right - flash_left; - - /* If window is tall, flash top and bottom line. */ - if (height > 3 * FRAME_LINE_HEIGHT (f)) - { - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, - (FRAME_INTERNAL_BORDER_WIDTH (f) - + FRAME_TOP_MARGIN_HEIGHT (f)), - width, flash_height); - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, - (height - flash_height - - FRAME_INTERNAL_BORDER_WIDTH (f)), - width, flash_height); + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, + (FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_TOP_MARGIN_HEIGHT (f)), + width, flash_height); + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, + (height - flash_height + - FRAME_INTERNAL_BORDER_WIDTH (f)), + width, flash_height); - } - else - /* If it is short, flash it all. */ - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), - width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + } + else + /* If it is short, flash it all. */ + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), + width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); - x_flush (f); + x_flush (f); - { - struct timespec delay = make_timespec (0, 150 * 1000 * 1000); - struct timespec wakeup = timespec_add (current_timespec (), delay); + struct timespec delay = make_timespec (0, 150 * 1000 * 1000); + struct timespec wakeup = timespec_add (current_timespec (), delay); + fd = ConnectionNumber (FRAME_X_DISPLAY (f)); - /* Keep waiting until past the time wakeup or any input gets - available. */ - while (! detect_input_pending ()) - { - struct timespec current = current_timespec (); - struct timespec timeout; + /* Keep waiting until past the time wakeup or any input gets + available. */ + while (! detect_input_pending ()) + { + struct timespec current = current_timespec (); + struct timespec timeout; - /* Break if result would not be positive. */ - if (timespec_cmp (wakeup, current) <= 0) - break; + /* Break if result would not be positive. */ + if (timespec_cmp (wakeup, current) <= 0) + break; - /* How long `select' should wait. */ - timeout = make_timespec (0, 10 * 1000 * 1000); + /* How long `select' should wait. */ + timeout = make_timespec (0, 10 * 1000 * 1000); - /* Try to wait that long--but we might wake up sooner. */ - pselect (0, NULL, NULL, NULL, &timeout, NULL); - } - } + /* Wait for some input to become available on the X + connection. */ + FD_ZERO (&fds); + FD_SET (fd, &fds); - /* If window is tall, flash top and bottom line. */ - if (height > 3 * FRAME_LINE_HEIGHT (f)) - { - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, - (FRAME_INTERNAL_BORDER_WIDTH (f) - + FRAME_TOP_MARGIN_HEIGHT (f)), - width, flash_height); - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, - (height - flash_height - - FRAME_INTERNAL_BORDER_WIDTH (f)), - width, flash_height); - } - else - /* If it is short, flash it all. */ - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), - width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + /* Try to wait that long--but we might wake up sooner. */ + pselect (fd + 1, &fds, NULL, NULL, &timeout, NULL); -#ifdef USE_GTK -#ifdef HAVE_GTK3 -#if GTK_CHECK_VERSION (3, 22, 0) - gdk_window_end_draw_frame (window, context); - cairo_region_destroy (region); -#else - cairo_destroy (cr); -#endif -#else - g_object_unref (G_OBJECT (gc)); -#endif -#undef XFillRectangle -#else - XFreeGC (FRAME_X_DISPLAY (f), gc); -#endif - x_flush (f); + /* Some input is available, exit the visible bell. */ + if (FD_ISSET (fd, &fds)) + break; } - } + + /* If window is tall, flash top and bottom line. */ + if (height > 3 * FRAME_LINE_HEIGHT (f)) + { + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, + (FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_TOP_MARGIN_HEIGHT (f)), + width, flash_height); + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, + (height - flash_height + - FRAME_INTERNAL_BORDER_WIDTH (f)), + width, flash_height); + } + else + /* If it is short, flash it all. */ + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), + width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + + if (FRAME_X_VISUAL_INFO (f)->class == TrueColor) + XFreeGC (FRAME_X_DISPLAY (f), gc); + x_flush (f); unblock_input (); } @@ -4417,6 +8898,105 @@ 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, view->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 + + /* Some of the following code depends on `normal_gc' being + up-to-date on the X server, but doesn't call a routine that will + flush it first. So do this ourselves instead. */ + XFlushGC (FRAME_X_DISPLAY (f), + f->output_data.x->normal_gc); + #ifdef USE_CAIRO if (FRAME_CR_CONTEXT (f)) { @@ -4436,6 +9016,18 @@ x_scroll_run (struct window *w, struct run *run) x, to_y); cairo_surface_mark_dirty_rectangle (surface, x, to_y, width, height); } +#ifdef USE_CAIRO_XCB_SURFACE + else if (cairo_surface_get_type (surface) == CAIRO_SURFACE_TYPE_XCB) + { + cairo_surface_flush (surface); + xcb_copy_area (FRAME_DISPLAY_INFO (f)->xcb_connection, + (xcb_drawable_t) FRAME_X_DRAWABLE (f), + (xcb_drawable_t) FRAME_X_DRAWABLE (f), + (xcb_gcontext_t) XGContextFromGC (f->output_data.x->normal_gc), + x, from_y, x, to_y, width, height); + cairo_surface_mark_dirty_rectangle (surface, x, to_y, width, height); + } +#endif else { cairo_surface_t *s @@ -4525,6 +9117,20 @@ static void x_new_focus_frame (struct x_display_info *dpyinfo, struct frame *frame) { struct frame *old_focus = dpyinfo->x_focus_frame; +#if defined USE_GTK && !defined HAVE_GTK3 && defined HAVE_XINPUT2 + XIEventMask mask; + ptrdiff_t l; + + if (dpyinfo->supports_xi2) + { + l = XIMaskLen (XI_LASTEVENT); + mask.mask = alloca (l); + mask.mask_len = l; + memset (mask.mask, 0, l); + + mask.deviceid = XIAllDevices; + } +#endif if (frame != dpyinfo->x_focus_frame) { @@ -4532,6 +9138,17 @@ x_new_focus_frame (struct x_display_info *dpyinfo, struct frame *frame) the correct value of x_focus_frame. */ dpyinfo->x_focus_frame = frame; + /* Once none of our frames are focused anymore, stop selecting + for raw input events from the root window. */ + +#if defined USE_GTK && !defined HAVE_GTK3 && defined HAVE_XINPUT2 + if (frame && dpyinfo->supports_xi2) + XISetMask (mask.mask, XI_RawKeyPress); + + if (dpyinfo->supports_xi2) + XISelectEvents (dpyinfo->display, dpyinfo->root_window, &mask, 1); +#endif + if (old_focus && old_focus->auto_lower) x_lower_frame (old_focus); @@ -4549,7 +9166,8 @@ x_new_focus_frame (struct x_display_info *dpyinfo, struct frame *frame) a FOCUS_IN_EVENT into *BUFP. */ static void -x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct frame *frame, struct input_event *bufp) +x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct frame *frame, + struct input_event *bufp) { if (type == FocusIn) { @@ -4565,7 +9183,18 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra #ifdef HAVE_X_I18N if (FRAME_XIC (frame)) - XSetICFocus (FRAME_XIC (frame)); + XSetICFocus (FRAME_XIC (frame)); +#ifdef USE_GTK + GtkWidget *widget; + + if (x_gtk_use_native_input) + { + gtk_im_context_focus_in (FRAME_X_OUTPUT (frame)->im_context); + widget = FRAME_GTK_OUTER_WIDGET (frame); + gtk_im_context_set_client_window (FRAME_X_OUTPUT (frame)->im_context, + gtk_widget_get_window (widget)); + } +#endif #endif } else if (type == FocusOut) @@ -4581,17 +9210,29 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra XSETFRAME (bufp->frame_or_window, frame); } + if (!frame->output_data.x->focus_state) + { #ifdef HAVE_X_I18N - if (FRAME_XIC (frame)) - XUnsetICFocus (FRAME_XIC (frame)); + if (FRAME_XIC (frame)) + XUnsetICFocus (FRAME_XIC (frame)); +#ifdef USE_GTK + if (x_gtk_use_native_input) + { + gtk_im_context_focus_out (FRAME_X_OUTPUT (frame)->im_context); + gtk_im_context_set_client_window (FRAME_X_OUTPUT (frame)->im_context, NULL); + } +#endif #endif + } + if (frame->pointer_invisible) XTtoggle_invisible_pointer (frame, false); } } -/* 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) @@ -4602,6 +9243,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); @@ -4650,6 +9298,13 @@ x_any_window_to_frame (struct x_display_info *dpyinfo, int wdesc) if (wdesc == None) return NULL; +#ifdef HAVE_XWIDGETS + struct xwidget_view *xv = xwidget_view_from_window (wdesc); + + if (xv) + return xv->frame; +#endif + FOR_EACH_FRAME (tail, frame) { if (found) @@ -4693,7 +9348,16 @@ static struct frame * x_menubar_window_to_frame (struct x_display_info *dpyinfo, const XEvent *event) { - Window wdesc = event->xany.window; + Window wdesc; +#ifdef HAVE_XINPUT2 + if (event->type == GenericEvent + && dpyinfo->supports_xi2 + && (event->xcookie.evtype == XI_ButtonPress + || event->xcookie.evtype == XI_ButtonRelease)) + wdesc = ((XIDeviceEvent *) event->xcookie.data)->event; + else +#endif + wdesc = event->xany.window; Lisp_Object tail, frame; struct frame *f; struct x_output *x; @@ -4762,10 +9426,430 @@ x_top_window_to_frame (struct x_display_info *dpyinfo, int wdesc) #else /* !USE_X_TOOLKIT && !USE_GTK */ #define x_any_window_to_frame(d, i) x_window_to_frame (d, i) -#define x_top_window_to_frame(d, i) x_window_to_frame (d, i) + +struct frame * +x_top_window_to_frame (struct x_display_info *dpyinfo, int wdesc) +{ + return x_window_to_frame (dpyinfo, wdesc); +} #endif /* USE_X_TOOLKIT || USE_GTK */ +static void +x_clear_dnd_targets (void) +{ + if (x_dnd_unwind_flag) + x_set_dnd_targets (NULL, 0); +} + +/* This function is defined far away from the rest of the XDND code so + it can utilize `x_any_window_to_frame'. */ + +Lisp_Object +x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, + Lisp_Object return_frame, Atom *ask_action_list, + const char **ask_action_names, size_t n_ask_actions, + bool allow_current_frame) +{ +#ifndef USE_GTK + XEvent next_event; + int finish; +#endif + XWindowAttributes root_window_attrs; + struct input_event hold_quit; + struct frame *any; + char *atom_name, *ask_actions; + Lisp_Object action, ltimestamp; + specpdl_ref ref; + ptrdiff_t i, end, fill; + XTextProperty prop; + xm_drop_start_message dmsg; + Lisp_Object frame_object, x, y, frame, local_value; +#ifdef HAVE_XKB + XkbStateRec keyboard_state; +#endif + + if (!FRAME_VISIBLE_P (f)) + { + x_set_dnd_targets (NULL, 0); + error ("Frame is invisible"); + } + + XSETFRAME (frame, f); + local_value = assq_no_quit (QXdndSelection, + FRAME_TERMINAL (f)->Vselection_alist); + + if (x_dnd_in_progress || x_dnd_waiting_for_finish) + { + x_set_dnd_targets (NULL, 0); + error ("A drag-and-drop session is already in progress"); + } + + if (CONSP (local_value)) + { + ref = SPECPDL_INDEX (); + + record_unwind_protect_void (x_clear_dnd_targets); + x_dnd_unwind_flag = true; + x_own_selection (QXdndSelection, + Fnth (make_fixnum (1), local_value), frame); + x_dnd_unwind_flag = false; + unbind_to (ref, Qnil); + } + else + { + x_set_dnd_targets (NULL, 0); + error ("No local value for XdndSelection"); + } + + if (popup_activated ()) + { + x_set_dnd_targets (NULL, 0); + error ("Trying to drag-and-drop from within a menu-entry"); + } + + ltimestamp = x_timestamp_for_selection (FRAME_DISPLAY_INFO (f), + QXdndSelection); + + if (BIGNUMP (ltimestamp)) + x_dnd_selection_timestamp = bignum_to_intmax (ltimestamp); + else + x_dnd_selection_timestamp = XFIXNUM (ltimestamp); + + if (n_ask_actions) + { + ask_actions = NULL; + end = 0; + + for (i = 0; i < n_ask_actions; ++i) + { + fill = end; + end += strlen (ask_action_names[i]) + 1; + + if (ask_actions) + ask_actions = xrealloc (ask_actions, end); + else + ask_actions = xmalloc (end); + + strncpy (ask_actions + fill, + ask_action_names[i], + end - fill); + } + + prop.value = (unsigned char *) ask_actions; + prop.encoding = XA_STRING; + prop.format = 8; + prop.nitems = end; + + block_input (); + XSetTextProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + &prop, FRAME_DISPLAY_INFO (f)->Xatom_XdndActionDescription); + xfree (ask_actions); + + XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_XdndActionList, XA_ATOM, 32, + PropModeReplace, (unsigned char *) ask_action_list, + n_ask_actions); + unblock_input (); + } + else + { + /* Delete those two properties, since some clients look at them + and not the action to decide whether or not the user should + be prompted to select an action. */ + + block_input (); + XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_XdndActionList); + XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_XdndActionDescription); + unblock_input (); + } + + x_dnd_in_progress = true; + x_dnd_frame = f; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_last_protocol_version = -1; + x_dnd_last_motif_style = XM_DRAG_STYLE_NONE; + x_dnd_mouse_rect_target = None; + x_dnd_action = None; + x_dnd_wanted_action = xaction; + x_dnd_return_frame = 0; + x_dnd_waiting_for_finish = false; + x_dnd_waiting_for_motif_finish = 0; + x_dnd_xm_use_help = false; + x_dnd_motif_setup_p = false; + x_dnd_end_window = None; + x_dnd_use_toplevels + = x_wm_supports (f, FRAME_DISPLAY_INFO (f)->Xatom_net_client_list_stacking); + x_dnd_toplevels = NULL; + x_dnd_allow_current_frame = allow_current_frame; + x_dnd_movement_frame = NULL; +#ifdef HAVE_XKB + x_dnd_keyboard_state = 0; + + if (FRAME_DISPLAY_INFO (f)->supports_xkb) + { + XkbSelectEvents (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + XkbStateNotifyMask, XkbStateNotifyMask); + XkbGetState (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + &keyboard_state); + + x_dnd_keyboard_state = (keyboard_state.mods + | keyboard_state.ptr_buttons); + } +#endif + + if (x_dnd_use_toplevels) + { + if (x_dnd_compute_toplevels (FRAME_DISPLAY_INFO (f))) + { + x_dnd_free_toplevels (); + x_dnd_use_toplevels = false; + } + } + + if (!NILP (return_frame)) + x_dnd_return_frame = 1; + + if (EQ (return_frame, Qnow)) + x_dnd_return_frame = 2; + + /* Now select for SubstructureNotifyMask and PropertyNotifyMask on + the root window, so we can get notified when window stacking + changes, a common operation during drag-and-drop. */ + + XGetWindowAttributes (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + &root_window_attrs); + + XSelectInput (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + root_window_attrs.your_event_mask + | SubstructureNotifyMask + | PropertyChangeMask); + + if (EQ (return_frame, Qnow)) + x_dnd_update_state (FRAME_DISPLAY_INFO (f), CurrentTime); + + while (x_dnd_in_progress || x_dnd_waiting_for_finish) + { + hold_quit.kind = NO_EVENT; +#ifdef USE_GTK + current_finish = X_EVENT_NORMAL; + current_hold_quit = &hold_quit; + current_count = 0; +#endif + + block_input (); +#ifdef USE_GTK + gtk_main_iteration (); +#else +#ifdef USE_X_TOOLKIT + XtAppNextEvent (Xt_app_con, &next_event); +#else + XNextEvent (FRAME_X_DISPLAY (f), &next_event); +#endif + +#ifdef HAVE_X_I18N +#ifdef HAVE_XINPUT2 + if (next_event.type != GenericEvent + || !FRAME_DISPLAY_INFO (f)->supports_xi2 + || (next_event.xgeneric.extension + != FRAME_DISPLAY_INFO (f)->xi2_opcode)) + { +#endif + if (!x_filter_event (FRAME_DISPLAY_INFO (f), &next_event)) + handle_one_xevent (FRAME_DISPLAY_INFO (f), + &next_event, &finish, &hold_quit); +#ifdef HAVE_XINPUT2 + } + else + handle_one_xevent (FRAME_DISPLAY_INFO (f), + &next_event, &finish, &hold_quit); +#endif +#else + handle_one_xevent (FRAME_DISPLAY_INFO (f), + &next_event, &finish, &hold_quit); +#endif +#endif + unblock_input (); + + if (x_dnd_movement_frame) + { + XSETFRAME (frame_object, x_dnd_movement_frame); + XSETINT (x, x_dnd_movement_x); + XSETINT (y, x_dnd_movement_y); + x_dnd_movement_frame = NULL; + + if (!NILP (Vx_dnd_movement_function) + && !FRAME_TOOLTIP_P (XFRAME (frame_object)) + && x_dnd_movement_x >= 0 + && x_dnd_movement_y >= 0 + && x_dnd_frame + && (XFRAME (frame_object) != x_dnd_frame + || x_dnd_allow_current_frame)) + { + x_dnd_old_window_attrs = root_window_attrs; + x_dnd_unwind_flag = true; + + ref = SPECPDL_INDEX (); + record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); + call2 (Vx_dnd_movement_function, frame_object, + Fposn_at_x_y (x, y, frame_object, Qnil)); + x_dnd_unwind_flag = false; + unbind_to (ref, Qnil); + } + } + + if (hold_quit.kind != NO_EVENT) + { + if (hold_quit.kind == SELECTION_REQUEST_EVENT) + { + x_dnd_old_window_attrs = root_window_attrs; + x_dnd_unwind_flag = true; + + ref = SPECPDL_INDEX (); + record_unwind_protect_ptr (x_dnd_cleanup_drag_and_drop, f); + x_handle_selection_event ((struct selection_input_event *) &hold_quit); + x_dnd_unwind_flag = false; + unbind_to (ref, Qnil); + continue; + } + + if (x_dnd_in_progress) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (f, x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style) + && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE + && x_dnd_motif_setup_p) + { + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; + dmsg.timestamp = hold_quit.timestamp; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_ACTION_DROP_CANCEL); + dmsg.x = 0; + dmsg.y = 0; + dmsg.index_atom = FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection; + dmsg.source_window = FRAME_X_WINDOW (f); + + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, + x_dnd_last_seen_window, + hold_quit.timestamp); + xm_send_drop_message (FRAME_DISPLAY_INFO (f), FRAME_X_WINDOW (f), + x_dnd_last_seen_window, &dmsg); + } + + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_dnd_frame = NULL; + } + + x_set_dnd_targets (NULL, 0); + x_dnd_waiting_for_finish = false; + + if (x_dnd_use_toplevels) + x_dnd_free_toplevels (); + + x_dnd_return_frame_object = NULL; + x_dnd_movement_frame = NULL; + + FRAME_DISPLAY_INFO (f)->grabbed = 0; +#ifdef USE_GTK + current_hold_quit = NULL; +#endif + /* Restore the old event mask. */ + XSelectInput (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + root_window_attrs.your_event_mask); +#ifdef HAVE_XKB + if (FRAME_DISPLAY_INFO (f)->supports_xkb) + XkbSelectEvents (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + XkbStateNotifyMask, 0); +#endif + quit (); + } + } + + x_set_dnd_targets (NULL, 0); + x_dnd_waiting_for_finish = false; + +#ifdef USE_GTK + current_hold_quit = NULL; +#endif + x_dnd_movement_frame = NULL; + + block_input (); + /* Restore the old event mask. */ + XSelectInput (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + root_window_attrs.your_event_mask); +#ifdef HAVE_XKB + if (FRAME_DISPLAY_INFO (f)->supports_xkb) + XkbSelectEvents (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + XkbStateNotifyMask, 0); +#endif + unblock_input (); + + if (x_dnd_return_frame == 3 + && FRAME_LIVE_P (x_dnd_return_frame_object)) + { + /* Deliberately preserve the last device if + x_dnd_return_frame_object is the drag source. */ + + if (x_dnd_return_frame_object != x_dnd_frame) + x_dnd_return_frame_object->last_mouse_device = Qnil; + + x_dnd_return_frame_object->mouse_moved = true; + + XSETFRAME (action, x_dnd_return_frame_object); + x_dnd_return_frame_object = NULL; + return action; + } + + x_dnd_return_frame_object = NULL; + + if (x_dnd_use_toplevels) + x_dnd_free_toplevels (); + FRAME_DISPLAY_INFO (f)->grabbed = 0; + + /* Emacs can't respond to DND events inside the nested event + loop, so when dragging items to itself, always return + XdndActionPrivate. */ + if (x_dnd_end_window != None + && (any = x_any_window_to_frame (FRAME_DISPLAY_INFO (f), + x_dnd_end_window)) + && (allow_current_frame || any != f)) + return QXdndActionPrivate; + + if (x_dnd_action != None) + { + block_input (); + atom_name = XGetAtomName (FRAME_X_DISPLAY (f), + x_dnd_action); + action = intern (atom_name); + XFree (atom_name); + unblock_input (); + + return action; + } + + return Qnil; +} + /* The focus may have changed. Figure out if it is a real focus change, by checking both FocusIn/Out and Enter/LeaveNotify events. @@ -4796,6 +9880,37 @@ x_detect_focus_change (struct x_display_info *dpyinfo, struct frame *frame, } break; +#ifdef HAVE_XINPUT2 + case GenericEvent: + { + XIEvent *xi_event = event->xcookie.data; + XIEnterEvent *enter_or_focus = event->xcookie.data; + + struct frame *focus_frame = dpyinfo->x_focus_event_frame; + int focus_state + = focus_frame ? focus_frame->output_data.x->focus_state : 0; + + if (xi_event->evtype == XI_FocusIn + || xi_event->evtype == XI_FocusOut) + x_focus_changed ((xi_event->evtype == XI_FocusIn + ? FocusIn : FocusOut), + ((enter_or_focus->detail + == XINotifyPointer) + ? FOCUS_IMPLICIT : FOCUS_EXPLICIT), + dpyinfo, frame, bufp); + else if ((xi_event->evtype == XI_Enter + || xi_event->evtype == XI_Leave) + && (enter_or_focus->detail != XINotifyInferior) + && enter_or_focus->focus + && !(focus_state & FOCUS_EXPLICIT)) + x_focus_changed ((xi_event->evtype == XI_Enter + ? FocusIn : FocusOut), + FOCUS_IMPLICIT, + dpyinfo, frame, bufp); + break; + } +#endif + case FocusIn: case FocusOut: /* Ignore transient focus events from hotkeys, window manager @@ -4891,6 +10006,11 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo) KeySym *syms; int syms_per_code; XModifierKeymap *mods; +#ifdef HAVE_XKB + int i; + int found_meta_p = false; + uint vmodmask; +#endif dpyinfo->meta_mod_mask = 0; dpyinfo->shift_lock_mask = 0; @@ -4898,11 +10018,60 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo) dpyinfo->super_mod_mask = 0; dpyinfo->hyper_mod_mask = 0; +#ifdef HAVE_XKB + if (dpyinfo->xkb_desc + && dpyinfo->xkb_desc->server) + { + for (i = 0; i < XkbNumVirtualMods; i++) + { + vmodmask = dpyinfo->xkb_desc->server->vmods[i]; + + if (dpyinfo->xkb_desc->names->vmods[i] == dpyinfo->Xatom_Meta) + { + dpyinfo->meta_mod_mask |= vmodmask; + + if (vmodmask) + found_meta_p = true; + } + else if (dpyinfo->xkb_desc->names->vmods[i] == dpyinfo->Xatom_Alt) + dpyinfo->alt_mod_mask |= vmodmask; + else if (dpyinfo->xkb_desc->names->vmods[i] == dpyinfo->Xatom_Super) + dpyinfo->super_mod_mask |= vmodmask; + else if (dpyinfo->xkb_desc->names->vmods[i] == dpyinfo->Xatom_Hyper) + dpyinfo->hyper_mod_mask |= vmodmask; + else if (dpyinfo->xkb_desc->names->vmods[i] == dpyinfo->Xatom_ShiftLock) + dpyinfo->shift_lock_mask |= vmodmask; + } + + if (!found_meta_p) + { + dpyinfo->meta_mod_mask = dpyinfo->alt_mod_mask; + dpyinfo->alt_mod_mask = 0; + } + + if (dpyinfo->alt_mod_mask & dpyinfo->meta_mod_mask) + dpyinfo->alt_mod_mask &= ~dpyinfo->meta_mod_mask; + + if (dpyinfo->hyper_mod_mask & dpyinfo->super_mod_mask) + dpyinfo->hyper_mod_mask &= ~dpyinfo->super_mod_mask; + + return; + } +#endif + XDisplayKeycodes (dpyinfo->display, &min_code, &max_code); syms = XGetKeyboardMapping (dpyinfo->display, min_code, max_code - min_code + 1, &syms_per_code); + + if (!syms) + { + dpyinfo->meta_mod_mask = Mod1Mask; + dpyinfo->super_mod_mask = Mod2Mask; + return; + } + mods = XGetModifierMapping (dpyinfo->display); /* Scan the modifier table to see which modifier bits the Meta and @@ -4912,66 +10081,66 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo) bool found_alt_or_meta; for (row = 3; row < 8; row++) - { - found_alt_or_meta = false; - for (col = 0; col < mods->max_keypermod; col++) - { - KeyCode code = mods->modifiermap[(row * mods->max_keypermod) + col]; - - /* Zeroes are used for filler. Skip them. */ - if (code == 0) - continue; - - /* Are any of this keycode's keysyms a meta key? */ + { + found_alt_or_meta = false; + for (col = 0; col < mods->max_keypermod; col++) { - int code_col; - - for (code_col = 0; code_col < syms_per_code; code_col++) - { - int sym = syms[((code - min_code) * syms_per_code) + code_col]; - - switch (sym) - { - case XK_Meta_L: - case XK_Meta_R: - found_alt_or_meta = true; - dpyinfo->meta_mod_mask |= (1 << row); - break; - - case XK_Alt_L: - case XK_Alt_R: - found_alt_or_meta = true; - dpyinfo->alt_mod_mask |= (1 << row); - break; + KeyCode code = mods->modifiermap[(row * mods->max_keypermod) + col]; - case XK_Hyper_L: - case XK_Hyper_R: - if (!found_alt_or_meta) - dpyinfo->hyper_mod_mask |= (1 << row); - code_col = syms_per_code; - col = mods->max_keypermod; - break; + /* Zeroes are used for filler. Skip them. */ + if (code == 0) + continue; - case XK_Super_L: - case XK_Super_R: - if (!found_alt_or_meta) - dpyinfo->super_mod_mask |= (1 << row); - code_col = syms_per_code; - col = mods->max_keypermod; - break; + /* Are any of this keycode's keysyms a meta key? */ + { + int code_col; - case XK_Shift_Lock: - /* Ignore this if it's not on the lock modifier. */ - if (!found_alt_or_meta && ((1 << row) == LockMask)) - dpyinfo->shift_lock_mask = LockMask; - code_col = syms_per_code; - col = mods->max_keypermod; - break; - } - } + for (code_col = 0; code_col < syms_per_code; code_col++) + { + int sym = syms[((code - min_code) * syms_per_code) + code_col]; + + switch (sym) + { + case XK_Meta_L: + case XK_Meta_R: + found_alt_or_meta = true; + dpyinfo->meta_mod_mask |= (1 << row); + break; + + case XK_Alt_L: + case XK_Alt_R: + found_alt_or_meta = true; + dpyinfo->alt_mod_mask |= (1 << row); + break; + + case XK_Hyper_L: + case XK_Hyper_R: + if (!found_alt_or_meta) + dpyinfo->hyper_mod_mask |= (1 << row); + code_col = syms_per_code; + col = mods->max_keypermod; + break; + + case XK_Super_L: + case XK_Super_R: + if (!found_alt_or_meta) + dpyinfo->super_mod_mask |= (1 << row); + code_col = syms_per_code; + col = mods->max_keypermod; + break; + + case XK_Shift_Lock: + /* Ignore this if it's not on the lock modifier. */ + if (!found_alt_or_meta && ((1 << row) == LockMask)) + dpyinfo->shift_lock_mask = LockMask; + code_col = syms_per_code; + col = mods->max_keypermod; + break; + } + } + } } - } - } + } } /* If we couldn't find any meta keys, accept any alt keys as meta keys. */ @@ -4988,8 +10157,17 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo) dpyinfo->alt_mod_mask &= ~dpyinfo->meta_mod_mask; } + /* If some keys are both super and hyper, make them just super. + Many X servers are misconfigured so that super and hyper are both + Mod4, but most users have no hyper key. */ + if (dpyinfo->hyper_mod_mask & dpyinfo->super_mod_mask) + dpyinfo->hyper_mod_mask &= ~dpyinfo->super_mod_mask; + XFree (syms); - XFreeModifiermap (mods); + + if (dpyinfo->modmap) + XFreeModifiermap (dpyinfo->modmap); + dpyinfo->modmap = mods; } /* Convert between the modifier bits X uses and the modifier bits @@ -5024,7 +10202,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; @@ -5092,13 +10270,26 @@ get_keysym_name (int keysym) /* Prepare a mouse-event in *RESULT for placement in the input queue. If the event is a button press, then note that we have grabbed - the mouse. */ + the mouse. + + The XButtonEvent structure passed as EVENT might not come from the + X server, and instead be artificially constructed from input + extension events. In these special events, the only fields that + are initialized are `time', `button', `state', `type', `window' and + `x' and `y'. This function should not access any other fields in + EVENT without also initializing the corresponding fields in `bv' + under the XI_ButtonPress and XI_ButtonRelease labels inside + `handle_one_xevent'. */ static Lisp_Object x_construct_mouse_click (struct input_event *result, const XButtonEvent *event, struct frame *f) { + int x = event->x; + int y = event->y; + Window dummy; + /* Make the event type NO_EVENT; we'll change that when we decide otherwise. */ result->kind = MOUSE_CLICK_EVENT; @@ -5110,8 +10301,16 @@ x_construct_mouse_click (struct input_event *result, ? up_modifier : down_modifier)); - XSETINT (result->x, event->x); - XSETINT (result->y, event->y); + /* If result->window is not the frame's edit widget (which can + happen with GTK+ scroll bars, for example), translate the + coordinates so they appear at the correct position. */ + if (event->window != FRAME_X_WINDOW (f)) + XTranslateCoordinates (FRAME_X_DISPLAY (f), + event->window, FRAME_X_WINDOW (f), + x, y, &x, &y, &dummy); + + XSETINT (result->x, x); + XSETINT (result->y, y); XSETFRAME (result->frame_or_window, f); result->arg = Qnil; return Qnil; @@ -5123,10 +10322,19 @@ x_construct_mouse_click (struct input_event *result, We have received a mouse movement event, which is given in *event. If the mouse is over a different glyph than it was last time, tell the mainstream emacs code by setting mouse_moved. If not, ask for - another motion event, so we can check again the next time it moves. */ + another motion event, so we can check again the next time it moves. + + The XMotionEvent structure passed as EVENT might not come from the + X server, and instead be artificially constructed from input + extension events. In these special events, the only fields that + are initialized are `time', `window', and `x' and `y'. This + function should not access any other fields in EVENT without also + initializing the corresponding fields in `ev' under the XI_Motion, + XI_Enter and XI_Leave labels inside `handle_one_xevent'. */ static bool -x_note_mouse_movement (struct frame *frame, const XMotionEvent *event) +x_note_mouse_movement (struct frame *frame, const XMotionEvent *event, + Lisp_Object device) { XRectangle *r; struct x_display_info *dpyinfo; @@ -5143,6 +10351,7 @@ x_note_mouse_movement (struct frame *frame, const XMotionEvent *event) if (event->window != FRAME_X_WINDOW (frame)) { frame->mouse_moved = true; + frame->last_mouse_device = device; dpyinfo->last_mouse_scroll_bar = NULL; note_mouse_highlight (frame, -1, -1); dpyinfo->last_mouse_glyph_frame = NULL; @@ -5157,6 +10366,7 @@ x_note_mouse_movement (struct frame *frame, const XMotionEvent *event) || event->y < r->y || event->y >= r->y + r->height) { frame->mouse_moved = true; + frame->last_mouse_device = device; dpyinfo->last_mouse_scroll_bar = NULL; note_mouse_highlight (frame, event->x, event->y); /* Remember which glyph we're now on. */ @@ -5259,7 +10469,8 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, x_catch_errors (FRAME_X_DISPLAY (*fp)); - if (gui_mouse_grabbed (dpyinfo) && !EQ (track_mouse, Qdropping)) + if (gui_mouse_grabbed (dpyinfo) && !EQ (track_mouse, Qdropping) + && !EQ (track_mouse, Qdrag_source)) { /* If mouse was grabbed on a frame, give coords for that frame even if the mouse is now outside it. */ @@ -5348,7 +10559,8 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, } if ((!f1 || FRAME_TOOLTIP_P (f1)) - && EQ (track_mouse, Qdropping) + && (EQ (track_mouse, Qdropping) + || EQ (track_mouse, Qdrag_source)) && gui_mouse_grabbed (dpyinfo)) { /* When dropping then if we didn't get a frame or only a @@ -5364,12 +10576,28 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, root_x, root_y, &win_x, &win_y, /* Child of win. */ &child); - f1 = dpyinfo->last_mouse_frame; + + if (!EQ (track_mouse, Qdrag_source) + /* Don't let tooltips interfere. */ + || (f1 && FRAME_TOOLTIP_P (f1))) + f1 = dpyinfo->last_mouse_frame; + else + { + /* Don't set FP but do set WIN_X and WIN_Y in this + case, so make_lispy_movement knows which + coordinates to report. */ + *bar_window = Qnil; + *part = 0; + *fp = NULL; + XSETINT (*x, win_x); + XSETINT (*y, win_y); + *timestamp = dpyinfo->last_mouse_movement_time; + } } else if (f1 && FRAME_TOOLTIP_P (f1)) f1 = NULL; - if (x_had_errors_p (FRAME_X_DISPLAY (*fp))) + if (x_had_errors_p (dpyinfo->display)) f1 = NULL; x_uncatch_errors_after_check (); @@ -5379,7 +10607,7 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, { struct scroll_bar *bar; - bar = x_window_to_scroll_bar (FRAME_X_DISPLAY (*fp), win, 2); + bar = x_window_to_scroll_bar (dpyinfo->display, win, 2); if (bar) { @@ -5392,7 +10620,7 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, if (!f1 && insist > 0) f1 = SELECTED_FRAME (); - if (f1) + if (f1 && FRAME_X_P (f1)) { /* Ok, we found a frame. Store all the values. last_mouse_glyph is a rectangle used to reduce the @@ -5402,7 +10630,6 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, on it, i.e. into the same rectangles that matrices on the frame are divided into. */ - /* FIXME: what if F1 is not an X frame? */ dpyinfo = FRAME_DISPLAY_INFO (f1); remember_mouse_glyph (f1, win_x, win_y, &dpyinfo->last_mouse_glyph); dpyinfo->last_mouse_glyph_frame = f1; @@ -5438,9 +10665,9 @@ x_window_to_scroll_bar (Display *display, Window window_id, int type) { Lisp_Object tail, frame; -#if defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS) +#if defined (USE_GTK) && !defined (HAVE_GTK3) && defined (USE_TOOLKIT_SCROLL_BARS) window_id = (Window) xg_get_scroll_id_for_window (display, window_id); -#endif /* USE_GTK && USE_TOOLKIT_SCROLL_BARS */ +#endif /* USE_GTK && !HAVE_GTK3 && USE_TOOLKIT_SCROLL_BARS */ FOR_EACH_FRAME (tail, frame) { @@ -5619,6 +10846,35 @@ xt_horizontal_action_hook (Widget widget, XtPointer client_data, String action_n } #endif /* not USE_GTK */ +/* Protect WINDOW from garbage collection until a matching scroll bar + message is received. Return whether or not protection + succeeded. */ +static bool +x_protect_window_for_callback (struct x_display_info *dpyinfo, + Lisp_Object window) +{ + if (dpyinfo->n_protected_windows + 1 + >= dpyinfo->protected_windows_max) + return false; + + dpyinfo->protected_windows[dpyinfo->n_protected_windows++] + = window; + return true; +} + +static void +x_unprotect_window_for_callback (struct x_display_info *dpyinfo) +{ + if (!dpyinfo->n_protected_windows) + emacs_abort (); + + dpyinfo->n_protected_windows--; + + if (dpyinfo->n_protected_windows) + memmove (dpyinfo->protected_windows, &dpyinfo->protected_windows[1], + sizeof (Lisp_Object) * dpyinfo->n_protected_windows); +} + /* Send a client message with message type Xatom_Scrollbar for a scroll action to the frame of WINDOW. PART is a value identifying the part of the scroll bar that was clicked on. PORTION is the @@ -5636,8 +10892,12 @@ x_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part, verify (INTPTR_WIDTH <= 64); int sign_shift = INTPTR_WIDTH - 32; - block_input (); + /* Don't do anything if too many scroll bar events have been + sent but not received. */ + if (!x_protect_window_for_callback (FRAME_DISPLAY_INFO (f), window)) + return; + block_input (); /* Construct a ClientMessage event to send to the frame. */ ev->type = ClientMessage; ev->message_type = (horizontal @@ -5667,7 +10927,8 @@ x_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part, /* Setting the event mask to zero means that the message will be sent to the client that created the window, and if that window no longer exists, no event will be sent. */ - XSendEvent (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), False, 0, &event); + XSendEvent (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), False, + NoEventMask, &event); unblock_input (); } @@ -6162,6 +11423,30 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar) XDefineCursor (XtDisplay (widget), XtWindow (widget), f->output_data.x->nontext_cursor); +#ifdef HAVE_XINPUT2 + /* Ask for input extension button and motion events. This lets us + send the proper `wheel-up' or `wheel-down' events to Emacs. */ + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + { + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + + mask.deviceid = XIAllMasterDevices; + XISetMask (m, XI_ButtonPress); + XISetMask (m, XI_ButtonRelease); + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); + + XISelectEvents (XtDisplay (widget), XtWindow (widget), + &mask, 1); + } +#endif #else /* !USE_MOTIF i.e. use Xaw */ /* Set resources. Create the widget. The background of the @@ -6363,6 +11648,30 @@ x_create_horizontal_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar) XDefineCursor (XtDisplay (widget), XtWindow (widget), f->output_data.x->nontext_cursor); +#ifdef HAVE_XINPUT2 + /* Ask for input extension button and motion events. This lets us + send the proper `wheel-up' or `wheel-down' events to Emacs. */ + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + { + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + + mask.deviceid = XIAllMasterDevices; + XISetMask (m, XI_ButtonPress); + XISetMask (m, XI_ButtonRelease); + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); + + XISelectEvents (XtDisplay (widget), XtWindow (widget), + &mask, 1); + } +#endif #else /* !USE_MOTIF i.e. use Xaw */ /* Set resources. Create the widget. The background of the @@ -6749,6 +12058,9 @@ x_scroll_bar_create (struct window *w, int top, int left, XSetWindowAttributes a; unsigned long mask; Window window; +#ifdef HAVE_XDBE + Drawable drawable; +#endif a.background_pixel = f->output_data.x->scroll_bar_background_pixel; if (a.background_pixel == -1) @@ -6777,7 +12089,51 @@ x_scroll_bar_create (struct window *w, int top, int left, CopyFromParent, /* Attributes. */ mask, &a); +#ifdef HAVE_XDBE + if (FRAME_DISPLAY_INFO (f)->supports_xdbe + && FRAME_X_DOUBLE_BUFFERED_P (f)) + { + x_catch_errors (FRAME_X_DISPLAY (f)); + drawable = XdbeAllocateBackBufferName (FRAME_X_DISPLAY (f), + window, XdbeCopied); + if (x_had_errors_p (FRAME_X_DISPLAY (f))) + drawable = window; + else + XSetWindowBackgroundPixmap (FRAME_X_DISPLAY (f), window, None); + x_uncatch_errors_after_check (); + } + else + drawable = window; +#endif + +#ifdef HAVE_XINPUT2 + /* Ask for input extension button and motion events. This lets us + send the proper `wheel-up' or `wheel-down' events to Emacs. */ + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + { + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + + mask.deviceid = XIAllMasterDevices; + XISetMask (m, XI_ButtonPress); + XISetMask (m, XI_ButtonRelease); + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); + + XISelectEvents (FRAME_X_DISPLAY (f), window, &mask, 1); + } +#endif + bar->x_window = window; +#ifdef HAVE_XDBE + bar->x_drawable = drawable; +#endif } #endif /* not USE_TOOLKIT_SCROLL_BARS */ @@ -6851,7 +12207,11 @@ x_scroll_bar_set_handle (struct scroll_bar *bar, int start, int end, bool rebuild) { bool dragging = bar->dragging != -1; +#ifndef HAVE_XDBE Window w = bar->x_window; +#else + Drawable w = bar->x_drawable; +#endif struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); GC gc = f->output_data.x->normal_gc; @@ -6901,10 +12261,22 @@ x_scroll_bar_set_handle (struct scroll_bar *bar, int start, int end, /* Draw the empty space above the handle. Note that we can't clear zero-height areas; that means "clear to end of window." */ if ((inside_width > 0) && (start > 0)) - x_clear_area1 (FRAME_X_DISPLAY (f), w, - VERTICAL_SCROLL_BAR_LEFT_BORDER, - VERTICAL_SCROLL_BAR_TOP_BORDER, - inside_width, start, False); + { + if (f->output_data.x->scroll_bar_background_pixel != -1) + XSetForeground (FRAME_X_DISPLAY (f), gc, + f->output_data.x->scroll_bar_background_pixel); + else + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_BACKGROUND_PIXEL (f)); + + XFillRectangle (FRAME_X_DISPLAY (f), w, gc, + VERTICAL_SCROLL_BAR_LEFT_BORDER, + VERTICAL_SCROLL_BAR_TOP_BORDER, + inside_width, start); + + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_FOREGROUND_PIXEL (f)); + } /* Change to proper foreground color if one is specified. */ if (f->output_data.x->scroll_bar_foreground_pixel != -1) @@ -6918,20 +12290,38 @@ x_scroll_bar_set_handle (struct scroll_bar *bar, int start, int end, VERTICAL_SCROLL_BAR_TOP_BORDER + start, inside_width, end - start); - /* Restore the foreground color of the GC if we changed it above. */ - if (f->output_data.x->scroll_bar_foreground_pixel != -1) - XSetForeground (FRAME_X_DISPLAY (f), gc, - FRAME_FOREGROUND_PIXEL (f)); /* Draw the empty space below the handle. Note that we can't clear zero-height areas; that means "clear to end of window." */ if ((inside_width > 0) && (end < inside_height)) - x_clear_area1 (FRAME_X_DISPLAY (f), w, - VERTICAL_SCROLL_BAR_LEFT_BORDER, - VERTICAL_SCROLL_BAR_TOP_BORDER + end, - inside_width, inside_height - end, False); + { + if (f->output_data.x->scroll_bar_background_pixel != -1) + XSetForeground (FRAME_X_DISPLAY (f), gc, + f->output_data.x->scroll_bar_background_pixel); + else + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_BACKGROUND_PIXEL (f)); + + XFillRectangle (FRAME_X_DISPLAY (f), w, gc, + VERTICAL_SCROLL_BAR_LEFT_BORDER, + VERTICAL_SCROLL_BAR_TOP_BORDER + end, + inside_width, inside_height - end); + + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_FOREGROUND_PIXEL (f)); + } + + /* Restore the foreground color of the GC if we changed it above. */ + if (f->output_data.x->scroll_bar_foreground_pixel != -1) + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_FOREGROUND_PIXEL (f)); } +#ifdef HAVE_XDBE + if (!rebuild) + x_scroll_bar_end_update (FRAME_DISPLAY_INFO (f), bar); +#endif + unblock_input (); } @@ -6953,6 +12343,11 @@ x_scroll_bar_remove (struct scroll_bar *bar) XtDestroyWidget (SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar)); #endif /* not USE_GTK */ #else +#ifdef HAVE_XDBE + if (bar->x_window != bar->x_drawable) + XdbeDeallocateBackBufferName (FRAME_X_DISPLAY (f), + bar->x_drawable); +#endif XDestroyWindow (FRAME_X_DISPLAY (f), bar->x_window); #endif @@ -7373,29 +12768,63 @@ XTjudge_scroll_bars (struct frame *f) static void x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) { +#ifndef HAVE_XDBE Window w = bar->x_window; +#else + Drawable w = bar->x_drawable; +#endif + struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); GC gc = f->output_data.x->normal_gc; block_input (); +#ifdef HAVE_XDBE + if (w != bar->x_window) + { + if (f->output_data.x->scroll_bar_background_pixel != -1) + XSetForeground (FRAME_X_DISPLAY (f), gc, + f->output_data.x->scroll_bar_background_pixel); + else + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_BACKGROUND_PIXEL (f)); + + XFillRectangle (FRAME_X_DISPLAY (f), + bar->x_drawable, + gc, event->xexpose.x, + event->xexpose.y, + event->xexpose.width, + event->xexpose.height); + + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_FOREGROUND_PIXEL (f)); + } +#endif + x_scroll_bar_set_handle (bar, bar->start, bar->end, true); /* Switch to scroll bar foreground color. */ if (f->output_data.x->scroll_bar_foreground_pixel != -1) XSetForeground (FRAME_X_DISPLAY (f), gc, - f->output_data.x->scroll_bar_foreground_pixel); + f->output_data.x->scroll_bar_foreground_pixel); /* Draw a one-pixel border just inside the edges of the scroll bar. */ XDrawRectangle (FRAME_X_DISPLAY (f), w, gc, /* x, y, width, height */ 0, 0, bar->width - 1, bar->height - 1); + XDrawPoint (FRAME_X_DISPLAY (f), w, gc, + bar->width - 1, bar->height - 1); + /* Restore the foreground color of the GC if we changed it above. */ if (f->output_data.x->scroll_bar_foreground_pixel != -1) XSetForeground (FRAME_X_DISPLAY (f), gc, FRAME_FOREGROUND_PIXEL (f)); +#ifdef HAVE_XDBE + x_scroll_bar_end_update (FRAME_DISPLAY_INFO (f), bar); +#endif + unblock_input (); } @@ -7527,6 +12956,24 @@ x_scroll_bar_note_movement (struct scroll_bar *bar, } } +#ifdef HAVE_XDBE +static void +x_scroll_bar_end_update (struct x_display_info *dpyinfo, + struct scroll_bar *bar) +{ + XdbeSwapInfo swap_info; + + /* This means the scroll bar is double-buffered. */ + if (bar->x_drawable != bar->x_window) + { + memset (&swap_info, 0, sizeof swap_info); + swap_info.swap_window = bar->x_window; + swap_info.swap_action = XdbeCopied; + XdbeSwapBuffers (dpyinfo->display, &swap_info, 1); + } +} +#endif + #endif /* !USE_TOOLKIT_SCROLL_BARS */ /* Return information to the user about the current position of the mouse @@ -7677,6 +13124,16 @@ x_scroll_bar_clear (struct frame *f) { #ifndef USE_TOOLKIT_SCROLL_BARS Lisp_Object bar; +#ifdef HAVE_XDBE + GC gc = f->output_data.x->normal_gc; + + if (f->output_data.x->scroll_bar_background_pixel != -1) + XSetForeground (FRAME_X_DISPLAY (f), gc, + f->output_data.x->scroll_bar_background_pixel); + else + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_BACKGROUND_PIXEL (f)); +#endif /* We can have scroll bars even if this is 0, if we just turned off scroll bar mode. @@ -7684,9 +13141,27 @@ x_scroll_bar_clear (struct frame *f) if (FRAME_HAS_VERTICAL_SCROLL_BARS (f)) for (bar = FRAME_SCROLL_BARS (f); VECTORP (bar); bar = XSCROLL_BAR (bar)->next) - XClearArea (FRAME_X_DISPLAY (f), - XSCROLL_BAR (bar)->x_window, - 0, 0, 0, 0, True); + { +#ifdef HAVE_XDBE + if (XSCROLL_BAR (bar)->x_window + == XSCROLL_BAR (bar)->x_drawable) +#endif + XClearArea (FRAME_X_DISPLAY (f), + XSCROLL_BAR (bar)->x_window, + 0, 0, 0, 0, True); +#ifdef HAVE_XDBE + else + XFillRectangle (FRAME_X_DISPLAY (f), + XSCROLL_BAR (bar)->x_drawable, + gc, 0, 0, XSCROLL_BAR (bar)->width, + XSCROLL_BAR (bar)->height); +#endif + } + +#ifdef HAVE_XDBE + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_FOREGROUND_PIXEL (f)); +#endif #endif /* not USE_TOOLKIT_SCROLL_BARS */ } @@ -7721,13 +13196,6 @@ static struct x_display_info *XTread_socket_fake_io_error; static struct x_display_info *next_noop_dpyinfo; -enum -{ - X_EVENT_NORMAL, - X_EVENT_GOTO_OUT, - X_EVENT_DROP -}; - /* Filter events for the current X input method. DPYINFO is the display this event is for. EVENT is the X event to filter. @@ -7745,18 +13213,64 @@ x_filter_event (struct x_display_info *dpyinfo, XEvent *event) XFilterEvent because that's the one for which the IC was created. */ - struct frame *f1 = x_any_window_to_frame (dpyinfo, - event->xclient.window); + struct frame *f1; - return XFilterEvent (event, f1 ? FRAME_X_WINDOW (f1) : None); -} +#if defined HAVE_XINPUT2 && defined USE_GTK + bool xinput_event = false; + if (dpyinfo->supports_xi2 + && event->type == GenericEvent + && (event->xgeneric.extension + == dpyinfo->xi2_opcode) + && ((event->xgeneric.evtype + == XI_KeyPress) + || (event->xgeneric.evtype + == XI_KeyRelease))) + { + f1 = x_any_window_to_frame (dpyinfo, + ((XIDeviceEvent *) + event->xcookie.data)->event); + xinput_event = true; + } + else #endif + f1 = x_any_window_to_frame (dpyinfo, + event->xclient.window); #ifdef USE_GTK -static int current_count; -static int current_finish; -static struct input_event *current_hold_quit; + if (!x_gtk_use_native_input + && !dpyinfo->prefer_native_input) + { +#endif + return XFilterEvent (event, f1 ? FRAME_X_WINDOW (f1) : None); +#ifdef USE_GTK + } + else if (f1 && (event->type == KeyPress + || event->type == KeyRelease +#ifdef HAVE_XINPUT2 + || xinput_event +#endif + )) + { + bool result; + + block_input (); + result = xg_filter_key (f1, event); + unblock_input (); + + if (result && f1) + /* There will probably be a GDK event generated soon, so + exercise the wire to make pselect return. */ + XNoOp (FRAME_X_DISPLAY (f1)); + + return result; + } + return 0; +#endif +} +#endif + +#ifdef USE_GTK /* This is the filter function invoked by the GTK event loop. It is invoked before the XEvent is translated to a GdkEvent, so we have a chance to act on the event before GTK. */ @@ -7783,6 +13297,40 @@ event_handler_gdk (GdkXEvent *gxev, GdkEvent *ev, gpointer data) unblock_input (); return GDK_FILTER_REMOVE; } +#elif USE_GTK + if (dpyinfo && (dpyinfo->prefer_native_input + || x_gtk_use_native_input) + && (xev->type == KeyPress +#ifdef HAVE_XINPUT2 + /* GTK claims cookies for us, so we don't have to claim + them here. */ + || (dpyinfo->supports_xi2 + && xev->type == GenericEvent + && (xev->xgeneric.extension + == dpyinfo->xi2_opcode) + && ((xev->xgeneric.evtype + == XI_KeyPress) + || (xev->xgeneric.evtype + == XI_KeyRelease))) +#endif + )) + { + struct frame *f; + +#ifdef HAVE_XINPUT2 + if (xev->type == GenericEvent) + f = x_any_window_to_frame (dpyinfo, + ((XIDeviceEvent *) xev->xcookie.data)->event); + else +#endif + f = x_any_window_to_frame (dpyinfo, xev->xany.window); + + if (f && xg_filter_key (f, xev)) + { + unblock_input (); + return GDK_FILTER_REMOVE; + } + } #endif if (! dpyinfo) @@ -7814,9 +13362,9 @@ x_net_wm_state (struct frame *f, Window window) { int value = FULLSCREEN_NONE; Lisp_Object lval = Qnil; - bool sticky = false; + bool sticky = false, shaded = false; - x_get_current_wm_state (f, window, &value, &sticky); + x_get_current_wm_state (f, window, &value, &sticky, &shaded); switch (value) { @@ -7835,29 +13383,53 @@ x_net_wm_state (struct frame *f, Window window) } store_frame_param (f, Qfullscreen, lval); -/** store_frame_param (f, Qsticky, sticky ? Qt : Qnil); **/ + store_frame_param (f, Qsticky, sticky ? Qt : Qnil); + store_frame_param (f, Qshaded, shaded ? Qt : Qnil); } -/* Flip back buffers on any frames with undrawn content. */ +/* Flip back buffers on FRAME if it has undrawn content. */ static void -flush_dirty_back_buffers (void) +flush_dirty_back_buffer_on (struct frame *f) { block_input (); - Lisp_Object tail, frame; - FOR_EACH_FRAME (tail, frame) - { - struct frame *f = XFRAME (frame); - if (FRAME_LIVE_P (f) && - FRAME_X_P (f) && - FRAME_X_WINDOW (f) && - !FRAME_GARBAGED_P (f) && - !buffer_flipping_blocked_p () && - FRAME_X_NEED_BUFFER_FLIP (f)) - show_back_buffer (f); - } + if (FRAME_LIVE_P (f) && + FRAME_X_P (f) && + FRAME_X_WINDOW (f) && + !FRAME_GARBAGED_P (f) && + !buffer_flipping_blocked_p () && + FRAME_X_NEED_BUFFER_FLIP (f)) + show_back_buffer (f); unblock_input (); } +#ifdef HAVE_GTK3 +void +x_scroll_bar_configure (GdkEvent *event) +{ + XEvent configure; + GdkDisplay *gdpy; + Display *dpy; + + configure.xconfigure.type = ConfigureNotify; + configure.xconfigure.serial = 0; + configure.xconfigure.send_event = event->configure.send_event; + configure.xconfigure.x = event->configure.x; + configure.xconfigure.y = event->configure.y; + configure.xconfigure.width = event->configure.width; + configure.xconfigure.height = event->configure.height; + configure.xconfigure.border_width = 0; + configure.xconfigure.event = GDK_WINDOW_XID (event->configure.window); + configure.xconfigure.window = GDK_WINDOW_XID (event->configure.window); + configure.xconfigure.above = None; + configure.xconfigure.override_redirect = False; + + gdpy = gdk_window_get_display (event->configure.window); + dpy = gdk_x11_display_get_xdisplay (gdpy); + + x_dispatch_event (&configure, dpy); +} +#endif + /** mouse_or_wdesc_frame: When not dropping and the mouse was grabbed for DPYINFO, return the frame where the mouse was seen last. If @@ -7873,7 +13445,8 @@ mouse_or_wdesc_frame (struct x_display_info *dpyinfo, int wdesc) ? dpyinfo->last_mouse_frame : NULL); - if (lm_f && !EQ (track_mouse, Qdropping)) + if (lm_f && !EQ (track_mouse, Qdropping) + && !EQ (track_mouse, Qdrag_source)) return lm_f; else { @@ -7889,6 +13462,210 @@ mouse_or_wdesc_frame (struct x_display_info *dpyinfo, int wdesc) } } +/* Get the window underneath the pointer, see if it moved, and update + the DND state accordingly. */ +static void +x_dnd_update_state (struct x_display_info *dpyinfo, Time timestamp) +{ + int root_x, root_y, dummy_x, dummy_y, target_proto, motif_style; + unsigned int dummy_mask; + Window dummy, dummy_child, target, toplevel; + xm_top_level_leave_message lmsg; + xm_top_level_enter_message emsg; + xm_drag_motion_message dmsg; + xm_drop_start_message dsmsg; + + if (XQueryPointer (dpyinfo->display, + dpyinfo->root_window, + &dummy, &dummy_child, + &root_x, &root_y, + &dummy_x, &dummy_y, + &dummy_mask)) + { + target = x_dnd_get_target_window (dpyinfo, root_x, + root_y, &target_proto, + &motif_style, &toplevel); + + if (toplevel != x_dnd_last_seen_toplevel) + { + if (toplevel != FRAME_OUTER_WINDOW (x_dnd_frame) + && x_dnd_return_frame == 1) + x_dnd_return_frame = 2; + + if (x_dnd_return_frame == 2 + && x_any_window_to_frame (dpyinfo, toplevel)) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1 + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + lmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_TOP_LEVEL_LEAVE); + lmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + lmsg.zero = 0; + lmsg.timestamp = timestamp; + lmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + + if (x_dnd_motif_setup_p) + xm_send_top_level_leave_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &lmsg); + } + + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_dnd_return_frame_object + = x_any_window_to_frame (dpyinfo, toplevel); + x_dnd_return_frame = 3; + x_dnd_waiting_for_finish = false; + target = None; + } + + x_dnd_last_seen_toplevel = toplevel; + } + + if (target != x_dnd_last_seen_window) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1 + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + lmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_TOP_LEVEL_LEAVE); + lmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + lmsg.zero = 0; + lmsg.timestamp = timestamp; + lmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + + if (x_dnd_motif_setup_p) + xm_send_top_level_leave_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &lmsg); + } + + x_dnd_action = None; + x_dnd_last_seen_window = target; + x_dnd_last_protocol_version = target_proto; + x_dnd_last_motif_style = motif_style; + + if (target != None && x_dnd_last_protocol_version != -1) + x_dnd_send_enter (x_dnd_frame, target, + x_dnd_last_protocol_version); + else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style)) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + emsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_TOP_LEVEL_ENTER); + emsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + emsg.zero = 0; + emsg.timestamp = timestamp; + emsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + emsg.index_atom = dpyinfo->Xatom_XdndSelection; + + if (x_dnd_motif_setup_p) + xm_send_top_level_enter_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + target, &emsg); + } + } + + if (x_dnd_last_protocol_version != -1 && target != None) + x_dnd_send_position (x_dnd_frame, target, + x_dnd_last_protocol_version, + root_x, root_y, + x_dnd_selection_timestamp, + x_dnd_wanted_action, 0, +#ifdef HAVE_XKB + x_dnd_keyboard_state +#else + 0 +#endif + ); + else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DRAG_MOTION); + dmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + (!x_dnd_xm_use_help + ? XM_DROP_ACTION_DROP + : XM_DROP_ACTION_DROP_HELP)); + dmsg.timestamp = timestamp; + dmsg.x = root_x; + dmsg.y = root_y; + + if (x_dnd_motif_setup_p) + xm_send_drag_motion_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + target, &dmsg); + } + } + /* The pointer moved out of the screen. */ + else if (x_dnd_last_protocol_version != -1) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (x_dnd_frame, + x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style) + && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE + && x_dnd_motif_setup_p) + { + dsmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + dsmsg.timestamp = timestamp; + dsmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_ACTION_DROP_CANCEL); + dsmsg.x = 0; + dsmsg.y = 0; + dsmsg.index_atom + = FRAME_DISPLAY_INFO (x_dnd_frame)->Xatom_XdndSelection; + dsmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + + x_dnd_send_xm_leave_for_drop (dpyinfo, x_dnd_frame, + x_dnd_last_seen_window, timestamp); + xm_send_drop_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &dsmsg); + } + + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_dnd_waiting_for_finish = false; + x_dnd_frame = NULL; + } +} + /* Handles the XEvent EVENT on display DPYINFO. *FINISH is X_EVENT_GOTO_OUT if caller should stop reading events. @@ -7900,7 +13677,11 @@ mouse_or_wdesc_frame (struct x_display_info *dpyinfo, int wdesc) static int handle_one_xevent (struct x_display_info *dpyinfo, +#ifndef HAVE_XINPUT2 const XEvent *event, +#else + XEvent *event, +#endif int *finish, struct input_event *hold_quit) { union buffered_input_event inev; @@ -7908,7 +13689,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, int do_help = 0; ptrdiff_t nbytes = 0; struct frame *any, *f = NULL; - struct coding_system coding; Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight; /* This holds the state XLookupString needs to implement dead keys and other tricks known as "compose processing". _X Window System_ @@ -7917,8 +13697,17 @@ handle_one_xevent (struct x_display_info *dpyinfo, static XComposeStatus compose_status; XEvent configureEvent; XEvent next_event; - - USE_SAFE_ALLOCA; + Lisp_Object coding; +#if defined USE_MOTIF && defined HAVE_XINPUT2 + /* Some XInput 2 events are important for Motif menu bars to work + correctly, so they must be translated into core events before + being passed to XtDispatchEvent. */ + bool use_copy = false; + XEvent copy; +#elif defined USE_GTK && !defined HAVE_GTK3 && defined HAVE_XINPUT2 + GdkEvent *copy = NULL; + GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (dpyinfo->display); +#endif *finish = X_EVENT_NORMAL; @@ -7926,7 +13715,21 @@ handle_one_xevent (struct x_display_info *dpyinfo, inev.ie.kind = NO_EVENT; inev.ie.arg = Qnil; - any = x_any_window_to_frame (dpyinfo, event->xany.window); + /* Ignore events coming from various extensions, such as XFIXES and + XKB. */ + if (event->type < LASTEvent) + { +#ifdef HAVE_XINPUT2 + if (event->type != GenericEvent) +#endif + any = x_any_window_to_frame (dpyinfo, event->xany.window); +#ifdef HAVE_XINPUT2 + else + any = NULL; +#endif + } + else + any = NULL; if (any && any->wait_event_type == event->type) any->wait_event_type = 0; /* Indicates we got it. */ @@ -7935,6 +13738,114 @@ handle_one_xevent (struct x_display_info *dpyinfo, { case ClientMessage: { + if (x_dnd_in_progress + && FRAME_DISPLAY_INFO (x_dnd_frame) == dpyinfo + && event->xclient.message_type == dpyinfo->Xatom_XdndStatus) + { + Window target; + + target = event->xclient.data.l[0]; + + if (x_dnd_last_protocol_version != -1 + && target == x_dnd_last_seen_window + && event->xclient.data.l[1] & 2) + { + x_dnd_mouse_rect_target = target; + x_dnd_mouse_rect.x = (event->xclient.data.l[2] & 0xffff0000) >> 16; + x_dnd_mouse_rect.y = (event->xclient.data.l[2] & 0xffff); + x_dnd_mouse_rect.width = (event->xclient.data.l[3] & 0xffff0000) >> 16; + x_dnd_mouse_rect.height = (event->xclient.data.l[3] & 0xffff); + } + else + x_dnd_mouse_rect_target = None; + + if (x_dnd_last_protocol_version != -1 + && target == x_dnd_last_seen_window) + { + if (event->xclient.data.l[1] & 1) + { + if (x_dnd_last_protocol_version >= 2) + x_dnd_action = event->xclient.data.l[4]; + else + x_dnd_action = dpyinfo->Xatom_XdndActionCopy; + } + else + x_dnd_action = None; + } + + goto done; + } + + if (event->xclient.message_type == dpyinfo->Xatom_XdndFinished + && (x_dnd_waiting_for_finish && !x_dnd_waiting_for_motif_finish) + && event->xclient.data.l[0] == x_dnd_pending_finish_target) + { + x_dnd_waiting_for_finish = false; + + if (x_dnd_waiting_for_finish_proto >= 5) + x_dnd_action = event->xclient.data.l[2]; + + if (x_dnd_waiting_for_finish_proto >= 5 + && !(event->xclient.data.l[1] & 1)) + x_dnd_action = None; + + goto done; + } + + if ((event->xclient.message_type + == dpyinfo->Xatom_MOTIF_DRAG_AND_DROP_MESSAGE) + /* FIXME: There should probably be a check that the event + comes from the same display where the drop event was + sent, but there's no way to get that information here + safely. */ + && x_dnd_waiting_for_finish + && x_dnd_waiting_for_motif_finish == 1) + { + xm_drop_start_reply reply; + uint16_t operation, status, action; + + if (!xm_read_drop_start_reply (event, &reply)) + { + operation = XM_DRAG_SIDE_EFFECT_OPERATION (reply.side_effects); + status = XM_DRAG_SIDE_EFFECT_SITE_STATUS (reply.side_effects); + action = XM_DRAG_SIDE_EFFECT_DROP_ACTION (reply.side_effects); + + if (operation != XM_DRAG_MOVE + && operation != XM_DRAG_COPY + && operation != XM_DRAG_LINK) + { + x_dnd_waiting_for_finish = false; + goto done; + } + + if (status != XM_DROP_SITE_VALID + || (action == XM_DROP_ACTION_DROP_CANCEL + || action == XM_DROP_ACTION_DROP_HELP)) + { + x_dnd_waiting_for_finish = false; + goto done; + } + + switch (operation) + { + case XM_DRAG_MOVE: + x_dnd_action = dpyinfo->Xatom_XdndActionMove; + break; + + case XM_DRAG_COPY: + x_dnd_action = dpyinfo->Xatom_XdndActionCopy; + break; + + case XM_DRAG_LINK: + x_dnd_action = dpyinfo->Xatom_XdndActionLink; + break; + } + + x_dnd_waiting_for_motif_finish = 2; + goto done; + } + } + if (event->xclient.message_type == dpyinfo->Xatom_wm_protocols && event->xclient.format == 32) { @@ -8025,6 +13936,85 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto done; } + + if (event->xclient.data.l[0] == dpyinfo->Xatom_net_wm_ping + && event->xclient.format == 32) + { + XEvent send_event = *event; + + send_event.xclient.window = dpyinfo->root_window; + XSendEvent (dpyinfo->display, dpyinfo->root_window, False, + /* FIXME: handling window stacking changes + during drag-and-drop requires Emacs to + select for SubstructureNotifyMask, + which in turn causes the message to be + sent to Emacs itself using the event + mask specified by the EWMH. To avoid + an infinite loop, just use + SubstructureRedirectMask when a + drag-and-drop operation is in + progress. */ + ((x_dnd_in_progress || x_dnd_waiting_for_finish) + ? SubstructureRedirectMask + : SubstructureRedirectMask | SubstructureNotifyMask), + &send_event); + + *finish = X_EVENT_DROP; + goto done; + } + +#if defined HAVE_XSYNC + if (event->xclient.data.l[0] == dpyinfo->Xatom_net_wm_sync_request + && event->xclient.format == 32 + && dpyinfo->xsync_supported_p) + { + struct frame *f + = x_top_window_to_frame (dpyinfo, + event->xclient.window); +#if defined HAVE_GTK3 + GtkWidget *widget; + GdkWindow *window; + GdkFrameClock *frame_clock; +#endif + + if (f) + { +#ifndef HAVE_GTK3 + if (event->xclient.data.l[4] == 0) + { + XSyncIntsToValue (&FRAME_X_OUTPUT (f)->pending_basic_counter_value, + event->xclient.data.l[2], event->xclient.data.l[3]); + FRAME_X_OUTPUT (f)->sync_end_pending_p = true; + } + else if (event->xclient.data.l[4] == 1) + { + XSyncIntsToValue (&FRAME_X_OUTPUT (f)->current_extended_counter_value, + event->xclient.data.l[2], event->xclient.data.l[3]); + FRAME_X_OUTPUT (f)->ext_sync_end_pending_p = true; + } + + *finish = X_EVENT_DROP; +#else + widget = FRAME_GTK_OUTER_WIDGET (f); + + if (widget && !FRAME_X_OUTPUT (f)->xg_sync_end_pending_p) + { + window = gtk_widget_get_window (widget); + eassert (window); + frame_clock = gdk_window_get_frame_clock (window); + eassert (frame_clock); + + gdk_frame_clock_request_phase (frame_clock, + GDK_FRAME_CLOCK_PHASE_BEFORE_PAINT); + + FRAME_X_OUTPUT (f)->xg_sync_end_pending_p = true; + } +#endif + goto done; + } + } +#endif + goto done; } @@ -8115,7 +14105,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, break; case SelectionNotify: - x_display_set_last_user_time (dpyinfo, event->xselection.time); #ifdef USE_X_TOOLKIT if (! x_window_to_frame (dpyinfo, event->xselection.requestor)) goto OTHER; @@ -8124,7 +14113,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, break; case SelectionClear: /* Someone has grabbed ownership. */ - x_display_set_last_user_time (dpyinfo, event->xselectionclear.time); #ifdef USE_X_TOOLKIT if (! x_window_to_frame (dpyinfo, event->xselectionclear.window)) goto OTHER; @@ -8140,7 +14128,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, break; case SelectionRequest: /* Someone wants our selection. */ - x_display_set_last_user_time (dpyinfo, event->xselectionrequest.time); #ifdef USE_X_TOOLKIT if (!x_window_to_frame (dpyinfo, event->xselectionrequest.owner)) goto OTHER; @@ -8155,13 +14142,92 @@ handle_one_xevent (struct x_display_info *dpyinfo, SELECTION_EVENT_TARGET (&inev.sie) = eventp->target; SELECTION_EVENT_PROPERTY (&inev.sie) = eventp->property; SELECTION_EVENT_TIME (&inev.sie) = eventp->time; + + /* If drag-and-drop is in progress, handle SelectionRequest + events immediately, by setting hold_quit to the input + event. */ + + if (x_dnd_in_progress || x_dnd_waiting_for_finish) + { + eassume (hold_quit); + + *hold_quit = inev.ie; + EVENT_INIT (inev.ie); + } + + if (x_dnd_waiting_for_finish + && x_dnd_waiting_for_motif_finish == 2 + && eventp->selection == dpyinfo->Xatom_XdndSelection + && (eventp->target == dpyinfo->Xatom_XmTRANSFER_SUCCESS + || eventp->target == dpyinfo->Xatom_XmTRANSFER_FAILURE)) + x_dnd_waiting_for_finish = false; } break; case PropertyNotify: - x_display_set_last_user_time (dpyinfo, event->xproperty.time); + if (x_dnd_in_progress && x_dnd_use_toplevels + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame) + && event->xproperty.atom == dpyinfo->Xatom_wm_state) + { + struct x_client_list_window *tem, *last; + + for (last = NULL, tem = x_dnd_toplevels; tem; + last = tem, tem = tem->next) + { + if (tem->window == event->xproperty.window) + { + Atom actual_type; + int actual_format, rc; + unsigned long nitems, bytesafter; + unsigned char *data = NULL; + + + if (event->xproperty.state == PropertyDelete) + { + if (!last) + x_dnd_toplevels = tem->next; + else + last->next = tem->next; + +#ifdef HAVE_XSHAPE + if (tem->n_input_rects != -1) + xfree (tem->input_rects); + if (tem->n_bounding_rects != -1) + xfree (tem->bounding_rects); +#endif + xfree (tem); + } + else + { + x_catch_errors (dpyinfo->display); + rc = XGetWindowProperty (dpyinfo->display, + event->xproperty.window, + dpyinfo->Xatom_wm_state, + 0, 2, False, AnyPropertyType, + &actual_type, &actual_format, + &nitems, &bytesafter, &data); + + if (!x_had_errors_p (dpyinfo->display) && rc == Success && data + && nitems == 2 && actual_format == 32) + tem->wm_state = ((unsigned long *) data)[0]; + else + tem->wm_state = WithdrawnState; + + if (data) + XFree (data); + x_uncatch_errors_after_check (); + } + + x_dnd_update_state (dpyinfo, event->xproperty.time); + break; + } + } + } + f = x_top_window_to_frame (dpyinfo, event->xproperty.window); - if (f && event->xproperty.atom == dpyinfo->Xatom_net_wm_state) + if (f && event->xproperty.atom == dpyinfo->Xatom_net_wm_state + /* This should never happen with embedded windows. */ + && !FRAME_X_EMBEDDED_P (f)) { bool not_hidden = x_handle_net_wm_state (f, &event->xproperty); @@ -8204,6 +14270,26 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } + if (event->xproperty.window == dpyinfo->root_window + && (event->xproperty.atom == dpyinfo->Xatom_net_client_list_stacking + || event->xproperty.atom == dpyinfo->Xatom_net_current_desktop) + && x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + if (x_dnd_use_toplevels) + { + x_dnd_free_toplevels (); + + if (x_dnd_compute_toplevels (dpyinfo)) + { + x_dnd_free_toplevels (); + x_dnd_use_toplevels = false; + } + } + + x_dnd_update_state (dpyinfo, event->xproperty.time); + } + x_handle_property_notify (&event->xproperty); xft_settings_event (dpyinfo, event); goto OTHER; @@ -8238,6 +14324,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)) @@ -8256,7 +14354,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } if (FRAME_X_DOUBLE_BUFFERED_P (f)) - font_drop_xrender_surfaces (f); + x_drop_xrender_surfaces (f); f->output_data.x->has_been_visible = true; SET_FRAME_GARBAGED (f); unblock_input (); @@ -8355,9 +14453,26 @@ handle_one_xevent (struct x_display_info *dpyinfo, case NoExpose: /* This occurs when an XCopyArea's source area was completely available. */ +#ifdef USE_X_TOOLKIT + *finish = X_EVENT_DROP; +#endif break; case UnmapNotify: + if (x_dnd_in_progress && x_dnd_use_toplevels + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + for (struct x_client_list_window *tem = x_dnd_toplevels; tem; + tem = tem->next) + { + if (tem->window == event->xunmap.window) + { + tem->mapped_p = false; + break; + } + } + } + /* Redo the mouse-highlight after the tooltip has gone. */ if (event->xunmap.window == tip_window) { @@ -8398,6 +14513,28 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case MapNotify: +#if defined HAVE_XINPUT2 && defined HAVE_GTK3 + if (xg_is_menu_window (dpyinfo->display, event->xmap.window)) + popup_activated_flag = 1; +#endif + + if (x_dnd_in_progress) + x_dnd_update_state (dpyinfo, dpyinfo->last_user_time); + + if (x_dnd_in_progress && x_dnd_use_toplevels + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + for (struct x_client_list_window *tem = x_dnd_toplevels; tem; + tem = tem->next) + { + if (tem->window == event->xmap.window) + { + tem->mapped_p = true; + break; + } + } + } + /* We use x_top_window_to_frame because map events can come for sub-windows and they don't mean that the frame is visible. */ @@ -8406,8 +14543,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, { bool iconified = FRAME_ICONIFIED_P (f); int value; - bool sticky; - bool not_hidden = x_get_current_wm_state (f, event->xmap.window, &value, &sticky); + bool sticky, shaded; + bool not_hidden = x_get_current_wm_state (f, event->xmap.window, &value, &sticky, + &shaded); if (CONSP (frame_size_history)) frame_size_history_extra @@ -8446,7 +14584,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_set_z_group (f, Qbelow, Qnil); } - if (not_hidden) + /* Embedded frames might have NET_WM_STATE left over, but + are always visible once mapped. */ + if (not_hidden || FRAME_X_EMBEDDED_P (f)) { SET_FRAME_VISIBLE (f, 1); SET_FRAME_ICONIFIED (f, false); @@ -8463,7 +14603,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, f->output_data.x->has_been_visible = true; } - if (not_hidden && iconified) + x_update_opaque_region (f, NULL); + + if ((not_hidden || FRAME_X_EMBEDDED_P (f)) && iconified) { inev.ie.kind = DEICONIFY_EVENT; XSETFRAME (inev.ie.frame_or_window, f); @@ -8472,9 +14614,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case KeyPress: - x_display_set_last_user_time (dpyinfo, event->xkey.time); ignore_next_mouse_click_timeout = 0; + coding = Qlatin_1; #if defined (USE_X_TOOLKIT) || defined (USE_GTK) /* Dispatch KeyPress events when in menu. */ @@ -8531,10 +14673,29 @@ handle_one_xevent (struct x_display_info *dpyinfo, unsigned char *copy_bufptr = copy_buffer; int copy_bufsiz = sizeof (copy_buffer); int modifiers; - Lisp_Object coding_system = Qlatin_1; Lisp_Object c; - /* Event will be modified. */ + /* `xkey' will be modified, but it's not important to modify + `event' itself. */ XKeyEvent xkey = event->xkey; + int i; +#ifdef HAVE_XINPUT2 + Time pending_keystroke_time; + struct xi_device_t *source; + + pending_keystroke_time = dpyinfo->pending_keystroke_time; + + if (event->xkey.time >= pending_keystroke_time) + { +#if defined USE_GTK && !defined HAVE_GTK3 + if (!dpyinfo->pending_keystroke_time_special_p) +#endif + dpyinfo->pending_keystroke_time = 0; +#if defined USE_GTK && !defined HAVE_GTK3 + else + dpyinfo->pending_keystroke_time_special_p = false; +#endif + } +#endif #ifdef USE_GTK /* Don't pass keys to GTK. A Tab will shift focus to the @@ -8566,16 +14727,37 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (modifiers & dpyinfo->meta_mod_mask) memset (&compose_status, 0, sizeof (compose_status)); +#ifdef HAVE_XKB + if (FRAME_DISPLAY_INFO (f)->xkb_desc) + { + XkbDescRec *rec = FRAME_DISPLAY_INFO (f)->xkb_desc; + + if (rec->map->modmap && rec->map->modmap[xkey.keycode]) + goto done_keysym; + } + else +#endif + { + if (dpyinfo->modmap) + { + for (i = 0; i < 8 * dpyinfo->modmap->max_keypermod; i++) + { + if (xkey.keycode == dpyinfo->modmap->modifiermap[i]) + goto done_keysym; + } + } + } + #ifdef HAVE_X_I18N if (FRAME_XIC (f)) { Status status_return; - coding_system = Vlocale_coding_system; nbytes = XmbLookupString (FRAME_XIC (f), &xkey, (char *) copy_bufptr, copy_bufsiz, &keysym, &status_return); + coding = Qnil; if (status_return == XBufferOverflow) { copy_bufsiz = nbytes + 1; @@ -8607,6 +14789,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, &compose_status); #endif +#ifdef XK_F1 + if (x_dnd_in_progress && keysym == XK_F1) + { + x_dnd_xm_use_help = true; + goto done_keysym; + } +#endif + /* If not using XIM/XIC, and a compose sequence is in progress, we break here. Otherwise, chars_matched is always 0. */ if (compose_status.chars_matched > 0 && nbytes == 0) @@ -8615,19 +14805,31 @@ handle_one_xevent (struct x_display_info *dpyinfo, memset (&compose_status, 0, sizeof (compose_status)); orig_keysym = keysym; - /* Common for all keysym input events. */ - XSETFRAME (inev.ie.frame_or_window, f); - inev.ie.modifiers - = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers); - inev.ie.timestamp = xkey.time; - - /* First deal with keysyms which have defined - translations to characters. */ - if (keysym >= 32 && keysym < 128) - /* Avoid explicitly decoding each ASCII character. */ - { - inev.ie.kind = ASCII_KEYSTROKE_EVENT; - inev.ie.code = keysym; + /* Common for all keysym input events. */ + XSETFRAME (inev.ie.frame_or_window, f); + inev.ie.modifiers + = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers); + inev.ie.timestamp = xkey.time; + + /* First deal with keysyms which have defined + translations to characters. */ + if (keysym >= 32 && keysym < 128) + /* Avoid explicitly decoding each ASCII character. */ + { + inev.ie.kind = ASCII_KEYSTROKE_EVENT; + inev.ie.code = keysym; + +#ifdef HAVE_XINPUT2 + if (event->xkey.time == pending_keystroke_time) + { + source = xi_device_from_id (dpyinfo, + dpyinfo->pending_keystroke_source); + + if (source) + inev.ie.device = source->name; + } +#endif + goto done_keysym; } @@ -8639,6 +14841,18 @@ handle_one_xevent (struct x_display_info *dpyinfo, else inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; inev.ie.code = keysym & 0xFFFFFF; + +#ifdef HAVE_XINPUT2 + if (event->xkey.time == pending_keystroke_time) + { + source = xi_device_from_id (dpyinfo, + dpyinfo->pending_keystroke_source); + + if (source) + inev.ie.device = source->name; + } +#endif + goto done_keysym; } @@ -8648,167 +14862,190 @@ handle_one_xevent (struct x_display_info *dpyinfo, Vx_keysym_table, Qnil), FIXNATP (c))) - { + { inev.ie.kind = (SINGLE_BYTE_CHAR_P (XFIXNAT (c)) ? ASCII_KEYSTROKE_EVENT : MULTIBYTE_CHAR_KEYSTROKE_EVENT); inev.ie.code = XFIXNAT (c); - goto done_keysym; - } - /* Random non-modifier sorts of keysyms. */ - if (((keysym >= XK_BackSpace && keysym <= XK_Escape) - || keysym == XK_Delete +#ifdef HAVE_XINPUT2 + if (event->xkey.time == pending_keystroke_time) + { + source = xi_device_from_id (dpyinfo, + dpyinfo->pending_keystroke_source); + + if (source) + inev.ie.device = source->name; + } +#endif + + goto done_keysym; + } + + /* Random non-modifier sorts of keysyms. */ + if (((keysym >= XK_BackSpace && keysym <= XK_Escape) + || keysym == XK_Delete #ifdef XK_ISO_Left_Tab - || (keysym >= XK_ISO_Left_Tab - && keysym <= XK_ISO_Enter) + || (keysym >= XK_ISO_Left_Tab + && keysym <= XK_ISO_Enter) #endif - || IsCursorKey (keysym) /* 0xff50 <= x < 0xff60 */ - || IsMiscFunctionKey (keysym) /* 0xff60 <= x < VARIES */ + || IsCursorKey (keysym) /* 0xff50 <= x < 0xff60 */ + || IsMiscFunctionKey (keysym) /* 0xff60 <= x < VARIES */ #ifdef HPUX - /* This recognizes the "extended function - keys". It seems there's no cleaner way. - Test IsModifierKey to avoid handling - mode_switch incorrectly. */ - || (XK_Select <= keysym && keysym < XK_KP_Space) + /* This recognizes the "extended function + keys". It seems there's no cleaner way. + Test IsModifierKey to avoid handling + mode_switch incorrectly. */ + || (XK_Select <= keysym && keysym < XK_KP_Space) #endif #ifdef XK_dead_circumflex - || orig_keysym == XK_dead_circumflex + || orig_keysym == XK_dead_circumflex #endif #ifdef XK_dead_grave - || orig_keysym == XK_dead_grave + || orig_keysym == XK_dead_grave #endif #ifdef XK_dead_tilde - || orig_keysym == XK_dead_tilde + || orig_keysym == XK_dead_tilde #endif #ifdef XK_dead_diaeresis - || orig_keysym == XK_dead_diaeresis + || orig_keysym == XK_dead_diaeresis #endif #ifdef XK_dead_macron - || orig_keysym == XK_dead_macron + || orig_keysym == XK_dead_macron #endif #ifdef XK_dead_degree - || orig_keysym == XK_dead_degree + || orig_keysym == XK_dead_degree #endif #ifdef XK_dead_acute - || orig_keysym == XK_dead_acute + || orig_keysym == XK_dead_acute #endif #ifdef XK_dead_cedilla - || orig_keysym == XK_dead_cedilla + || orig_keysym == XK_dead_cedilla #endif #ifdef XK_dead_breve - || orig_keysym == XK_dead_breve + || orig_keysym == XK_dead_breve #endif #ifdef XK_dead_ogonek - || orig_keysym == XK_dead_ogonek + || orig_keysym == XK_dead_ogonek #endif #ifdef XK_dead_caron - || orig_keysym == XK_dead_caron + || orig_keysym == XK_dead_caron #endif #ifdef XK_dead_doubleacute - || orig_keysym == XK_dead_doubleacute + || orig_keysym == XK_dead_doubleacute #endif #ifdef XK_dead_abovedot - || orig_keysym == XK_dead_abovedot -#endif - || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */ - || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */ - /* Any "vendor-specific" key is ok. */ - || (orig_keysym & (1 << 28)) - || (keysym != NoSymbol && nbytes == 0)) - && ! (IsModifierKey (orig_keysym) - /* The symbols from XK_ISO_Lock - to XK_ISO_Last_Group_Lock - don't have real modifiers but - should be treated similarly to - Mode_switch by Emacs. */ + || orig_keysym == XK_dead_abovedot +#endif +#ifdef XK_dead_abovering + || orig_keysym == XK_dead_abovering +#endif +#ifdef XK_dead_belowdot + || orig_keysym == XK_dead_belowdot +#endif +#ifdef XK_dead_voiced_sound + || orig_keysym == XK_dead_voiced_sound +#endif +#ifdef XK_dead_semivoiced_sound + || orig_keysym == XK_dead_semivoiced_sound +#endif +#ifdef XK_dead_hook + || orig_keysym == XK_dead_hook +#endif +#ifdef XK_dead_horn + || orig_keysym == XK_dead_horn +#endif +#ifdef XK_dead_stroke + || orig_keysym == XK_dead_stroke +#endif +#ifdef XK_dead_abovecomma + || orig_keysym == XK_dead_abovecomma +#endif + || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */ + || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */ + /* Any "vendor-specific" key is ok. */ + || (orig_keysym & (1 << 28)) + || (keysym != NoSymbol && nbytes == 0)) + && ! (IsModifierKey (orig_keysym) + /* The symbols from XK_ISO_Lock + to XK_ISO_Last_Group_Lock + don't have real modifiers but + should be treated similarly to + Mode_switch by Emacs. */ #if defined XK_ISO_Lock && defined XK_ISO_Last_Group_Lock - || (XK_ISO_Lock <= orig_keysym - && orig_keysym <= XK_ISO_Last_Group_Lock) + || (XK_ISO_Lock <= orig_keysym + && orig_keysym <= XK_ISO_Last_Group_Lock) #endif - )) + )) { STORE_KEYSYM_FOR_DEBUG (keysym); /* make_lispy_event will convert this to a symbolic key. */ inev.ie.kind = NON_ASCII_KEYSTROKE_EVENT; inev.ie.code = keysym; + +#ifdef HAVE_XINPUT2 + if (event->xkey.time == pending_keystroke_time) + { + source = xi_device_from_id (dpyinfo, + dpyinfo->pending_keystroke_source); + + if (source) + inev.ie.device = source->name; + } +#endif + goto done_keysym; } { /* Raw bytes, not keysym. */ ptrdiff_t i; - int nchars, len; - for (i = 0, nchars = 0; i < nbytes; i++) + for (i = 0; i < nbytes; i++) { - if (ASCII_CHAR_P (copy_bufptr[i])) - nchars++; STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); } - if (nchars < nbytes) + if (nbytes) { - /* Decode the input data. */ - -#ifdef HAVE_GLIB - /* If this isn't done in a build with GLib (usually - with GTK), then the resulting signal in - `setup_coding_system' will cause Emacs to - crash. */ - if (NILP (Fcoding_system_p (coding_system))) - coding_system = Qraw_text; -#endif - - /* The input should be decoded with `coding_system' - which depends on which X*LookupString function - we used just above and the locale. */ - setup_coding_system (coding_system, &coding); - coding.src_multibyte = false; - coding.dst_multibyte = true; - /* The input is converted to events, thus we can't - handle composition. Anyway, there's no XIM that - gives us composition information. */ - coding.common_flags &= ~CODING_ANNOTATION_MASK; - - SAFE_NALLOCA (coding.destination, MAX_MULTIBYTE_LENGTH, - nbytes); - coding.dst_bytes = MAX_MULTIBYTE_LENGTH * nbytes; - coding.mode |= CODING_MODE_LAST_BLOCK; - decode_coding_c_string (&coding, copy_bufptr, nbytes, Qnil); - nbytes = coding.produced; - nchars = coding.produced_char; - copy_bufptr = coding.destination; - } + inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + inev.ie.arg = make_unibyte_string ((char *) copy_bufptr, nbytes); + + Fput_text_property (make_fixnum (0), make_fixnum (nbytes), + Qcoding, coding, inev.ie.arg); + +#ifdef HAVE_XINPUT2 + if (event->xkey.time == pending_keystroke_time + /* I-Bus sometimes sends events generated from + multiple filtered keystrokes with a time of 0, + so just use the recorded source device if it + exists. */ + || (pending_keystroke_time && !event->xkey.time)) + { + source = xi_device_from_id (dpyinfo, + dpyinfo->pending_keystroke_source); - /* Convert the input data to a sequence of - character events. */ - for (i = 0; i < nbytes; i += len) - { - int ch; - if (nchars == nbytes) - ch = copy_bufptr[i], len = 1; - else - ch = string_char_and_length (copy_bufptr + i, &len); - inev.ie.kind = (SINGLE_BYTE_CHAR_P (ch) - ? ASCII_KEYSTROKE_EVENT - : MULTIBYTE_CHAR_KEYSTROKE_EVENT); - inev.ie.code = ch; - kbd_buffer_store_buffered_event (&inev, hold_quit); + if (source) + inev.ie.device = source->name; + } +#endif } - count += nchars; - - inev.ie.kind = NO_EVENT; /* Already stored above. */ - if (keysym == NoSymbol) break; } - /* FIXME: check side effects and remove this. */ - ((XEvent *) event)->xkey = xkey; } done_keysym: #ifdef HAVE_X_I18N + if (f) + { + struct window *w = XWINDOW (f->selected_window); + xic_set_preeditarea (w, w->cursor.x, w->cursor.y); + + if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea)) + xic_set_statusarea (f); + } + /* Don't dispatch this event since XtDispatchEvent calls XFilterEvent, and two calls in a row may freeze the client. */ @@ -8818,7 +15055,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif case KeyRelease: - x_display_set_last_user_time (dpyinfo, event->xkey.time); #ifdef HAVE_X_I18N /* Don't dispatch this event since XtDispatchEvent calls XFilterEvent, and two calls in a row may freeze the @@ -8830,7 +15066,34 @@ handle_one_xevent (struct x_display_info *dpyinfo, case EnterNotify: x_display_set_last_user_time (dpyinfo, event->xcrossing.time); - x_detect_focus_change (dpyinfo, any, event, &inev.ie); + + if (x_top_window_to_frame (dpyinfo, event->xcrossing.window)) + 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; @@ -8840,12 +15103,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* EnterNotify counts as mouse movement, so update things that depend on mouse position. */ if (f && !f->output_data.x->hourglass_p) - x_note_mouse_movement (f, &event->xmotion); + x_note_mouse_movement (f, &event->xmotion, Qnil); #ifdef USE_GTK /* We may get an EnterNotify on the buttons in the toolbar. In that case we moved out of any highlighted area and need to note this. */ if (!f && dpyinfo->last_mouse_glyph_frame) - x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &event->xmotion); + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &event->xmotion, + Qnil); #endif goto OTHER; @@ -8883,9 +15147,39 @@ handle_one_xevent (struct x_display_info *dpyinfo, case LeaveNotify: 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); + + if (xvw) + { + xwidget_motion_or_crossing (xvw, event); + goto OTHER; + } + } +#endif + + if (x_top_window_to_frame (dpyinfo, event->xcrossing.window)) + x_detect_focus_change (dpyinfo, any, event, &inev.ie); + +#if defined USE_X_TOOLKIT + /* If the mouse leaves the edit widget, then any mouse highlight + should be cleared. */ + f = x_window_to_frame (dpyinfo, event->xcrossing.window); + + if (!f) + f = x_top_window_to_frame (dpyinfo, event->xcrossing.window); +#else f = x_top_window_to_frame (dpyinfo, event->xcrossing.window); +#endif +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 + /* The XI2 event mask is set on the frame widget, so this event + likely originates from the shell widget, which we aren't + interested in. */ + if (dpyinfo->supports_xi2) + f = NULL; +#endif if (f) { if (f == hlinfo->mouse_face_mouse_frame) @@ -8906,7 +15200,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef USE_GTK /* See comment in EnterNotify above */ else if (dpyinfo->last_mouse_glyph_frame) - x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &event->xmotion); + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, + &event->xmotion, Qnil); #endif goto OTHER; @@ -8916,7 +15211,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, case MotionNotify: { - x_display_set_last_user_time (dpyinfo, event->xmotion.time); + XMotionEvent xmotion = event->xmotion; + previous_help_echo_string = help_echo_string; help_echo_string = Qnil; @@ -8928,10 +15224,194 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = mouse_or_wdesc_frame (dpyinfo, event->xmotion.window); + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + Window target, toplevel; + int target_proto, motif_style; + xm_top_level_leave_message lmsg; + xm_top_level_enter_message emsg; + xm_drag_motion_message dmsg; + + /* Sometimes the drag-and-drop operation starts with the + pointer of a frame invisible due to input. Since + motion events are ignored during that, make the pointer + visible manually. */ + + if (f) + XTtoggle_invisible_pointer (f, false); + + target = x_dnd_get_target_window (dpyinfo, + event->xmotion.x_root, + event->xmotion.y_root, + &target_proto, + &motif_style, &toplevel); + + if (toplevel != x_dnd_last_seen_toplevel) + { + if (toplevel != FRAME_OUTER_WINDOW (x_dnd_frame) + && x_dnd_return_frame == 1) + x_dnd_return_frame = 2; + + if (x_dnd_return_frame == 2 + && x_any_window_to_frame (dpyinfo, toplevel)) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1 + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + lmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_TOP_LEVEL_LEAVE); + lmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + lmsg.zero = 0; + lmsg.timestamp = event->xmotion.time; + lmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + + if (x_dnd_motif_setup_p) + xm_send_top_level_leave_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &lmsg); + } + + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_dnd_return_frame_object + = x_any_window_to_frame (dpyinfo, toplevel); + x_dnd_return_frame = 3; + x_dnd_waiting_for_finish = false; + target = None; + } + + x_dnd_last_seen_toplevel = toplevel; + } + + if (target != x_dnd_last_seen_window) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1 + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + /* This is apparently required. If we don't send + a motion event with the current root window + coordinates of the pointer before the top level + leave, then Motif displays an ugly black border + around the previous drop site. */ + + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DRAG_MOTION); + dmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + dmsg.side_effects = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_SITE_NONE, XM_DRAG_NOOP, + XM_DROP_ACTION_DROP_CANCEL); + dmsg.timestamp = event->xmotion.time; + dmsg.x = event->xmotion.x_root; + dmsg.y = event->xmotion.y_root; + + lmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_TOP_LEVEL_LEAVE); + lmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + lmsg.zero = 0; + lmsg.timestamp = event->xbutton.time; + lmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + + if (x_dnd_motif_setup_p) + { + xm_send_drag_motion_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &dmsg); + xm_send_top_level_leave_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &lmsg); + } + } + + x_dnd_action = None; + x_dnd_last_seen_window = target; + x_dnd_last_protocol_version = target_proto; + x_dnd_last_motif_style = motif_style; + + if (target != None && x_dnd_last_protocol_version != -1) + x_dnd_send_enter (x_dnd_frame, target, + x_dnd_last_protocol_version); + else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style)) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + emsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_TOP_LEVEL_ENTER); + emsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + emsg.zero = 0; + emsg.timestamp = event->xbutton.time; + emsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + emsg.index_atom = dpyinfo->Xatom_XdndSelection; + + if (x_dnd_motif_setup_p) + xm_send_top_level_enter_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + target, &emsg); + } + } + + if (x_dnd_last_protocol_version != -1 && target != None) + x_dnd_send_position (x_dnd_frame, target, + x_dnd_last_protocol_version, + event->xmotion.x_root, + event->xmotion.y_root, + x_dnd_selection_timestamp, + x_dnd_wanted_action, 0, + event->xmotion.state); + else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DRAG_MOTION); + dmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + dmsg.side_effects = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + (!x_dnd_xm_use_help + ? XM_DROP_ACTION_DROP + : XM_DROP_ACTION_DROP_HELP)); + dmsg.timestamp = event->xbutton.time; + dmsg.x = event->xmotion.x_root; + dmsg.y = event->xmotion.y_root; + + if (x_dnd_motif_setup_p) + xm_send_drag_motion_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + target, &dmsg); + } + + goto OTHER; + } + #ifdef USE_GTK - if (f && xg_event_is_for_scrollbar (f, event)) + if (f && xg_event_is_for_scrollbar (f, event, false)) 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 @@ -8951,8 +15431,18 @@ handle_one_xevent (struct x_display_info *dpyinfo, || !NILP (focus_follows_mouse))) { static Lisp_Object last_mouse_window; + + if (xmotion.window != FRAME_X_WINDOW (f)) + { + XTranslateCoordinates (FRAME_X_DISPLAY (f), + xmotion.window, FRAME_X_WINDOW (f), + xmotion.x, xmotion.y, &xmotion.x, + &xmotion.y, &xmotion.subwindow); + xmotion.window = FRAME_X_WINDOW (f); + } + Lisp_Object window = window_from_coordinates - (f, event->xmotion.x, event->xmotion.y, 0, false, false); + (f, xmotion.x, xmotion.y, 0, false, false); /* A window will be autoselected only when it is not selected now and the last mouse movement event was @@ -8974,7 +15464,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, last_mouse_window = window; } - if (!x_note_mouse_movement (f, &event->xmotion)) + if (!x_note_mouse_movement (f, &xmotion, Qnil)) help_echo_string = previous_help_echo_string; } else @@ -9032,15 +15522,110 @@ handle_one_xevent (struct x_display_info *dpyinfo, configureEvent = next_event; } + if (x_dnd_in_progress && x_dnd_use_toplevels + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + int rc, dest_x, dest_y; + Window child; + struct x_client_list_window *tem, *last = NULL; + + for (tem = x_dnd_toplevels; tem; last = tem, tem = tem->next) + { + /* Not completely right, since the parent could be + unmapped, but good enough. */ + + if (tem->window == configureEvent.xconfigure.window) + { + x_catch_errors (dpyinfo->display); + rc = (XTranslateCoordinates (dpyinfo->display, + configureEvent.xconfigure.window, + dpyinfo->root_window, + -configureEvent.xconfigure.border_width, + -configureEvent.xconfigure.border_width, + &dest_x, &dest_y, &child) + && !x_had_errors_p (dpyinfo->display)); + x_uncatch_errors_after_check (); + + if (rc) + { + tem->x = dest_x; + tem->y = dest_y; + tem->width = (configureEvent.xconfigure.width + + configureEvent.xconfigure.border_width); + tem->height = (configureEvent.xconfigure.height + + configureEvent.xconfigure.border_width); + } + else + { + /* The window was probably destroyed, so get rid + of it. */ + + if (!last) + x_dnd_toplevels = tem->next; + else + last->next = tem->next; + +#ifdef HAVE_XSHAPE + if (tem->n_input_rects != -1) + xfree (tem->input_rects); + if (tem->n_bounding_rects != -1) + xfree (tem->bounding_rects); +#endif + xfree (tem); + } + + break; + } + } + } + +#if defined HAVE_GTK3 && defined USE_TOOLKIT_SCROLL_BARS + struct scroll_bar *bar = x_window_to_scroll_bar (dpyinfo->display, + configureEvent.xconfigure.window, 2); + + /* There is really no other way to make GTK scroll bars fit + in the dimensions we want them to. */ + if (bar) + { + /* Skip all the pending configure events, not just the + ones where window motion occurred. */ + while (XPending (dpyinfo->display)) + { + XNextEvent (dpyinfo->display, &next_event); + if (next_event.type != ConfigureNotify + || next_event.xconfigure.window != event->xconfigure.window) + { + XPutBackEvent (dpyinfo->display, &next_event); + break; + } + else + configureEvent = next_event; + } + + if (configureEvent.xconfigure.width != max (bar->width, 1) + || configureEvent.xconfigure.height != max (bar->height, 1)) + { + XResizeWindow (dpyinfo->display, bar->x_window, + max (bar->width, 1), max (bar->height, 1)); + x_flush (WINDOW_XFRAME (XWINDOW (bar->window))); + } + + if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) + x_drop_xrender_surfaces (f); + + goto OTHER; + } +#endif + f = x_top_window_to_frame (dpyinfo, configureEvent.xconfigure.window); - /* Unfortunately, we need to call font_drop_xrender_surfaces for + /* Unfortunately, we need to call x_drop_xrender_surfaces for _all_ ConfigureNotify events, otherwise we miss some and flicker. Don't try to optimize these calls by looking only for size changes: that's not sufficient. We miss some surface invalidations and flicker. */ block_input (); if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) - font_drop_xrender_surfaces (f); + x_drop_xrender_surfaces (f); unblock_input (); #if defined USE_CAIRO && !defined USE_GTK if (f) @@ -9050,6 +15635,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_cr_update_surface_desired_size (any, configureEvent.xconfigure.width, configureEvent.xconfigure.height); + if (f || (any && configureEvent.xconfigure.window == FRAME_X_WINDOW (any))) + x_update_opaque_region (f ? f : any, &configureEvent); #endif #ifdef USE_GTK if (!f @@ -9070,7 +15657,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, block_input (); if (FRAME_X_DOUBLE_BUFFERED_P (f)) - font_drop_xrender_surfaces (f); + x_drop_xrender_surfaces (f); unblock_input (); xg_frame_resized (f, configureEvent.xconfigure.width, configureEvent.xconfigure.height); @@ -9078,6 +15665,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_cr_update_surface_desired_size (f, configureEvent.xconfigure.width, configureEvent.xconfigure.height); #endif + x_update_opaque_region (f, &configureEvent); f = 0; } #endif @@ -9125,6 +15713,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* Even if the number of character rows and columns has not changed, the font size may have changed, so we need to check the pixel dimensions as well. */ + if (width != FRAME_PIXEL_WIDTH (f) || height != FRAME_PIXEL_HEIGHT (f) || (f->new_size_p @@ -9176,27 +15765,184 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef HAVE_X_I18N - if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea)) - xic_set_statusarea (f); + if (f) + { + if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea)) + xic_set_statusarea (f); + + struct window *w = XWINDOW (f->selected_window); + xic_set_preeditarea (w, w->cursor.x, w->cursor.y); + } #endif } + + if (x_dnd_in_progress) + x_dnd_update_state (dpyinfo, dpyinfo->last_user_time); goto OTHER; case ButtonRelease: case ButtonPress: { + if (event->xbutton.type == ButtonPress) + x_display_set_last_user_time (dpyinfo, event->xbutton.time); + +#ifdef HAVE_XWIDGETS + struct xwidget_view *xvw = xwidget_view_from_window (event->xbutton.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) && (event->xbutton.button < 4)) + { + inev.ie.kind = SELECT_WINDOW_EVENT; + inev.ie.frame_or_window = xvw->w; + } + + *finish = X_EVENT_DROP; + 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; + bool dnd_grab = false; + + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + if (event->xbutton.type == ButtonPress + && x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + { + x_dnd_send_position (x_dnd_frame, + x_dnd_last_seen_window, + x_dnd_last_protocol_version, + event->xbutton.x_root, + event->xbutton.y_root, + x_dnd_selection_timestamp, + x_dnd_wanted_action, + event->xbutton.button, + event->xbutton.state); + + goto OTHER; + } + + for (int i = 1; i < 8; ++i) + { + if (i != event->xbutton.button + && event->xbutton.state & (Button1Mask << (i - 1))) + dnd_grab = true; + } + + if (!dnd_grab && event->xbutton.type == ButtonRelease) + { + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_in_progress = false; + + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + { + x_dnd_pending_finish_target = x_dnd_last_seen_window; + x_dnd_waiting_for_finish_proto = x_dnd_last_protocol_version; + + x_dnd_waiting_for_finish + = x_dnd_send_drop (x_dnd_frame, x_dnd_last_seen_window, + x_dnd_selection_timestamp, + x_dnd_last_protocol_version); + } + else if (x_dnd_last_seen_window != None) + { + xm_drop_start_message dmsg; + xm_drag_receiver_info drag_receiver_info; + + if (!xm_read_drag_receiver_info (dpyinfo, x_dnd_last_seen_window, + &drag_receiver_info) + && drag_receiver_info.protocol_style != XM_DRAG_STYLE_NONE + && (x_dnd_allow_current_frame + || x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame))) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + if (x_dnd_motif_setup_p) + { + memset (&dmsg, 0, sizeof dmsg); + + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + (!x_dnd_xm_use_help + ? XM_DROP_ACTION_DROP + : XM_DROP_ACTION_DROP_HELP)); + dmsg.timestamp = event->xbutton.time; + dmsg.x = event->xbutton.x_root; + dmsg.y = event->xbutton.y_root; + dmsg.index_atom = dpyinfo->Xatom_XdndSelection; + dmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + + if (!XM_DRAG_STYLE_IS_DROP_ONLY (drag_receiver_info.protocol_style)) + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (x_dnd_frame), + x_dnd_frame, x_dnd_last_seen_window, + event->xbutton.time); + + xm_send_drop_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &dmsg); + + x_dnd_waiting_for_finish = true; + x_dnd_waiting_for_motif_finish = 1; + } + } + else + { + x_set_pending_dnd_time (event->xbutton.time); + x_dnd_send_unsupported_drop (dpyinfo, (x_dnd_last_seen_toplevel != None + ? x_dnd_last_seen_toplevel + : x_dnd_last_seen_window), + event->xbutton.x_root, event->xbutton.y_root, + event->xbutton.time); + } + } + else if (x_dnd_last_seen_toplevel != None) + { + x_set_pending_dnd_time (event->xbutton.time); + x_dnd_send_unsupported_drop (dpyinfo, x_dnd_last_seen_toplevel, + event->xbutton.x_root, + event->xbutton.y_root, + event->xbutton.time); + } + + + x_dnd_last_protocol_version = -1; + x_dnd_last_motif_style = XM_DRAG_STYLE_NONE; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_frame = NULL; + x_set_dnd_targets (NULL, 0); + } + + goto OTHER; + } + + if (x_dnd_in_progress) + goto OTHER; memset (&compose_status, 0, sizeof (compose_status)); dpyinfo->last_mouse_glyph_frame = NULL; - x_display_set_last_user_time (dpyinfo, event->xbutton.time); - f = mouse_or_wdesc_frame (dpyinfo, event->xmotion.window); + f = mouse_or_wdesc_frame (dpyinfo, event->xbutton.window); if (f && event->xbutton.type == ButtonPress && !popup_activated () && !x_window_to_scroll_bar (event->xbutton.display, @@ -9221,7 +15967,36 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #ifdef USE_GTK - if (f && xg_event_is_for_scrollbar (f, event)) + if (!f) + { + f = x_any_window_to_frame (dpyinfo, event->xbutton.window); + + if (event->xbutton.button > 3 + && event->xbutton.button < 9 + && f) + { + if (ignore_next_mouse_click_timeout) + { + if (event->type == ButtonPress + && event->xbutton.time > ignore_next_mouse_click_timeout) + { + ignore_next_mouse_click_timeout = 0; + x_construct_mouse_click (&inev.ie, &event->xbutton, f); + } + if (event->type == ButtonRelease) + ignore_next_mouse_click_timeout = 0; + } + else + x_construct_mouse_click (&inev.ie, &event->xbutton, f); + + *finish = X_EVENT_DROP; + goto OTHER; + } + else + f = NULL; + } + + if (f && xg_event_is_for_scrollbar (f, event, false)) f = 0; #endif if (f) @@ -9253,7 +16028,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, int y = event->xbutton.y; window = window_from_coordinates (f, x, y, 0, true, true); - tool_bar_p = EQ (window, f->tool_bar_window); + tool_bar_p = (EQ (window, f->tool_bar_window) + && (event->xbutton.type != ButtonRelease + || f->last_tool_bar_item != -1)); if (tool_bar_p && event->xbutton.button < 4) handle_tool_bar_click @@ -9330,11 +16107,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, #if defined (USE_X_TOOLKIT) || defined (USE_GTK) f = x_menubar_window_to_frame (dpyinfo, event); - /* For a down-event in the menu bar, - don't pass it to Xt right now. - Instead, save it away - and we will pass it to Xt from kbd_buffer_get_event. - That way, we can run some Lisp code first. */ + /* For a down-event in the menu bar, don't pass it to Xt or + GTK right away. Instead, save it and pass it to Xt or GTK + from kbd_buffer_get_event. That way, we can run some Lisp + code first. */ if (! popup_activated () #ifdef USE_GTK /* Gtk+ menus only react to the first three buttons. */ @@ -9349,12 +16125,26 @@ handle_one_xevent (struct x_display_info *dpyinfo, && event->xbutton.y < FRAME_MENUBAR_HEIGHT (f) && event->xbutton.same_screen) { - if (!f->output_data.x->saved_menu_event) - f->output_data.x->saved_menu_event = xmalloc (sizeof *event); - *f->output_data.x->saved_menu_event = *event; - inev.ie.kind = MENU_BAR_ACTIVATE_EVENT; - XSETFRAME (inev.ie.frame_or_window, f); - *finish = X_EVENT_DROP; +#ifdef USE_MOTIF + unsigned char column_type; + Widget widget; + + widget = XtWindowToWidget (dpyinfo->display, + event->xbutton.window); + XtVaGetValues (widget, XmNrowColumnType, &column_type, NULL); + + if (column_type != XmMENU_BAR) + { +#endif + if (!f->output_data.x->saved_menu_event) + f->output_data.x->saved_menu_event = xmalloc (sizeof *event); + *f->output_data.x->saved_menu_event = *event; + inev.ie.kind = MENU_BAR_ACTIVATE_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + *finish = X_EVENT_DROP; +#ifdef USE_MOTIF + } +#endif } else goto OTHER; @@ -9363,6 +16153,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, break; case CirculateNotify: + if (x_dnd_in_progress) + x_dnd_update_state (dpyinfo, dpyinfo->last_user_time); goto OTHER; case CirculateRequest: @@ -9393,14 +16185,2698 @@ handle_one_xevent (struct x_display_info *dpyinfo, xft_settings_event (dpyinfo, event); break; +#ifdef HAVE_XINPUT2 + case GenericEvent: + { + if (!dpyinfo->supports_xi2) + goto OTHER; + + if (event->xgeneric.extension != dpyinfo->xi2_opcode) + /* Not an XI2 event. */ + goto OTHER; + + bool must_free_data = false; + XIEvent *xi_event = (XIEvent *) event->xcookie.data; + /* Sometimes the event is already claimed by GTK, which + will free its data in due course. */ + if (!xi_event && XGetEventData (dpyinfo->display, &event->xcookie)) + { + must_free_data = true; + xi_event = (XIEvent *) event->xcookie.data; + } + + XIDeviceEvent *xev = (XIDeviceEvent *) xi_event; + + if (!xi_event) + { + eassert (!must_free_data); + goto OTHER; + } + + switch (event->xcookie.evtype) + { + case XI_FocusIn: + { + XIFocusInEvent *focusin = (XIFocusInEvent *) xi_event; + struct xi_device_t *source; + + any = x_any_window_to_frame (dpyinfo, focusin->event); + source = xi_device_from_id (dpyinfo, focusin->sourceid); +#ifdef USE_GTK + /* Some WMs (e.g. Mutter in Gnome Shell), don't unmap + minimized/iconified windows; thus, for those WMs we won't get + a MapNotify when unminimizing/deiconifying. Check here if we + are deiconizing a window (Bug42655). + + But don't do that by default on GTK since it may cause a plain + invisible frame get reported as iconified, compare + https://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00133.html. + That is fixed above but bites us here again. + + The option x_set_frame_visibility_more_laxly allows to override + the default behavior (Bug#49955, Bug#53298). */ + if (EQ (x_set_frame_visibility_more_laxly, Qfocus_in) + || EQ (x_set_frame_visibility_more_laxly, Qt)) +#endif /* USE_GTK */ + { + f = any; + if (f && FRAME_ICONIFIED_P (f)) + { + SET_FRAME_VISIBLE (f, 1); + SET_FRAME_ICONIFIED (f, false); + f->output_data.x->has_been_visible = true; + inev.ie.kind = DEICONIFY_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + } + } + + x_detect_focus_change (dpyinfo, any, event, &inev.ie); + + if (inev.ie.kind != NO_EVENT && source) + inev.ie.device = source->name; + goto XI_OTHER; + } + + case XI_FocusOut: + { + XIFocusOutEvent *focusout = (XIFocusOutEvent *) xi_event; + struct xi_device_t *source; + + any = x_any_window_to_frame (dpyinfo, focusout->event); + source = xi_device_from_id (dpyinfo, focusout->sourceid); + x_detect_focus_change (dpyinfo, any, event, &inev.ie); + + if (inev.ie.kind != NO_EVENT && source) + inev.ie.device = source->name; + goto XI_OTHER; + } + + case XI_Enter: + { + XIEnterEvent *enter = (XIEnterEvent *) xi_event; + XMotionEvent ev; + struct xi_device_t *source; + + any = x_top_window_to_frame (dpyinfo, enter->event); + source = xi_device_from_id (dpyinfo, enter->sourceid); + ev.x = lrint (enter->event_x); + ev.y = lrint (enter->event_y); + ev.window = enter->event; + ev.time = enter->time; + + x_display_set_last_user_time (dpyinfo, xi_event->time); + +#ifdef USE_MOTIF + use_copy = true; + + copy.xcrossing.type = EnterNotify; + copy.xcrossing.serial = enter->serial; + copy.xcrossing.send_event = enter->send_event; + copy.xcrossing.display = dpyinfo->display; + copy.xcrossing.window = enter->event; + copy.xcrossing.root = enter->root; + copy.xcrossing.subwindow = enter->child; + copy.xcrossing.time = enter->time; + copy.xcrossing.x = lrint (enter->event_x); + copy.xcrossing.y = lrint (enter->event_y); + copy.xcrossing.x_root = lrint (enter->root_x); + copy.xcrossing.y_root = lrint (enter->root_y); + copy.xcrossing.mode = enter->mode; + copy.xcrossing.detail = enter->detail; + copy.xcrossing.focus = enter->focus; + copy.xcrossing.state = 0; + copy.xcrossing.same_screen = True; +#endif + + /* There is no need to handle entry/exit events for + passive focus from non-top windows at all, since they + are an inferiors of the frame's top window, which will + get virtual events. */ + if (any) + x_detect_focus_change (dpyinfo, any, event, &inev.ie); + + if (!any) + any = x_any_window_to_frame (dpyinfo, enter->event); + +#ifdef HAVE_XINPUT2_1 + xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid, + true); +#endif + + { +#ifdef HAVE_XWIDGETS + struct xwidget_view *xwidget_view = xwidget_view_from_window (enter->event); +#endif + +#ifdef HAVE_XWIDGETS + if (xwidget_view) + { + xwidget_motion_or_crossing (xwidget_view, event); + + goto XI_OTHER; + } +#endif + } + + f = any; + + if (f && x_mouse_click_focus_ignore_position) + ignore_next_mouse_click_timeout = xi_event->time + 200; + + /* EnterNotify counts as mouse movement, + so update things that depend on mouse position. */ + if (f && !f->output_data.x->hourglass_p) + x_note_mouse_movement (f, &ev, source ? source->name : Qnil); +#ifdef USE_GTK + /* We may get an EnterNotify on the buttons in the toolbar. In that + case we moved out of any highlighted area and need to note this. */ + if (!f && dpyinfo->last_mouse_glyph_frame) + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev, + source ? source->name : Qnil); +#endif + goto XI_OTHER; + } + + case XI_Leave: + { + XILeaveEvent *leave = (XILeaveEvent *) xi_event; +#ifdef USE_GTK + struct xi_device_t *source; + XMotionEvent ev; + + ev.x = lrint (leave->event_x); + ev.y = lrint (leave->event_y); + ev.window = leave->event; + ev.time = leave->time; +#endif + + any = x_top_window_to_frame (dpyinfo, leave->event); + +#ifdef USE_GTK + source = xi_device_from_id (dpyinfo, leave->sourceid); +#endif + + /* This allows us to catch LeaveNotify events generated by + popup menu grabs. FIXME: this is right when there is a + focus menu, but implicit focus tracking can get screwed + up if we get this and no XI_Enter event later. */ + +#ifdef USE_X_TOOLKIT + if (popup_activated () + && leave->mode == XINotifyPassiveUngrab) + any = x_any_window_to_frame (dpyinfo, leave->event); +#endif + +#ifdef USE_MOTIF + use_copy = true; + + copy.xcrossing.type = LeaveNotify; + copy.xcrossing.serial = leave->serial; + copy.xcrossing.send_event = leave->send_event; + copy.xcrossing.display = dpyinfo->display; + copy.xcrossing.window = leave->event; + copy.xcrossing.root = leave->root; + copy.xcrossing.subwindow = leave->child; + copy.xcrossing.time = leave->time; + copy.xcrossing.x = lrint (leave->event_x); + copy.xcrossing.y = lrint (leave->event_y); + copy.xcrossing.x_root = lrint (leave->root_x); + copy.xcrossing.y_root = lrint (leave->root_y); + copy.xcrossing.mode = leave->mode; + copy.xcrossing.detail = leave->detail; + copy.xcrossing.focus = leave->focus; + copy.xcrossing.state = 0; + copy.xcrossing.same_screen = True; +#endif + + /* One problem behind the design of XInput 2 scrolling is + that valuators are not unique to each window, but only + the window that has grabbed the valuator's device or + the window that the device's pointer is on top of can + receive motion events. There is also no way to + retrieve the value of a valuator outside of each motion + event. + + As such, to prevent wildly inaccurate results when the + valuators have changed outside Emacs, we reset our + records of each valuator's value whenever the pointer + moves out of a frame (and not into one of its + children, which we know about). */ +#ifdef HAVE_XINPUT2_1 + if (leave->detail != XINotifyInferior && any) + xi_reset_scroll_valuators_for_device_id (dpyinfo, + leave->deviceid, false); +#endif + + x_display_set_last_user_time (dpyinfo, xi_event->time); + +#ifdef HAVE_XWIDGETS + { + struct xwidget_view *xvw + = xwidget_view_from_window (leave->event); + + if (xvw) + { + *finish = X_EVENT_DROP; + xwidget_motion_or_crossing (xvw, event); + + goto XI_OTHER; + } + } +#endif + + if (any) + x_detect_focus_change (dpyinfo, any, event, &inev.ie); + +#ifndef USE_X_TOOLKIT + f = x_top_window_to_frame (dpyinfo, leave->event); +#else + /* On Xt builds that have XI2, the enter and leave event + masks are set on the frame widget's window. */ + f = x_window_to_frame (dpyinfo, leave->event); + + if (!f) + f = x_top_window_to_frame (dpyinfo, leave->event); +#endif + if (f) + { + if (f == hlinfo->mouse_face_mouse_frame) + { + /* If we move outside the frame, then we're + certainly no longer on any text in the frame. */ + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = 0; + } + + /* Generate a nil HELP_EVENT to cancel a help-echo. + Do it only if there's something to cancel. + Otherwise, the startup message is cleared when + the mouse leaves the frame. */ + if (any_help_event_p) + do_help = -1; + } +#ifdef USE_GTK + /* See comment in EnterNotify above */ + else if (dpyinfo->last_mouse_glyph_frame) + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev, + source ? source->name : Qnil); +#endif + goto XI_OTHER; + } + + case XI_Motion: + { + struct xi_device_t *device, *source; +#ifdef HAVE_XINPUT2_1 + XIValuatorState *states; + double *values; + bool found_valuator = false; +#endif + /* A fake XMotionEvent for x_note_mouse_movement. */ + XMotionEvent ev; + xm_top_level_leave_message lmsg; + xm_top_level_enter_message emsg; + xm_drag_motion_message dmsg; + int dnd_state; + + source = xi_device_from_id (dpyinfo, xev->sourceid); + +#ifdef HAVE_XINPUT2_1 + states = &xev->valuators; + values = states->values; +#endif + + device = xi_device_from_id (dpyinfo, xev->deviceid); + + if (!device) + goto XI_OTHER; + +#ifdef HAVE_XINPUT2_2 + if (xev->flags & XIPointerEmulated) + goto XI_OTHER; +#endif + + Window dummy; + +#ifdef HAVE_XINPUT2_1 +#ifdef HAVE_XWIDGETS + struct xwidget_view *xv = xwidget_view_from_window (xev->event); + double xv_total_x = 0.0; + double xv_total_y = 0.0; +#endif + double total_x = 0.0; + double total_y = 0.0; + + int real_x, real_y; + + for (int i = 0; i < states->mask_len * 8; i++) + { + if (XIMaskIsSet (states->mask, i)) + { + struct xi_scroll_valuator_t *val; + double delta, scroll_unit; + int scroll_height; + Lisp_Object window; + + /* See the comment on top of + x_init_master_valuators for more details on how + scroll wheel movement is reported on XInput 2. */ + delta = x_get_scroll_valuator_delta (dpyinfo, device, + i, *values, &val); + values++; + + if (delta != DBL_MAX) + { + if (!f) + { + f = x_any_window_to_frame (dpyinfo, xev->event); + + if (!f) + { +#if defined USE_MOTIF || !defined USE_TOOLKIT_SCROLL_BARS + struct scroll_bar *bar + = x_window_to_scroll_bar (xi_event->display, + xev->event, 2); + + if (bar) + f = WINDOW_XFRAME (XWINDOW (bar->window)); + + if (!f) +#endif + goto XI_OTHER; + } + } + +#ifdef USE_GTK + if (f && xg_event_is_for_scrollbar (f, event, true)) + *finish = X_EVENT_DROP; +#endif + + if (FRAME_X_WINDOW (f) != xev->event) + XTranslateCoordinates (dpyinfo->display, + xev->event, FRAME_X_WINDOW (f), + lrint (xev->event_x), + lrint (xev->event_y), + &real_x, &real_y, &dummy); + else + { + real_x = lrint (xev->event_x); + real_y = lrint (xev->event_y); + } + +#ifdef HAVE_XWIDGETS + if (xv) + { + if (val->horizontal) + xv_total_x += delta; + else + xv_total_y += delta; + + found_valuator = true; + continue; + } +#endif + + if (delta == 0.0) + found_valuator = true; + + if (signbit (delta) != signbit (val->emacs_value)) + val->emacs_value = 0; + + val->emacs_value += delta; + + if (mwheel_coalesce_scroll_events + && (fabs (val->emacs_value) < 1) + && (fabs (delta) > 0)) + continue; + + window = window_from_coordinates (f, real_x, real_y, NULL, + false, false); + + if (WINDOWP (window)) + scroll_height = XWINDOW (window)->pixel_height; + else + /* EVENT_X and EVENT_Y can be outside the + frame if F holds the input grab, so fall + back to the height of the frame instead. */ + scroll_height = FRAME_PIXEL_HEIGHT (f); + + scroll_unit = pow (scroll_height, 2.0 / 3.0); + + if (NUMBERP (Vx_scroll_event_delta_factor)) + scroll_unit *= XFLOATINT (Vx_scroll_event_delta_factor); + + if (val->horizontal) + total_x += val->emacs_value * scroll_unit; + else + total_y += val->emacs_value * scroll_unit; + + found_valuator = true; + val->emacs_value = 0; + } + } + } + +#ifdef HAVE_XWIDGETS + if (xv) + { + uint state = xev->mods.effective; + x_display_set_last_user_time (dpyinfo, xev->time); + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + state |= Button3Mask; + } + + if (found_valuator) + xwidget_scroll (xv, xev->event_x, xev->event_y, + -xv_total_x, -xv_total_y, state, + xev->time, (xv_total_x == 0.0 + && xv_total_y == 0.0)); + else + xwidget_motion_notify (xv, xev->event_x, xev->event_y, + xev->root_x, xev->root_y, state, + xev->time); + + goto XI_OTHER; + } + else + { +#endif + if (found_valuator) + { + x_display_set_last_user_time (dpyinfo, xev->time); + +#if defined USE_GTK && !defined HAVE_GTK3 + /* Unlike on Motif, we can't select for XI + events on the scroll bar window under GTK+ 2. + So instead of that, just ignore XI wheel + events which land on a scroll bar. + + Here we assume anything which isn't the edit + widget window is a scroll bar. */ + + if (xev->child != None + && xev->child != FRAME_X_WINDOW (f)) + goto OTHER; +#endif + + if (fabs (total_x) > 0 || fabs (total_y) > 0) + { + inev.ie.kind = (fabs (total_y) >= fabs (total_x) + ? WHEEL_EVENT : HORIZ_WHEEL_EVENT); + inev.ie.timestamp = xev->time; + + XSETINT (inev.ie.x, lrint (real_x)); + XSETINT (inev.ie.y, lrint (real_y)); + XSETFRAME (inev.ie.frame_or_window, f); + + inev.ie.modifiers = (signbit (fabs (total_y) >= fabs (total_x) + ? total_y : total_x) + ? down_modifier : up_modifier); + inev.ie.modifiers + |= x_x_to_emacs_modifiers (dpyinfo, + xev->mods.effective); + inev.ie.arg = list3 (Qnil, + make_float (total_x), + make_float (total_y)); + } + else + { + inev.ie.kind = TOUCH_END_EVENT; + inev.ie.timestamp = xev->time; + + XSETINT (inev.ie.x, lrint (real_x)); + XSETINT (inev.ie.y, lrint (real_y)); + XSETFRAME (inev.ie.frame_or_window, f); + } + + if (source && source->name) + inev.ie.device = source->name; + + goto XI_OTHER; + } +#ifdef HAVE_XWIDGETS + } +#endif +#endif /* HAVE_XINPUT2_1 */ + + ev.x = lrint (xev->event_x); + ev.y = lrint (xev->event_y); + ev.window = xev->event; + ev.time = xev->time; + +#ifdef USE_MOTIF + use_copy = true; + + copy.xmotion.type = MotionNotify; + copy.xmotion.serial = xev->serial; + copy.xmotion.send_event = xev->send_event; + copy.xmotion.display = dpyinfo->display; + copy.xmotion.window = xev->event; + copy.xmotion.root = xev->root; + copy.xmotion.subwindow = xev->child; + copy.xmotion.time = xev->time; + copy.xmotion.x = lrint (xev->event_x); + copy.xmotion.y = lrint (xev->event_y); + copy.xmotion.x_root = lrint (xev->root_x); + copy.xmotion.y_root = lrint (xev->root_y); + copy.xmotion.state = 0; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy.xmotion.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy.xmotion.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy.xmotion.state |= Button3Mask; + } + + copy.xmotion.is_hint = False; + copy.xmotion.same_screen = True; +#endif + + previous_help_echo_string = help_echo_string; + help_echo_string = Qnil; + + if (hlinfo->mouse_face_hidden) + { + hlinfo->mouse_face_hidden = false; + clear_mouse_face (hlinfo); + } + + f = mouse_or_wdesc_frame (dpyinfo, xev->event); + + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + Window target, toplevel; + int target_proto, motif_style; + + /* Sometimes the drag-and-drop operation starts with the + pointer of a frame invisible due to input. Since + motion events are ignored during that, make the pointer + visible manually. */ + + if (f) + XTtoggle_invisible_pointer (f, false); + + target = x_dnd_get_target_window (dpyinfo, + xev->root_x, + xev->root_y, + &target_proto, + &motif_style, + &toplevel); + + if (toplevel != x_dnd_last_seen_toplevel) + { + if (toplevel != FRAME_OUTER_WINDOW (x_dnd_frame) + && x_dnd_return_frame == 1) + x_dnd_return_frame = 2; + + if (x_dnd_return_frame == 2 + && x_any_window_to_frame (dpyinfo, toplevel)) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1 + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + lmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_TOP_LEVEL_LEAVE); + lmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + lmsg.zero = 0; + lmsg.timestamp = event->xmotion.time; + lmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + + if (x_dnd_motif_setup_p) + xm_send_top_level_leave_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &lmsg); + } + + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_dnd_return_frame_object + = x_any_window_to_frame (dpyinfo, toplevel); + x_dnd_return_frame = 3; + x_dnd_waiting_for_finish = false; + target = None; + } + + x_dnd_last_seen_toplevel = toplevel; + } + + if (target != x_dnd_last_seen_window) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1 + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) + && x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame)) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + /* This is apparently required. If we don't + send a motion event with the current root + window coordinates of the pointer before + the top level leave, then Motif displays + an ugly black border around the previous + drop site. */ + + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DRAG_MOTION); + dmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_SITE_NONE, XM_DRAG_NOOP, + XM_DROP_ACTION_DROP_CANCEL); + dmsg.timestamp = xev->time; + dmsg.x = lrint (xev->root_x); + dmsg.y = lrint (xev->root_y); + + lmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_TOP_LEVEL_LEAVE); + lmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + lmsg.zero = 0; + lmsg.timestamp = xev->time; + lmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + + if (x_dnd_motif_setup_p) + { + xm_send_drag_motion_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &dmsg); + xm_send_top_level_leave_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &lmsg); + } + } + + x_dnd_action = None; + x_dnd_last_seen_window = target; + x_dnd_last_protocol_version = target_proto; + x_dnd_last_motif_style = motif_style; + + if (target != None && x_dnd_last_protocol_version != -1) + x_dnd_send_enter (x_dnd_frame, target, + x_dnd_last_protocol_version); + else if (target != None && XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style)) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + emsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_TOP_LEVEL_ENTER); + emsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + emsg.zero = 0; + emsg.timestamp = xev->time; + emsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + emsg.index_atom = dpyinfo->Xatom_XdndSelection; + + if (x_dnd_motif_setup_p) + xm_send_top_level_enter_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + target, &emsg); + } + } + + if (x_dnd_last_protocol_version != -1 && target != None) + { + dnd_state = xev->mods.effective; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + dnd_state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + dnd_state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + dnd_state |= Button3Mask; + } + + x_dnd_send_position (x_dnd_frame, target, + x_dnd_last_protocol_version, + xev->root_x, xev->root_y, + x_dnd_selection_timestamp, + x_dnd_wanted_action, 0, + dnd_state); + } + else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DRAG_MOTION); + dmsg.byteorder = XM_BYTE_ORDER_CUR_FIRST; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + (!x_dnd_xm_use_help + ? XM_DROP_ACTION_DROP + : XM_DROP_ACTION_DROP_HELP)); + dmsg.timestamp = xev->time; + dmsg.x = lrint (xev->root_x); + dmsg.y = lrint (xev->root_y); + + if (x_dnd_motif_setup_p) + xm_send_drag_motion_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + target, &dmsg); + } + + goto XI_OTHER; + } + +#ifdef USE_GTK + if (f && xg_event_is_for_scrollbar (f, event, false)) + f = 0; +#endif + if (f) + { + if (xev->event != FRAME_X_WINDOW (f)) + { + XTranslateCoordinates (FRAME_X_DISPLAY (f), + xev->event, FRAME_X_WINDOW (f), + ev.x, ev.y, &ev.x, &ev.y, &dummy); + ev.window = FRAME_X_WINDOW (f); + } + + /* Maybe generate a SELECT_WINDOW_EVENT for + `mouse-autoselect-window' but don't let popup menus + interfere with this (Bug#1261). */ + if (!NILP (Vmouse_autoselect_window) + && !popup_activated () + /* Don't switch if we're currently in the minibuffer. + This tries to work around problems where the + minibuffer gets unselected unexpectedly, and where + you then have to move your mouse all the way down to + the minibuffer to select it. */ + && !MINI_WINDOW_P (XWINDOW (selected_window)) + /* With `focus-follows-mouse' non-nil create an event + also when the target window is on another frame. */ + && (f == XFRAME (selected_frame) + || !NILP (focus_follows_mouse))) + { + static Lisp_Object last_mouse_window; + Lisp_Object window = window_from_coordinates (f, ev.x, ev.y, 0, false, false); + + /* A window will be autoselected only when it is not + selected now and the last mouse movement event was + not in it. The remainder of the code is a bit vague + wrt what a "window" is. For immediate autoselection, + the window is usually the entire window but for GTK + where the scroll bars don't count. For delayed + autoselection the window is usually the window's text + area including the margins. */ + if (WINDOWP (window) + && !EQ (window, last_mouse_window) + && !EQ (window, selected_window)) + { + inev.ie.kind = SELECT_WINDOW_EVENT; + inev.ie.frame_or_window = window; + + if (source) + inev.ie.device = source->name; + } + + /* Remember the last window where we saw the mouse. */ + last_mouse_window = window; + } + + if (!x_note_mouse_movement (f, &ev, source ? source->name : Qnil)) + help_echo_string = previous_help_echo_string; + } + else + { +#ifndef USE_TOOLKIT_SCROLL_BARS + struct scroll_bar *bar + = x_window_to_scroll_bar (xi_event->display, xev->event, 2); + + if (bar) + x_scroll_bar_note_movement (bar, &ev); +#endif /* USE_TOOLKIT_SCROLL_BARS */ + + /* If we move outside the frame, then we're + certainly no longer on any text in the frame. */ + clear_mouse_face (hlinfo); + } + + /* If the contents of the global variable help_echo_string + has changed, generate a HELP_EVENT. */ + if (!NILP (help_echo_string) + || !NILP (previous_help_echo_string)) + do_help = 1; + goto XI_OTHER; + } + + case XI_ButtonRelease: + case XI_ButtonPress: + { + /* 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; + struct xi_device_t *device, *source; +#ifdef HAVE_XWIDGETS + struct xwidget_view *xvw; +#endif + /* A fake XButtonEvent for x_construct_mouse_click. */ + XButtonEvent bv; + bool dnd_grab = false; + int dnd_state; + + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + if (xev->evtype == XI_ButtonPress + && x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + { + dnd_state = xev->mods.effective; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + dnd_state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + dnd_state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + dnd_state |= Button3Mask; + } + + x_dnd_send_position (x_dnd_frame, x_dnd_last_seen_window, + x_dnd_last_protocol_version, xev->root_x, + xev->root_y, x_dnd_selection_timestamp, + x_dnd_wanted_action, xev->detail, dnd_state); + + goto XI_OTHER; + } + + for (int i = 0; i < xev->buttons.mask_len * 8; ++i) + { + if (i != xev->detail && XIMaskIsSet (xev->buttons.mask, i)) + dnd_grab = true; + } + + if (!dnd_grab && xev->evtype == XI_ButtonRelease) + { + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_in_progress = false; + + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + { + x_dnd_pending_finish_target = x_dnd_last_seen_window; + x_dnd_waiting_for_finish_proto = x_dnd_last_protocol_version; + + x_dnd_waiting_for_finish + = x_dnd_send_drop (x_dnd_frame, x_dnd_last_seen_window, + x_dnd_selection_timestamp, + x_dnd_last_protocol_version); + } + else if (x_dnd_last_seen_window != None) + { + xm_drop_start_message dmsg; + xm_drag_receiver_info drag_receiver_info; + + if (!xm_read_drag_receiver_info (dpyinfo, x_dnd_last_seen_window, + &drag_receiver_info) + && drag_receiver_info.protocol_style != XM_DRAG_STYLE_NONE + && (x_dnd_allow_current_frame + || x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame))) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + if (x_dnd_motif_setup_p) + { + memset (&dmsg, 0, sizeof dmsg); + + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + (!x_dnd_xm_use_help + ? XM_DROP_ACTION_DROP + : XM_DROP_ACTION_DROP_HELP)); + dmsg.timestamp = xev->time; + dmsg.x = lrint (xev->root_x); + dmsg.y = lrint (xev->root_y); + /* This atom technically has to be + unique to each drag-and-drop + operation, but that isn't easy to + accomplish, since we cannot + randomly move data around between + selections. Let's hope no two + instances of Emacs try to drag + into the same window at the same + time. */ + dmsg.index_atom = dpyinfo->Xatom_XdndSelection; + dmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + + if (!XM_DRAG_STYLE_IS_DROP_ONLY (drag_receiver_info.protocol_style)) + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (x_dnd_frame), + x_dnd_frame, x_dnd_last_seen_window, + xev->time); + + xm_send_drop_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &dmsg); + + x_dnd_waiting_for_finish = true; + x_dnd_waiting_for_motif_finish = 1; + } + } + else + { + x_set_pending_dnd_time (xev->time); + x_dnd_send_unsupported_drop (dpyinfo, (x_dnd_last_seen_toplevel != None + ? x_dnd_last_seen_toplevel + : x_dnd_last_seen_window), + xev->root_x, xev->root_y, xev->time); + } + } + else if (x_dnd_last_seen_toplevel != None) + { + x_set_pending_dnd_time (xev->time); + x_dnd_send_unsupported_drop (dpyinfo, + x_dnd_last_seen_toplevel, + xev->root_x, xev->root_y, + xev->time); + } + + x_dnd_last_protocol_version = -1; + x_dnd_last_motif_style = XM_DRAG_STYLE_NONE; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_frame = NULL; + x_set_dnd_targets (NULL, 0); + + goto XI_OTHER; + } + } + + if (x_dnd_in_progress) + goto XI_OTHER; + +#ifdef USE_MOTIF +#ifdef USE_TOOLKIT_SCROLL_BARS + struct scroll_bar *bar + = x_window_to_scroll_bar (dpyinfo->display, + xev->event, 2); +#endif + + use_copy = true; + copy.xbutton.type = (xev->evtype == XI_ButtonPress + ? ButtonPress : ButtonRelease); + copy.xbutton.serial = xev->serial; + copy.xbutton.send_event = xev->send_event; + copy.xbutton.display = dpyinfo->display; + copy.xbutton.window = xev->event; + copy.xbutton.root = xev->root; + copy.xbutton.subwindow = xev->child; + copy.xbutton.time = xev->time; + copy.xbutton.x = lrint (xev->event_x); + copy.xbutton.y = lrint (xev->event_y); + copy.xbutton.x_root = lrint (xev->root_x); + copy.xbutton.y_root = lrint (xev->root_y); + copy.xbutton.state = xev->mods.effective; + copy.xbutton.button = xev->detail; + copy.xbutton.same_screen = True; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy.xbutton.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy.xbutton.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy.xbutton.state |= Button3Mask; + } +#elif defined USE_GTK && !defined HAVE_GTK3 + copy = gdk_event_new (xev->evtype == XI_ButtonPress + ? GDK_BUTTON_PRESS : GDK_BUTTON_RELEASE); + + copy->button.window = gdk_x11_window_lookup_for_display (gdpy, xev->event); + copy->button.send_event = xev->send_event; + copy->button.time = xev->time; + copy->button.x = xev->event_x; + copy->button.y = xev->event_y; + copy->button.x_root = xev->root_x; + copy->button.y_root = xev->root_y; + copy->button.state = xev->mods.effective; + copy->button.button = xev->detail; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy->button.state |= GDK_BUTTON1_MASK; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy->button.state |= GDK_BUTTON2_MASK; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy->button.state |= GDK_BUTTON3_MASK; + } + + if (!copy->button.window) + emacs_abort (); + + g_object_ref (copy->button.window); + + if (popup_activated () + && xev->evtype == XI_ButtonRelease) + goto XI_OTHER; +#endif + +#ifdef HAVE_XINPUT2_1 + /* Ignore emulated scroll events when XI2 native + scroll events are present. */ + if (xev->flags & XIPointerEmulated) + { +#if !defined USE_MOTIF || !defined USE_TOOLKIT_SCROLL_BARS + *finish = X_EVENT_DROP; +#else + if (bar) + *finish = X_EVENT_DROP; +#endif + goto XI_OTHER; + } +#endif + + if (xev->evtype == XI_ButtonPress) + x_display_set_last_user_time (dpyinfo, xev->time); + + source = xi_device_from_id (dpyinfo, xev->sourceid); + +#ifdef HAVE_XWIDGETS + xvw = xwidget_view_from_window (xev->event); + if (xvw) + { + xwidget_button (xvw, xev->evtype == XI_ButtonPress, + lrint (xev->event_x), lrint (xev->event_y), + xev->detail, xev->mods.effective, xev->time); + + if (!EQ (selected_window, xvw->w) && (xev->detail < 4)) + { + inev.ie.kind = SELECT_WINDOW_EVENT; + inev.ie.frame_or_window = xvw->w; + + if (source) + inev.ie.device = source->name; + } + + *finish = X_EVENT_DROP; + goto XI_OTHER; + } +#endif + + device = xi_device_from_id (dpyinfo, xev->deviceid); + + if (!device) + goto XI_OTHER; + + bv.button = xev->detail; + bv.type = xev->evtype == XI_ButtonPress ? ButtonPress : ButtonRelease; + bv.x = lrint (xev->event_x); + bv.y = lrint (xev->event_y); + bv.window = xev->event; + bv.state = xev->mods.effective; + bv.time = xev->time; + + dpyinfo->last_mouse_glyph_frame = NULL; + + f = mouse_or_wdesc_frame (dpyinfo, xev->event); + + if (f && xev->evtype == XI_ButtonPress + && !popup_activated () + && !x_window_to_scroll_bar (dpyinfo->display, xev->event, 2) + && !FRAME_NO_ACCEPT_FOCUS (f)) + { + /* When clicking into a child frame or when clicking + into a parent frame with the child frame selected and + `no-accept-focus' is not set, select the clicked + frame. */ + struct frame *hf = dpyinfo->highlight_frame; + + if (FRAME_PARENT_FRAME (f) || (hf && frame_ancestor_p (f, hf))) + { + block_input (); + XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), + RevertToParent, CurrentTime); + if (FRAME_PARENT_FRAME (f)) + XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f)); + unblock_input (); + } + } + +#ifdef USE_GTK + if (!f) + { + int real_x = lrint (xev->event_x); + int real_y = lrint (xev->event_y); + Window child; + + f = x_any_window_to_frame (dpyinfo, xev->event); + + if (xev->detail > 3 && xev->detail < 9 && f) + { + if (xev->evtype == XI_ButtonRelease) + { + if (FRAME_X_WINDOW (f) != xev->event) + XTranslateCoordinates (dpyinfo->display, xev->event, + FRAME_X_WINDOW (f), real_x, + real_y, &real_x, &real_y, &child); + + if (xev->detail <= 5) + inev.ie.kind = WHEEL_EVENT; + else + inev.ie.kind = HORIZ_WHEEL_EVENT; + + if (source) + inev.ie.device = source->name; + + inev.ie.timestamp = xev->time; + + XSETINT (inev.ie.x, real_x); + XSETINT (inev.ie.y, real_y); + XSETFRAME (inev.ie.frame_or_window, f); + + inev.ie.modifiers + |= x_x_to_emacs_modifiers (dpyinfo, + xev->mods.effective); + + inev.ie.modifiers |= xev->detail % 2 ? down_modifier : up_modifier; + } + + *finish = X_EVENT_DROP; + goto XI_OTHER; + } + else + f = NULL; + } + + if (f && xg_event_is_for_scrollbar (f, event, false)) + f = 0; +#endif + + if (f) + { + if (xev->detail >= 4 && xev->detail <= 8) + { + if (xev->evtype == XI_ButtonRelease) + { + if (xev->detail <= 5) + inev.ie.kind = WHEEL_EVENT; + else + inev.ie.kind = HORIZ_WHEEL_EVENT; + + if (source) + inev.ie.device = source->name; + + inev.ie.timestamp = xev->time; + + XSETINT (inev.ie.x, lrint (xev->event_x)); + XSETINT (inev.ie.y, lrint (xev->event_y)); + XSETFRAME (inev.ie.frame_or_window, f); + + inev.ie.modifiers + |= x_x_to_emacs_modifiers (dpyinfo, + xev->mods.effective); + + inev.ie.modifiers |= xev->detail % 2 ? down_modifier : up_modifier; + } + + goto XI_OTHER; + } + + /* Is this in the tab-bar? */ + if (WINDOWP (f->tab_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tab_bar_window))) + { + Lisp_Object window; + int x = bv.x; + int y = bv.y; + + window = window_from_coordinates (f, x, y, 0, true, true); + tab_bar_p = EQ (window, f->tab_bar_window); + + if (tab_bar_p) + tab_bar_arg = handle_tab_bar_click + (f, x, y, xev->evtype == XI_ButtonPress, + x_x_to_emacs_modifiers (dpyinfo, bv.state)); + } + +#if ! defined (USE_GTK) + /* Is this in the tool-bar? */ + if (WINDOWP (f->tool_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window))) + { + Lisp_Object window; + int x = bv.x; + int y = bv.y; + + window = window_from_coordinates (f, x, y, 0, true, true); + /* Ignore button release events if the mouse + wasn't previously pressed on the tool bar. + We do this because otherwise selecting some + text with the mouse and then releasing it on + the tool bar doesn't stop selecting text, + since the tool bar eats the button up + event. */ + tool_bar_p = (EQ (window, f->tool_bar_window) + && (xev->evtype != XI_ButtonRelease + || f->last_tool_bar_item != -1)); + + if (tool_bar_p && xev->detail < 4) + handle_tool_bar_click_with_device + (f, x, y, xev->evtype == XI_ButtonPress, + x_x_to_emacs_modifiers (dpyinfo, bv.state), + source ? source->name : Qt); + } +#endif /* !USE_GTK */ + + if (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p) +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) + if (! popup_activated ()) +#endif + { + if (ignore_next_mouse_click_timeout) + { + if (xev->evtype == XI_ButtonPress + && xev->time > ignore_next_mouse_click_timeout) + { + ignore_next_mouse_click_timeout = 0; + x_construct_mouse_click (&inev.ie, &bv, f); + } + if (xev->evtype == XI_ButtonRelease) + ignore_next_mouse_click_timeout = 0; + } + else + x_construct_mouse_click (&inev.ie, &bv, f); + + if (!NILP (tab_bar_arg)) + inev.ie.arg = tab_bar_arg; + } + if (FRAME_X_EMBEDDED_P (f)) + xembed_send_message (f, xev->time, + XEMBED_REQUEST_FOCUS, 0, 0, 0); + } + else + { + struct scroll_bar *bar + = x_window_to_scroll_bar (dpyinfo->display, + xev->event, 2); + +#ifndef USE_TOOLKIT_SCROLL_BARS + if (bar) + x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie); +#else + /* Make the "Ctrl-Mouse-2 splits window" work for toolkit + scroll bars. */ + if (bar && xev->mods.effective & ControlMask) + { + x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie); + *finish = X_EVENT_DROP; + } +#endif + } + + if (xev->evtype == XI_ButtonPress) + { + dpyinfo->grabbed |= (1 << xev->detail); + device->grab |= (1 << xev->detail); + dpyinfo->last_mouse_frame = f; + if (f && !tab_bar_p) + f->last_tab_bar_item = -1; +#if ! defined (USE_GTK) + if (f && !tool_bar_p) + f->last_tool_bar_item = -1; +#endif /* not USE_GTK */ + + } + else + { + dpyinfo->grabbed &= ~(1 << xev->detail); + device->grab &= ~(1 << xev->detail); + } + + if (source && inev.ie.kind != NO_EVENT) + inev.ie.device = source->name; + + if (f) + f->mouse_moved = false; + +#if defined (USE_GTK) + /* No Xt toolkit currently available has support for XI2. + So the code here assumes use of GTK. */ + f = x_menubar_window_to_frame (dpyinfo, event); + if (f /* Gtk+ menus only react to the first three buttons. */ + && xev->detail < 3) + { + /* What is done with Core Input ButtonPressed is not + possible here, because GenericEvents cannot be saved. */ + bool was_waiting_for_input = waiting_for_input; + /* This hack was adopted from the NS port. Whether + or not it is actually safe is a different story + altogether. */ + if (waiting_for_input) + waiting_for_input = 0; + set_frame_menubar (f, true); + waiting_for_input = was_waiting_for_input; + } +#endif + goto XI_OTHER; + } + + case XI_KeyPress: + { + int state = xev->mods.effective; + Lisp_Object c; +#ifdef HAVE_XKB + unsigned int mods_rtrn; +#endif + int keycode = xev->detail; + KeySym keysym; + char copy_buffer[81]; + char *copy_bufptr = copy_buffer; + int copy_bufsiz = sizeof (copy_buffer); + ptrdiff_t i; + uint old_state; + struct xi_device_t *device, *source; + + coding = Qlatin_1; + + device = xi_device_from_id (dpyinfo, xev->deviceid); + source = xi_device_from_id (dpyinfo, xev->sourceid); + + if (!device) + goto XI_OTHER; + +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) + /* Dispatch XI_KeyPress events when in menu. */ + if (popup_activated ()) + goto XI_OTHER; +#endif + + x_display_set_last_user_time (dpyinfo, xev->time); + ignore_next_mouse_click_timeout = 0; + + f = x_any_window_to_frame (dpyinfo, xev->event); + + XKeyPressedEvent xkey; + + memset (&xkey, 0, sizeof xkey); + + xkey.type = KeyPress; + xkey.serial = xev->serial; + xkey.send_event = xev->send_event; + xkey.display = dpyinfo->display; + xkey.window = xev->event; + xkey.root = xev->root; + xkey.subwindow = xev->child; + xkey.time = xev->time; + xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14)) + | (xev->group.effective << 13)); + + xkey.x = lrint (xev->event_x); + xkey.y = lrint (xev->event_y); + xkey.x_root = lrint (xev->root_x); + xkey.y_root = lrint (xev->root_y); + + /* Some input methods react differently depending on the + buttons that are pressed. */ + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + xkey.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + xkey.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + xkey.state |= Button3Mask; + } + + xkey.keycode = xev->detail; + xkey.same_screen = True; + +#ifdef HAVE_X_I18N +#ifdef USE_GTK + if ((!x_gtk_use_native_input + && x_filter_event (dpyinfo, (XEvent *) &xkey)) + || (x_gtk_use_native_input + && x_filter_event (dpyinfo, event))) + { + /* Try to attribute core key events from the input + method to the input extension event that caused + them. */ + dpyinfo->pending_keystroke_time = xev->time; + dpyinfo->pending_keystroke_source = xev->sourceid; + + *finish = X_EVENT_DROP; + goto XI_OTHER; + } +#else + if (x_filter_event (dpyinfo, (XEvent *) &xkey)) + { + /* Try to attribute core key events from the input + method to the input extension event that caused + them. */ + dpyinfo->pending_keystroke_time = xev->time; + dpyinfo->pending_keystroke_source = xev->sourceid; + + *finish = X_EVENT_DROP; + goto XI_OTHER; + } +#endif +#elif USE_GTK + if ((x_gtk_use_native_input + || dpyinfo->prefer_native_input) + && xg_filter_key (any, event)) + { + /* Try to attribute core key events from the input + method to the input extension event that caused + them. */ + dpyinfo->pending_keystroke_time = xev->time; + dpyinfo->pending_keystroke_source = xev->sourceid; + + *finish = X_EVENT_DROP; + goto XI_OTHER; + } +#endif + + state |= x_emacs_to_x_modifiers (dpyinfo, extra_keyboard_modifiers); + +#ifdef HAVE_XKB + if (FRAME_DISPLAY_INFO (f)->xkb_desc) + { + XkbDescRec *rec = FRAME_DISPLAY_INFO (f)->xkb_desc; + + if (rec->map->modmap && rec->map->modmap[xev->detail]) + goto xi_done_keysym; + } + else +#endif + { + if (dpyinfo->modmap) + { + for (i = 0; i < 8 * dpyinfo->modmap->max_keypermod; i++) + { + if (xev->detail == dpyinfo->modmap->modifiermap[i]) + goto xi_done_keysym; + } + } + } + +#ifdef HAVE_XKB + if (dpyinfo->xkb_desc) + { + uint xkb_state = state; + xkb_state &= ~(1 << 13 | 1 << 14); + xkb_state |= xev->group.effective << 13; + + if (!XkbTranslateKeyCode (dpyinfo->xkb_desc, keycode, + xkb_state, &mods_rtrn, &keysym)) + goto XI_OTHER; + } + else + { +#endif + int keysyms_per_keycode_return; + KeySym *ksms = XGetKeyboardMapping (dpyinfo->display, keycode, 1, + &keysyms_per_keycode_return); + if (!(keysym = ksms[0])) + { + XFree (ksms); + goto XI_OTHER; + } + XFree (ksms); +#ifdef HAVE_XKB + } +#endif + + if (keysym == NoSymbol) + goto XI_OTHER; + + /* If mouse-highlight is an integer, input clears out + mouse highlighting. */ + if (!hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight) + && (f == 0 +#if ! defined (USE_GTK) + || !EQ (f->tool_bar_window, hlinfo->mouse_face_window) +#endif + || !EQ (f->tab_bar_window, hlinfo->mouse_face_window)) + ) + { + clear_mouse_face (hlinfo); + hlinfo->mouse_face_hidden = true; + } + + if (f != 0) + { +#ifdef USE_GTK + /* Don't pass keys to GTK. A Tab will shift focus to the + tool bar in GTK 2.4. Keys will still go to menus and + dialogs because in that case popup_activated is nonzero + (see above). */ + *finish = X_EVENT_DROP; +#endif + + XSETFRAME (inev.ie.frame_or_window, f); + inev.ie.modifiers + = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), state); + inev.ie.timestamp = xev->time; + +#ifdef HAVE_X_I18N + if (FRAME_XIC (f)) + { + Status status_return; + nbytes = XmbLookupString (FRAME_XIC (f), + &xkey, (char *) copy_bufptr, + copy_bufsiz, &keysym, + &status_return); + coding = Qnil; + + if (status_return == XBufferOverflow) + { + copy_bufsiz = nbytes + 1; + copy_bufptr = alloca (copy_bufsiz); + nbytes = XmbLookupString (FRAME_XIC (f), + &xkey, (char *) copy_bufptr, + copy_bufsiz, &keysym, + &status_return); + } + + if (status_return == XLookupNone) + goto xi_done_keysym; + else if (status_return == XLookupChars) + { + keysym = NoSymbol; + state = 0; + } + else if (status_return != XLookupKeySym + && status_return != XLookupBoth) + emacs_abort (); + } + else +#endif + { +#ifdef HAVE_XKB + int overflow = 0; + KeySym sym = keysym; + + if (dpyinfo->xkb_desc) + { + nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, + state & ~mods_rtrn, copy_bufptr, + copy_bufsiz, &overflow); + if (overflow) + { + copy_bufptr = alloca ((copy_bufsiz += overflow) + * sizeof *copy_bufptr); + overflow = 0; + nbytes = XkbTranslateKeySym (dpyinfo->display, &sym, + state & ~mods_rtrn, copy_bufptr, + copy_bufsiz, &overflow); + + if (overflow) + nbytes = 0; + } + + coding = Qnil; + } + else +#endif + { + old_state = xkey.state; + xkey.state &= ~ControlMask; + xkey.state &= ~(dpyinfo->meta_mod_mask + | dpyinfo->super_mod_mask + | dpyinfo->hyper_mod_mask + | dpyinfo->alt_mod_mask); + + nbytes = XLookupString (&xkey, copy_bufptr, + copy_bufsiz, &keysym, + NULL); + + xkey.state = old_state; + } + } + +#ifdef XK_F1 + if (x_dnd_in_progress && keysym == XK_F1) + { + x_dnd_xm_use_help = true; + goto xi_done_keysym; + } +#endif + + /* First deal with keysyms which have defined + translations to characters. */ + if (keysym >= 32 && keysym < 128) + /* Avoid explicitly decoding each ASCII character. */ + { + inev.ie.kind = ASCII_KEYSTROKE_EVENT; + inev.ie.code = keysym; + + if (source) + inev.ie.device = source->name; + + goto xi_done_keysym; + } + + /* Keysyms directly mapped to Unicode characters. */ + if (keysym >= 0x01000000 && keysym <= 0x0110FFFF) + { + if (keysym < 0x01000080) + inev.ie.kind = ASCII_KEYSTROKE_EVENT; + else + inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + + if (source) + inev.ie.device = source->name; + + inev.ie.code = keysym & 0xFFFFFF; + goto xi_done_keysym; + } + + /* Now non-ASCII. */ + if (HASH_TABLE_P (Vx_keysym_table) + && (c = Fgethash (make_fixnum (keysym), + Vx_keysym_table, + Qnil), + FIXNATP (c))) + { + inev.ie.kind = (SINGLE_BYTE_CHAR_P (XFIXNAT (c)) + ? ASCII_KEYSTROKE_EVENT + : MULTIBYTE_CHAR_KEYSTROKE_EVENT); + inev.ie.code = XFIXNAT (c); + + if (source) + inev.ie.device = source->name; + + goto xi_done_keysym; + } + + /* Random non-modifier sorts of keysyms. */ + if (((keysym >= XK_BackSpace && keysym <= XK_Escape) + || keysym == XK_Delete +#ifdef XK_ISO_Left_Tab + || (keysym >= XK_ISO_Left_Tab + && keysym <= XK_ISO_Enter) +#endif + || IsCursorKey (keysym) /* 0xff50 <= x < 0xff60 */ + || IsMiscFunctionKey (keysym) /* 0xff60 <= x < VARIES */ +#ifdef HPUX + /* This recognizes the "extended function + keys". It seems there's no cleaner way. + Test IsModifierKey to avoid handling + mode_switch incorrectly. */ + || (XK_Select <= keysym && keysym < XK_KP_Space) +#endif +#ifdef XK_dead_circumflex + || keysym == XK_dead_circumflex +#endif +#ifdef XK_dead_grave + || keysym == XK_dead_grave +#endif +#ifdef XK_dead_tilde + || keysym == XK_dead_tilde +#endif +#ifdef XK_dead_diaeresis + || keysym == XK_dead_diaeresis +#endif +#ifdef XK_dead_macron + || keysym == XK_dead_macron +#endif +#ifdef XK_dead_degree + || keysym == XK_dead_degree +#endif +#ifdef XK_dead_acute + || keysym == XK_dead_acute +#endif +#ifdef XK_dead_cedilla + || keysym == XK_dead_cedilla +#endif +#ifdef XK_dead_breve + || keysym == XK_dead_breve +#endif +#ifdef XK_dead_ogonek + || keysym == XK_dead_ogonek +#endif +#ifdef XK_dead_caron + || keysym == XK_dead_caron +#endif +#ifdef XK_dead_doubleacute + || keysym == XK_dead_doubleacute +#endif +#ifdef XK_dead_abovedot + || keysym == XK_dead_abovedot +#endif +#ifdef XK_dead_abovering + || keysym == XK_dead_abovering +#endif +#ifdef XK_dead_belowdot + || keysym == XK_dead_belowdot +#endif +#ifdef XK_dead_voiced_sound + || keysym == XK_dead_voiced_sound +#endif +#ifdef XK_dead_semivoiced_sound + || keysym == XK_dead_semivoiced_sound +#endif +#ifdef XK_dead_hook + || keysym == XK_dead_hook +#endif +#ifdef XK_dead_horn + || keysym == XK_dead_horn +#endif +#ifdef XK_dead_stroke + || keysym == XK_dead_stroke +#endif +#ifdef XK_dead_abovecomma + || keysym == XK_dead_abovecomma +#endif + || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */ + || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */ + /* Any "vendor-specific" key is ok. */ + || (keysym & (1 << 28)) + || (keysym != NoSymbol && nbytes == 0)) + && ! (IsModifierKey (keysym) + /* The symbols from XK_ISO_Lock + to XK_ISO_Last_Group_Lock + don't have real modifiers but + should be treated similarly to + Mode_switch by Emacs. */ +#if defined XK_ISO_Lock && defined XK_ISO_Last_Group_Lock + || (XK_ISO_Lock <= keysym + && keysym <= XK_ISO_Last_Group_Lock) +#endif + )) + { + STORE_KEYSYM_FOR_DEBUG (keysym); + /* make_lispy_event will convert this to a symbolic + key. */ + inev.ie.kind = NON_ASCII_KEYSTROKE_EVENT; + inev.ie.code = keysym; + + if (source) + inev.ie.device = source->name; + + goto xi_done_keysym; + } + + for (i = 0; i < nbytes; i++) + { + STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); + } + + if (nbytes) + { + inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + inev.ie.arg = make_unibyte_string (copy_bufptr, nbytes); + + Fput_text_property (make_fixnum (0), make_fixnum (nbytes), + Qcoding, coding, inev.ie.arg); + + if (source) + inev.ie.device = source->name; + } + goto xi_done_keysym; + } + + goto XI_OTHER; + } + +#if defined USE_GTK && !defined HAVE_GTK3 + case XI_RawKeyPress: + { + XIRawEvent *raw_event = (XIRawEvent *) xi_event; + + /* This is the only way to attribute core keyboard + events generated on GTK+ 2.x to the extension device + that generated them. */ + dpyinfo->pending_keystroke_time = raw_event->time; + dpyinfo->pending_keystroke_source = raw_event->sourceid; + dpyinfo->pending_keystroke_time_special_p = true; + goto XI_OTHER; + } +#endif + + case XI_KeyRelease: +#if defined HAVE_X_I18N || defined USE_GTK + { + XKeyPressedEvent xkey; + + memset (&xkey, 0, sizeof xkey); + + xkey.type = KeyRelease; + xkey.serial = xev->serial; + xkey.send_event = xev->send_event; + xkey.display = dpyinfo->display; + xkey.window = xev->event; + xkey.root = xev->root; + xkey.subwindow = xev->child; + xkey.time = xev->time; + xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14)) + | (xev->group.effective << 13)); + xkey.x = lrint (xev->event_x); + xkey.y = lrint (xev->event_y); + xkey.x_root = lrint (xev->root_x); + xkey.y_root = lrint (xev->root_y); + + /* Some input methods react differently depending on the + buttons that are pressed. */ + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + xkey.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + xkey.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + xkey.state |= Button3Mask; + } + + xkey.keycode = xev->detail; + xkey.same_screen = True; + +#ifdef HAVE_X_I18N + if (x_filter_event (dpyinfo, (XEvent *) &xkey)) + *finish = X_EVENT_DROP; +#else + f = x_any_window_to_frame (xkey->event); + + if (f && xg_filter_key (f, event)) + *finish = X_EVENT_DROP; +#endif + } +#endif + + goto XI_OTHER; + + case XI_PropertyEvent: + goto XI_OTHER; + + case XI_HierarchyChanged: + { + XIHierarchyEvent *hev = (XIHierarchyEvent *) xi_event; + XIDeviceInfo *info; + int i, j, ndevices, n_disabled, *disabled; + struct xi_device_t *device, *devices; +#ifdef HAVE_XINPUT2_2 + struct xi_touch_point_t *tem, *last; +#endif + + disabled = alloca (sizeof *disabled * hev->num_info); + n_disabled = 0; + + for (i = 0; i < hev->num_info; ++i) + { + if (hev->info[i].flags & XIDeviceEnabled) + { + x_catch_errors (dpyinfo->display); + info = XIQueryDevice (dpyinfo->display, hev->info[i].deviceid, + &ndevices); + x_uncatch_errors (); + + if (info && info->enabled) + { + dpyinfo->devices + = xrealloc (dpyinfo->devices, (sizeof *dpyinfo->devices + * ++dpyinfo->num_devices)); + device = &dpyinfo->devices[dpyinfo->num_devices - 1]; + xi_populate_device_from_info (device, info); + } + + if (info) + XIFreeDeviceInfo (info); + } + else if (hev->info[i].flags & XIDeviceDisabled) + disabled[n_disabled++] = hev->info[i].deviceid; + else if (hev->info[i].flags & XISlaveDetached + || hev->info[i].flags & XISlaveAttached) + { + device = xi_device_from_id (dpyinfo, hev->info[i].deviceid); + x_catch_errors (dpyinfo->display); + info = XIQueryDevice (dpyinfo->display, hev->info[i].deviceid, + &ndevices); + x_uncatch_errors (); + + if (info) + { + if (device && info->enabled) + device->use = info->use; + else if (device) + disabled[n_disabled++] = hev->info[i].deviceid; + + XIFreeDeviceInfo (info); + } + } + } + + if (n_disabled) + { + ndevices = 0; + devices = xmalloc (sizeof *devices * dpyinfo->num_devices); + + for (i = 0; i < dpyinfo->num_devices; ++i) + { + for (j = 0; j < n_disabled; ++j) + { + if (disabled[j] == dpyinfo->devices[i].device_id) + { +#ifdef HAVE_XINPUT2_1 + xfree (dpyinfo->devices[i].valuators); +#endif +#ifdef HAVE_XINPUT2_2 + tem = dpyinfo->devices[i].touchpoints; + while (tem) + { + last = tem; + tem = tem->next; + xfree (last); + } +#endif + goto continue_detachment; + } + } + + devices[ndevices++] = dpyinfo->devices[i]; + + continue_detachment: + continue; + } + + xfree (dpyinfo->devices); + dpyinfo->devices = devices; + dpyinfo->num_devices = ndevices; + } + + goto XI_OTHER; + } + + case XI_DeviceChanged: + { + XIDeviceChangedEvent *device_changed = (XIDeviceChangedEvent *) xi_event; + struct xi_device_t *device; +#ifdef HAVE_XINPUT2_2 + struct xi_touch_point_t *tem, *last; +#endif + int c; +#ifdef HAVE_XINPUT2_1 + int i; +#endif + + device = xi_device_from_id (dpyinfo, device_changed->deviceid); + + if (!device) + { + /* An existing device might have been enabled. */ + x_init_master_valuators (dpyinfo); + + /* Now try to find the device again, in case it was + just enabled. */ + device = xi_device_from_id (dpyinfo, device_changed->deviceid); + } + + /* If it wasn't enabled, then stop handling this event. */ + if (!device) + goto XI_OTHER; + + /* Free data that we will regenerate from new + information. */ +#ifdef HAVE_XINPUT2_1 + device->valuators = xrealloc (device->valuators, + (device_changed->num_classes + * sizeof *device->valuators)); + device->scroll_valuator_count = 0; +#endif +#ifdef HAVE_XINPUT2_2 + device->direct_p = false; +#endif + + for (c = 0; c < device_changed->num_classes; ++c) + { + switch (device_changed->classes[c]->type) + { +#ifdef HAVE_XINPUT2_1 + case XIScrollClass: + { + XIScrollClassInfo *info; + + info = (XIScrollClassInfo *) device_changed->classes[c]; + struct xi_scroll_valuator_t *valuator; + + valuator = &device->valuators[device->scroll_valuator_count++]; + valuator->horizontal + = (info->scroll_type == XIScrollTypeHorizontal); + valuator->invalid_p = true; + valuator->emacs_value = DBL_MIN; + valuator->increment = info->increment; + valuator->number = info->number; + + break; + } +#endif + +#ifdef HAVE_XINPUT2_2 + case XITouchClass: + { + XITouchClassInfo *info; + + info = (XITouchClassInfo *) device_changed->classes[c]; + device->direct_p = info->mode == XIDirectTouch; + } +#endif + default: + break; + } + } + +#ifdef HAVE_XINPUT2_1 + for (c = 0; c < device_changed->num_classes; ++c) + { + if (device_changed->classes[c]->type == XIValuatorClass) + { + XIValuatorClassInfo *info; + + info = (XIValuatorClassInfo *) device_changed->classes[c]; + + for (i = 0; i < device->scroll_valuator_count; ++i) + { + if (device->valuators[i].number == info->number) + { + device->valuators[i].invalid_p = false; + device->valuators[i].current_value = info->value; + + /* Make sure that this is reset if the + pointer moves into a window of ours. + + Otherwise the valuator state could be + left invalid if the DeviceChange + event happened with the pointer + outside any Emacs frame. */ + device->valuators[i].pending_enter_reset = true; + } + } + } + } +#endif + +#ifdef HAVE_XINPUT2_2 + /* The device is no longer a DirectTouch device, so + remove any touchpoints that we might have + recorded. */ + if (!device->direct_p) + { + tem = device->touchpoints; + + while (tem) + { + last = tem; + tem = tem->next; + xfree (last); + } + + device->touchpoints = NULL; + } +#endif + + goto XI_OTHER; + } + +#ifdef HAVE_XINPUT2_2 + case XI_TouchBegin: + { + struct xi_device_t *device, *source; + bool menu_bar_p = false, tool_bar_p = false; +#ifdef HAVE_GTK3 + GdkRectangle test_rect; +#endif + device = xi_device_from_id (dpyinfo, xev->deviceid); + source = xi_device_from_id (dpyinfo, xev->sourceid); + x_display_set_last_user_time (dpyinfo, xev->time); + + if (!device) + goto XI_OTHER; + + if (xi_find_touch_point (device, xev->detail)) + emacs_abort (); + + f = x_any_window_to_frame (dpyinfo, xev->event); + +#ifdef HAVE_GTK3 + menu_bar_p = (f && FRAME_X_OUTPUT (f)->menubar_widget + && xg_event_is_for_menubar (f, event)); + if (f && FRAME_X_OUTPUT (f)->toolbar_widget) + { + int scale = xg_get_scale (f); + + test_rect.x = xev->event_x / scale; + test_rect.y = xev->event_y / scale; + test_rect.width = 1; + test_rect.height = 1; + + tool_bar_p = gtk_widget_intersect (FRAME_X_OUTPUT (f)->toolbar_widget, + &test_rect, NULL); + } +#endif + + if (!menu_bar_p && !tool_bar_p) + { + if (f && device->direct_p) + { + *finish = X_EVENT_DROP; + if (x_input_grab_touch_events) + XIAllowTouchEvents (dpyinfo->display, xev->deviceid, + xev->detail, xev->event, XIAcceptTouch); + + if (!x_had_errors_p (dpyinfo->display)) + { + xi_link_touch_point (device, xev->detail, xev->event_x, + xev->event_y); + + inev.ie.kind = TOUCHSCREEN_BEGIN_EVENT; + inev.ie.timestamp = xev->time; + XSETFRAME (inev.ie.frame_or_window, f); + XSETINT (inev.ie.x, lrint (xev->event_x)); + XSETINT (inev.ie.y, lrint (xev->event_y)); + XSETINT (inev.ie.arg, xev->detail); + + if (source) + inev.ie.device = source->name; + } + } +#ifndef HAVE_GTK3 + else if (x_input_grab_touch_events) + XIAllowTouchEvents (dpyinfo->display, xev->deviceid, + xev->detail, xev->event, XIRejectTouch); +#endif + } + else + { +#ifdef HAVE_GTK3 + bool was_waiting_for_input = waiting_for_input; + /* This hack was adopted from the NS port. Whether + or not it is actually safe is a different story + altogether. */ + if (waiting_for_input) + waiting_for_input = 0; + set_frame_menubar (f, true); + waiting_for_input = was_waiting_for_input; +#endif + } + + goto XI_OTHER; + } + + case XI_TouchUpdate: + { + struct xi_device_t *device, *source; + struct xi_touch_point_t *touchpoint; + Lisp_Object arg = Qnil; + + device = xi_device_from_id (dpyinfo, xev->deviceid); + source = xi_device_from_id (dpyinfo, xev->sourceid); + x_display_set_last_user_time (dpyinfo, xev->time); + + if (!device) + goto XI_OTHER; + + touchpoint = xi_find_touch_point (device, xev->detail); + + if (!touchpoint) + goto XI_OTHER; + + touchpoint->x = xev->event_x; + touchpoint->y = xev->event_y; + + f = x_any_window_to_frame (dpyinfo, xev->event); + + if (f && device->direct_p) + { + inev.ie.kind = TOUCHSCREEN_UPDATE_EVENT; + inev.ie.timestamp = xev->time; + XSETFRAME (inev.ie.frame_or_window, f); + + for (touchpoint = device->touchpoints; + touchpoint; touchpoint = touchpoint->next) + { + arg = Fcons (list3i (lrint (touchpoint->x), + lrint (touchpoint->y), + lrint (touchpoint->number)), + arg); + } + + if (source) + inev.ie.device = source->name; + + inev.ie.arg = arg; + } + + goto XI_OTHER; + } + + case XI_TouchEnd: + { + struct xi_device_t *device, *source; + bool unlinked_p; + + device = xi_device_from_id (dpyinfo, xev->deviceid); + source = xi_device_from_id (dpyinfo, xev->sourceid); + x_display_set_last_user_time (dpyinfo, xev->time); + + if (!device) + goto XI_OTHER; + + unlinked_p = xi_unlink_touch_point (xev->detail, device); + + if (unlinked_p) + { + f = x_any_window_to_frame (dpyinfo, xev->event); + + if (f && device->direct_p) + { + inev.ie.kind = TOUCHSCREEN_END_EVENT; + inev.ie.timestamp = xev->time; + + XSETFRAME (inev.ie.frame_or_window, f); + XSETINT (inev.ie.x, lrint (xev->event_x)); + XSETINT (inev.ie.y, lrint (xev->event_y)); + XSETINT (inev.ie.arg, xev->detail); + + if (source) + inev.ie.device = source->name; + } + } + + goto XI_OTHER; + } + +#endif + +#ifdef HAVE_XINPUT2_4 + case XI_GesturePinchBegin: + case XI_GesturePinchUpdate: + { + XIGesturePinchEvent *pev = (XIGesturePinchEvent *) xi_event; + struct xi_device_t *device, *source; + + device = xi_device_from_id (dpyinfo, pev->deviceid); + source = xi_device_from_id (dpyinfo, pev->sourceid); + x_display_set_last_user_time (dpyinfo, xi_event->time); + + if (!device) + goto XI_OTHER; + +#ifdef HAVE_XWIDGETS + struct xwidget_view *xvw = xwidget_view_from_window (pev->event); + + if (xvw) + { + *finish = X_EVENT_DROP; + xwidget_pinch (xvw, pev); + goto XI_OTHER; + } +#endif + + any = x_any_window_to_frame (dpyinfo, pev->event); + if (any) + { + inev.ie.kind = PINCH_EVENT; + inev.ie.modifiers = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (any), + pev->mods.effective); + XSETINT (inev.ie.x, lrint (pev->event_x)); + XSETINT (inev.ie.y, lrint (pev->event_y)); + XSETFRAME (inev.ie.frame_or_window, any); + inev.ie.arg = list4 (make_float (pev->delta_x), + make_float (pev->delta_y), + make_float (pev->scale), + make_float (pev->delta_angle)); + + if (source) + inev.ie.device = source->name; + } + + /* Once again GTK seems to crash when confronted by + events it doesn't understand. */ + *finish = X_EVENT_DROP; + goto XI_OTHER; + } + + case XI_GesturePinchEnd: + { +#if defined HAVE_XWIDGETS + XIGesturePinchEvent *pev = (XIGesturePinchEvent *) xi_event; + struct xwidget_view *xvw = xwidget_view_from_window (pev->event); + + if (xvw) + xwidget_pinch (xvw, pev); +#endif + *finish = X_EVENT_DROP; + goto XI_OTHER; + } +#endif + default: + goto XI_OTHER; + } + + xi_done_keysym: +#ifdef HAVE_X_I18N + if (f) + { + struct window *w = XWINDOW (f->selected_window); + xic_set_preeditarea (w, w->cursor.x, w->cursor.y); + + if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea)) + xic_set_statusarea (f); + } +#endif + if (must_free_data) + XFreeEventData (dpyinfo->display, &event->xcookie); + goto done_keysym; + + XI_OTHER: + if (must_free_data) + XFreeEventData (dpyinfo->display, &event->xcookie); + goto OTHER; + } +#endif + default: +#ifdef HAVE_XKB + if (dpyinfo->supports_xkb + && event->type == dpyinfo->xkb_event_type) + { + XkbEvent *xkbevent = (XkbEvent *) event; + + if (xkbevent->any.xkb_type == XkbNewKeyboardNotify + || xkbevent->any.xkb_type == XkbMapNotify) + { + if (dpyinfo->xkb_desc) + { + if (XkbGetUpdatedMap (dpyinfo->display, + (XkbKeySymsMask + | XkbKeyTypesMask + | XkbModifierMapMask + | XkbVirtualModsMask), + dpyinfo->xkb_desc) == Success) + { + XkbGetNames (dpyinfo->display, + XkbGroupNamesMask | XkbVirtualModNamesMask, + dpyinfo->xkb_desc); + } + else + { + XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True); + dpyinfo->xkb_desc = NULL; + } + } + else + { + dpyinfo->xkb_desc = XkbGetMap (dpyinfo->display, + (XkbKeySymsMask + | XkbKeyTypesMask + | XkbModifierMapMask + | XkbVirtualModsMask), + XkbUseCoreKbd); + + if (dpyinfo->xkb_desc) + XkbGetNames (dpyinfo->display, + XkbGroupNamesMask | XkbVirtualModNamesMask, + dpyinfo->xkb_desc); + } + + XkbRefreshKeyboardMapping (&xkbevent->map); + x_find_modifier_meanings (dpyinfo); + } + else if (x_dnd_in_progress + && xkbevent->any.xkb_type == XkbStateNotify) + x_dnd_keyboard_state = (xkbevent->state.mods + | xkbevent->state.ptr_buttons); + } +#endif +#ifdef HAVE_XSHAPE + if (dpyinfo->xshape_supported_p + && event->type == dpyinfo->xshape_event_base + ShapeNotify + && x_dnd_in_progress && x_dnd_use_toplevels + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + XEvent xevent; + XShapeEvent *xse = (XShapeEvent *) event; +#if defined HAVE_XCB_SHAPE && defined HAVE_XCB_SHAPE_INPUT_RECTS + xcb_shape_get_rectangles_cookie_t bounding_rect_cookie; + xcb_shape_get_rectangles_reply_t *bounding_rect_reply; + xcb_rectangle_iterator_t bounding_rect_iterator; + + xcb_shape_get_rectangles_cookie_t input_rect_cookie; + xcb_shape_get_rectangles_reply_t *input_rect_reply; + xcb_rectangle_iterator_t input_rect_iterator; + + xcb_generic_error_t *error; +#else + XRectangle *rects; + int rc, ordering; +#endif + + while (XPending (dpyinfo->display)) + { + XNextEvent (dpyinfo->display, &xevent); + + if (xevent.type == dpyinfo->xshape_event_base + ShapeNotify + && ((XShapeEvent *) &xevent)->window == xse->window) + xse = (XShapeEvent *) &xevent; + else + { + XPutBackEvent (dpyinfo->display, &xevent); + break; + } + } + + for (struct x_client_list_window *tem = x_dnd_toplevels; tem; + tem = tem->next) + { + if (tem->window == xse->window) + { + if (tem->n_input_rects != -1) + xfree (tem->input_rects); + if (tem->n_bounding_rects != -1) + xfree (tem->bounding_rects); + + tem->n_input_rects = -1; + tem->n_bounding_rects = -1; + +#if defined HAVE_XCB_SHAPE && defined HAVE_XCB_SHAPE_INPUT_RECTS + bounding_rect_cookie = xcb_shape_get_rectangles (dpyinfo->xcb_connection, + (xcb_window_t) xse->window, + XCB_SHAPE_SK_BOUNDING); + if (dpyinfo->xshape_major > 1 + || (dpyinfo->xshape_major == 1 + && dpyinfo->xshape_minor >= 1)) + input_rect_cookie + = xcb_shape_get_rectangles (dpyinfo->xcb_connection, + (xcb_window_t) xse->window, + XCB_SHAPE_SK_INPUT); + + bounding_rect_reply = xcb_shape_get_rectangles_reply (dpyinfo->xcb_connection, + bounding_rect_cookie, + &error); + + if (bounding_rect_reply) + { + bounding_rect_iterator + = xcb_shape_get_rectangles_rectangles_iterator (bounding_rect_reply); + tem->n_bounding_rects = bounding_rect_iterator.rem + 1; + tem->bounding_rects = xmalloc (tem->n_bounding_rects + * sizeof *tem->bounding_rects); + tem->n_bounding_rects = 0; + + for (; bounding_rect_iterator.rem; xcb_rectangle_next (&bounding_rect_iterator)) + { + tem->bounding_rects[tem->n_bounding_rects].x + = bounding_rect_iterator.data->x; + tem->bounding_rects[tem->n_bounding_rects].y + = bounding_rect_iterator.data->y; + tem->bounding_rects[tem->n_bounding_rects].width + = bounding_rect_iterator.data->width; + tem->bounding_rects[tem->n_bounding_rects].height + = bounding_rect_iterator.data->height; + + tem->n_bounding_rects++; + } + + free (bounding_rect_reply); + } + else + free (error); + + if (dpyinfo->xshape_major > 1 + || (dpyinfo->xshape_major == 1 + && dpyinfo->xshape_minor >= 1)) + { + input_rect_reply = xcb_shape_get_rectangles_reply (dpyinfo->xcb_connection, + input_rect_cookie, &error); + + if (input_rect_reply) + { + input_rect_iterator + = xcb_shape_get_rectangles_rectangles_iterator (input_rect_reply); + tem->n_input_rects = input_rect_iterator.rem + 1; + tem->input_rects = xmalloc (tem->n_input_rects + * sizeof *tem->input_rects); + tem->n_input_rects = 0; + + for (; input_rect_iterator.rem; xcb_rectangle_next (&input_rect_iterator)) + { + tem->input_rects[tem->n_input_rects].x + = input_rect_iterator.data->x; + tem->input_rects[tem->n_input_rects].y + = input_rect_iterator.data->y; + tem->input_rects[tem->n_input_rects].width + = input_rect_iterator.data->width; + tem->input_rects[tem->n_input_rects].height + = input_rect_iterator.data->height; + + tem->n_input_rects++; + } + + free (input_rect_reply); + } + else + free (error); + } +#else + x_catch_errors (dpyinfo->display); + rects = XShapeGetRectangles (dpyinfo->display, + xse->window, + ShapeBounding, + &count, &ordering); + rc = x_had_errors_p (dpyinfo->display); + x_uncatch_errors_after_check (); + + /* Does XShapeGetRectangles allocate anything upon an + error? */ + if (!rc) + { + tem->n_bounding_rects = count; + tem->bounding_rects + = xmalloc (sizeof *tem->bounding_rects * count); + memcpy (tem->bounding_rects, rects, + sizeof *tem->bounding_rects * count); + + XFree (rects); + } + +#ifdef ShapeInput + if (dpyinfo->xshape_major > 1 + || (dpyinfo->xshape_major == 1 + && dpyinfo->xshape_minor >= 1)) + { + x_catch_errors (dpyinfo->display); + rects = XShapeGetRectangles (dpyinfo->display, + xse->window, ShapeInput, + &count, &ordering); + rc = x_had_errors_p (dpyinfo->display); + x_uncatch_errors_after_check (); + + /* Does XShapeGetRectangles allocate anything upon + an error? */ + if (!rc) + { + tem->n_input_rects = count; + tem->input_rects + = xmalloc (sizeof *tem->input_rects * count); + memcpy (tem->input_rects, rects, + sizeof *tem->input_rects * count); + + XFree (rects); + } + } +#endif +#endif + + /* Handle the common case where the input shape equals the + bounding shape. */ + + if (tem->n_input_rects != -1 + && tem->n_bounding_rects == tem->n_input_rects + && !memcmp (tem->bounding_rects, tem->input_rects, + tem->n_input_rects * sizeof *tem->input_rects)) + { + xfree (tem->input_rects); + tem->n_input_rects = -1; + } + + /* And the common case where there is no input rect and the + bouding rect equals the window dimensions. */ + + if (tem->n_input_rects == -1 + && tem->n_bounding_rects == 1 + && tem->bounding_rects[0].width == tem->width + && tem->bounding_rects[0].height == tem->height + && tem->bounding_rects[0].x == -tem->border_width + && tem->bounding_rects[0].y == -tem->border_width) + { + xfree (tem->bounding_rects); + tem->n_bounding_rects = -1; + } + + break; + } + } + } +#endif OTHER: #ifdef USE_X_TOOLKIT block_input (); - if (*finish != X_EVENT_DROP) - XtDispatchEvent ((XEvent *) event); - unblock_input (); + if (*finish != X_EVENT_DROP) + { + /* Ignore some obviously bogus ConfigureNotify events that + other clients have been known to send Emacs. + (bug#54051)*/ + if (event->type != ConfigureNotify + || (event->xconfigure.width != 0 + && event->xconfigure.height != 0)) + { +#if defined USE_MOTIF && defined HAVE_XINPUT2 + XtDispatchEvent (use_copy ? © : (XEvent *) event); +#else + XtDispatchEvent ((XEvent *) event); +#endif + } + } + unblock_input (); #endif /* USE_X_TOOLKIT */ +#if defined USE_GTK && !defined HAVE_GTK3 && defined HAVE_XINPUT2 + if (*finish != X_EVENT_DROP && copy) + { + gtk_main_do_event (copy); + *finish = X_EVENT_DROP; + } + + if (copy) + gdk_event_free (copy); +#endif break; } @@ -9411,6 +18887,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, count++; } +#ifdef USE_TOOLKIT_SCROLL_BARS + if (event->xany.type == ClientMessage + && inev.ie.kind == SCROLL_BAR_CLICK_EVENT) + x_unprotect_window_for_callback (dpyinfo); +#endif + if (do_help && !(hold_quit && hold_quit->kind != NO_EVENT)) { @@ -9435,21 +18917,29 @@ handle_one_xevent (struct x_display_info *dpyinfo, count++; } - /* Sometimes event processing draws to the frame outside redisplay. - To ensure that these changes become visible, draw them here. */ - flush_dirty_back_buffers (); - SAFE_FREE (); + /* Sometimes event processing draws to either F or ANY outside + redisplay. To ensure that these changes become visible, draw + them here. */ + + if (f) + flush_dirty_back_buffer_on (f); + + if (any && any != f) + flush_dirty_back_buffer_on (any); return count; } -#if defined USE_X_TOOLKIT || defined USE_MOTIF || defined USE_GTK - /* Handles the XEvent EVENT on display DISPLAY. This is used for event loops outside the normal event handling, i.e. looping while a popup menu or a dialog is posted. Returns the value handle_one_xevent sets in the finish argument. */ + +#ifdef USE_GTK +static int +#else int +#endif x_dispatch_event (XEvent *event, Display *display) { struct x_display_info *dpyinfo; @@ -9462,7 +18952,6 @@ x_dispatch_event (XEvent *event, Display *display) return finish; } -#endif /* Read events coming from the X server. Return as soon as there are no more events to be read. @@ -9479,6 +18968,13 @@ XTread_socket (struct terminal *terminal, struct input_event *hold_quit) bool event_found = false; struct x_display_info *dpyinfo = terminal->display_info.x; + /* Don't allow XTread_socket to do anything if drag-and-drop is in + progress. If unblock_input causes XTread_socket to be called and + read X events while the drag-and-drop event loop is in progress, + things can go wrong very quick. */ + if (x_dnd_in_progress || x_dnd_waiting_for_finish) + return 0; + block_input (); /* For debugging, this gives a way to fake an I/O error. */ @@ -9498,8 +18994,19 @@ XTread_socket (struct terminal *terminal, struct input_event *hold_quit) #ifdef HAVE_X_I18N /* Filter events for the current X input method. */ - if (x_filter_event (dpyinfo, &event)) - continue; +#ifdef HAVE_XINPUT2 + if (event.type != GenericEvent + || !dpyinfo->supports_xi2 + || event.xgeneric.extension != dpyinfo->xi2_opcode) + { + /* Input extension key events are filtered inside + handle_one_xevent. */ +#endif + if (x_filter_event (dpyinfo, &event)) + continue; +#ifdef HAVE_XINPUT2 + } +#endif #endif event_found = true; @@ -9533,6 +19040,20 @@ XTread_socket (struct terminal *terminal, struct input_event *hold_quit) if (current_finish == X_EVENT_GOTO_OUT) break; } + + /* Now see if `xg_pending_quit_event' was set. */ + if (xg_pending_quit_event.kind != NO_EVENT) + { + /* Check that the frame is still valid. It could have been + deleted between now and the time the event was recorded. */ + if (FRAME_LIVE_P (XFRAME (xg_pending_quit_event.frame_or_window))) + /* Store that event into hold_quit and clear the pending quit + event. */ + *hold_quit = xg_pending_quit_event; + + /* If the frame is invalid, just clear the event as well. */ + xg_pending_quit_event.kind = NO_EVENT; + } #endif /* USE_GTK */ /* On some systems, an X bug causes Emacs to get no more events @@ -9734,8 +19255,8 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text x += cursor_glyph->pixel_width - width; x_fill_rectangle (f, gc, x, - WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y), - width, row->height); + WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y), + width, row->height, false); } else /* HBAR_CURSOR */ { @@ -9756,7 +19277,7 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text x_fill_rectangle (f, gc, x, WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y + row->height - width), - w->phys_cursor_width - 1, width); + w->phys_cursor_width - 1, width, false); } x_reset_clip_rectangles (f, gc); @@ -9792,7 +19313,9 @@ x_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, int y, enum text_cursor_kinds cursor_type, int cursor_width, bool on_p, bool active_p) { +#ifdef HAVE_X_I18N struct frame *f = XFRAME (WINDOW_FRAME (w)); +#endif if (on_p) { @@ -9838,8 +19361,7 @@ x_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, #ifdef HAVE_X_I18N if (w == XWINDOW (f->selected_window)) - if (FRAME_XIC (f)) - xic_set_preeditarea (w, x, y); + xic_set_preeditarea (w, x, y); #endif } @@ -9892,11 +19414,19 @@ x_bitmap_icon (struct frame *f, Lisp_Object file) } #elif defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) - - rc = x_create_bitmap_from_xpm_data (f, gnu_xpm_bits); - if (rc != -1) - FRAME_DISPLAY_INFO (f)->icon_bitmap_id = rc; - + /* This allocates too many colors. */ + if ((FRAME_X_VISUAL_INFO (f)->class == TrueColor + || FRAME_X_VISUAL_INFO (f)->class == StaticColor + || FRAME_X_VISUAL_INFO (f)->class == StaticGray) + /* That pixmap needs about 240 colors, and we should + also leave some more space for other colors as + well. */ + || FRAME_X_VISUAL_INFO (f)->colormap_size >= (240 * 4)) + { + rc = x_create_bitmap_from_xpm_data (f, gnu_xpm_bits); + if (rc != -1) + FRAME_DISPLAY_INFO (f)->icon_bitmap_id = rc; + } #endif /* If all else fails, use the (black and white) xbm image. */ @@ -10152,7 +19682,7 @@ x_connection_closed (Display *dpy, const char *error_message, bool ioerror) { struct x_display_info *dpyinfo = x_display_info_for_display (dpy); Lisp_Object frame, tail; - ptrdiff_t idx = SPECPDL_INDEX (); + specpdl_ref idx = SPECPDL_INDEX (); error_msg = alloca (strlen (error_message) + 1); strcpy (error_msg, error_message); @@ -10259,6 +19789,10 @@ static void x_error_quitter (Display *, XErrorEvent *); static int x_error_handler (Display *display, XErrorEvent *event) { +#ifdef HAVE_XINPUT2 + struct x_display_info *dpyinfo; +#endif + #if defined USE_GTK && defined HAVE_GTK3 if ((event->error_code == BadMatch || event->error_code == BadWindow) && event->request_code == X_SetInputFocus) @@ -10267,6 +19801,24 @@ x_error_handler (Display *display, XErrorEvent *event) } #endif + /* If we try to ungrab or grab a device that doesn't exist anymore + (that happens a lot in xmenu.c), just ignore the error. */ + +#ifdef HAVE_XINPUT2 + dpyinfo = x_display_info_for_display (display); + + /* 51 is X_XIGrabDevice and 52 is X_XIUngrabDevice. + + 53 is X_XIAllowEvents. We handle errors from that here to avoid + a sync in handle_one_xevent. */ + if (dpyinfo && dpyinfo->supports_xi2 + && event->request_code == dpyinfo->xi2_opcode + && (event->minor_code == 51 + || event->minor_code == 52 + || event->minor_code == 53)) + return 0; +#endif + if (x_error_message) x_error_catcher (display, event); else @@ -10474,6 +20026,9 @@ xim_instantiate_callback (Display *display, XPointer client_data, XPointer call_ struct xim_inst_t *xim_inst = (struct xim_inst_t *) client_data; struct x_display_info *dpyinfo = xim_inst->dpyinfo; + if (x_dnd_in_progress) + return; + /* We don't support multiple XIM connections. */ if (dpyinfo->xim) return; @@ -10532,9 +20087,11 @@ xim_initialize (struct x_display_info *dpyinfo, char *resource_name) ret = XRegisterIMInstantiateCallback (dpyinfo->display, dpyinfo->rdb, xim_inst->resource_name, emacs_class, xim_instantiate_callback, - /* This is XPointer in XFree86 but (XPointer *) - on Tru64, at least, hence the configure test. */ - (XRegisterIMInstantiateCallback_arg6) xim_inst); + /* This is XPointer in XFree86 but (XPointer *) on Tru64, at + least, but the configure test doesn't work because + xim_instantiate_callback can either be XIMProc or + XIDProc, so just cast to void *. */ + (void *) xim_inst); eassert (ret == True); #else /* not HAVE_X11R6_XIM */ xim_open_dpy (dpyinfo, resource_name); @@ -10559,8 +20116,7 @@ xim_close_dpy (struct x_display_info *dpyinfo) { Bool ret = XUnregisterIMInstantiateCallback (dpyinfo->display, dpyinfo->rdb, xim_inst->resource_name, - emacs_class, xim_instantiate_callback, - (XRegisterIMInstantiateCallback_arg6) xim_inst); + emacs_class, xim_instantiate_callback, (void *) xim_inst); eassert (ret == True); } xfree (xim_inst->resource_name); @@ -10675,7 +20231,7 @@ x_calc_absolute_position (struct frame *f) which means, do adjust for borders but don't change the gravity. */ static void -x_set_offset (struct frame *f, register int xoff, register int yoff, int change_gravity) +x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) { int modified_top, modified_left; #ifdef USE_GTK @@ -10883,6 +20439,18 @@ x_set_sticky (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) dpyinfo->Xatom_net_wm_state_sticky, None); } +void +x_set_shaded (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) +{ + Lisp_Object frame; + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + + XSETFRAME (frame, f); + + set_wm_state (frame, !NILP (new_value), + dpyinfo->Xatom_net_wm_state_shaded, None); +} + /** * x_set_skip_taskbar: * @@ -10983,7 +20551,8 @@ static bool x_get_current_wm_state (struct frame *f, Window window, int *size_state, - bool *sticky) + bool *sticky, + bool *shaded) { unsigned long actual_size; int i; @@ -11007,6 +20576,7 @@ x_get_current_wm_state (struct frame *f, *sticky = false; *size_state = FULLSCREEN_NONE; + *shaded = false; block_input (); @@ -11068,6 +20638,8 @@ x_get_current_wm_state (struct frame *f, *size_state = FULLSCREEN_BOTH; else if (a == dpyinfo->Xatom_net_wm_state_sticky) *sticky = true; + else if (a == dpyinfo->Xatom_net_wm_state_shaded) + *shaded = true; } #ifdef USE_XCB @@ -11090,7 +20662,7 @@ do_ewmh_fullscreen (struct frame *f) int cur; bool dummy; - x_get_current_wm_state (f, FRAME_OUTER_WINDOW (f), &cur, &dummy); + x_get_current_wm_state (f, FRAME_OUTER_WINDOW (f), &cur, &dummy, &dummy); /* Some window managers don't say they support _NET_WM_STATE, but they do say they support _NET_WM_STATE_FULLSCREEN. Try that also. */ @@ -11230,8 +20802,10 @@ x_handle_net_wm_state (struct frame *f, const XPropertyEvent *event) { int value = FULLSCREEN_NONE; Lisp_Object lval; - bool sticky = false; - bool not_hidden = x_get_current_wm_state (f, event->window, &value, &sticky); + bool sticky = false, shaded = false; + bool not_hidden = x_get_current_wm_state (f, event->window, + &value, &sticky, + &shaded); lval = Qnil; switch (value) @@ -11252,6 +20826,7 @@ x_handle_net_wm_state (struct frame *f, const XPropertyEvent *event) store_frame_param (f, Qfullscreen, lval); store_frame_param (f, Qsticky, sticky ? Qt : Qnil); + store_frame_param (f, Qshaded, shaded ? Qt : Qnil); return not_hidden; } @@ -11567,9 +21142,27 @@ void frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) { block_input (); +#ifdef HAVE_XINPUT2 + int deviceid; - XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f), - 0, 0, 0, 0, pix_x, pix_y); + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + { + if (XIGetClientPointer (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + &deviceid)) + { + x_catch_errors (FRAME_X_DISPLAY (f)); + XIWarpPointer (FRAME_X_DISPLAY (f), + deviceid, None, + FRAME_X_WINDOW (f), + 0, 0, 0, 0, pix_x, pix_y); + x_uncatch_errors (); + } + } + else +#endif + XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f), + 0, 0, 0, 0, pix_x, pix_y); unblock_input (); } @@ -11597,6 +21190,13 @@ x_lower_frame (struct frame *f) XFlush (FRAME_X_DISPLAY (f)); unblock_input (); } +#ifdef HAVE_XWIDGETS + /* Make sure any X windows owned by xwidget views of the parent + still display below the lowered frame. */ + + if (FRAME_PARENT_FRAME (f)) + lower_frame_xwidget_views (FRAME_PARENT_FRAME (f)); +#endif } static void @@ -11682,7 +21282,7 @@ x_focus_frame (struct frame *f, bool noactivate) } else { - XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), RevertToParent, CurrentTime); if (!noactivate) x_ewmh_activate_frame (f); @@ -11750,6 +21350,11 @@ xembed_send_message (struct frame *f, Time t, enum xembed_message msg, void x_make_frame_visible (struct frame *f) { +#ifndef USE_GTK + struct x_display_info *dpyinfo; + struct x_output *output; +#endif + if (FRAME_PARENT_FRAME (f)) { if (!FRAME_VISIBLE_P (f)) @@ -11774,6 +21379,10 @@ x_make_frame_visible (struct frame *f) gui_set_bitmap_icon (f); +#ifndef USE_GTK + dpyinfo = FRAME_DISPLAY_INFO (f); +#endif + if (! FRAME_VISIBLE_P (f)) { /* We test asked_for_visible here to make sure we don't @@ -11785,6 +21394,60 @@ x_make_frame_visible (struct frame *f) && ! f->output_data.x->asked_for_visible) x_set_offset (f, f->left_pos, f->top_pos, 0); +#ifndef USE_GTK + output = FRAME_X_OUTPUT (f); + + if (!x_wm_supports (f, dpyinfo->Xatom_net_wm_user_time_window)) + { + if (output->user_time_window == None) + output->user_time_window = FRAME_OUTER_WINDOW (f); + else if (output->user_time_window != FRAME_OUTER_WINDOW (f)) + { + XDestroyWindow (dpyinfo->display, + output->user_time_window); + XDeleteProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_user_time_window); + output->user_time_window = FRAME_OUTER_WINDOW (f); + } + } + else + { + if (output->user_time_window == FRAME_OUTER_WINDOW (f) + || output->user_time_window == None) + { + XSetWindowAttributes attrs; + memset (&attrs, 0, sizeof attrs); + + output->user_time_window + = XCreateWindow (dpyinfo->display, FRAME_X_WINDOW (f), + -1, -1, 1, 1, 0, 0, InputOnly, + CopyFromParent, 0, &attrs); + + XDeleteProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_user_time); + XChangeProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_user_time_window, + XA_WINDOW, 32, PropModeReplace, + (unsigned char *) &output->user_time_window, + 1); + } + } + + if (dpyinfo->last_user_time) + XChangeProperty (dpyinfo->display, + output->user_time_window, + dpyinfo->Xatom_net_wm_user_time, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &dpyinfo->last_user_time, 1); + else + XDeleteProperty (dpyinfo->display, + output->user_time_window, + dpyinfo->Xatom_net_wm_user_time); +#endif + f->output_data.x->asked_for_visible = true; if (! EQ (Vx_no_window_manager, Qt)) @@ -11808,6 +21471,12 @@ x_make_frame_visible (struct frame *f) XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); #endif /* not USE_GTK */ #endif /* not USE_X_TOOLKIT */ + + if (FRAME_X_EMBEDDED_P (f)) + { + SET_FRAME_VISIBLE (f, true); + SET_FRAME_ICONIFIED (f, false); + } } XFlush (FRAME_X_DISPLAY (f)); @@ -12058,7 +21727,7 @@ x_iconify_frame (struct frame *f) msg.xclient.data.l[0] = IconicState; if (! XSendEvent (FRAME_X_DISPLAY (f), - DefaultRootWindow (FRAME_X_DISPLAY (f)), + FRAME_DISPLAY_INFO (f)->root_window, False, SubstructureRedirectMask | SubstructureNotifyMask, &msg)) @@ -12156,15 +21825,29 @@ 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 */ tear_down_x_back_buffer (f); if (FRAME_X_WINDOW (f)) - XDestroyWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); + XDestroyWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); #endif /* !USE_X_TOOLKIT */ +#ifdef HAVE_XSYNC + if (FRAME_X_BASIC_COUNTER (f) != None) + XSyncDestroyCounter (FRAME_X_DISPLAY (f), + FRAME_X_BASIC_COUNTER (f)); + + if (FRAME_X_EXTENDED_COUNTER (f) != None) + XSyncDestroyCounter (FRAME_X_DISPLAY (f), + FRAME_X_EXTENDED_COUNTER (f)); +#endif + unload_color (f, FRAME_FOREGROUND_PIXEL (f)); unload_color (f, FRAME_BACKGROUND_PIXEL (f)); unload_color (f, f->output_data.x->cursor_pixel); @@ -12237,9 +21920,13 @@ x_free_frame_resources (struct frame *f) XFlush (FRAME_X_DISPLAY (f)); } - xfree (f->output_data.x->saved_menu_event); - xfree (f->output_data.x); - f->output_data.x = NULL; +#ifdef HAVE_GTK3 + if (FRAME_OUTPUT_DATA (f)->scrollbar_background_css_provider) + g_object_unref (FRAME_OUTPUT_DATA (f)->scrollbar_background_css_provider); + + if (FRAME_OUTPUT_DATA (f)->scrollbar_foreground_css_provider) + g_object_unref (FRAME_OUTPUT_DATA (f)->scrollbar_foreground_css_provider); +#endif if (f == dpyinfo->x_focus_frame) dpyinfo->x_focus_frame = 0; @@ -12266,6 +21953,21 @@ x_destroy_window (struct frame *f) if (dpyinfo->display != 0) x_free_frame_resources (f); + xfree (f->output_data.x->saved_menu_event); + xfree (f->output_data.x); + +#ifdef HAVE_X_I18N + if (f->output_data.x->preedit_chars) + xfree (f->output_data.x->preedit_chars); +#endif + +#ifdef HAVE_XINPUT2 + if (f->output_data.x->xi_masks) + XFree (f->output_data.x->xi_masks); +#endif + + f->output_data.x = NULL; + dpyinfo->reference_count--; } @@ -12285,6 +21987,9 @@ x_wm_set_size_hint (struct frame *f, long flags, bool user_position) { XSizeHints size_hints; Window window = FRAME_OUTER_WINDOW (f); +#ifdef USE_X_TOOLKIT + WMShellWidget shell; +#endif if (!window) return; @@ -12292,7 +21997,63 @@ x_wm_set_size_hint (struct frame *f, long flags, bool user_position) #ifdef USE_X_TOOLKIT if (f->output_data.x->widget) { - widget_update_wm_size_hints (f->output_data.x->widget); + /* Do this dance in xterm.c because some stuff is not as easily + available in widget.c. */ + + eassert (XtIsWMShell (f->output_data.x->widget)); + shell = (WMShellWidget) f->output_data.x->widget; + + shell->wm.size_hints.flags &= ~(PPosition | USPosition); + shell->wm.size_hints.flags |= flags & (PPosition | USPosition); + + if (user_position) + { + shell->wm.size_hints.flags &= ~PPosition; + shell->wm.size_hints.flags |= USPosition; + } + + widget_update_wm_size_hints (f->output_data.x->widget, + f->output_data.x->edit_widget); + +#ifdef USE_MOTIF + /* Do this all over again for the benefit of Motif, which always + knows better than the programmer. */ + shell->wm.size_hints.flags &= ~(PPosition | USPosition); + shell->wm.size_hints.flags |= flags & (PPosition | USPosition); + + if (user_position) + { + shell->wm.size_hints.flags &= ~PPosition; + shell->wm.size_hints.flags |= USPosition; + } + + /* Drill hints into Motif, since it keeps setting its own. */ + size_hints.flags = shell->wm.size_hints.flags; + size_hints.x = shell->wm.size_hints.x; + size_hints.y = shell->wm.size_hints.y; + size_hints.width = shell->wm.size_hints.width; + size_hints.height = shell->wm.size_hints.height; + size_hints.min_width = shell->wm.size_hints.min_width; + size_hints.min_height = shell->wm.size_hints.min_height; + size_hints.max_width = shell->wm.size_hints.max_width; + size_hints.max_height = shell->wm.size_hints.max_height; + size_hints.width_inc = shell->wm.size_hints.width_inc; + size_hints.height_inc = shell->wm.size_hints.height_inc; + size_hints.min_aspect.x = shell->wm.size_hints.min_aspect.x; + size_hints.min_aspect.y = shell->wm.size_hints.min_aspect.y; + size_hints.max_aspect.x = shell->wm.size_hints.max_aspect.x; + size_hints.max_aspect.y = shell->wm.size_hints.max_aspect.y; +#ifdef HAVE_X11XTR6 + size_hints.base_width = shell->wm.base_width; + size_hints.base_height = shell->wm.base_height; + size_hints.win_gravity = shell->wm.win_gravity; +#endif + + XSetWMNormalHints (XtDisplay (f->output_data.x->widget), + XtWindow (f->output_data.x->widget), + &size_hints); +#endif + return; } #endif @@ -12670,8 +22431,12 @@ static bool x_probe_xfixes_extension (Display *dpy) { #ifdef HAVE_XFIXES - int major, minor; - return XFixesQueryVersion (dpy, &major, &minor) && major >= 4; + struct x_display_info *info + = x_display_info_for_display (dpy); + + return (info + && info->xfixes_supported_p + && info->xfixes_major >= 4); #else return false; #endif /* HAVE_XFIXES */ @@ -12742,6 +22507,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) #ifdef USE_XCB xcb_connection_t *xcb_conn; #endif + char *cm_atom_sprintf; block_input (); @@ -12934,7 +22700,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) vendor ? build_string (vendor) : empty_unibyte_string)); block_input (); terminal->next_terminal = terminal_list; - terminal_list = terminal; + terminal_list = terminal; } /* Don't let the initial kboard remain current longer than necessary. @@ -12987,8 +22753,10 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->x_id = ++x_display_id; +#ifndef HAVE_XKB /* Figure out which modifier bits mean what. */ x_find_modifier_meanings (dpyinfo); +#endif /* Get the scroll bar cursor. */ #ifdef USE_GTK @@ -13009,6 +22777,45 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) #else dpyinfo->display->db = xrdb; #endif + +#ifdef HAVE_XRENDER + int event_base, error_base; + dpyinfo->xrender_supported_p + = XRenderQueryExtension (dpyinfo->display, &event_base, &error_base); + + if (dpyinfo->xrender_supported_p) + dpyinfo->xrender_supported_p + = XRenderQueryVersion (dpyinfo->display, &dpyinfo->xrender_major, + &dpyinfo->xrender_minor); +#endif + + /* This must come after XRenderQueryVersion! */ +#ifdef HAVE_XCOMPOSITE + int composite_event_base, composite_error_base; + dpyinfo->composite_supported_p = XCompositeQueryExtension (dpyinfo->display, + &composite_event_base, + &composite_error_base); + + if (dpyinfo->composite_supported_p) + dpyinfo->composite_supported_p + = XCompositeQueryVersion (dpyinfo->display, + &dpyinfo->composite_major, + &dpyinfo->composite_minor); +#endif + +#ifdef HAVE_XSHAPE + dpyinfo->xshape_supported_p + = XShapeQueryExtension (dpyinfo->display, + &dpyinfo->xshape_event_base, + &dpyinfo->xshape_error_base); + + if (dpyinfo->xshape_supported_p) + dpyinfo->xshape_supported_p + = XShapeQueryVersion (dpyinfo->display, + &dpyinfo->xshape_major, + &dpyinfo->xshape_minor); +#endif + /* Put the rdb where we can find it in a way that works on all versions. */ dpyinfo->rdb = xrdb; @@ -13023,21 +22830,53 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) reset_mouse_highlight (&dpyinfo->mouse_highlight); - /* See if we can construct pixel values from RGB values. */ - if (dpyinfo->visual->class == TrueColor) - { - get_bits_and_offset (dpyinfo->visual->red_mask, - &dpyinfo->red_bits, &dpyinfo->red_offset); - get_bits_and_offset (dpyinfo->visual->blue_mask, - &dpyinfo->blue_bits, &dpyinfo->blue_offset); - get_bits_and_offset (dpyinfo->visual->green_mask, - &dpyinfo->green_bits, &dpyinfo->green_offset); - } +#ifdef HAVE_XRENDER + if (dpyinfo->xrender_supported_p + /* This could already have been initialized by + `select_visual'. */ + && !dpyinfo->pict_format) + dpyinfo->pict_format = XRenderFindVisualFormat (dpyinfo->display, + dpyinfo->visual); +#endif + +#ifdef HAVE_XSYNC + int xsync_event_base, xsync_error_base; + dpyinfo->xsync_supported_p + = XSyncQueryExtension (dpyinfo->display, + &xsync_event_base, + &xsync_error_base); + + if (dpyinfo->xsync_supported_p) + dpyinfo->xsync_supported_p = XSyncInitialize (dpyinfo->display, + &dpyinfo->xsync_major, + &dpyinfo->xsync_minor); + + { + AUTO_STRING (synchronizeResize, "synchronizeResize"); + AUTO_STRING (SynchronizeResize, "SynchronizeResize"); + + Lisp_Object value = gui_display_get_resource (dpyinfo, + synchronizeResize, + SynchronizeResize, + Qnil, Qnil); + + if (STRINGP (value) && + (!strcmp (SSDATA (value), "false") + || !strcmp (SSDATA (value), "off"))) + dpyinfo->xsync_supported_p = false; + } +#endif + +#ifdef HAVE_XINERAMA + int xin_event_base, xin_error_base; + dpyinfo->xinerama_supported_p + = XineramaQueryExtension (dpy, &xin_event_base, &xin_error_base); +#endif /* See if a private colormap is requested. */ if (dpyinfo->visual == DefaultVisualOfScreen (dpyinfo->screen)) { - if (dpyinfo->visual->class == PseudoColor) + if (dpyinfo->visual_info.class == PseudoColor) { AUTO_STRING (privateColormap, "privateColormap"); AUTO_STRING (PrivateColormap, "PrivateColormap"); @@ -13054,6 +22893,52 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->cmap = XCreateColormap (dpyinfo->display, dpyinfo->root_window, dpyinfo->visual, AllocNone); + /* See if we can construct pixel values from RGB values. */ + if (dpyinfo->visual_info.class == TrueColor) + { + get_bits_and_offset (dpyinfo->visual_info.red_mask, + &dpyinfo->red_bits, &dpyinfo->red_offset); + get_bits_and_offset (dpyinfo->visual_info.blue_mask, + &dpyinfo->blue_bits, &dpyinfo->blue_offset); + get_bits_and_offset (dpyinfo->visual_info.green_mask, + &dpyinfo->green_bits, &dpyinfo->green_offset); + +#ifdef HAVE_XRENDER + if (dpyinfo->pict_format) + { + unsigned long channel_mask + = ((unsigned long) dpyinfo->pict_format->direct.alphaMask + << dpyinfo->pict_format->direct.alpha); + + if (channel_mask) + get_bits_and_offset (channel_mask, &dpyinfo->alpha_bits, + &dpyinfo->alpha_offset); + dpyinfo->alpha_mask = channel_mask; + } + else +#endif + { + XColor xc; + unsigned long alpha_mask; + xc.red = 65535; + xc.green = 65535; + xc.blue = 65535; + + if (XAllocColor (dpyinfo->display, + dpyinfo->cmap, &xc) != 0) + { + alpha_mask = xc.pixel & ~(dpyinfo->visual_info.red_mask + | dpyinfo->visual_info.blue_mask + | dpyinfo->visual_info.green_mask); + + if (alpha_mask) + get_bits_and_offset (alpha_mask, &dpyinfo->alpha_bits, + &dpyinfo->alpha_offset); + dpyinfo->alpha_mask = alpha_mask; + } + } + } + #ifdef HAVE_XDBE dpyinfo->supports_xdbe = false; int xdbe_major; @@ -13062,6 +22947,196 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->supports_xdbe = true; #endif +#ifdef USE_XCB + xcb_screen_t *xcb_screen = NULL; + xcb_screen_iterator_t iter; + xcb_visualid_t wanted = { XVisualIDFromVisual (dpyinfo->visual) }; + xcb_depth_iterator_t depth_iter; + xcb_visualtype_iterator_t visual_iter; + + int screen = DefaultScreen (dpyinfo->display); + + iter = xcb_setup_roots_iterator (xcb_get_setup (dpyinfo->xcb_connection)); + for (; iter.rem; --screen, xcb_screen_next (&iter)) + { + if (!screen) + xcb_screen = iter.data; + } + + if (xcb_screen) + { + depth_iter = xcb_screen_allowed_depths_iterator (xcb_screen); + for (; depth_iter.rem; xcb_depth_next (&depth_iter)) + { + visual_iter = xcb_depth_visuals_iterator (depth_iter.data); + for (; visual_iter.rem; xcb_visualtype_next (&visual_iter)) + { + if (wanted == visual_iter.data->visual_id) + { + dpyinfo->xcb_visual = visual_iter.data; + break; + } + } + } + } +#endif + +#ifdef HAVE_XINPUT2 + dpyinfo->supports_xi2 = false; + int rc; + int major = 2; + int xi_first_event, xi_first_error; + +#ifdef HAVE_XINPUT2_4 + int minor = 4; +#elif defined HAVE_XINPUT2_3 /* XInput 2.3 */ + int minor = 3; +#elif defined HAVE_XINPUT2_2 /* XInput 2.2 */ + int minor = 2; +#elif defined HAVE_XINPUT2_1 /* XInput 2.1 */ + int minor = 1; +#else /* Some old version of XI2 we're not interested in. */ + int minor = 0; +#endif + + if (XQueryExtension (dpyinfo->display, "XInputExtension", + &dpyinfo->xi2_opcode, &xi_first_event, + &xi_first_error)) + { +#ifdef HAVE_GTK3 + bool move_backwards = false; + int original_minor = minor; + + query: + + /* Catch errors caused by GTK requesting a different version of + XInput 2 than what Emacs was built with. Usually, the X + server tolerates these mistakes, but a BadValue error can + result if only one of GTK or Emacs wasn't built with support + for XInput 2.2. + + To work around the first, it suffices to increase the minor + version until the X server is happy if the XIQueryVersion + request results in an error. If that doesn't work, however, + then it's the latter, so decrease the minor until the version + that GTK requested is found. */ +#endif + + x_catch_errors (dpyinfo->display); + + rc = XIQueryVersion (dpyinfo->display, &major, &minor); + +#ifdef HAVE_GTK3 + /* Increase the minor version until we find one the X + server agrees with. If that didn't work, then + decrease the version until it either hits zero or + becomes agreeable to the X server. */ + + if (x_had_errors_p (dpyinfo->display)) + { + x_uncatch_errors_after_check (); + + /* Since BadValue errors can't be generated if both the + prior and current requests specify a version of 2.2 or + later, this means the prior request specified a version + of the input extension less than 2.2. */ + if (minor >= 2) + { + move_backwards = true; + minor = original_minor; + + if (--minor < 0) + rc = BadRequest; + else + goto query; + } + else + { + if (!move_backwards) + { + minor++; + goto query; + } + + if (--minor < 0) + rc = BadRequest; + else + goto query; + + } + } + else + x_uncatch_errors_after_check (); +#else + if (x_had_errors_p (dpyinfo->display)) + rc = BadRequest; + + x_uncatch_errors_after_check (); +#endif + + if (rc == Success) + { + dpyinfo->supports_xi2 = true; + x_init_master_valuators (dpyinfo); + } + } + + dpyinfo->xi2_version = minor; +#endif + +#ifdef HAVE_XRANDR + int xrr_event_base, xrr_error_base; + bool xrr_ok = false; + xrr_ok = XRRQueryExtension (dpy, &xrr_event_base, &xrr_error_base); + if (xrr_ok) + { + XRRQueryVersion (dpy, &dpyinfo->xrandr_major_version, + &dpyinfo->xrandr_minor_version); + } +#endif + +#ifdef HAVE_XKB + int xkb_major, xkb_minor, xkb_op, xkb_error_code; + xkb_major = XkbMajorVersion; + xkb_minor = XkbMinorVersion; + + if (XkbLibraryVersion (&xkb_major, &xkb_minor) + && XkbQueryExtension (dpyinfo->display, &xkb_op, &dpyinfo->xkb_event_type, + &xkb_error_code, &xkb_major, &xkb_minor)) + { + dpyinfo->supports_xkb = true; + dpyinfo->xkb_desc = XkbGetMap (dpyinfo->display, + (XkbKeySymsMask + | XkbKeyTypesMask + | XkbModifierMapMask + | XkbVirtualModsMask), + XkbUseCoreKbd); + + if (dpyinfo->xkb_desc) + XkbGetNames (dpyinfo->display, + XkbGroupNamesMask | XkbVirtualModNamesMask, + dpyinfo->xkb_desc); + + XkbSelectEvents (dpyinfo->display, XkbUseCoreKbd, + XkbNewKeyboardNotifyMask | XkbMapNotifyMask, + XkbNewKeyboardNotifyMask | XkbMapNotifyMask); + } +#endif + +#ifdef HAVE_XFIXES + int xfixes_event_base, xfixes_error_base; + dpyinfo->xfixes_supported_p + = XFixesQueryExtension (dpyinfo->display, &xfixes_event_base, + &xfixes_error_base); + + if (dpyinfo->xfixes_supported_p) + { + if (!XFixesQueryVersion (dpyinfo->display, &dpyinfo->xfixes_major, + &dpyinfo->xfixes_minor)) + dpyinfo->xfixes_supported_p = false; + } +#endif + #if defined USE_CAIRO || defined HAVE_XFT { /* If we are using Xft, the following precautions should be made: @@ -13078,11 +23153,6 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) or larger than other for other applications, even if it is the same font name (monospace-10 for example). */ -# ifdef HAVE_XRENDER - int event_base, error_base; - XRenderQueryExtension (dpyinfo->display, &event_base, &error_base); -# endif - char *v = XGetDefault (dpyinfo->display, "Xft", "dpi"); double d; if (v != NULL && sscanf (v, "%lf", &d) == 1) @@ -13104,6 +23174,15 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) } { + int n = snprintf (NULL, 0, "_NET_WM_CM_S%d", + XScreenNumberOfScreen (dpyinfo->screen)); + cm_atom_sprintf = alloca (n + 1); + + snprintf (cm_atom_sprintf, n + 1, "_NET_WM_CM_S%d", + XScreenNumberOfScreen (dpyinfo->screen)); + } + + { static const struct { const char *name; @@ -13116,9 +23195,11 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("WM_SAVE_YOURSELF", Xatom_wm_save_yourself) ATOM_REFS_INIT ("WM_DELETE_WINDOW", Xatom_wm_delete_window) ATOM_REFS_INIT ("WM_CHANGE_STATE", Xatom_wm_change_state) + ATOM_REFS_INIT ("WM_STATE", Xatom_wm_state) ATOM_REFS_INIT ("WM_CONFIGURE_DENIED", Xatom_wm_configure_denied) ATOM_REFS_INIT ("WM_MOVED", Xatom_wm_window_moved) ATOM_REFS_INIT ("WM_CLIENT_LEADER", Xatom_wm_client_leader) + ATOM_REFS_INIT ("WM_TRANSIENT_FOR", Xatom_wm_transient_for) ATOM_REFS_INIT ("Editres", Xatom_editres) ATOM_REFS_INIT ("CLIPBOARD", Xatom_CLIPBOARD) ATOM_REFS_INIT ("TIMESTAMP", Xatom_TIMESTAMP) @@ -13129,12 +23210,14 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("MULTIPLE", Xatom_MULTIPLE) ATOM_REFS_INIT ("INCR", Xatom_INCR) ATOM_REFS_INIT ("_EMACS_TMP_", Xatom_EMACS_TMP) + ATOM_REFS_INIT ("EMACS_SERVER_TIME_PROP", Xatom_EMACS_SERVER_TIME_PROP) ATOM_REFS_INIT ("TARGETS", Xatom_TARGETS) ATOM_REFS_INIT ("NULL", Xatom_NULL) ATOM_REFS_INIT ("ATOM", Xatom_ATOM) ATOM_REFS_INIT ("ATOM_PAIR", Xatom_ATOM_PAIR) ATOM_REFS_INIT ("CLIPBOARD_MANAGER", Xatom_CLIPBOARD_MANAGER) ATOM_REFS_INIT ("_XEMBED_INFO", Xatom_XEMBED_INFO) + ATOM_REFS_INIT ("_MOTIF_WM_HINTS", Xatom_MOTIF_WM_HINTS) /* For properties of font. */ ATOM_REFS_INIT ("PIXEL_SIZE", Xatom_PIXEL_SIZE) ATOM_REFS_INIT ("AVERAGE_WIDTH", Xatom_AVERAGE_WIDTH) @@ -13155,6 +23238,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("_NET_WM_STATE_MAXIMIZED_VERT", Xatom_net_wm_state_maximized_vert) ATOM_REFS_INIT ("_NET_WM_STATE_STICKY", Xatom_net_wm_state_sticky) + ATOM_REFS_INIT ("_NET_WM_STATE_SHADED", Xatom_net_wm_state_shaded) ATOM_REFS_INIT ("_NET_WM_STATE_HIDDEN", Xatom_net_wm_state_hidden) ATOM_REFS_INIT ("_NET_WM_WINDOW_TYPE", Xatom_net_window_type) ATOM_REFS_INIT ("_NET_WM_WINDOW_TYPE_TOOLTIP", @@ -13168,6 +23252,12 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("_NET_FRAME_EXTENTS", Xatom_net_frame_extents) ATOM_REFS_INIT ("_NET_CURRENT_DESKTOP", Xatom_net_current_desktop) ATOM_REFS_INIT ("_NET_WORKAREA", Xatom_net_workarea) + ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST", Xatom_net_wm_sync_request) + ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST_COUNTER", Xatom_net_wm_sync_request_counter) + ATOM_REFS_INIT ("_NET_WM_FRAME_DRAWN", Xatom_net_wm_frame_drawn) + ATOM_REFS_INIT ("_NET_WM_USER_TIME", Xatom_net_wm_user_time) + ATOM_REFS_INIT ("_NET_WM_USER_TIME_WINDOW", Xatom_net_wm_user_time_window) + ATOM_REFS_INIT ("_NET_CLIENT_LIST_STACKING", Xatom_net_client_list_stacking) /* Session management */ ATOM_REFS_INIT ("SM_CLIENT_ID", Xatom_SM_CLIENT_ID) ATOM_REFS_INIT ("_XSETTINGS_SETTINGS", Xatom_xsettings_prop) @@ -13175,12 +23265,51 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("_NET_WM_STATE_SKIP_TASKBAR", Xatom_net_wm_state_skip_taskbar) ATOM_REFS_INIT ("_NET_WM_STATE_ABOVE", Xatom_net_wm_state_above) ATOM_REFS_INIT ("_NET_WM_STATE_BELOW", Xatom_net_wm_state_below) + ATOM_REFS_INIT ("_NET_WM_OPAQUE_REGION", Xatom_net_wm_opaque_region) + ATOM_REFS_INIT ("_NET_WM_PING", Xatom_net_wm_ping) + ATOM_REFS_INIT ("_NET_WM_PID", Xatom_net_wm_pid) +#ifdef HAVE_XKB + ATOM_REFS_INIT ("Meta", Xatom_Meta) + ATOM_REFS_INIT ("Super", Xatom_Super) + ATOM_REFS_INIT ("Hyper", Xatom_Hyper) + ATOM_REFS_INIT ("ShiftLock", Xatom_ShiftLock) + ATOM_REFS_INIT ("Alt", Xatom_Alt) +#endif + /* DND source. */ + ATOM_REFS_INIT ("XdndAware", Xatom_XdndAware) + ATOM_REFS_INIT ("XdndSelection", Xatom_XdndSelection) + ATOM_REFS_INIT ("XdndTypeList", Xatom_XdndTypeList) + ATOM_REFS_INIT ("XdndActionCopy", Xatom_XdndActionCopy) + ATOM_REFS_INIT ("XdndActionMove", Xatom_XdndActionMove) + ATOM_REFS_INIT ("XdndActionLink", Xatom_XdndActionLink) + ATOM_REFS_INIT ("XdndActionAsk", Xatom_XdndActionAsk) + ATOM_REFS_INIT ("XdndActionPrivate", Xatom_XdndActionPrivate) + ATOM_REFS_INIT ("XdndActionList", Xatom_XdndActionList) + ATOM_REFS_INIT ("XdndActionDescription", Xatom_XdndActionDescription) + ATOM_REFS_INIT ("XdndProxy", Xatom_XdndProxy) + ATOM_REFS_INIT ("XdndEnter", Xatom_XdndEnter) + ATOM_REFS_INIT ("XdndPosition", Xatom_XdndPosition) + ATOM_REFS_INIT ("XdndStatus", Xatom_XdndStatus) + ATOM_REFS_INIT ("XdndLeave", Xatom_XdndLeave) + ATOM_REFS_INIT ("XdndDrop", Xatom_XdndDrop) + ATOM_REFS_INIT ("XdndFinished", Xatom_XdndFinished) + /* Motif drop protocol support. */ + ATOM_REFS_INIT ("_MOTIF_DRAG_WINDOW", Xatom_MOTIF_DRAG_WINDOW) + ATOM_REFS_INIT ("_MOTIF_DRAG_TARGETS", Xatom_MOTIF_DRAG_TARGETS) + ATOM_REFS_INIT ("_MOTIF_DRAG_AND_DROP_MESSAGE", + Xatom_MOTIF_DRAG_AND_DROP_MESSAGE) + ATOM_REFS_INIT ("_MOTIF_DRAG_INITIATOR_INFO", + Xatom_MOTIF_DRAG_INITIATOR_INFO) + ATOM_REFS_INIT ("_MOTIF_DRAG_RECEIVER_INFO", + Xatom_MOTIF_DRAG_RECEIVER_INFO) + ATOM_REFS_INIT ("XmTRANSFER_SUCCESS", Xatom_XmTRANSFER_SUCCESS) + ATOM_REFS_INIT ("XmTRANSFER_FAILURE", Xatom_XmTRANSFER_FAILURE) }; int i; enum { atom_count = ARRAYELTS (atom_refs) }; /* 1 for _XSETTINGS_SN. */ - enum { total_atom_count = 1 + atom_count }; + enum { total_atom_count = 2 + atom_count }; Atom atoms_return[total_atom_count]; char *atom_names[total_atom_count]; static char const xsettings_fmt[] = "_XSETTINGS_S%d"; @@ -13194,6 +23323,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) sprintf (xsettings_atom_name, xsettings_fmt, XScreenNumberOfScreen (dpyinfo->screen)); atom_names[i] = xsettings_atom_name; + atom_names[i + 1] = cm_atom_sprintf; XInternAtoms (dpyinfo->display, atom_names, total_atom_count, False, atoms_return); @@ -13201,10 +23331,16 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) for (i = 0; i < atom_count; i++) *(Atom *) ((char *) dpyinfo + atom_refs[i].offset) = atoms_return[i]; - /* Manually copy last atom. */ + /* Manually copy last two atoms. */ dpyinfo->Xatom_xsettings_sel = atoms_return[i]; + dpyinfo->Xatom_NET_WM_CM_Sn = atoms_return[i + 1]; } +#ifdef HAVE_XKB + /* Figure out which modifier bits mean what. */ + x_find_modifier_meanings (dpyinfo); +#endif + dpyinfo->x_dnd_atoms_size = 8; dpyinfo->x_dnd_atoms = xmalloc (sizeof *dpyinfo->x_dnd_atoms * dpyinfo->x_dnd_atoms_size); @@ -13286,6 +23422,33 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) #endif } +#ifdef HAVE_X_I18N + { + AUTO_STRING (inputStyle, "inputStyle"); + AUTO_STRING (InputStyle, "InputStyle"); + Lisp_Object value = gui_display_get_resource (dpyinfo, inputStyle, InputStyle, + Qnil, Qnil); + + if (STRINGP (value)) + { + if (!strcmp (SSDATA (value), "callback")) + dpyinfo->preferred_xim_style = STYLE_CALLBACK; + else if (!strcmp (SSDATA (value), "none")) + dpyinfo->preferred_xim_style = STYLE_NONE; + else if (!strcmp (SSDATA (value), "overthespot")) + dpyinfo->preferred_xim_style = STYLE_OVERTHESPOT; + else if (!strcmp (SSDATA (value), "offthespot")) + dpyinfo->preferred_xim_style = STYLE_OFFTHESPOT; + else if (!strcmp (SSDATA (value), "root")) + dpyinfo->preferred_xim_style = STYLE_ROOT; +#ifdef USE_GTK + else if (!strcmp (SSDATA (value), "native")) + dpyinfo->prefer_native_input = true; +#endif + } + } +#endif + #ifdef HAVE_X_SM /* Only do this for the very first display in the Emacs session. Ignore X session management when Emacs was first started on a @@ -13294,10 +23457,16 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) x_session_initialize (dpyinfo); #endif -#ifdef USE_CAIRO +#if defined USE_CAIRO || defined HAVE_XRENDER x_extension_initialize (dpyinfo); #endif +#ifdef USE_TOOLKIT_SCROLL_BARS + dpyinfo->protected_windows = xmalloc (sizeof (Lisp_Object) * 256); + dpyinfo->n_protected_windows = 0; + dpyinfo->protected_windows_max = 256; +#endif + unblock_input (); return dpyinfo; @@ -13352,6 +23521,13 @@ x_delete_display (struct x_display_info *dpyinfo) xfree (dpyinfo->x_id_name); xfree (dpyinfo->x_dnd_atoms); xfree (dpyinfo->color_cells); +#ifdef USE_TOOLKIT_SCROLL_BARS + xfree (dpyinfo->protected_windows); +#endif +#ifdef HAVE_XINPUT2 + if (dpyinfo->supports_xi2) + x_free_xi_devices (dpyinfo); +#endif xfree (dpyinfo); } @@ -13494,6 +23670,10 @@ x_delete_terminal (struct terminal *terminal) XrmDestroyDatabase (dpyinfo->rdb); #endif +#ifdef HAVE_XKB + if (dpyinfo->xkb_desc) + XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True); +#endif #ifdef USE_GTK xg_display_close (dpyinfo->display); #else @@ -13503,6 +23683,9 @@ x_delete_terminal (struct terminal *terminal) XCloseDisplay (dpyinfo->display); #endif #endif /* ! USE_GTK */ + + if (dpyinfo->modmap) + XFreeModifiermap (dpyinfo->modmap); /* Do not close the connection here because it's already closed by X(t)CloseDisplay (Bug#18403). */ dpyinfo->display = NULL; @@ -13588,6 +23771,7 @@ x_create_terminal (struct x_display_info *dpyinfo) terminal->free_pixmap = x_free_pixmap; terminal->delete_frame_hook = x_destroy_window; terminal->delete_terminal_hook = x_delete_terminal; + terminal->toolkit_position_hook = x_toolkit_position; /* Other hooks are NULL by default. */ return terminal; @@ -13653,13 +23837,56 @@ x_initialize (void) void init_xterm (void) { - /* Emacs can handle only core input events, so make sure - Gtk doesn't use Xinput or Xinput2 extensions. */ +#ifndef HAVE_XINPUT2 + /* Emacs can handle only core input events when built without XI2 + support, so make sure Gtk doesn't use Xinput or Xinput2 + extensions. */ +#ifndef HAVE_GTK3 xputenv ("GDK_CORE_DEVICE_EVENTS=1"); +#else + gdk_disable_multidevice (); +#endif +#endif } #endif void +mark_xterm (void) +{ + Lisp_Object val; +#if defined HAVE_XINPUT2 || defined USE_TOOLKIT_SCROLL_BARS + struct x_display_info *dpyinfo; + int i; +#endif + + if (x_dnd_return_frame_object) + { + XSETFRAME (val, x_dnd_return_frame_object); + mark_object (val); + } + + if (x_dnd_movement_frame) + { + XSETFRAME (val, x_dnd_movement_frame); + mark_object (val); + } + +#if defined HAVE_XINPUT2 || defined USE_TOOLKIT_SCROLL_BARS + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) + { +#ifdef HAVE_XINPUT2 + for (i = 0; i < dpyinfo->num_devices; ++i) + mark_object (dpyinfo->devices[i].name); +#endif +#ifdef USE_TOOLKIT_SCROLL_BARS + for (i = 0; i < dpyinfo->n_protected_windows; ++i) + mark_object (dpyinfo->protected_windows[i]); +#endif + } +#endif +} + +void syms_of_xterm (void) { x_error_message = NULL; @@ -13667,6 +23894,7 @@ syms_of_xterm (void) DEFSYM (Qvendor_specific_keysyms, "vendor-specific-keysyms"); DEFSYM (Qlatin_1, "latin-1"); + DEFSYM (Qnow, "now"); #ifdef USE_GTK xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); @@ -13712,7 +23940,7 @@ selected window or cursor position is preserved. */); A value of nil means Emacs doesn't use toolkit scroll bars. With the X Window system, the value is a symbol describing the X toolkit. Possible values are: gtk, motif, xaw, or xaw3d. -With MS Windows or Nextstep, the value is t. */); +With MS Windows, Haiku windowing or Nextstep, the value is t. */); #ifdef USE_TOOLKIT_SCROLL_BARS #ifdef USE_MOTIF Vx_toolkit_scroll_bars = intern_c_string ("motif"); @@ -13738,6 +23966,7 @@ With MS Windows or Nextstep, the value is t. */); Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier)); DEFSYM (Qsuper, "super"); Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier)); + DEFSYM (QXdndSelection, "XdndSelection"); DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, doc: /* Which keys Emacs uses for the ctrl modifier. @@ -13813,8 +24042,19 @@ consuming frame position adjustments. In newer versions of GTK, Emacs always uses gtk_window_move and ignores the value of this variable. */); x_gtk_use_window_move = true; + DEFVAR_LISP ("x-scroll-event-delta-factor", Vx_scroll_event_delta_factor, + doc: /* A scale to apply to pixel deltas reported in scroll events. +This option is only effective when Emacs is built with XInput 2 +support. */); + Vx_scroll_event_delta_factor = make_float (1.0); DEFSYM (Qexpose, "expose"); + DEFVAR_BOOL ("x-gtk-use-native-input", x_gtk_use_native_input, + doc: /* Non-nil means to use GTK for input method support. +This provides better support for some modern input methods, and is +only effective when Emacs is built with GTK. */); + x_gtk_use_native_input = false; + DEFVAR_LISP ("x-set-frame-visibility-more-laxly", x_set_frame_visibility_more_laxly, doc: /* Non-nil means set frame visibility more laxly. @@ -13829,4 +24069,42 @@ frame as visible in either of these two cases. Note that any non-nil setting may cause invisible frames get erroneously reported as iconified. */); x_set_frame_visibility_more_laxly = Qnil; + + DEFVAR_BOOL ("x-input-grab-touch-events", x_input_grab_touch_events, + doc: /* Non-nil means to actively grab touch events. +This means touch sequences that started on an Emacs frame will +reliably continue to receive updates even if the finger moves off the +frame, but may cause crashes with some window managers and/or external +programs. */); + x_input_grab_touch_events = true; + + DEFVAR_BOOL ("x-dnd-fix-motif-leave", x_dnd_fix_motif_leave, + doc: /* Work around Motif bug during drag-and-drop. +When non-nil, Emacs will send a motion event containing impossible +coordinates to a Motif drop receiver when the mouse moves outside it +during a drag-and-drop session, to work around broken implementations +of Motif. */); + x_dnd_fix_motif_leave = true; + + DEFVAR_LISP ("x-dnd-movement-function", Vx_dnd_movement_function, + doc: /* Function called upon mouse movement on a frame during drag-and-drop. +It should either be nil, or accept two arguments FRAME and POSITION, +where FRAME is the frame the mouse is on top of, and POSITION is a +mouse position list. */); + Vx_dnd_movement_function = Qnil; + + DEFVAR_LISP ("x-dnd-unsupported-drop-function", Vx_dnd_unsupported_drop_function, + doc: /* Function called when trying to drop on an unsupported window. +This function is called whenever the user tries to drop +something on a window that does not support either the XDND or +Motif protocols for drag-and-drop. It should return a non-nil +value if the drop was handled by the function, and nil if it was +not. It should accept several arguments TARGETS, X, Y, ACTION, +WINDOW-ID and FRAME, where TARGETS is the list of targets that +was passed to `x-begin-drag', WINDOW-ID is the numeric XID of +the window that is being dropped on, X and Y are the root +window-relative coordinates where the drop happened, ACTION +is the action that was passed to `x-begin-drag', and FRAME is +the frame which initiated the drag-and-drop operation. */); + Vx_dnd_unsupported_drop_function = Qnil; } diff --git a/src/xterm.h b/src/xterm.h index 0040958cd35..5d2b397874d 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -32,6 +32,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <X11/Xatom.h> #include <X11/Xresource.h> +#ifdef HAVE_XINPUT2 +#include <X11/extensions/XInput2.h> +#endif + #ifdef USE_X_TOOLKIT #include <X11/StringDefs.h> #include <X11/IntrinsicP.h> /* CoreP.h needs this */ @@ -54,6 +58,10 @@ typedef Widget xt_or_gtk_widget; #define GTK_CHECK_VERSION(i, j, k) false #endif +#ifdef HAVE_XRENDER +#include <X11/extensions/Xrender.h> +#endif + #ifdef USE_GTK /* Some definitions to reduce conditionals. */ typedef GtkWidget *xt_or_gtk_widget; @@ -78,6 +86,9 @@ typedef GtkWidget *xt_or_gtk_widget; #ifdef CAIRO_HAS_SVG_SURFACE #include <cairo-svg.h> #endif +#ifdef USE_CAIRO_XCB +#include <cairo-xcb.h> +#endif #endif #ifdef HAVE_X_I18N @@ -88,6 +99,14 @@ typedef GtkWidget *xt_or_gtk_widget; #include <X11/Xlib-xcb.h> #endif +#ifdef HAVE_XKB +#include <X11/XKBlib.h> +#endif + +#ifdef HAVE_XSYNC +#include <X11/extensions/sync.h> +#endif + #include "dispextern.h" #include "termhooks.h" @@ -113,6 +132,7 @@ INLINE_HEADER_BEGIN | FocusChangeMask \ | LeaveWindowMask \ | EnterWindowMask \ + | PropertyChangeMask \ | VisibilityChangeMask) #ifdef HAVE_X11R6_XIM @@ -124,6 +144,21 @@ struct xim_inst_t }; #endif /* HAVE_X11R6_XIM */ +#ifdef HAVE_XINPUT2 +#if HAVE_XISCROLLCLASSINFO_TYPE && defined XIScrollClass +#define HAVE_XINPUT2_1 +#endif +#if HAVE_XITOUCHCLASSINFO_TYPE && defined XITouchClass +#define HAVE_XINPUT2_2 +#endif +#if HAVE_XIBARRIERRELEASEPOINTERINFO_DEVICEID && defined XIBarrierPointerReleased +#define HAVE_XINPUT2_3 +#endif +#if HAVE_XIGESTURECLASSINFO_TYPE && defined XIGestureClass +#define HAVE_XINPUT2_4 +#endif +#endif + /* Structure recording X pixmap and reference count. If REFCOUNT is 0 then this record is free to be reused. */ @@ -141,7 +176,7 @@ struct x_bitmap_record int height, width, depth; }; -#ifdef USE_CAIRO +#if defined USE_CAIRO || defined HAVE_XRENDER struct x_gc_ext_data { #define MAX_CLIP_RECTS 2 @@ -151,7 +186,9 @@ struct x_gc_ext_data /* Clipping rectangles. */ XRectangle clip_rects[MAX_CLIP_RECTS]; }; +#endif +#ifdef USE_CAIRO extern cairo_pattern_t *x_bitmap_stipple (struct frame *, Pixmap); #endif @@ -163,6 +200,54 @@ struct color_name_cache_entry char *name; }; +#ifdef HAVE_XINPUT2 + +#ifdef HAVE_XINPUT2_1 +struct xi_scroll_valuator_t +{ + bool invalid_p; + bool pending_enter_reset; + double current_value; + double emacs_value; + double increment; + + int number; + int horizontal; +}; +#endif + +#ifdef HAVE_XINPUT2_2 +struct xi_touch_point_t +{ + struct xi_touch_point_t *next; + + int number; + double x, y; +}; +#endif + +struct xi_device_t +{ + int device_id; +#ifdef HAVE_XINPUT2_1 + int scroll_valuator_count; +#endif + int grab, use; +#ifdef HAVE_XINPUT2_2 + bool direct_p; +#endif + +#ifdef HAVE_XINPUT2_1 + struct xi_scroll_valuator_t *valuators; +#endif +#ifdef HAVE_XINPUT2_2 + struct xi_touch_point_t *touchpoints; +#endif + + Lisp_Object name; +}; +#endif + Status x_parse_color (struct frame *f, const char *color_name, XColor *color); @@ -199,6 +284,14 @@ struct x_display_info /* The Visual being used for this display. */ Visual *visual; + /* The visual information corresponding to VISUAL. */ + XVisualInfo visual_info; + +#ifdef HAVE_XRENDER + /* The picture format for this display. */ + XRenderPictFormat *pict_format; +#endif + /* The colormap being used. */ Colormap cmap; @@ -289,10 +382,10 @@ struct x_display_info use; XK_Caps_Lock should only affect alphabetic keys. With this arrangement, the lock modifier should shift the character if (EVENT.state & shift_lock_mask) != 0. */ - int meta_mod_mask, shift_lock_mask; + unsigned int meta_mod_mask, shift_lock_mask; /* These are like meta_mod_mask, but for different modifiers. */ - int alt_mod_mask, super_mod_mask, hyper_mod_mask; + unsigned alt_mod_mask, super_mod_mask, hyper_mod_mask; /* Communication with window managers. */ Atom Xatom_wm_protocols; @@ -304,20 +397,24 @@ struct x_display_info /* Atom for indicating window state to the window manager. */ Atom Xatom_wm_change_state; + Atom Xatom_wm_state; /* Other WM communication */ Atom Xatom_wm_configure_denied; /* When our config request is denied */ Atom Xatom_wm_window_moved; /* When the WM moves us. */ Atom Xatom_wm_client_leader; /* Id of client leader window. */ + Atom Xatom_wm_transient_for; /* Id of whatever window we are + transient for. */ /* EditRes protocol */ Atom Xatom_editres; /* More atoms, which are selection types. */ Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE, - Xatom_COMPOUND_TEXT, Xatom_UTF8_STRING, - Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL, - Xatom_ATOM, Xatom_ATOM_PAIR, Xatom_CLIPBOARD_MANAGER; + Xatom_COMPOUND_TEXT, Xatom_UTF8_STRING, + Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL, + Xatom_ATOM, Xatom_ATOM_PAIR, Xatom_CLIPBOARD_MANAGER, + Xatom_EMACS_SERVER_TIME_PROP; /* More atoms for font properties. The last three are private properties, see the comments in src/fontset.h. */ @@ -334,6 +431,15 @@ struct x_display_info /* Atom used in XEmbed client messages. */ Atom Xatom_XEMBED, Xatom_XEMBED_INFO; + /* Atom used to determine whether or not the screen is composited. */ + Atom Xatom_NET_WM_CM_Sn; + + Atom Xatom_MOTIF_WM_HINTS, Xatom_MOTIF_DRAG_WINDOW, + Xatom_MOTIF_DRAG_TARGETS, Xatom_MOTIF_DRAG_AND_DROP_MESSAGE, + Xatom_MOTIF_DRAG_INITIATOR_INFO, Xatom_MOTIF_DRAG_RECEIVER_INFO; + + Atom Xatom_XmTRANSFER_SUCCESS, Xatom_XmTRANSFER_FAILURE; + /* The frame (if any) which has the X window that has keyboard focus. Zero if none. This is examined by Ffocus_frame in xfns.c. Note that a mere EnterNotify event can set this; if you need to know the @@ -369,8 +475,10 @@ struct x_display_info /* The scroll bar in which the last X motion event occurred. */ struct scroll_bar *last_mouse_scroll_bar; - /* Time of last user interaction as returned in X events on this display. */ - Time last_user_time; + /* Time of last user interaction as returned in X events on this + display, and time where WM support for `_NET_WM_USER_TIME_WINDOW' + was last checked. */ + Time last_user_time, last_user_check_time; /* Position where the mouse was last time we reported a motion. This is a position on last_mouse_motion_frame. */ @@ -397,6 +505,7 @@ struct x_display_info XIM xim; XIMStyles *xim_styles; struct xim_inst_t *xim_callback_data; + XIMStyle preferred_xim_style; #endif /* A cache mapping color names to RGB values. */ @@ -408,8 +517,9 @@ struct x_display_info int ncolor_cells; /* Bits and shifts to use to compose pixel values on TrueColor visuals. */ - int red_bits, blue_bits, green_bits; - int red_offset, blue_offset, green_offset; + int red_bits, blue_bits, green_bits, alpha_bits; + int red_offset, blue_offset, green_offset, alpha_offset; + unsigned long alpha_mask; /* The type of window manager we have. If we move FRAME_OUTER_WINDOW to x/y 0/0, some window managers (type A) puts the window manager @@ -444,7 +554,12 @@ struct x_display_info Xatom_net_wm_state_maximized_horz, Xatom_net_wm_state_maximized_vert, Xatom_net_wm_state_sticky, Xatom_net_wm_state_above, Xatom_net_wm_state_below, Xatom_net_wm_state_hidden, Xatom_net_wm_state_skip_taskbar, - Xatom_net_frame_extents, Xatom_net_current_desktop, Xatom_net_workarea; + Xatom_net_wm_state_shaded, Xatom_net_frame_extents, Xatom_net_current_desktop, + Xatom_net_workarea, Xatom_net_wm_opaque_region, Xatom_net_wm_ping, + Xatom_net_wm_sync_request, Xatom_net_wm_sync_request_counter, + Xatom_net_wm_frame_drawn, Xatom_net_wm_user_time, + Xatom_net_wm_user_time_window, Xatom_net_client_list_stacking, + Xatom_net_wm_pid; /* XSettings atoms and windows. */ Atom Xatom_xsettings_sel, Xatom_xsettings_prop, Xatom_xsettings_mgr; @@ -458,22 +573,111 @@ struct x_display_info /* SM */ Atom Xatom_SM_CLIENT_ID; + /* DND source. */ + Atom Xatom_XdndAware, Xatom_XdndSelection, Xatom_XdndTypeList, + Xatom_XdndActionCopy, Xatom_XdndActionMove, Xatom_XdndActionLink, + Xatom_XdndActionAsk, Xatom_XdndActionPrivate, Xatom_XdndActionList, + Xatom_XdndActionDescription, Xatom_XdndProxy, Xatom_XdndEnter, + Xatom_XdndPosition, Xatom_XdndStatus, Xatom_XdndLeave, Xatom_XdndDrop, + Xatom_XdndFinished; + +#ifdef HAVE_XKB + /* Virtual modifiers */ + Atom Xatom_Meta, Xatom_Super, Xatom_Hyper, Xatom_ShiftLock, Xatom_Alt; +#endif + + /* Core modifier map when XKB is not present. */ + XModifierKeymap *modmap; + #ifdef HAVE_XRANDR int xrandr_major_version; int xrandr_minor_version; #endif -#ifdef USE_CAIRO +#if defined USE_CAIRO || defined HAVE_XRENDER XExtCodes *ext_codes; #endif #ifdef USE_XCB xcb_connection_t *xcb_connection; + xcb_visualtype_t *xcb_visual; #endif #ifdef HAVE_XDBE bool supports_xdbe; #endif + +#ifdef HAVE_XINPUT2 + bool supports_xi2; + int xi2_version; + int xi2_opcode; + + int num_devices; + struct xi_device_t *devices; + + Time pending_keystroke_time; + int pending_keystroke_source; + +#if defined USE_GTK && !defined HAVE_GTK3 + /* This means the two variables above shouldn't be reset the first + time a KeyPress event arrives, since they were set from a raw key + press event that was sent before the first (real, not sent by an + input method) core key event. */ + bool pending_keystroke_time_special_p; +#endif +#endif + +#ifdef HAVE_XKB + bool supports_xkb; + int xkb_event_type; + XkbDescPtr xkb_desc; +#endif + +#ifdef USE_GTK + bool prefer_native_input; +#endif + +#ifdef HAVE_XRENDER + bool xrender_supported_p; + int xrender_major; + int xrender_minor; +#endif + +#ifdef HAVE_XFIXES + bool xfixes_supported_p; + int xfixes_major; + int xfixes_minor; +#endif + +#ifdef HAVE_XSYNC + bool xsync_supported_p; + int xsync_major; + int xsync_minor; +#endif + +#ifdef HAVE_XINERAMA + bool xinerama_supported_p; +#endif + +#ifdef HAVE_XCOMPOSITE + bool composite_supported_p; + int composite_major; + int composite_minor; +#endif + +#ifdef HAVE_XSHAPE + bool xshape_supported_p; + int xshape_major; + int xshape_minor; + int xshape_event_base; + int xshape_error_base; +#endif + +#ifdef USE_TOOLKIT_SCROLL_BARS + Lisp_Object *protected_windows; + int n_protected_windows; + int protected_windows_max; +#endif }; #ifdef HAVE_X_I18N @@ -481,6 +685,11 @@ struct x_display_info extern bool use_xim; #endif +#ifdef HAVE_XINPUT2 +/* Defined in xmenu.c. */ +extern int popup_activated_flag; +#endif + /* This is a chain of structures for all the X displays currently in use. */ extern struct x_display_info *x_display_list; @@ -533,6 +742,13 @@ struct x_output window's back buffer. */ Drawable draw_desc; +#ifdef HAVE_XRENDER + /* The Xrender picture that corresponds to this drawable. None + means no picture format was found, or the Xrender extension is + not present. */ + Picture picture; +#endif + /* Flag that indicates whether we've modified the back buffer and need to publish our modifications to the front buffer at a convenient time. */ @@ -560,6 +776,12 @@ struct x_output Widget menubar_widget; #endif +#ifndef USE_GTK + /* A window used to store the user time property. May be None or + the frame's outer window. */ + Window user_time_window; +#endif + #ifdef USE_GTK /* The widget of this screen. This is the window of a top widget. */ GtkWidget *widget; @@ -585,6 +807,15 @@ struct x_output GtkTooltip *ttip_widget; GtkWidget *ttip_lbl; GtkWindow *ttip_window; + + GtkIMContext *im_context; + +#ifdef HAVE_GTK3 + /* The CSS providers used for scroll bar foreground and background + colors. */ + GtkCssProvider *scrollbar_foreground_css_provider; + GtkCssProvider *scrollbar_background_css_provider; +#endif #endif /* USE_GTK */ /* If >=0, a bitmap index. The indicated bitmap is used for the @@ -696,6 +927,19 @@ struct x_output XFontSet xic_xfs; #endif +#ifdef HAVE_XSYNC + XSyncCounter basic_frame_counter; + XSyncCounter extended_frame_counter; + XSyncValue pending_basic_counter_value; + XSyncValue current_extended_counter_value; + + bool_bf sync_end_pending_p : 1; + bool_bf ext_sync_end_pending_p : 1; +#ifdef HAVE_GTK3 + bool_bf xg_sync_end_pending_p : 1; +#endif +#endif + /* Relief GCs, colors etc. */ struct relief { @@ -731,6 +975,18 @@ struct x_output They are used when creating the cairo surface next time. */ int cr_surface_desired_width, cr_surface_desired_height; #endif + +#ifdef HAVE_X_I18N + ptrdiff_t preedit_size; + char *preedit_chars; + bool preedit_active; + int preedit_caret; +#endif + +#ifdef HAVE_XINPUT2 + XIEventMask *xi_masks; + int num_xi_masks; +#endif }; enum @@ -841,6 +1097,24 @@ extern void x_mark_frame_dirty (struct frame *f); /* This is the Visual which frame F is on. */ #define FRAME_X_VISUAL(f) FRAME_DISPLAY_INFO (f)->visual +/* And its corresponding visual info. */ +#define FRAME_X_VISUAL_INFO(f) (&FRAME_DISPLAY_INFO (f)->visual_info) + +#ifdef HAVE_XRENDER +#define FRAME_X_PICTURE_FORMAT(f) FRAME_DISPLAY_INFO (f)->pict_format +#define FRAME_X_PICTURE(f) ((f)->output_data.x->picture) +#define FRAME_CHECK_XR_VERSION(f, major, minor) \ + (FRAME_DISPLAY_INFO (f)->xrender_supported_p \ + && ((FRAME_DISPLAY_INFO (f)->xrender_major == (major) \ + && FRAME_DISPLAY_INFO (f)->xrender_minor >= (minor)) \ + || (FRAME_DISPLAY_INFO (f)->xrender_major > (major)))) +#endif + +#ifdef HAVE_XSYNC +#define FRAME_X_BASIC_COUNTER(f) FRAME_X_OUTPUT (f)->basic_frame_counter +#define FRAME_X_EXTENDED_COUNTER(f) FRAME_X_OUTPUT (f)->extended_frame_counter +#endif + /* This is the Colormap which frame F uses. */ #define FRAME_X_COLORMAP(f) FRAME_DISPLAY_INFO (f)->cmap @@ -876,6 +1150,11 @@ struct scroll_bar /* The X window representing this scroll bar. */ Window x_window; +#if defined HAVE_XDBE && !defined USE_TOOLKIT_SCROLL_BARS + /* The X drawable representing this scroll bar. */ + Drawable x_drawable; +#endif + /* The position and size of the scroll bar in pixels, relative to the frame. */ int top, left, width, height; @@ -1104,21 +1383,42 @@ extern void x_clear_area (struct frame *f, int, int, int, int); extern void x_mouse_leave (struct x_display_info *); #endif -#if defined USE_X_TOOLKIT || defined USE_MOTIF +#ifndef USE_GTK 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); extern cairo_t *x_begin_cr_clip (struct frame *, GC); extern void x_end_cr_clip (struct frame *); -extern void x_set_cr_source_with_gc_foreground (struct frame *, GC); -extern void x_set_cr_source_with_gc_background (struct frame *, GC); +extern void x_set_cr_source_with_gc_foreground (struct frame *, GC, bool); +extern void x_set_cr_source_with_gc_background (struct frame *, GC, bool); extern void x_cr_draw_frame (cairo_t *, struct frame *); extern Lisp_Object x_cr_export_frames (Lisp_Object, cairo_surface_type_t); #endif +#ifdef HAVE_XRENDER +extern void x_xrender_color_from_gc_background (struct frame *, GC, + XRenderColor *, bool); +extern void x_xr_ensure_picture (struct frame *f); +extern void x_xr_apply_ext_clip (struct frame *f, GC gc); +extern void x_xr_reset_ext_clip (struct frame *f); +#endif + +#ifdef HAVE_GTK3 +extern void x_scroll_bar_configure (GdkEvent *); +#endif + +extern Lisp_Object x_dnd_begin_drag_and_drop (struct frame *, Time, Atom, + Lisp_Object, Atom *, const char **, + size_t, bool); +extern void x_dnd_do_unsupported_drop (struct x_display_info *, Lisp_Object, + Lisp_Object, Lisp_Object, Window, int, + int, Time); +extern void x_set_dnd_targets (Atom *, int); + INLINE int x_display_pixel_height (struct x_display_info *dpyinfo) { @@ -1131,19 +1431,10 @@ x_display_pixel_width (struct x_display_info *dpyinfo) return WidthOfScreen (dpyinfo->screen); } -INLINE void -x_display_set_last_user_time (struct x_display_info *dpyinfo, Time t) -{ -#ifdef ENABLE_CHECKING - eassert (t <= X_ULONG_MAX); -#endif - dpyinfo->last_user_time = t; -} - INLINE unsigned long x_make_truecolor_pixel (struct x_display_info *dpyinfo, int r, int g, int b) { - unsigned long pr, pg, pb; + unsigned long pr, pg, pb, pa = dpyinfo->alpha_mask; /* Scale down RGB values to the visual's bits per RGB, and shift them to the right position in the pixel color. Note that the @@ -1153,7 +1444,7 @@ x_make_truecolor_pixel (struct x_display_info *dpyinfo, int r, int g, int b) pb = (b >> (16 - dpyinfo->blue_bits)) << dpyinfo->blue_offset; /* Assemble the pixel color. */ - return pr | pg | pb; + return pr | pg | pb | pa; } /* If display has an immutable color map, freeing colors is not @@ -1161,13 +1452,14 @@ x_make_truecolor_pixel (struct x_display_info *dpyinfo, int r, int g, int b) also allows us to make other optimizations relating to server-side reference counts. */ INLINE bool -x_mutable_colormap (Visual *visual) +x_mutable_colormap (XVisualInfo *visual) { int class = visual->class; return (class != StaticColor && class != StaticGray && class != TrueColor); } extern void x_set_sticky (struct frame *, Lisp_Object, Lisp_Object); +extern void x_set_shaded (struct frame *, Lisp_Object, Lisp_Object); extern void x_set_skip_taskbar (struct frame *, Lisp_Object, Lisp_Object); extern void x_set_z_group (struct frame *, Lisp_Object, Lisp_Object); extern bool x_wm_supports (struct frame *, Atom); @@ -1184,6 +1476,10 @@ extern void x_change_tool_bar_height (struct frame *, int); extern void x_implicitly_set_name (struct frame *, Lisp_Object, Lisp_Object); extern void x_set_scroll_bar_default_width (struct frame *); extern void x_set_scroll_bar_default_height (struct frame *); +#ifdef USE_LUCID +extern void xlw_monitor_dimensions_at_pos (Display *, Screen *, int, int, + int *, int *, int *, int *); +#endif /* Defined in xselect.c. */ @@ -1217,6 +1513,11 @@ extern Lisp_Object x_property_data_to_lisp (struct frame *, extern void x_clipboard_manager_save_frame (Lisp_Object); extern void x_clipboard_manager_save_all (void); +extern Lisp_Object x_timestamp_for_selection (struct x_display_info *, + Lisp_Object); +extern void x_set_pending_dnd_time (Time); +extern void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object); + #ifdef USE_GTK extern bool xg_set_icon (struct frame *, Lisp_Object); extern bool xg_set_icon_from_xpm_data (struct frame *, const char **); @@ -1263,6 +1564,27 @@ extern bool x_session_have_connection (void); extern void x_session_close (void); #endif +#ifdef HAVE_X_I18N +#define STYLE_OFFTHESPOT (XIMPreeditArea | XIMStatusArea) +#define STYLE_OVERTHESPOT (XIMPreeditPosition | XIMStatusNothing) +#define STYLE_ROOT (XIMPreeditNothing | XIMStatusNothing) +#define STYLE_CALLBACK (XIMPreeditCallbacks | XIMStatusNothing) +#define STYLE_NONE (XIMPreeditNothing | XIMStatusNothing) +#endif + +#ifdef USE_GTK +extern struct input_event xg_pending_quit_event; +#endif + +extern bool x_dnd_in_progress; +extern struct frame *x_dnd_frame; + +#ifdef HAVE_XINPUT2 +extern struct xi_device_t *xi_device_from_id (struct x_display_info *, int); +extern bool xi_frame_selected_for (struct frame *, unsigned long); +#endif + +extern void mark_xterm (void); /* Is the frame embedded into another application? */ diff --git a/src/xwidget.c b/src/xwidget.c index 7dd28e233f6..8bdfab02fd4 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -19,6 +19,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> +#include "buffer.h" +#include "coding.h" #include "xwidget.h" #include "lisp.h" @@ -30,15 +32,51 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "sysstdio.h" #include "termhooks.h" #include "window.h" +#include "process.h" /* Include xwidget bottom end headers. */ #ifdef USE_GTK #include <webkit2/webkit2.h> #include <JavaScriptCore/JavaScript.h> +#include <cairo.h> +#ifndef HAVE_PGTK +#include <cairo-xlib.h> +#include <X11/Xlib.h> +#else +#include <gtk/gtk.h> +#endif +#ifdef HAVE_XINPUT2 +#include <X11/extensions/XInput2.h> +#endif #elif defined NS_IMPL_COCOA #include "nsxwidget.h" #endif +#include <math.h> + +static Lisp_Object id_to_xwidget_map; +static Lisp_Object internal_xwidget_view_list; +static Lisp_Object internal_xwidget_list; +static uint32_t xwidget_counter = 0; + +#ifdef USE_GTK +#ifdef HAVE_X_WINDOWS +static Lisp_Object x_window_to_xwv_map; +#if WEBKIT_CHECK_VERSION (2, 34, 0) +static Lisp_Object dummy_tooltip_string; +#endif +#endif +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); +static GdkWindow *pick_embedded_child (GdkWindow *, double, double, gpointer); +#endif + static struct xwidget * allocate_xwidget (void) { @@ -56,6 +94,8 @@ allocate_xwidget_view (void) static struct xwidget_view *xwidget_view_lookup (struct xwidget *, struct window *); +static void kill_xwidget (struct xwidget *); + #ifdef USE_GTK static void webkit_view_load_changed_cb (WebKitWebView *, WebKitLoadEvent, @@ -64,18 +104,183 @@ 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 *, bool, + struct xwidget_view *); +static gboolean run_file_chooser_cb (WebKitWebView *, + WebKitFileChooserRequest *, + gpointer); + +struct widget_search_data +{ + int x; + int y; + bool foundp; + bool first; + GtkWidget *data; +}; + +static void find_widget (GtkWidget *t, struct widget_search_data *); #endif +#ifdef HAVE_PGTK +static void mouse_target_changed (WebKitWebView *, WebKitHitTestResult *, guint, + gpointer); + +static int +xw_forward_event_translate (GdkEvent *event, struct xwidget_view *xv, + struct xwidget *xw) +{ + GtkWidget *widget; + int new_x, new_y; + + switch (event->type) + { + case GDK_BUTTON_PRESS: + case GDK_BUTTON_RELEASE: + case GDK_2BUTTON_PRESS: + case GDK_3BUTTON_PRESS: + widget = find_widget_at_pos (xw->widgetwindow_osr, + lrint (event->button.x - xv->clip_left), + lrint (event->button.y - xv->clip_top), + &new_x, &new_y, false, NULL); + if (widget) + { + event->any.window = gtk_widget_get_window (widget); + event->button.x = new_x; + event->button.y = new_y; + return 1; + } + return 0; + case GDK_SCROLL: + widget = find_widget_at_pos (xw->widgetwindow_osr, + lrint (event->scroll.x - xv->clip_left), + lrint (event->scroll.y - xv->clip_top), + &new_x, &new_y, false, NULL); + if (widget) + { + event->any.window = gtk_widget_get_window (widget); + event->scroll.x = new_x; + event->scroll.y = new_y; + return 1; + } + return 0; + case GDK_MOTION_NOTIFY: + widget = find_widget_at_pos (xw->widgetwindow_osr, + lrint (event->motion.x - xv->clip_left), + lrint (event->motion.y - xv->clip_top), + &new_x, &new_y, false, NULL); + if (widget) + { + event->any.window = gtk_widget_get_window (widget); + event->motion.x = new_x; + event->motion.y = new_y; + return 1; + } + return 0; + case GDK_ENTER_NOTIFY: + case GDK_LEAVE_NOTIFY: + widget = find_widget_at_pos (xw->widgetwindow_osr, + lrint (event->crossing.x - xv->clip_left), + lrint (event->crossing.y - xv->clip_top), + &new_x, &new_y, false, NULL); + if (widget) + { + event->any.window = gtk_widget_get_window (widget); + event->crossing.x = new_x; + event->crossing.y = new_y; + return 1; + } + return 0; + default: + return 0; + } +} + +static gboolean +xw_forward_event_from_view (GtkWidget *widget, GdkEvent *event, + gpointer user_data) +{ + struct xwidget_view *xv = user_data; + struct xwidget *xw = XXWIDGET (xv->model); + GdkEvent *eventcopy; + bool translated_p; + + if (NILP (xw->buffer)) + return TRUE; + + eventcopy = gdk_event_copy (event); + translated_p = xw_forward_event_translate (eventcopy, xv, xw); + record_osr_embedder (xv); + + g_object_ref (eventcopy->any.window); + if (translated_p) + gtk_main_do_event (eventcopy); + gdk_event_free (eventcopy); + + /* Don't propagate this event further. */ + return TRUE; +} +#endif + +#ifdef HAVE_X_WINDOWS +enum xw_crossing_mode + { + XW_CROSSING_LEFT, + XW_CROSSING_ENTERED, + XW_CROSSING_NONE + }; + +static guint +xw_translate_x_modifiers (struct x_display_info *dpyinfo, + unsigned int modifiers) +{ + guint mods = 0; + + if (modifiers & dpyinfo->meta_mod_mask) + { + /* GDK always assumes Mod1 is alt, but that's no reason for + us to make that mistake as well. */ + if (!dpyinfo->alt_mod_mask) + mods |= GDK_MOD1_MASK; + else + mods |= GDK_META_MASK; + } + + if (modifiers & dpyinfo->alt_mod_mask) + mods |= GDK_MOD1_MASK; + if (modifiers & dpyinfo->super_mod_mask) + mods |= GDK_SUPER_MASK; + if (modifiers & dpyinfo->hyper_mod_mask) + mods |= GDK_HYPER_MASK; + if (modifiers & ControlMask) + mods |= GDK_CONTROL_MASK; + if (modifiers & ShiftMask) + mods |= GDK_SHIFT_MASK; + + return mods; +} + +static bool xw_maybe_synthesize_crossing (struct xwidget_view *, + GdkWindow *, int, int, int, + Time, unsigned int, + GdkCrossingMode, GdkCrossingMode); +static void xw_notify_virtual_upwards_until (struct xwidget_view *, GdkWindow *, + GdkWindow *, GdkWindow *, unsigned int, + int, int, Time, GdkEventType, bool, + GdkCrossingMode); +static void window_coords_from_toplevel (GdkWindow *, GdkWindow *, int, + int, int *, int *); +#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 +288,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 +304,11 @@ Returns the newly constructed xwidget, or nil if construction fails. */) CHECK_FIXNAT (width); CHECK_FIXNAT (height); + if (!EQ (type, Qwebkit)) + error ("Bad xwidget type"); + + Frequire (Qxwidget, Qnil, Qnil); + struct xwidget *xw = allocate_xwidget (); Lisp_Object val; xw->type = type; @@ -106,15 +319,22 @@ Returns the newly constructed xwidget, or nil if construction fails. */) xw->width = XFIXNAT (width); xw->kill_without_query = false; XSETXWIDGET (val, xw); - Vxwidget_list = Fcons (val, Vxwidget_list); + internal_xwidget_list = Fcons (val, internal_xwidget_list); + Vxwidget_list = Fcopy_sequence (internal_xwidget_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) @@ -125,24 +345,45 @@ Returns the newly constructed xwidget, or nil if construction fails. */) xw->widgetwindow_osr = gtk_offscreen_window_new (); gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width, xw->height); + gtk_container_check_resize (GTK_CONTAINER (xw->widgetwindow_osr)); 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)) + { + WebKitWebContext *ctx = webkit_web_context_new (); + xw->widget_osr = webkit_web_view_new_with_context (ctx); + g_object_unref (ctx); + + g_signal_connect (G_OBJECT (ctx), + "download-started", + G_CALLBACK (webkit_download_cb), xw); + + webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), + "about:blank"); + /* 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. */ + catch_child_signal (); + } + 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); + gtk_widget_queue_allocate (GTK_WIDGET (xw->widget_osr)); if (EQ (xw->type, Qwebkit)) { @@ -157,6 +398,16 @@ Returns the newly constructed xwidget, or nil if construction fails. */) gtk_widget_show (xw->widget_osr); gtk_widget_show (xw->widgetwindow_osr); +#if !defined HAVE_XINPUT2 && !defined HAVE_PGTK + synthesize_focus_in_event (xw->widgetwindow_osr); +#endif + + 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); + g_signal_connect (G_OBJECT (gtk_widget_get_window (xw->widgetwindow_osr)), + "pick-embedded-child", G_CALLBACK (pick_embedded_child), NULL); /* Store some xwidget data in the gtk widgets for convenient retrieval in the event handlers. */ @@ -170,17 +421,34 @@ Returns the newly constructed xwidget, or nil if construction fails. */) "load-changed", G_CALLBACK (webkit_view_load_changed_cb), xw); - g_signal_connect (G_OBJECT (webkit_context), - "download-started", - G_CALLBACK (webkit_download_cb), xw); - g_signal_connect (G_OBJECT (xw->widget_osr), "decide-policy", G_CALLBACK (webkit_decide_policy_cb), xw); +#ifdef HAVE_PGTK + g_signal_connect (G_OBJECT (xw->widget_osr), + "mouse-target-changed", + G_CALLBACK (mouse_target_changed), + xw); +#endif + 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->widget_osr), + "run-file-chooser", + G_CALLBACK (run_file_chooser_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 @@ -190,6 +458,220 @@ Returns the newly constructed xwidget, or nil if construction fails. */) return val; } +DEFUN ("xwidget-live-p", Fxwidget_live_p, Sxwidget_live_p, + 1, 1, 0, doc: /* Return t if OBJECT is an xwidget that has not been killed. +Value is nil if OBJECT is not an xwidget or if it has been killed. */) + (Lisp_Object object) +{ + return ((XWIDGETP (object) + && !NILP (XXWIDGET (object)->buffer)) + ? Qt : Qnil); +} + +#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; +#ifdef HAVE_XINPUT2 + GdkWindow *embedder; + GdkWindow *osw; +#endif +#endif + + CHECK_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + + if (!NILP (frame)) + f = decode_window_system_frame (frame); + else if (FRAME_WINDOW_P (SELECTED_FRAME ())) + f = SELECTED_FRAME (); + +#ifdef USE_GTK +#ifdef HAVE_XINPUT2 + /* XI2 GDK devices crash if we try this without an embedder set. */ + if (!f) + return Qnil; + + block_input (); + osw = gtk_widget_get_window (xw->widgetwindow_osr); + embedder = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)); + + gdk_offscreen_window_set_embedder (osw, embedder); + unblock_input (); +#endif + 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 += '_'; + +#ifndef HAVE_PGTK + if (f) + modifiers = x_emacs_to_x_modifiers (FRAME_DISPLAY_INFO (f), modifiers); + else + modifiers = 0; +#else + if (f) + modifiers = pgtk_emacs_to_gtk_modifiers (FRAME_DISPLAY_INFO (f), modifiers); + else + modifiers = 0; +#endif + } + 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; + } + +#ifndef HAVE_PGTK + if (f) + modifiers = x_emacs_to_x_modifiers (FRAME_DISPLAY_INFO (f), + XFIXNUM (XCAR (XCDR (decoded)))); + else + modifiers = 0; +#else + if (f) + modifiers = pgtk_emacs_to_gtk_modifiers (FRAME_DISPLAY_INFO (f), + XFIXNUM (XCAR (XCDR (decoded)))); + else + modifiers = 0; +#endif + + if (found) + keycode = off + 0xff00; + } + + if (character == -1 && keycode == -1) + { +#ifdef HAVE_XINPUT2 + block_input (); + if (xw->embedder_view) + record_osr_embedder (xw->embedder_view); + else + gdk_offscreen_window_set_embedder (osw, NULL); + unblock_input (); +#endif + 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; +#ifndef HAVE_X_WINDOWS + xg_event->key.state = modifiers; +#else + if (f) + xg_event->key.state = xw_translate_x_modifiers (FRAME_DISPLAY_INFO (f), + modifiers); +#endif + + 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); + +#ifdef HAVE_XINPUT2 + if (xw->embedder_view) + record_osr_embedder (xw->embedder_view); + else + gdk_offscreen_window_set_embedder (osw, NULL); +#endif + 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. @@ -206,7 +688,7 @@ BUFFER may be a buffer or the name of one. */) xw_list = Qnil; - for (tail = Vxwidget_list; CONSP (tail); tail = XCDR (tail)) + for (tail = internal_xwidget_list; CONSP (tail); tail = XCDR (tail)) { xw = XCAR (tail); if (XWIDGETP (xw) && EQ (Fxwidget_buffer (xw), buffer)) @@ -221,16 +703,1444 @@ 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 GdkWindow * +pick_embedded_child (GdkWindow *window, double x, double y, + gpointer user_data) +{ + GtkWidget *widget; + GtkWidget *child; + GdkEvent event; + int xout, yout; + + event.any.window = window; + event.any.type = GDK_NOTHING; + + widget = gtk_get_event_widget (&event); + + if (!widget) + return NULL; + + child = find_widget_at_pos (widget, lrint (x), lrint (y), + &xout, &yout, false, NULL); + + if (!child) + return NULL; + + return gtk_widget_get_window (child); +} + +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); +#ifndef HAVE_PGTK + embedder = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (view->frame)); +#else + embedder = gtk_widget_get_window (view->widget); +#endif + 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 = internal_xwidget_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; +#ifndef HAVE_PGTK + 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; + } +#else + *xout = x; + *yout = y; +#endif +} + +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; +#ifndef HAVE_PGTK + 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; + } +#else + *xout = x; + *yout = y; +#endif +} + +static GdkDevice * +find_suitable_pointer (struct frame *f, bool need_smooth) +{ + GdkSeat *seat = gdk_display_get_default_seat + (gtk_widget_get_display (FRAME_GTK_WIDGET (f))); + GList *devices, *tem; + GdkDevice *device; + + if (!seat) + return NULL; + + devices = gdk_seat_get_slaves (seat, GDK_SEAT_CAPABILITY_ALL_POINTING); + device = NULL; + tem = NULL; + + if (need_smooth) + { + for (tem = devices; tem; tem = tem->next) + { + device = GDK_DEVICE (tem->data); + + if (gdk_device_get_source (device) == GDK_SOURCE_TOUCHPAD) + break; + } + } + + g_list_free (devices); + + return !tem ? gdk_seat_get_pointer (seat) : device; +} + +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, + bool pointer_grabs, + struct xwidget_view *vw) +{ + struct widget_search_data data; +#ifdef HAVE_X_WINDOWS + GtkWidget *grab = NULL; + + if (pointer_grabs) + { + grab = vw->passive_grab; + + if (grab && gtk_widget_get_window (grab)) + { + gtk_widget_translate_coordinates (w, grab, x, + y, new_x, new_y); + + return grab; + } + } +#endif + + 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; +} + +#ifdef HAVE_PGTK +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; + GdkWindow *wdesc; + + xw->hit_result = webkit_hit_test_result_get_context (res); + + for (Lisp_Object tem = internal_xwidget_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 (gtk_widget_get_realized (xvw->widget)) + { + wdesc = gtk_widget_get_window (xvw->widget); + gdk_window_set_cursor (wdesc, xvw->cursor); + } + } + } + } +} + +static void +mouse_target_changed (WebKitWebView *webview, + WebKitHitTestResult *hitresult, + guint modifiers, gpointer xw) +{ + define_cursors (xw, hitresult); +} +#endif + +static gboolean +run_file_chooser_cb (WebKitWebView *webview, + WebKitFileChooserRequest *request, + gpointer user_data) +{ + struct frame *f = SELECTED_FRAME (); + GtkFileChooserNative *chooser; + GtkFileFilter *filter; + bool select_multiple_p; + guint response; + GSList *filenames; + GSList *tem; + int i, len; + gchar **files; + + /* 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; + + chooser = gtk_file_chooser_native_new ("Select file", + GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + GTK_FILE_CHOOSER_ACTION_OPEN, "Select", + "Cancel"); + filter = webkit_file_chooser_request_get_mime_types_filter (request); + select_multiple_p = webkit_file_chooser_request_get_select_multiple (request); + + gtk_file_chooser_set_select_multiple (GTK_FILE_CHOOSER (chooser), + select_multiple_p); + gtk_file_chooser_add_filter (GTK_FILE_CHOOSER (chooser), filter); + response = gtk_native_dialog_run (GTK_NATIVE_DIALOG (chooser)); + + if (response != GTK_RESPONSE_ACCEPT) + { + gtk_native_dialog_destroy (GTK_NATIVE_DIALOG (chooser)); + webkit_file_chooser_request_cancel (request); + + return TRUE; + } + + filenames = gtk_file_chooser_get_filenames (GTK_FILE_CHOOSER (chooser)); + len = g_slist_length (filenames); + files = alloca (sizeof *files * (len + 1)); + + for (tem = filenames, i = 0; tem; tem = tem->next, ++i) + files[i] = tem->data; + files[len] = NULL; + + g_slist_free (filenames); + webkit_file_chooser_request_select_files (request, (const gchar **) files); + + for (i = 0; i < len; ++i) + g_free (files[i]); + + gtk_native_dialog_destroy (GTK_NATIVE_DIALOG (chooser)); + + return TRUE; +} + +#ifdef HAVE_X_WINDOWS + +static void +xv_drag_begin_cb (GtkWidget *widget, + GdkDragContext *context, + gpointer user_data) +{ + struct xwidget_view *view = user_data; + + if (view->passive_grab) + { + g_signal_handler_disconnect (view->passive_grab, + view->passive_grab_destruction_signal); + g_signal_handler_disconnect (view->passive_grab, + view->passive_grab_drag_signal); + view->passive_grab = NULL; + } +} + +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; + struct xwidget *model = XXWIDGET (view->model); + GtkWidget *target; + GtkWidget *ungrab_target; + GdkWindow *toplevel, *target_window; + int view_x, view_y; + + /* X and Y should be relative to the origin of view->wdesc. */ + x += view->clip_left; + y += view->clip_top; + + view_x = x; + view_y = y; + + target = find_widget_at_pos (model->widgetwindow_osr, x, y, &x, &y, + true, view); + + if (!target) + target = model->widget_osr; + + xg_event = gdk_event_new (down_p ? GDK_BUTTON_PRESS : GDK_BUTTON_RELEASE); + + 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, false); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + + + if (down_p && !view->passive_grab) + { + view->passive_grab = target; + view->passive_grab_destruction_signal + = g_signal_connect (G_OBJECT (view->passive_grab), + "destroy", G_CALLBACK (gtk_widget_destroyed), + &view->passive_grab); + view->passive_grab_drag_signal + = g_signal_connect (G_OBJECT (view->passive_grab), + "drag-begin", G_CALLBACK (xv_drag_begin_cb), + view); + } + else + { + ungrab_target = find_widget_at_pos (model->widgetwindow_osr, + view_x, view_y, &x, &y, + false, NULL); + + if (view->last_crossing_window && ungrab_target) + { + xw_maybe_synthesize_crossing (view, gtk_widget_get_window (ungrab_target), + view_x, view_y, XW_CROSSING_NONE, + time, modifier_state, GDK_CROSSING_UNGRAB, + GDK_CROSSING_UNGRAB); + } + else + { + toplevel = gtk_widget_get_window (model->widgetwindow_osr); + xg_event = gdk_event_new (GDK_LEAVE_NOTIFY); + target_window = gtk_widget_get_window (target); + window_coords_from_toplevel (target_window, toplevel, view_x, + view_y, &x, &y); + + xg_event->crossing.x = x; + xg_event->crossing.y = y; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.detail = GDK_NOTIFY_ANCESTOR; + xg_event->crossing.mode = GDK_CROSSING_UNGRAB; + xg_event->crossing.window = g_object_ref (target_window); + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + + xw_notify_virtual_upwards_until (view, target_window, toplevel, toplevel, + modifier_state, view_x, view_y, time, + GDK_LEAVE_NOTIFY, false, + GDK_CROSSING_UNGRAB); + + if (target_window != toplevel) + { + xg_event = gdk_event_new (GDK_LEAVE_NOTIFY); + + xg_event->crossing.x = view_y; + xg_event->crossing.y = view_y; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.detail = GDK_NOTIFY_VIRTUAL; + xg_event->crossing.mode = GDK_CROSSING_UNGRAB; + xg_event->crossing.window = g_object_ref (toplevel); + + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + } + + } + + if (view->passive_grab) + { + g_signal_handler_disconnect (view->passive_grab, + view->passive_grab_destruction_signal); + g_signal_handler_disconnect (view->passive_grab, + view->passive_grab_drag_signal); + view->passive_grab = NULL; + } + } +} + +void +xwidget_button (struct xwidget_view *view, + bool down_p, int x, int y, int button, + int modifier_state, Time time) +{ + if (NILP (XXWIDGET (view->model)->buffer)) + return; + + record_osr_embedder (view); + + if (button < 4 || button > 8) + xwidget_button_1 (view, down_p, x, y, button, modifier_state, time); + else + { + if (!down_p) + { + 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, + true, view); + + 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, + false); + + 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); + } + } +} + +#ifdef HAVE_XINPUT2 +void +xwidget_motion_notify (struct xwidget_view *view, + double x, double y, + double root_x, double root_y, + uint state, Time time) +{ + GdkEvent *xg_event; + GtkWidget *target; + struct xwidget *model = XXWIDGET (view->model); + int target_x, target_y; + + if (NILP (model->buffer)) + return; + + record_osr_embedder (view); + + target = find_widget_at_pos (model->widgetwindow_osr, + lrint (x + view->clip_left), + lrint (y + view->clip_top), + &target_x, &target_y, + true, view); + + if (!target) + { + target_x = lrint (x + view->clip_left); + target_y = lrint (y + view->clip_top); + target = model->widget_osr; + } + else if (xw_maybe_synthesize_crossing (view, gtk_widget_get_window (target), + x + view->clip_left, y + view->clip_top, + XW_CROSSING_NONE, time, state, + (view->passive_grab + ? GDK_CROSSING_GRAB + : GDK_CROSSING_NORMAL), + GDK_CROSSING_NORMAL)) + return; + + xg_event = gdk_event_new (GDK_MOTION_NOTIFY); + xg_event->any.window = gtk_widget_get_window (target); + xg_event->motion.x = target_x; + xg_event->motion.y = target_y; + xg_event->motion.x_root = root_x; + xg_event->motion.y_root = root_y; + xg_event->motion.time = time; + xg_event->motion.state = state; + xg_event->motion.device = find_suitable_pointer (view->frame, false); + + g_object_ref (xg_event->any.window); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); +} + +void +xwidget_scroll (struct xwidget_view *view, double x, double y, + double dx, double dy, uint state, Time time, + bool stop_p) +{ + GdkEvent *xg_event; + GtkWidget *target; + struct xwidget *model = XXWIDGET (view->model); + int target_x, target_y; + + if (NILP (model->buffer)) + return; + + record_osr_embedder (view); + + target = find_widget_at_pos (model->widgetwindow_osr, + lrint (x + view->clip_left), + lrint (y + view->clip_top), + &target_x, &target_y, + true, view); + + if (!target) + { + target_x = lrint (x); + target_y = lrint (y); + target = model->widget_osr; + } + + xg_event = gdk_event_new (GDK_SCROLL); + xg_event->any.window = gtk_widget_get_window (target); + xg_event->scroll.direction = GDK_SCROLL_SMOOTH; + xg_event->scroll.x = target_x; + xg_event->scroll.y = target_y; + xg_event->scroll.x_root = lrint (x); + xg_event->scroll.y_root = lrint (y); + xg_event->scroll.time = time; + xg_event->scroll.state = state; + xg_event->scroll.delta_x = dx; + xg_event->scroll.delta_y = dy; + xg_event->scroll.device = find_suitable_pointer (view->frame, true); + xg_event->scroll.is_stop = stop_p; + + g_object_ref (xg_event->any.window); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); +} + +#ifdef HAVE_XINPUT2_4 +void +xwidget_pinch (struct xwidget_view *view, XIGesturePinchEvent *xev) +{ +#if GTK_CHECK_VERSION (3, 18, 0) + GdkEvent *xg_event; + GtkWidget *target; + struct xwidget *model = XXWIDGET (view->model); + int target_x, target_y; + double x = xev->event_x; + double y = xev->event_y; + + if (NILP (model->buffer)) + return; + + record_osr_embedder (view); + + target = find_widget_at_pos (model->widgetwindow_osr, + lrint (x + view->clip_left), + lrint (y + view->clip_top), + &target_x, &target_y, + true, view); + + if (!target) + { + target_x = lrint (x); + target_y = lrint (y); + target = model->widget_osr; + } + + xg_event = gdk_event_new (GDK_TOUCHPAD_PINCH); + xg_event->any.window = gtk_widget_get_window (target); + xg_event->touchpad_pinch.x = target_x; + xg_event->touchpad_pinch.y = target_y; + xg_event->touchpad_pinch.dx = xev->delta_x; + xg_event->touchpad_pinch.dy = xev->delta_y; + xg_event->touchpad_pinch.angle_delta = xev->delta_angle; + xg_event->touchpad_pinch.scale = xev->scale; + xg_event->touchpad_pinch.x_root = xev->root_x; + xg_event->touchpad_pinch.y_root = xev->root_y; + xg_event->touchpad_pinch.state = xev->mods.effective; + xg_event->touchpad_pinch.n_fingers = 2; + + switch (xev->evtype) + { + case XI_GesturePinchBegin: + xg_event->touchpad_pinch.phase = GDK_TOUCHPAD_GESTURE_PHASE_BEGIN; + break; + case XI_GesturePinchUpdate: + xg_event->touchpad_pinch.phase = GDK_TOUCHPAD_GESTURE_PHASE_UPDATE; + break; + case XI_GesturePinchEnd: + xg_event->touchpad_pinch.phase = GDK_TOUCHPAD_GESTURE_PHASE_END; + break; + } + + gdk_event_set_device (xg_event, find_suitable_pointer (view->frame, false)); + + g_object_ref (xg_event->any.window); + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); +#endif +} +#endif +#endif + +#ifdef HAVE_XINPUT2 +static GdkNotifyType +xi_translate_notify_detail (int detail) +{ + switch (detail) + { + case XINotifyInferior: + return GDK_NOTIFY_INFERIOR; + case XINotifyAncestor: + return GDK_NOTIFY_ANCESTOR; + case XINotifyVirtual: + return GDK_NOTIFY_VIRTUAL; + case XINotifyNonlinear: + return GDK_NOTIFY_NONLINEAR; + case XINotifyNonlinearVirtual: + return GDK_NOTIFY_NONLINEAR_VIRTUAL; + default: + emacs_abort (); + } +} +#endif + +static void +window_coords_from_toplevel (GdkWindow *window, GdkWindow *toplevel, + int x, int y, int *out_x, int *out_y) +{ + GdkWindow *parent; + GList *children, *l; + gdouble x_out, y_out; + + if (window == toplevel) + { + *out_x = x; + *out_y = y; + return; + } + + children = NULL; + while ((parent = gdk_window_get_parent (window)) != toplevel) + { + children = g_list_prepend (children, window); + window = parent; + } + + for (l = children; l != NULL; l = l->next) + gdk_window_coords_from_parent (l->data, x, y, &x_out, &y_out); + + g_list_free (children); + + *out_x = x_out; + *out_y = y_out; +} + +static GdkWindow * +xw_find_common_ancestor (GdkWindow *window, + GdkWindow *other, + GdkWindow *toplevel) +{ + GdkWindow *tem; + GList *l1 = NULL; + GList *l2 = NULL; + GList *i1, *i2; + + tem = window; + while (tem && tem != toplevel) + { + l1 = g_list_prepend (l1, tem); + tem = gdk_window_get_parent (tem); + } + + tem = other; + while (tem && tem != toplevel) + { + l2 = g_list_prepend (l2, tem); + tem = gdk_window_get_parent (tem); + } + + tem = NULL; + i1 = l1; + i2 = l2; + + while (i1 && i2 && (i1->data == i2->data)) + { + tem = i1->data; + i1 = i1->next; + i2 = i2->next; + } + + g_list_free (l1); + g_list_free (l2); + + return tem; +} + +static void +xw_notify_virtual_upwards_until (struct xwidget_view *xv, + GdkWindow *window, + GdkWindow *until, + GdkWindow *toplevel, + unsigned int state, + int x, int y, Time time, + GdkEventType type, + bool nonlinear_p, + GdkCrossingMode crossing) +{ + GdkEvent *xg_event; + GdkWindow *tem; + int cx, cy; + + for (tem = gdk_window_get_parent (window); + tem && (tem != until); + tem = gdk_window_get_parent (tem)) + { + xg_event = gdk_event_new (type); + + gdk_event_set_device (xg_event, + find_suitable_pointer (xv->frame, false)); + window_coords_from_toplevel (tem, toplevel, x, y, &cx, &cy); + xg_event->crossing.x = cx; + xg_event->crossing.y = cy; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.detail = (nonlinear_p + ? GDK_NOTIFY_NONLINEAR_VIRTUAL + : GDK_NOTIFY_VIRTUAL); + xg_event->crossing.mode = crossing; + xg_event->crossing.window = g_object_ref (tem); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + } +} + +static void +xw_notify_virtual_downwards_until (struct xwidget_view *xv, + GdkWindow *window, + GdkWindow *until, + GdkWindow *toplevel, + unsigned int state, + int x, int y, Time time, + GdkEventType type, + bool nonlinear_p, + GdkCrossingMode crossing) +{ + GdkEvent *xg_event; + GdkWindow *tem; + int cx, cy; + GList *path = NULL, *it; + + tem = gdk_window_get_parent (window); + + while (tem && tem != until) + { + path = g_list_prepend (path, tem); + tem = gdk_window_get_parent (tem); + } + + for (it = path; it; it = it->next) + { + tem = it->data; + xg_event = gdk_event_new (type); + + gdk_event_set_device (xg_event, + find_suitable_pointer (xv->frame, false)); + window_coords_from_toplevel (tem, toplevel, x, y, &cx, &cy); + xg_event->crossing.x = cx; + xg_event->crossing.y = cy; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.detail = (nonlinear_p + ? GDK_NOTIFY_NONLINEAR_VIRTUAL + : GDK_NOTIFY_VIRTUAL); + xg_event->crossing.mode = crossing; + xg_event->crossing.window = g_object_ref (tem); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + } + + g_list_free (path); +} + +static void +xw_update_cursor_for_view (struct xwidget_view *xv, + GdkWindow *crossing_window) +{ + GdkCursor *xg_cursor; + Cursor cursor; + + xg_cursor = gdk_window_get_cursor (crossing_window); + + if (xg_cursor) + { + cursor = gdk_x11_cursor_get_xcursor (xg_cursor); + + if (gdk_x11_cursor_get_xdisplay (xg_cursor) == xv->dpy) + xv->cursor = cursor; + } + else + xv->cursor = FRAME_OUTPUT_DATA (xv->frame)->nontext_cursor; + + if (xv->wdesc != None) + XDefineCursor (xv->dpy, xv->wdesc, xv->cursor); +} + +static void +xw_last_crossing_cursor_cb (GdkWindow *window, + GParamSpec *spec, + gpointer user_data) +{ + xw_update_cursor_for_view (user_data, window); +} + +static bool +xw_maybe_synthesize_crossing (struct xwidget_view *view, + GdkWindow *current_window, + int x, int y, int crossing, + Time time, unsigned int state, + GdkCrossingMode entry_crossing, + GdkCrossingMode exit_crossing) +{ + GdkWindow *last_crossing, *toplevel, *ancestor; + GdkEvent *xg_event; + int cx, cy; + bool nonlinear_p; + bool retention_flag; + +#if WEBKIT_CHECK_VERSION (2, 34, 0) + /* Work around a silly bug in WebKitGTK+ that tries to make tooltip + windows transient for our offscreen window. */ + int tooltip_width, tooltip_height; + + xg_prepare_tooltip (view->frame, dummy_tooltip_string, + &tooltip_width, &tooltip_height); +#endif + + toplevel = gtk_widget_get_window (XXWIDGET (view->model)->widgetwindow_osr); + retention_flag = false; + + if (crossing == XW_CROSSING_LEFT + && (view->last_crossing_window + && !gdk_window_is_destroyed (view->last_crossing_window))) + { + xw_notify_virtual_upwards_until (view, view->last_crossing_window, + toplevel, toplevel, + state, x, y, time, + GDK_LEAVE_NOTIFY, false, + exit_crossing); + } + + if (view->last_crossing_window + && (gdk_window_is_destroyed (view->last_crossing_window) + || crossing == XW_CROSSING_LEFT)) + { + if (!gdk_window_is_destroyed (view->last_crossing_window) + && view->last_crossing_window != toplevel) + { + xg_event = gdk_event_new (GDK_LEAVE_NOTIFY); + window_coords_from_toplevel (view->last_crossing_window, + toplevel, x, y, &cx, &cy); + + xg_event->crossing.x = cx; + xg_event->crossing.y = cy; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.detail = GDK_NOTIFY_ANCESTOR; + xg_event->crossing.mode = exit_crossing; + xg_event->crossing.window = g_object_ref (view->last_crossing_window); + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + + xw_notify_virtual_upwards_until (view, view->last_crossing_window, + gdk_window_get_parent (toplevel), + toplevel, state, x, y, time, + GDK_LEAVE_NOTIFY, false, exit_crossing); + retention_flag = true; + } + + g_signal_handler_disconnect (view->last_crossing_window, + view->last_crossing_cursor_signal); + g_clear_pointer (&view->last_crossing_window, + g_object_unref); + } + last_crossing = view->last_crossing_window; + + if (!last_crossing) + { + if (current_window) + { + view->last_crossing_window = g_object_ref (current_window); + xw_update_cursor_for_view (view, current_window); + view->last_crossing_cursor_signal + = g_signal_connect (G_OBJECT (current_window), "notify::cursor", + G_CALLBACK (xw_last_crossing_cursor_cb), view); + + xw_notify_virtual_downwards_until (view, current_window, + toplevel, toplevel, + state, x, y, time, + GDK_ENTER_NOTIFY, + false, entry_crossing); + } + return retention_flag; + } + + if (last_crossing != current_window) + { + view->last_crossing_window = g_object_ref (current_window); + g_signal_handler_disconnect (last_crossing, view->last_crossing_cursor_signal); + + xw_update_cursor_for_view (view, current_window); + view->last_crossing_cursor_signal + = g_signal_connect (G_OBJECT (current_window), "notify::cursor", + G_CALLBACK (xw_last_crossing_cursor_cb), view); + + ancestor = xw_find_common_ancestor (last_crossing, current_window, toplevel); + + if (!ancestor) + emacs_abort (); + + nonlinear_p = (last_crossing != ancestor) && (current_window != ancestor); + + if (nonlinear_p || (last_crossing != ancestor)) + xw_notify_virtual_upwards_until (view, last_crossing, + ancestor, toplevel, + state, x, y, time, + GDK_LEAVE_NOTIFY, + nonlinear_p, + exit_crossing); + + xg_event = gdk_event_new (GDK_LEAVE_NOTIFY); + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); + window_coords_from_toplevel (last_crossing, toplevel, + x, y, &cx, &cy); + xg_event->crossing.x = cx; + xg_event->crossing.y = cy; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.state = state; + xg_event->crossing.detail = (nonlinear_p + ? GDK_NOTIFY_NONLINEAR + : (last_crossing == ancestor + ? GDK_NOTIFY_INFERIOR + : GDK_NOTIFY_ANCESTOR)); + xg_event->crossing.mode = exit_crossing; + xg_event->crossing.window = g_object_ref (last_crossing); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + + if (nonlinear_p || (current_window != ancestor)) + xw_notify_virtual_downwards_until (view, current_window, + ancestor, toplevel, + state, x, y, time, + GDK_ENTER_NOTIFY, + nonlinear_p, + entry_crossing); + + xg_event = gdk_event_new (GDK_ENTER_NOTIFY); + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); + window_coords_from_toplevel (current_window, toplevel, + x, y, &cx, &cy); + xg_event->crossing.x = cx; + xg_event->crossing.y = cy; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.state = state; + xg_event->crossing.detail = (nonlinear_p + ? GDK_NOTIFY_NONLINEAR + : (current_window == ancestor + ? GDK_NOTIFY_INFERIOR + : GDK_NOTIFY_ANCESTOR)); + xg_event->crossing.mode = entry_crossing; + xg_event->crossing.window = g_object_ref (current_window); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + g_object_unref (last_crossing); + + return true; + } + + return false; +} + +void +xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event) +{ + GdkEvent *xg_event; + struct xwidget *model = XXWIDGET (view->model); + int x, y, toplevel_x, toplevel_y; + GtkWidget *target; +#ifdef HAVE_XINPUT2 + XIEnterEvent *xev = NULL; +#endif + + if (NILP (model->buffer)) + return; + +#ifdef HAVE_XINPUT2 + if (event->type != GenericEvent) +#endif + { + xg_event = gdk_event_new (event->type == MotionNotify + ? GDK_MOTION_NOTIFY + : (event->type == LeaveNotify + ? GDK_LEAVE_NOTIFY + : GDK_ENTER_NOTIFY)); + toplevel_x = (event->type == MotionNotify + ? event->xmotion.x + view->clip_left + : event->xcrossing.x + view->clip_left); + toplevel_y = (event->type == MotionNotify + ? event->xmotion.y + view->clip_top + : event->xcrossing.y + view->clip_top); + target = find_widget_at_pos (model->widgetwindow_osr, + toplevel_x, toplevel_y, &x, &y, + true, view); + } +#ifdef HAVE_XINPUT2 + else + { + eassert (event->xcookie.evtype == XI_Enter + || event->xcookie.evtype == XI_Leave); + + xev = (XIEnterEvent *) event->xcookie.data; + xg_event = gdk_event_new (event->type == XI_Enter + ? GDK_ENTER_NOTIFY + : GDK_LEAVE_NOTIFY); + target = find_widget_at_pos (model->widgetwindow_osr, + (toplevel_x + = lrint (xev->event_x + view->clip_left)), + (toplevel_y + = lrint (xev->event_y + view->clip_top)), + &x, &y, true, view); + } +#endif + + 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) + { + if (!xw_maybe_synthesize_crossing (view, xg_event->any.window, + toplevel_x, toplevel_y, + XW_CROSSING_NONE, event->xmotion.time, + event->xmotion.state, + (view->passive_grab + ? GDK_CROSSING_GRAB + : GDK_CROSSING_NORMAL), + GDK_CROSSING_NORMAL)) + { + 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, false); + } + else + { + gdk_event_free (xg_event); + return; + } + } +#ifdef HAVE_XINPUT2 + else if (event->type == GenericEvent) + { + xg_event->crossing.x = x; + xg_event->crossing.y = y; + xg_event->crossing.x_root = (gdouble) xev->root_x; + xg_event->crossing.y_root = (gdouble) xev->root_y; + xg_event->crossing.time = xev->time; + xg_event->crossing.focus = xev->focus; + xg_event->crossing.mode = xev->mode; + xg_event->crossing.detail = xi_translate_notify_detail (xev->detail); + xg_event->crossing.state = xev->mods.effective; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + xg_event->crossing.state |= GDK_BUTTON1_MASK; + if (XIMaskIsSet (xev->buttons.mask, 2)) + xg_event->crossing.state |= GDK_BUTTON2_MASK; + if (XIMaskIsSet (xev->buttons.mask, 3)) + xg_event->crossing.state |= GDK_BUTTON3_MASK; + } + + if (view->passive_grab + || xw_maybe_synthesize_crossing (view, xg_event->any.window, + toplevel_x, toplevel_y, + (xev->type == XI_Enter + ? XW_CROSSING_ENTERED + : XW_CROSSING_LEFT), + xev->time, xg_event->crossing.state, + (view->passive_grab + ? GDK_CROSSING_GRAB + : GDK_CROSSING_NORMAL), + GDK_CROSSING_NORMAL)) + { + gdk_event_free (xg_event); + return; + } + + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); + } +#endif + else + { + if (view->passive_grab + || xw_maybe_synthesize_crossing (view, xg_event->any.window, + toplevel_x, toplevel_y, + (event->type == EnterNotify + ? XW_CROSSING_ENTERED + : XW_CROSSING_LEFT), + event->xcrossing.time, + event->xcrossing.state, + (view->passive_grab + ? GDK_CROSSING_GRAB + : GDK_CROSSING_NORMAL), + GDK_CROSSING_NORMAL)) + { + gdk_event_free (xg_event); + return; + } + + 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; + xg_event->crossing.focus = event->xcrossing.focus; + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); + } + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); +} + +#endif /* HAVE_X_WINDOWS */ + +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->focus_change.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 (), + false)); + + g_object_ref (wnd); + + gtk_main_do_event (focus_event); + gdk_event_free (focus_event); +} + +#ifdef HAVE_X_WINDOWS +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); +} +#endif + 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); +#ifdef HAVE_X_WINDOWS + XMoveWindow (xv->dpy, xv->wdesc, + xv->x + xv->clip_left, + xv->y + xv->clip_top); + XMapWindow (xv->dpy, xv->wdesc); + XFlush (xv->dpy); +#else + gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (xv->frame)), + xv->widget, xv->x + xv->clip_left, + xv->y + xv->clip_top); + gtk_widget_show_all (xv->widget); +#endif } /* Hide an xwidget view. */ @@ -238,28 +2148,115 @@ static void xwidget_hide_view (struct xwidget_view *xv) { xv->hidden = true; - gtk_fixed_move (GTK_FIXED (xv->emacswindow), xv->widgetwindow, - 10000, 10000); +#ifdef HAVE_X_WINDOWS + XUnmapWindow (xv->dpy, xv->wdesc); + XFlush (xv->dpy); +#else + gtk_widget_hide (xv->widget); +#endif } +#ifndef HAVE_PGTK +static void +xv_do_draw (struct xwidget_view *xw, struct xwidget *w) +{ + GtkOffscreenWindow *wnd; + cairo_surface_t *surface; + + if (xw->just_resized) + return; + + if (NILP (w->buffer)) + { + XClearWindow (xw->dpy, xw->wdesc); + return; + } + + 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 (); +} +#else +static void +xwidget_view_draw_cb (GtkWidget *widget, cairo_t *cr, + gpointer data) +{ + struct xwidget_view *view = data; + struct xwidget *w = XXWIDGET (view->model); + GtkOffscreenWindow *wnd; + cairo_surface_t *surface; + + if (NILP (w->buffer)) + return; + + block_input (); + wnd = GTK_OFFSCREEN_WINDOW (w->widgetwindow_osr); + surface = gtk_offscreen_window_get_surface (wnd); + + cairo_save (cr); + if (surface) + { + cairo_translate (cr, -view->clip_left, + -view->clip_top); + cairo_set_source_surface (cr, surface, 0, 0); + cairo_set_operator (cr, CAIRO_OPERATOR_SOURCE); + cairo_paint (cr); + } + cairo_restore (cr); + + unblock_input (); +} +#endif + /* 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 = internal_xwidget_view_list; CONSP (tail); + tail = XCDR (tail)) + { + if (XWIDGET_VIEW_P (XCAR (tail))) + { + struct xwidget_view *view = XXWIDGET_VIEW (XCAR (tail)); +#ifdef HAVE_X_WINDOWS + if (view->wdesc && XXWIDGET (view->model) == xwidget) + xv_do_draw (view, XXWIDGET (view->model)); +#else + gtk_widget_queue_draw (view->widget); +#endif + } + } + + unblock_input (); return FALSE; } + +#ifdef HAVE_X_WINDOWS +void +xwidget_expose (struct xwidget_view *xv) +{ + struct xwidget *xw = XXWIDGET (xv->model); + + xv_do_draw (xv, xw); +} +#endif #endif /* USE_GTK */ void @@ -313,22 +2310,121 @@ store_xwidget_js_callback_event (struct xwidget *xw, #ifdef USE_GTK +static void +store_xwidget_display_event (struct xwidget *xw, + struct xwidget *src) +{ + struct input_event evt; + Lisp_Object val, src_val; + + XSETXWIDGET (val, xw); + XSETXWIDGET (src_val, src); + EVENT_INIT (evt); + evt.kind = XWIDGET_DISPLAY_EVENT; + evt.frame_or_window = Qnil; + evt.arg = list2 (val, src_val); + kbd_buffer_store_event (&evt); +} + +static void +webkit_ready_to_show (WebKitWebView *new_view, + gpointer user_data) +{ + Lisp_Object tem; + struct xwidget *xw; + struct xwidget *src; + + src = find_xwidget_for_offscreen_window (GDK_WINDOW (user_data)); + + for (tem = internal_xwidget_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) + { + /* The source widget was destroyed before we had a + chance to display the new widget. */ + if (!src) + kill_xwidget (xw); + else + store_xwidget_display_event (xw, src); + } + } + } +} + +static GtkWidget * +webkit_create_cb_1 (WebKitWebView *webview, + struct xwidget *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), + gtk_widget_get_window (xv->widgetwindow_osr)); + + 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. */ @@ -357,7 +2453,7 @@ webkit_js_to_lisp (JSCValue *value) const gint32 dlen = jsc_value_to_int32 (len); Lisp_Object obj; - if (! (0 <= dlen && dlen < PTRDIFF_MAX + 1.0)) + if (! (0 <= dlen && dlen < G_MAXINT32)) memory_full (SIZE_MAX); ptrdiff_t n = dlen; @@ -419,8 +2515,8 @@ webkit_javascript_finished_cb (GObject *webview, if (!js_result) { - g_warning ("Error running javascript: %s", error->message); - g_error_free (error); + if (error) + g_error_free (error); return; } @@ -479,6 +2575,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), xw); + return TRUE; + } case WEBKIT_POLICY_DECISION_TYPE_NAVIGATION_ACTION: { WebKitNavigationPolicyDecision *navigation_decision = @@ -499,49 +2622,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); - gtk_widget_draw (xw->widget_osr, cr); - return FALSE; -} + gtk_widget_show (box); + gtk_widget_show (label); -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); + gtk_box_pack_start (GTK_BOX (box), label, TRUE, TRUE, 0); - /* TODO: This might leak events. They should be deallocated later, - perhaps in xwgir_event_cb. */ - gtk_main_do_event (eventcopy); + if (type == WEBKIT_SCRIPT_DIALOG_PROMPT) + { + entry = gtk_entry_new (); + message = webkit_script_dialog_prompt_get_default_text (script_dialog); - /* Don't propagate this event further. */ - return TRUE; -} + gtk_widget_show (entry); + gtk_entry_set_text (GTK_ENTRY (entry), message); + gtk_box_pack_end (GTK_BOX (box), entry, TRUE, TRUE, 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; + result = gtk_dialog_run (GTK_DIALOG (dialog)); + + if (type == WEBKIT_SCRIPT_DIALOG_CONFIRM + || type == WEBKIT_SCRIPT_DIALOG_BEFORE_UNLOAD_CONFIRM) + webkit_script_dialog_confirm_set_confirmed (script_dialog, result == 0); + + 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 */ @@ -562,69 +2711,55 @@ xwidget_init_view (struct xwidget *xww, Lisp_Object val; XSETXWIDGET_VIEW (val, xv); - Vxwidget_view_list = Fcons (val, Vxwidget_view_list); + internal_xwidget_view_list = Fcons (val, internal_xwidget_view_list); + Vxwidget_view_list = Fcopy_sequence (internal_xwidget_view_list); XSETWINDOW (xv->w, s->w); 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); +#ifdef HAVE_X_WINDOWS + xv->dpy = FRAME_X_DISPLAY (s->f); - /* Draw the view on damage-event. */ - g_signal_connect (G_OBJECT (xww->widgetwindow_osr), "damage-event", - G_CALLBACK (offscreen_damage_event), xv->widget); - - 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->x = x; + xv->y = y; - 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); + 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 = FRAME_OUTPUT_DATA (s->f)->nontext_cursor; + xv->just_resized = false; + xv->last_crossing_window = NULL; + xv->passive_grab = NULL; +#elif defined HAVE_PGTK + xv->dpyinfo = FRAME_DISPLAY_INFO (s->f); + xv->widget = gtk_drawing_area_new (); + gtk_widget_set_app_paintable (xv->widget, TRUE); + gtk_widget_add_events (xv->widget, GDK_ALL_EVENTS_MASK); + gtk_container_add (GTK_CONTAINER (FRAME_GTK_WIDGET (s->f)), + xv->widget); + + g_signal_connect (xv->widget, "draw", + G_CALLBACK (xwidget_view_draw_cb), xv); + g_signal_connect (xv->widget, "event", + G_CALLBACK (xw_forward_event_from_view), xv); - /* 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->frame = s->f; + xv->cursor = cursor_for_hit (xww->hit_result, s->f); + xv->just_resized = false; #elif defined NS_IMPL_COCOA nsxwidget_init_view (xv, xww, s, x, y); nsxwidget_resize_view(xv, xww->width, xww->height); @@ -656,6 +2791,8 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) #ifdef USE_GTK if (!xv) xv = xwidget_init_view (xww, s, x, y); + + xv->just_resized = false; #elif defined NS_IMPL_COCOA if (!xv) { @@ -678,21 +2815,10 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) } #endif - window_box (s->w, TEXT_AREA, &text_area_x, &text_area_y, - &text_area_width, &text_area_height); + xv->area = s->area; - /* 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)); - } + window_box (s->w, xv->area, &text_area_x, &text_area_y, + &text_area_width, &text_area_height); clip_left = max (0, text_area_x - x); clip_right = max (clip_left, @@ -711,15 +2837,96 @@ 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 HAVE_X_WINDOWS + bool wdesc_was_none = xv->wdesc == None; +#endif xv->x = x; xv->y = y; +#ifdef HAVE_X_WINDOWS + 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); +#ifdef HAVE_XINPUT2 + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + + if (FRAME_DISPLAY_INFO (s->f)->supports_xi2) + { + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + mask.deviceid = XIAllMasterDevices; + + XISetMask (m, XI_Motion); + XISetMask (m, XI_ButtonPress); + XISetMask (m, XI_ButtonRelease); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); +#ifdef HAVE_XINPUT2_4 + if (FRAME_DISPLAY_INFO (s->f)->xi2_version >= 4) + { + XISetMask (m, XI_GesturePinchBegin); + XISetMask (m, XI_GesturePinchUpdate); + XISetMask (m, XI_GesturePinchEnd); + } +#endif + XISelectEvents (xv->dpy, xv->wdesc, &mask, 1); + } +#endif + XLowerWindow (xv->dpy, xv->wdesc); + 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 +#ifdef HAVE_PGTK + block_input (); +#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); +#ifdef HAVE_X_WINDOWS + 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 HAVE_PGTK + gtk_widget_set_size_request (xv->widget, clip_right - clip_left, + clip_bottom - clip_top); + gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (xv->frame)), + xv->widget, x + clip_left, y + clip_top); + gtk_widget_queue_allocate (xv->widget); #elif defined NS_IMPL_COCOA nsxwidget_move_view (xv, x + clip_left, y + clip_top); #endif @@ -730,15 +2937,38 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) covers the entire frame. Clipping might have changed even if we haven't actually moved; try to figure out when we need to reclip for real. */ +#ifndef HAVE_PGTK if (xv->clip_right != clip_right || xv->clip_bottom != clip_bottom || xv->clip_top != clip_top || xv->clip_left != clip_left) +#endif { #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); +#ifdef HAVE_X_WINDOWS + 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); + } +#else + gtk_widget_set_size_request (xv->widget, clip_right - clip_left, + clip_bottom - clip_top); + gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (xv->frame)), + xv->widget, x + clip_left, y + clip_top); + gtk_widget_queue_allocate (xv->widget); +#endif #elif defined NS_IMPL_COCOA nsxwidget_resize_view (xv, clip_right - clip_left, clip_bottom - clip_top); @@ -755,37 +2985,48 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) a redraw. It seems its possible to get out of sync with emacs redraws so emacs background sometimes shows up instead of the xwidgets background. It's just a visual glitch though. */ - if (!xwidget_hidden (xv)) + /* When xww->buffer is nil, that means the xwidget has been killed. */ + if (!NILP (xww->buffer)) { + 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); + nsxwidget_set_needsdisplay (xv); #endif + } } -} +#ifdef HAVE_X_WINDOWS + else + { + XSetWindowBackground (xv->dpy, xv->wdesc, + FRAME_BACKGROUND_PIXEL (s->f)); + } +#endif + +#if defined HAVE_XINPUT2 || defined HAVE_PGTK + if (!NILP (xww->buffer)) + { + record_osr_embedder (xv); + synthesize_focus_in_event (xww->widget_osr); + } +#endif -static bool -xwidget_is_web_view (struct xwidget *xw) -{ #ifdef USE_GTK - return xw->widget_osr != NULL && WEBKIT_IS_WEB_VIEW (xw->widget_osr); -#elif defined NS_IMPL_COCOA - return nsxwidget_is_web_view (xw); + unblock_input (); #endif } +#define CHECK_WEBKIT_WIDGET(xw) \ + if (NILP (xw->buffer) || !EQ (xw->type, Qwebkit)) \ + error ("Not a WebKit widget") + /* Macro that checks xwidget hold webkit web view first. */ #define WEBKIT_FN_INIT() \ - CHECK_XWIDGET (xwidget); \ + CHECK_LIVE_XWIDGET (xwidget); \ struct xwidget *xw = XXWIDGET (xwidget); \ - if (!xwidget_is_web_view (xw)) \ - { \ - fputs ("ERROR xw->widget_osr does not hold a webkit instance\n", \ - stdout); \ - return Qnil; \ - } + CHECK_WEBKIT_WIDGET (xw) DEFUN ("xwidget-webkit-uri", Fxwidget_webkit_uri, Sxwidget_webkit_uri, @@ -796,7 +3037,10 @@ DEFUN ("xwidget-webkit-uri", WEBKIT_FN_INIT (); #ifdef USE_GTK WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr); - return build_string (webkit_web_view_get_uri (wkwv)); + const gchar *uri = webkit_web_view_get_uri (wkwv); + if (!uri) + return build_string (""); + return build_string (uri); #elif defined NS_IMPL_COCOA return nsxwidget_webkit_uri (xw); #endif @@ -830,6 +3074,7 @@ DEFUN ("xwidget-webkit-goto-uri", uri = ENCODE_FILE (uri); #ifdef USE_GTK webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), SSDATA (uri)); + catch_child_signal (); #elif defined NS_IMPL_COCOA nsxwidget_webkit_goto_uri (xw, SSDATA (uri)); #endif @@ -839,21 +3084,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)); @@ -946,7 +3202,7 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, doc: /* Resize XWIDGET to NEW_WIDTH, NEW_HEIGHT. */ ) (Lisp_Object xwidget, Lisp_Object new_width, Lisp_Object new_height) { - CHECK_XWIDGET (xwidget); + CHECK_LIVE_XWIDGET (xwidget); int w = check_integer_range (new_width, 0, INT_MAX); int h = check_integer_range (new_height, 0, INT_MAX); struct xwidget *xw = XXWIDGET (xwidget); @@ -954,21 +3210,10 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, xw->width = w; xw->height = h; - /* If there is an offscreen widget resize it first. */ -#ifdef USE_GTK - if (xw->widget_osr) - { - gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width, - xw->height); - gtk_container_resize_children (GTK_CONTAINER (xw->widgetwindow_osr)); - gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, - xw->height); - } -#elif defined NS_IMPL_COCOA - nsxwidget_resize (xw); -#endif + block_input (); - for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail)) + for (Lisp_Object tail = internal_xwidget_view_list; CONSP (tail); + tail = XCDR (tail)) { if (XWIDGET_VIEW_P (XCAR (tail))) { @@ -976,15 +3221,33 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, 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); + xv->just_resized = true; + SET_FRAME_GARBAGED (xv->frame); +#else + wset_redisplay (XWINDOW (xv->w)); #endif } } } + redisplay (); + + /* If there is an offscreen widget resize it first. */ +#ifdef USE_GTK + if (xw->widget_osr) + { + gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width, + xw->height); + 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); +#endif + unblock_input (); + return Qnil; } @@ -999,7 +3262,7 @@ This can be used to read the xwidget desired size, and resizes the Emacs allocated area accordingly. */) (Lisp_Object xwidget) { - CHECK_XWIDGET (xwidget); + CHECK_LIVE_XWIDGET (xwidget); #ifdef USE_GTK GtkRequisition requisition; gtk_widget_size_request (XXWIDGET (xwidget)->widget_osr, &requisition); @@ -1034,7 +3297,7 @@ DEFUN ("xwidget-info", Currently [TYPE TITLE WIDTH HEIGHT]. */) (Lisp_Object xwidget) { - CHECK_XWIDGET (xwidget); + CHECK_LIVE_XWIDGET (xwidget); struct xwidget *xw = XXWIDGET (xwidget); return CALLN (Fvector, xw->type, xw->title, make_fixed_natnum (xw->width), make_fixed_natnum (xw->height)); @@ -1083,19 +3346,55 @@ DEFUN ("delete-xwidget-view", { CHECK_XWIDGET_VIEW (xwidget_view); struct xwidget_view *xv = XXWIDGET_VIEW (xwidget_view); + + block_input (); #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; +#ifdef HAVE_X_WINDOWS + if (xv->wdesc != None) + { + 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); + } + + if (xv->last_crossing_window) + g_signal_handler_disconnect (xv->last_crossing_window, + xv->last_crossing_cursor_signal); + g_clear_pointer (&xv->last_crossing_window, + g_object_unref); + + if (xv->passive_grab) + { + g_signal_handler_disconnect (xv->passive_grab, + xv->passive_grab_destruction_signal); + g_signal_handler_disconnect (xv->passive_grab, + xv->passive_grab_drag_signal); + xv->passive_grab = NULL; + } + +#else + gtk_widget_destroy (xv->widget); +#endif + + if (xw->embedder_view == xv && !NILP (xw->buffer)) + { + 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 - Vxwidget_view_list = Fdelq (xwidget_view, Vxwidget_view_list); + internal_xwidget_view_list = Fdelq (xwidget_view, internal_xwidget_view_list); + Vxwidget_view_list = Fcopy_sequence (internal_xwidget_view_list); + unblock_input (); return Qnil; } @@ -1113,7 +3412,7 @@ Return nil if no association is found. */) window = Fselected_window (); CHECK_WINDOW (window); - for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); + for (Lisp_Object tail = internal_xwidget_view_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object xwidget_view = XCAR (tail); @@ -1131,7 +3430,7 @@ DEFUN ("xwidget-plist", doc: /* Return the plist of XWIDGET. */) (Lisp_Object xwidget) { - CHECK_XWIDGET (xwidget); + CHECK_LIVE_XWIDGET (xwidget); return XXWIDGET (xwidget)->plist; } @@ -1145,6 +3444,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_LIVE_XWIDGET (xwidget); + CHECK_BUFFER (buffer); + + XXWIDGET (xwidget)->buffer = buffer; + return Qnil; +} + DEFUN ("set-xwidget-plist", Fset_xwidget_plist, Sset_xwidget_plist, 2, 2, 0, @@ -1152,7 +3464,7 @@ DEFUN ("set-xwidget-plist", Returns PLIST. */) (Lisp_Object xwidget, Lisp_Object plist) { - CHECK_XWIDGET (xwidget); + CHECK_LIVE_XWIDGET (xwidget); CHECK_LIST (plist); XXWIDGET (xwidget)->plist = plist; @@ -1168,7 +3480,7 @@ exiting or killing a buffer if XWIDGET is running. This function returns FLAG. */) (Lisp_Object xwidget, Lisp_Object flag) { - CHECK_XWIDGET (xwidget); + CHECK_LIVE_XWIDGET (xwidget); XXWIDGET (xwidget)->kill_without_query = NILP (flag); return flag; } @@ -1179,16 +3491,414 @@ DEFUN ("xwidget-query-on-exit-flag", doc: /* Return the current value of the query-on-exit flag for XWIDGET. */) (Lisp_Object xwidget) { - CHECK_XWIDGET (xwidget); + CHECK_LIVE_XWIDGET (xwidget); 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_LIVE_XWIDGET (xwidget); + +#ifdef USE_GTK + xw = XXWIDGET (xwidget); + CHECK_WEBKIT_WIDGET (xw); + + 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_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + CHECK_WEBKIT_WIDGET (xw); + + 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_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + CHECK_WEBKIT_WIDGET (xw); + + 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_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + CHECK_WEBKIT_WIDGET (xw); + + 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; +} + +DEFUN ("kill-xwidget", Fkill_xwidget, Skill_xwidget, + 1, 1, 0, + doc: /* Kill the specified XWIDGET. +This releases all window system resources associated with XWIDGET, +removes it from `xwidget-list', and detaches it from its buffer. */) + (Lisp_Object xwidget) +{ + struct xwidget *xw; + + CHECK_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + + block_input (); + kill_xwidget (xw); + unblock_input (); + + return Qnil; +} + +#ifdef USE_GTK +DEFUN ("xwidget-webkit-load-html", Fxwidget_webkit_load_html, + Sxwidget_webkit_load_html, 2, 3, 0, + doc: /* Make XWIDGET's WebKit widget render TEXT. +XWIDGET should be a WebKit xwidget, that will receive TEXT. TEXT +should be a string that will be displayed by XWIDGET as HTML markup. +BASE-URI should be a string containing a URI that is used to locate +resources with relative URLs, and if not specified, defaults +to "about:blank". */) + (Lisp_Object xwidget, Lisp_Object text, Lisp_Object base_uri) +{ + struct xwidget *xw; + WebKitWebView *webview; + char *data, *uri; + + CHECK_LIVE_XWIDGET (xwidget); + CHECK_STRING (text); + if (NILP (base_uri)) + base_uri = build_string ("about:blank"); + else + CHECK_STRING (base_uri); + + base_uri = ENCODE_UTF_8 (base_uri); + text = ENCODE_UTF_8 (text); + xw = XXWIDGET (xwidget); + CHECK_WEBKIT_WIDGET (xw); + + data = SSDATA (text); + uri = SSDATA (base_uri); + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + + block_input (); + webkit_web_view_load_html (webview, data, uri); + unblock_input (); + + return Qnil; +} + +DEFUN ("xwidget-webkit-back-forward-list", Fxwidget_webkit_back_forward_list, + Sxwidget_webkit_back_forward_list, 1, 2, 0, + doc: /* Return the navigation history of XWIDGET, a WebKit xwidget. + +Return the history as a list of the form (BACK HERE FORWARD), where +HERE is the current navigation item, while BACK and FORWARD are lists +of history items of the form (IDX TITLE URI). Here, IDX is an index +that can be passed to `xwidget-webkit-goto-history', TITLE is a string +containing the human-readable title of the history item, and URI is +the URI of the history item. + +BACK, HERE, and FORWARD can all be nil depending on the state of the +navigation history. + +BACK and FORWARD will each not contain more elements than LIMIT. If +LIMIT is not specified or nil, it is treated as `50'. */) + (Lisp_Object xwidget, Lisp_Object limit) +{ + struct xwidget *xw; + Lisp_Object back, here, forward; + WebKitWebView *webview; + WebKitBackForwardList *list; + WebKitBackForwardListItem *item; + GList *parent, *tem; + int i; + unsigned int lim; + Lisp_Object title, uri; + const gchar *item_title, *item_uri; + + back = Qnil; + here = Qnil; + forward = Qnil; + + if (NILP (limit)) + limit = make_fixnum (50); + else + CHECK_FIXNAT (limit); + + CHECK_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + list = webkit_web_view_get_back_forward_list (webview); + item = webkit_back_forward_list_get_current_item (list); + lim = XFIXNAT (limit); + + if (item) + { + item_title = webkit_back_forward_list_item_get_title (item); + item_uri = webkit_back_forward_list_item_get_uri (item); + here = list3 (make_fixnum (0), + build_string_from_utf8 (item_title ? item_title : ""), + build_string_from_utf8 (item_uri ? item_uri : "")); + } + parent = webkit_back_forward_list_get_back_list_with_limit (list, lim); + + if (parent) + { + for (i = 1, tem = parent; tem; tem = tem->next, ++i) + { + item = tem->data; + item_title = webkit_back_forward_list_item_get_title (item); + item_uri = webkit_back_forward_list_item_get_uri (item); + title = build_string_from_utf8 (item_title ? item_title : ""); + uri = build_string_from_utf8 (item_uri ? item_uri : ""); + back = Fcons (list3 (make_fixnum (-i), title, uri), back); + } + } + + back = Fnreverse (back); + g_list_free (parent); + + parent = webkit_back_forward_list_get_forward_list_with_limit (list, lim); + + if (parent) + { + for (i = 1, tem = parent; tem; tem = tem->next, ++i) + { + item = tem->data; + item_title = webkit_back_forward_list_item_get_title (item); + item_uri = webkit_back_forward_list_item_get_uri (item); + title = build_string_from_utf8 (item_title ? item_title : ""); + uri = build_string_from_utf8 (item_uri ? item_uri : ""); + forward = Fcons (list3 (make_fixnum (i), title, uri), forward); + } + } + + forward = Fnreverse (forward); + g_list_free (parent); + + return list3 (back, here, forward); +} + +DEFUN ("xwidget-webkit-estimated-load-progress", + Fxwidget_webkit_estimated_load_progress, Sxwidget_webkit_estimated_load_progress, + 1, 1, 0, doc: /* Get the estimated load progress of XWIDGET, a WebKit widget. +Return a value ranging from 0.0 to 1.0, based on how close XWIDGET +is to completely loading its page. */) + (Lisp_Object xwidget) +{ + struct xwidget *xw; + WebKitWebView *webview; + double value; + + CHECK_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + CHECK_WEBKIT_WIDGET (xw); + + block_input (); + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + value = webkit_web_view_get_estimated_load_progress (webview); + unblock_input (); + + return make_float (value); +} +#endif + +DEFUN ("xwidget-webkit-set-cookie-storage-file", + Fxwidget_webkit_set_cookie_storage_file, Sxwidget_webkit_set_cookie_storage_file, + 2, 2, 0, doc: /* Make the WebKit widget XWIDGET load and store cookies in FILE. + +Cookies will be stored as plain text in FILE, which must be an +absolute file name. All xwidgets related to XWIDGET will also +store cookies in FILE and load them from there. */) + (Lisp_Object xwidget, Lisp_Object file) +{ +#ifdef USE_GTK + struct xwidget *xw; + WebKitWebView *webview; + WebKitWebContext *context; + WebKitCookieManager *manager; + + CHECK_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + CHECK_WEBKIT_WIDGET (xw); + CHECK_STRING (file); + + block_input (); + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + context = webkit_web_view_get_context (webview); + manager = webkit_web_context_get_cookie_manager (context); + webkit_cookie_manager_set_persistent_storage (manager, + SSDATA (ENCODE_UTF_8 (file)), + WEBKIT_COOKIE_PERSISTENT_STORAGE_TEXT); + unblock_input (); +#endif + + return Qnil; +} + +DEFUN ("xwidget-webkit-stop-loading", Fxwidget_webkit_stop_loading, + Sxwidget_webkit_stop_loading, + 1, 1, 0, doc: /* Stop loading data in the WebKit widget XWIDGET. +This will stop any data transfer that may still be in progress inside +XWIDGET as part of loading a page. */) + (Lisp_Object xwidget) +{ +#ifdef USE_GTK + struct xwidget *xw; + WebKitWebView *webview; + + CHECK_LIVE_XWIDGET (xwidget); + xw = XXWIDGET (xwidget); + CHECK_WEBKIT_WIDGET (xw); + + block_input (); + webview = WEBKIT_WEB_VIEW (xw->widget_osr); + webkit_web_view_stop_loading (webview); + unblock_input (); +#endif + + return Qnil; +} + void syms_of_xwidget (void) { defsubr (&Smake_xwidget); defsubr (&Sxwidgetp); + defsubr (&Sxwidget_live_p); DEFSYM (Qxwidgetp, "xwidgetp"); + DEFSYM (Qxwidget_live_p, "xwidget-live-p"); defsubr (&Sxwidget_view_p); DEFSYM (Qxwidget_view_p, "xwidget-view-p"); defsubr (&Sxwidget_info); @@ -1215,6 +3925,20 @@ 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); + defsubr (&Sxwidget_webkit_set_cookie_storage_file); + defsubr (&Sxwidget_webkit_stop_loading); +#ifdef USE_GTK + defsubr (&Sxwidget_webkit_load_html); + defsubr (&Sxwidget_webkit_back_forward_list); + defsubr (&Sxwidget_webkit_estimated_load_progress); +#endif + defsubr (&Skill_xwidget); DEFSYM (QCxwidget, ":xwidget"); DEFSYM (QCtitle, ":title"); @@ -1228,14 +3952,34 @@ syms_of_xwidget (void) DEFSYM (QCplist, ":plist"); DEFVAR_LISP ("xwidget-list", Vxwidget_list, - doc: /* xwidgets list. */); + doc: /* List of all xwidgets that have not been killed. */); Vxwidget_list = Qnil; DEFVAR_LISP ("xwidget-view-list", Vxwidget_view_list, - doc: /* xwidget views list. */); + doc: /* List of all xwidget views. */); Vxwidget_view_list = Qnil; Fprovide (intern ("xwidget-internal"), Qnil); + + id_to_xwidget_map = CALLN (Fmake_hash_table, QCtest, Qeq, + QCweakness, Qvalue); + staticpro (&id_to_xwidget_map); + + internal_xwidget_list = Qnil; + staticpro (&internal_xwidget_list); + internal_xwidget_view_list = Qnil; + staticpro (&internal_xwidget_view_list); + +#ifdef HAVE_X_WINDOWS + x_window_to_xwv_map = CALLN (Fmake_hash_table, QCtest, Qeq); + + staticpro (&x_window_to_xwv_map); + +#if WEBKIT_CHECK_VERSION (2, 34, 0) + dummy_tooltip_string = build_string (""); + staticpro (&dummy_tooltip_string); +#endif +#endif } @@ -1276,7 +4020,7 @@ void xwidget_view_delete_all_in_window (struct window *w) { struct xwidget_view *xv = NULL; - for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); + for (Lisp_Object tail = internal_xwidget_view_list; CONSP (tail); tail = XCDR (tail)) { if (XWIDGET_VIEW_P (XCAR (tail))) @@ -1321,7 +4065,7 @@ lookup_xwidget (Lisp_Object spec) static void xwidget_start_redisplay (void) { - for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); + for (Lisp_Object tail = internal_xwidget_view_list; CONSP (tail); tail = XCDR (tail)) { if (XWIDGET_VIEW_P (XCAR (tail))) @@ -1374,25 +4118,22 @@ 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); -#ifdef USE_GTK - /* FIXME: Is it safe to assume xwidget_view_lookup - always succeeds here? If so, this comment can be removed. - If not, the code probably needs fixing. */ - eassume (xv); - xwidget_touch (xv); -#elif defined NS_IMPL_COCOA - /* In NS xwidget, xv can be NULL for the second or + = xwidget_view_lookup (xwidget_from_id (glyph->u.xwidget), w); + + /* In NS xwidget, xv can be NULL for the second or later views for a model, the result of 1 to 1 - model view relation enforcement. */ + model view relation enforcement. `xwidget_view_lookup' + has also been observed to return NULL here on X-Windows + at least once, so stay safe and only touch it if it's + not NULL. */ + if (xv) xwidget_touch (xv); -#endif } } } - for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); + for (Lisp_Object tail = internal_xwidget_view_list; CONSP (tail); tail = XCDR (tail)) { if (XWIDGET_VIEW_P (XCAR (tail))) @@ -1424,6 +4165,82 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix) } } +#ifdef HAVE_X_WINDOWS +void +lower_frame_xwidget_views (struct frame *f) +{ + struct xwidget_view *xv; + + for (Lisp_Object tail = internal_xwidget_view_list; CONSP (tail); + tail = XCDR (tail)) + { + xv = XXWIDGET_VIEW (XCAR (tail)); + if (xv->frame == f && xv->wdesc != None) + XLowerWindow (xv->dpy, xv->wdesc); + } +} +#endif + +#ifndef NS_IMPL_COCOA +void +kill_frame_xwidget_views (struct frame *f) +{ + Lisp_Object rem = Qnil; + + for (Lisp_Object tail = internal_xwidget_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 + +static void +kill_xwidget (struct xwidget *xw) +{ + Lisp_Object val; + XSETXWIDGET (val, xw); + + internal_xwidget_list = Fdelq (val, internal_xwidget_list); + Vxwidget_list = Fcopy_sequence (internal_xwidget_list); +#ifdef USE_GTK + xw->buffer = Qnil; + + 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++) + { + Lisp_Object cb = AREF (xw->script_callbacks, idx); + if (!NILP (cb)) + xfree (xmint_pointer (XCAR (cb))); + ASET (xw->script_callbacks, idx, Qnil); + } + } + + xw->widget_osr = NULL; + xw->widgetwindow_osr = NULL; + xw->find_text = NULL; + + catch_child_signal (); +#elif defined NS_IMPL_COCOA + nsxwidget_kill (xw); +#endif +} + /* Kill all xwidget in BUFFER. */ void kill_buffer_xwidgets (Lisp_Object buffer) @@ -1432,28 +4249,13 @@ kill_buffer_xwidgets (Lisp_Object buffer) for (tail = Fget_buffer_xwidgets (buffer); CONSP (tail); tail = XCDR (tail)) { xwidget = XCAR (tail); - Vxwidget_list = Fdelq (xwidget, Vxwidget_list); - /* TODO free the GTK things in xw. */ { - CHECK_XWIDGET (xwidget); + CHECK_LIVE_XWIDGET (xwidget); struct xwidget *xw = XXWIDGET (xwidget); -#ifdef USE_GTK - if (xw->widget_osr && xw->widgetwindow_osr) - { - gtk_widget_destroy (xw->widget_osr); - gtk_widget_destroy (xw->widgetwindow_osr); - } - if (!NILP (xw->script_callbacks)) - for (ptrdiff_t idx = 0; idx < ASIZE (xw->script_callbacks); idx++) - { - Lisp_Object cb = AREF (xw->script_callbacks, idx); - if (!NILP (cb)) - xfree (xmint_pointer (XCAR (cb))); - ASET (xw->script_callbacks, idx, Qnil); - } -#elif defined NS_IMPL_COCOA - nsxwidget_kill (xw); -#endif + + kill_xwidget (xw); } } + + catch_child_signal (); } diff --git a/src/xwidget.h b/src/xwidget.h index f4c63be3e28..502beb67650 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -32,11 +32,21 @@ struct window; #if defined (USE_GTK) #include <gtk/gtk.h> +#ifndef HAVE_PGTK +#include <X11/Xlib.h> +#include "xterm.h" +#else +#include "pgtkterm.h" +#endif #elif defined (NS_IMPL_COCOA) && defined (__OBJC__) #import <AppKit/NSView.h> #import "nsxwidget.h" #endif +#ifdef HAVE_XINPUT2 +#include <X11/extensions/XInput2.h> +#endif + struct xwidget { union vectorlike_header header; @@ -59,11 +69,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. */ @@ -97,10 +112,28 @@ struct xwidget_view /* The "live" instance isn't drawn. */ bool hidden; + enum glyph_row_area area; + #if defined (USE_GTK) +#ifndef HAVE_PGTK + Display *dpy; + Window wdesc; + + GdkWindow *last_crossing_window; + guint last_crossing_cursor_signal; + GtkWidget *passive_grab; + guint passive_grab_destruction_signal; + guint passive_grab_drag_signal; +#else + struct pgtk_display_info *dpyinfo; GtkWidget *widget; - GtkWidget *widgetwindow; - GtkWidget *emacswindow; +#endif + Emacs_Cursor cursor; + struct frame *frame; + + cairo_surface_t *cr_surface; + cairo_t *cr_context; + int just_resized; #elif defined (NS_IMPL_COCOA) # ifdef __OBJC__ XvWindow *xvWindow; @@ -127,9 +160,16 @@ struct xwidget_view #define XXWIDGET(a) (eassert (XWIDGETP (a)), \ XUNTAG (a, Lisp_Vectorlike, struct xwidget)) +#define XWIDGET_LIVE_P(w) (!NILP ((w)->buffer)) + #define CHECK_XWIDGET(x) \ CHECK_TYPE (XWIDGETP (x), Qxwidgetp, x) +#define CHECK_LIVE_XWIDGET(x) \ + CHECK_TYPE ((XWIDGETP (x) \ + && XWIDGET_LIVE_P (XXWIDGET (x))), \ + Qxwidget_live_p, x) + /* Test for xwidget_view pseudovector. */ #define XWIDGET_VIEW_P(x) PSEUDOVECTORP (x, PVEC_XWIDGET_VIEW) #define XXWIDGET_VIEW(a) (eassert (XWIDGET_VIEW_P (a)), \ @@ -162,6 +202,32 @@ 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 lower_frame_xwidget_views (struct frame *f); +#endif +#ifndef NS_IMPL_COCOA +extern void kill_frame_xwidget_views (struct frame *f); +#endif +#ifdef HAVE_X_WINDOWS +extern void xwidget_button (struct xwidget_view *, bool, int, + int, int, int, Time); +extern void xwidget_motion_or_crossing (struct xwidget_view *, + const XEvent *); +#ifdef HAVE_XINPUT2 +extern void xwidget_motion_notify (struct xwidget_view *, double, + double, double, double, uint, Time); +extern void xwidget_scroll (struct xwidget_view *, double, double, + double, double, uint, Time, bool); +#ifdef HAVE_XINPUT2_4 +extern void xwidget_pinch (struct xwidget_view *, XIGesturePinchEvent *); +#endif +#endif +#endif #else INLINE_HEADER_BEGIN INLINE void syms_of_xwidget (void) {} |